diff options
Diffstat (limited to 'src/Tomato/Data')
| -rw-r--r-- | src/Tomato/Data/Except.hs | 9 | ||||
| -rw-r--r-- | src/Tomato/Data/Message.hs | 81 | ||||
| -rw-r--r-- | src/Tomato/Data/Tomato.hs | 70 | 
3 files changed, 160 insertions, 0 deletions
diff --git a/src/Tomato/Data/Except.hs b/src/Tomato/Data/Except.hs new file mode 100644 index 0000000..30212cf --- /dev/null +++ b/src/Tomato/Data/Except.hs @@ -0,0 +1,9 @@ +module Tomato.Data.Except +    ( DecodeException (..) +    ) where + +import RIO + +data DecodeException = DecodeException !Text +  deriving (Show, Typeable) +instance Exception DecodeException diff --git a/src/Tomato/Data/Message.hs b/src/Tomato/Data/Message.hs new file mode 100644 index 0000000..0f650db --- /dev/null +++ b/src/Tomato/Data/Message.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DeriveGeneric #-} +module Tomato.Data.Message +    ( InMessage (..) +    , GMIUrl (..) +    , OutMessage (..) +    ) where + +import RIO + +import Data.Aeson ((.:), (.=)) +import Network.HTTP.Req +    ( Url +    , Scheme (Https) +    , useHttpsURI +    , renderUrl +    ) + +import qualified Data.Aeson as Ae +import qualified Data.Aeson.Types as Ae +import qualified RIO.Vector as V +import qualified Text.URI as URI + +data InMessage = InMessage +    { hasAttach :: !Bool +    , groupId   :: !Text +    , isUser    :: !Bool +    , text      :: !Text +    } deriving (Show, Generic) + +instance NFData InMessage + +instance Ae.FromJSON InMessage where +    parseJSON = Ae.withObject "InMessage" $ \o -> InMessage +        <$> (o .: "attachments" >>= Ae.withArray "attachments" (pure . not . null)) +        <*> o .: "group_id" +        <*> ((==) ("user" :: Text) <$> o .: "sender_type") +        <*> o .: "text" + + +newtype GMIUrl = GMIUrl +    { unGMIUrl :: Url Https +    } deriving Show + +instance Ae.FromJSON GMIUrl where +    parseJSON = Ae.withObject "payload" $ \o -> do +        p <- o .: "payload" +        u <- p .: "url" +        GMIUrl <$> toUrl u +      where +        toUrl :: Text -> Ae.Parser (Url Https) +        toUrl t = maybe mzero pure $ fmap fst $ useHttpsURI =<< URI.mkURI t + +data OutMessage = OutMessage +    { image :: !GMIUrl +    } deriving Show + +instance Ae.ToJSON OutMessage where +    toJSON om = Ae.object +        [ "attachments" .= +            ( Ae.Array $ V.singleton attach ) +        -- , "bot_id" .= botId +        ] +      where +        attach :: Ae.Value +        attach = Ae.object +            [ "type" .= ("image" :: Text) +            , "url"  .= url +            ] +        url :: Text +        url = renderUrl $ unGMIUrl $ image om + +  -- { +  -- "bot_id"  : "j5abcdefg", +  -- "text"    : "Hello world", +  -- "attachments" : [ +  --   { +  --     "type"  : "image", +  --     "url"   : "https://i.groupme.com/somethingsomething.large" +  --   } +  -- ] +-- } diff --git a/src/Tomato/Data/Tomato.hs b/src/Tomato/Data/Tomato.hs new file mode 100644 index 0000000..4b75adf --- /dev/null +++ b/src/Tomato/Data/Tomato.hs @@ -0,0 +1,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 :: !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  | 
