245 lines
6.5 KiB
Haskell
245 lines
6.5 KiB
Haskell
{-# 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)
|
||
|
||
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
|
||
| ExternalSource MetaLink
|
||
deriving (Show, Generic, FromJSON, ToJSON)
|
||
|
||
data Stream = Stream
|
||
{ details :: StreamDetails,
|
||
source :: StreamSource
|
||
}
|
||
deriving (Show, Generic, FromJSON, ToJSON)
|
||
|
||
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
|