aboutsummaryrefslogtreecommitdiff
path: root/src/Tomato/Data/Tomato.hs
blob: e74f9654ed187996c79f234490daf51e9af4b854 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
module Tomato.Data.Tomato
    ( Links (..)
    , Tomato (..)
    , Urls (..)
    ) where

import RIO

import Data.Aeson ((.:), (.:!))
import Network.HTTP.Req (Url, Scheme (Https), useHttpsURI)

import qualified Data.Aeson as Ae
import qualified Data.Aeson.Types as Ae
import qualified Text.URI as URI


data Tomato = Tomato
    { id          :: !Text
    , width       :: !Word
    , height      :: !Word
    , color       :: !Text
    , blur_hash   :: !Text
    , description :: !(Maybe Text)
    , urls        :: !Urls
    , links       :: !Links
    } deriving Show

instance Ae.FromJSON Tomato where
    parseJSON = Ae.withObject "Tomato" $ \o -> Tomato
        <$> o .: "id"
        <*> o .: "width"
        <*> o .: "height"
        <*> o .: "color"
        <*> o .: "blur_hash"
        <*> o .:! "description"
        <*> o .: "urls"
        <*> o .: "links"

data Links = Links
    { self              :: !(Url Https)
    , html              :: !(Url Https)
    , download          :: !(Url Https)
    , download_location :: !(Url Https)
    } deriving Show

instance Ae.FromJSON Links where
    parseJSON = Ae.withObject "Links" $ \o -> Links
        <$> (o .: "self" >>= toUrl)
        <*> (o .: "html" >>= toUrl)
        <*> (o .: "download" >>= toUrl)
        <*> (o .: "download_location" >>= toUrl)

data Urls = Urls
    { raw     :: !(Url Https)
    , full    :: !(Url Https)
    , regular :: !(Url Https)
    , small   :: !(Url Https)
    , thumb   :: !(Url Https)
    } deriving Show

instance Ae.FromJSON Urls where
    parseJSON = Ae.withObject "Urls" $ \o -> Urls
        <$> (o .: "raw" >>= toUrl)
        <*> (o .: "full" >>= toUrl)
        <*> (o .: "regular" >>= toUrl)
        <*> (o .: "small" >>= toUrl)
        <*> (o .: "thumb" >>= toUrl)

toUrl :: Text -> Ae.Parser (Url Https)
toUrl t = maybe mzero pure $ fmap fst $ useHttpsURI =<< URI.mkURI t