parse meta

This commit is contained in:
senstella
2025-11-04 16:10:05 +09:00
parent de13e895c8
commit a2ca530a14
2 changed files with 99 additions and 14 deletions

View File

@@ -2,19 +2,30 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Char (isDigit, toLower)
import Data.Text (pack, splitOn, unpack)
import Data.Time import Data.Time
import GHC.Generics import GHC.Generics
import Text.Read (readMaybe)
data ContentType data ContentType
= Movie = Movie
| Series | Series
| Channel | Channel
| Tv | Tv
deriving (Show, Eq, Generic, FromJSON, ToJSON) 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 ContentID = ContentID String deriving (Show, Eq, Generic, FromJSON, ToJSON)
@@ -28,18 +39,54 @@ newtype BingeGroup = BingeGroup String deriving (Show, Eq, Generic, FromJSON, To
newtype OpensubtitleHash = OpensubtitleHash 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, FromJSON, ToJSON) data ImageShape = Square | Poster | Landscape deriving (Show, Eq, Generic)
data YearInfo = Single Int | Range Int Int deriving (Show, Eq, Generic, FromJSON, ToJSON) instance ToJSON ImageShape where
toJSON = genericToJSON lowercaseSumtypeOptions
data Language = Language String deriving (Show, Eq, Generic, FromJSON, ToJSON) instance FromJSON ImageShape where
parseJSON = genericParseJSON lowercaseSumtypeOptions
data Trailer = Trailer String | Clip String deriving (Show, Eq, Generic, FromJSON, ToJSON) 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 data MetaLink
= MetaLink = MetaLink
{ name :: String, { name :: String,
category :: [String], category :: String,
url :: Url url :: Url
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, FromJSON, ToJSON)
@@ -51,8 +98,8 @@ data StreamDetails = StreamDetails
subtitles :: Maybe [Subtitle], subtitles :: Maybe [Subtitle],
-- we arent doing soruces cuz no torrent for now -- we arent doing soruces cuz no torrent for now
bingeGroup :: Maybe BingeGroup, bingeGroup :: Maybe BingeGroup,
vContentIDeoHash :: Maybe OpensubtitleHash, videoHash :: Maybe OpensubtitleHash,
vContentIDeoSize :: Maybe Int, videoSize :: Maybe Int,
filename :: Maybe String filename :: Maybe String
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, FromJSON, ToJSON)
@@ -70,9 +117,9 @@ data Stream = Stream
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, FromJSON, ToJSON)
data Video = VContentIDeo data Video = Video
{ id :: ContentID, { id :: ContentID,
title :: String, name :: String,
released :: UTCTime, released :: UTCTime,
thumbnail :: Maybe Url, thumbnail :: Maybe Url,
streams :: Maybe [Stream], streams :: Maybe [Stream],
@@ -138,16 +185,43 @@ data MetaData = Meta
released :: Maybe UTCTime, released :: Maybe UTCTime,
trailers :: Maybe [Trailer], trailers :: Maybe [Trailer],
links :: Maybe [MetaLink], links :: Maybe [MetaLink],
video :: Maybe [Video], videos :: Maybe [Video],
runtime :: Maybe String, runtime :: Maybe String,
language :: Maybe String, language :: Maybe String,
country :: Maybe String, country :: Maybe String,
awards :: Maybe String, awards :: Maybe String,
website :: Maybe Url website :: Maybe Url
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, ToJSON)
data Catalog = Catalog {} deriving (Show, Generic, FromJSON, 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 data Subtitle = Subtitle
{ id :: SubtitleID, { id :: SubtitleID,
@@ -156,5 +230,15 @@ data Subtitle = Subtitle
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, FromJSON, ToJSON)
lowercaseSumtypeOptions :: Options
lowercaseSumtypeOptions =
defaultOptions
{ constructorTagModifier = Prelude.map toLower
}
main :: IO () main :: IO ()
main = putStrLn "Hello, Haskell!" main = do
putStrLn "Hello, Haskell!"
a <- readFile "./test.json"
let test = decodeStrictText (pack a) :: Maybe MetaData
print test

View File

@@ -56,6 +56,7 @@ executable popcorn
aeson, aeson,
base ^>=4.17.2.1, base ^>=4.17.2.1,
time, time,
text
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: app hs-source-dirs: app