{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} module Main where import Data.Aeson import Data.Aeson.Types (Parser) import Data.Char (isDigit, toLower) import Data.Text (pack, splitOn, unpack) import Data.Time import GHC.Generics import Text.Read (readMaybe) import Control.Applicative (asum) data ContentType = Movie | Series | Channel | Tv deriving (Show, Eq, Generic) instance ToJSON ContentType where toJSON = genericToJSON lowercaseSumtypeOptions instance FromJSON ContentType where parseJSON = genericParseJSON lowercaseSumtypeOptions newtype ContentID = ContentID String deriving (Show, Eq, Generic, FromJSON, ToJSON) newtype SubtitleID = SubtitleID String deriving (Show, Eq, Generic, FromJSON, ToJSON) newtype ContentIDPrefix = ContentIDPrefix String deriving (Show, Eq, Generic, FromJSON, ToJSON) newtype Url = Url String deriving (Show, Eq, Generic, FromJSON, ToJSON) newtype BingeGroup = BingeGroup String deriving (Show, Eq, Generic, FromJSON, ToJSON) newtype OpensubtitleHash = OpensubtitleHash String deriving (Show, Eq, Generic, FromJSON, ToJSON) data ImageShape = Square | Poster | Landscape deriving (Show, Eq, Generic) instance ToJSON ImageShape where toJSON = genericToJSON lowercaseSumtypeOptions instance FromJSON ImageShape where parseJSON = genericParseJSON lowercaseSumtypeOptions data YearInfo = SingleYear Int | RangeYear Int Int deriving (Show, Eq, Generic, ToJSON) instance FromJSON YearInfo where parseJSON = withText "YearInfo" $ \t -> do let str = unpack t numbers = filter isDigit str ( if '–' `elem` str then ( let parts = splitOn "–" t in case parts of [start, end] -> case (readMaybe (unpack start), readMaybe (unpack end)) of (Just s, Just e) -> pure $ RangeYear s e _ -> fail "invalid format" _ -> fail "no two numbers" ) else ( case readMaybe numbers of Just year -> pure $ SingleYear year Nothing -> fail "invalid" ) ) newtype Language = Language String deriving (Show, Eq, Generic, FromJSON, ToJSON) data Trailer = Trailer String | Clip String deriving (Show, Eq, Generic, ToJSON) instance FromJSON Trailer where parseJSON (Object v) = do t <- v .: "type" :: Parser String src <- v .: "source" case t of "Trailer" -> pure $ Trailer src "Clip" -> pure $ Clip src _ -> fail "wrong type" parseJSON _ = fail "trailer invalid" data MetaLink = MetaLink { name :: String, category :: String, url :: Url } deriving (Show, Generic, FromJSON, ToJSON) data StreamDetails = StreamDetails { name :: Maybe String, title :: Maybe String, description :: Maybe String, subtitles :: Maybe [Subtitle], -- we arent doing soruces cuz no torrent for now bingeGroup :: Maybe BingeGroup, videoHash :: Maybe OpensubtitleHash, videoSize :: Maybe Int, filename :: Maybe String } deriving (Show, Generic, FromJSON, ToJSON) data StreamSource = UrlSource Url | YoutubeSource String | TorrentSource String Int | ExternalSource MetaLink deriving (Show, Generic, FromJSON, ToJSON) data Stream = Stream { details :: StreamDetails, source :: StreamSource } deriving (Show, Generic, ToJSON) instance FromJSON Stream where parseJSON (Object v) = Stream <$> streamDetails <*> streamSource where behaviorHints = v .: "behaviorHints" behaviorHints :: Parser Object streamDetails = StreamDetails <$> v .: "name" <*> v .: "title" <*> v .: "description" <*> v .: "subtitles" <*> (behaviorHints >>= (.: "bingeGroup")) <*> (behaviorHints >>= (.: "videoHash")) <*> (behaviorHints >>= (.: "videoSize")) <*> (behaviorHints >>= (.: "filename")) streamSource = asum [ UrlSource <$> v .: "url", YoutubeSource <$> v.: "ytId", ExternalSource <$> v .: "externalUrl", TorrentSource <$> v .: "infoHash" <*> v .: "fileIdx"] parseJSON _ = fail "expected an object" data Video = Video { id :: ContentID, name :: String, released :: UTCTime, thumbnail :: Maybe Url, streams :: Maybe [Stream], available :: Maybe Bool, -- or maybe just bool is fine episode :: Maybe Int, season :: Maybe Int, trailers :: Maybe [Stream], overview :: Maybe String } deriving (Show, Generic, FromJSON, ToJSON) data Feature = Search { required :: Bool, options :: Maybe [ContentIDPrefix], optionsLimit :: Maybe Int } | Genre { required :: Bool, options :: Maybe [ContentIDPrefix], optionsLimit :: Maybe Int } | Skip deriving (Show, Generic, FromJSON, ToJSON) data Resource a where MetaResource :: { metaTypes :: [ContentType], metaContentIDPrefix :: [ContentIDPrefix] } -> Resource MetaData CatalogResource :: { catalogTypes :: [ContentType], catalogContentIDPrefix :: [ContentIDPrefix], catalogExtra :: [Feature] } -> Resource Catalog StreamResource :: { streamTypes :: [ContentType], streamContentIDPrefix :: [ContentIDPrefix] } -> Resource Stream SubtitleResource :: { subtitleTypes :: [ContentType], subtitleContentIDPrefix :: [ContentIDPrefix] } -> Resource Subtitle data MetaData = Meta { id :: ContentID, contentType :: ContentType, name :: String, genres :: Maybe [String], poster :: Maybe Url, posterShape :: Maybe ImageShape, background :: Maybe Url, logo :: Maybe Url, description :: Maybe String, releaseInfo :: Maybe YearInfo, director :: Maybe [String], cast :: Maybe [String], imdbRating :: Maybe Float, released :: Maybe UTCTime, trailers :: Maybe [Trailer], links :: Maybe [MetaLink], videos :: Maybe [Video], runtime :: Maybe String, language :: Maybe String, country :: Maybe String, awards :: Maybe String, website :: Maybe Url } deriving (Show, Generic, ToJSON) instance FromJSON MetaData where parseJSON (Object v) = Meta <$> v .: "id" <*> v .: "type" <*> v .: "name" <*> v .:? "genres" <*> v .:? "poster" <*> v .:? "posterShape" <*> v .:? "background" <*> v .:? "logo" <*> v .:? "description" <*> v .:? "releaseInfo" <*> v .:? "director" <*> v .:? "cast" <*> (fmap (>>= readMaybe) (v .:? "imdbRating") :: Parser (Maybe Float)) <*> v .:? "released" <*> v .:? "trailers" <*> v .:? "links" <*> v .:? "videos" <*> v .:? "runtime" <*> v .:? "language" <*> v .:? "country" <*> v .:? "awards" <*> v .:? "website" parseJSON _ = fail "Expected an Object for MetaData" newtype Catalog = Catalog [MetaData] deriving (Show, Generic, FromJSON, ToJSON) data Subtitle = Subtitle { id :: SubtitleID, url :: Url, language :: Language } deriving (Show, Generic, FromJSON, ToJSON) lowercaseSumtypeOptions :: Options lowercaseSumtypeOptions = defaultOptions { constructorTagModifier = Prelude.map toLower } main :: IO () main = do putStrLn "Hello, Haskell!" a <- readFile "./test.json" let test = decodeStrictText (pack a) :: Maybe MetaData print test