{-# LANGUAGE TemplateHaskell #-}

{- |
Module      :  Google.Response

Define data types to represent all of the responses that are received from the Google API.
-}
module Google.Response
  ( Token(..)
  , Account(..)
  , DateTime(..)
  , ZonedDateTime(..)
  , CalendarEvent(..)
  , CalendarEventList(..)
  , GmailSend(..)
  , GmailList(..)
  , GmailMessage(..)
  , ExtendedProperties(..)
  , FileResource(..)
  , FileList(..)
  , MediaContent(..)
  ) where

import Data.Aeson (FromJSON(..), (.:?), withObject)
import Data.Aeson.Casing (snakeCase)
import Data.Aeson.TH (Options(..), defaultOptions, deriveFromJSON, deriveJSON)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Text (Text, intercalate, splitOn)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Web.FormUrlEncoded (FromForm, ToForm)
import Data.Time.Clock (UTCTime)
import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC)
import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..), parseUrlPieces, toUrlPieces)

import Google.Type (FileId, MediaType, MediaContent(..))


data Token = Token
  { Token -> Text
accessToken :: Text
  , Token -> Text
tokenType :: Text
  , Token -> Int
expiresIn :: Int
  } deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Typeable)

deriveJSON (defaultOptions {fieldLabelModifier = snakeCase}) ''Token

instance FromForm Token

instance ToForm Token

newtype Account = Account
  { Account -> Text
email :: Text
  } deriving (Account -> Account -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, Typeable, ByteString -> Either Text Account
Text -> Either Text Account
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text Account
$cparseQueryParam :: Text -> Either Text Account
parseHeader :: ByteString -> Either Text Account
$cparseHeader :: ByteString -> Either Text Account
parseUrlPiece :: Text -> Either Text Account
$cparseUrlPiece :: Text -> Either Text Account
FromHttpApiData, Account -> Builder
Account -> ByteString
Account -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Account -> Text
$ctoQueryParam :: Account -> Text
toHeader :: Account -> ByteString
$ctoHeader :: Account -> ByteString
toEncodedUrlPiece :: Account -> Builder
$ctoEncodedUrlPiece :: Account -> Builder
toUrlPiece :: Account -> Text
$ctoUrlPiece :: Account -> Text
ToHttpApiData)

deriveJSON defaultOptions ''Account

instance FromHttpApiData [Account] where
  parseUrlPiece :: Text -> Either Text [Account]
parseUrlPiece = forall (t :: * -> *) a.
(Traversable t, FromHttpApiData a) =>
t Text -> Either Text (t a)
parseUrlPieces forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> [Text]
splitOn Text
",")

instance ToHttpApiData [Account] where
  toUrlPiece :: [Account] -> Text
toUrlPiece = (Text -> [Text] -> Text
intercalate Text
",") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
(Functor t, ToHttpApiData a) =>
t a -> t Text
toUrlPieces


newtype DateTime = DateTime
  { DateTime -> UTCTime
dateTime :: UTCTime
  } deriving (DateTime -> DateTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateTime -> DateTime -> Bool
$c/= :: DateTime -> DateTime -> Bool
== :: DateTime -> DateTime -> Bool
$c== :: DateTime -> DateTime -> Bool
Eq, forall x. Rep DateTime x -> DateTime
forall x. DateTime -> Rep DateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateTime x -> DateTime
$cfrom :: forall x. DateTime -> Rep DateTime x
Generic, Int -> DateTime -> ShowS
[DateTime] -> ShowS
DateTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateTime] -> ShowS
$cshowList :: [DateTime] -> ShowS
show :: DateTime -> String
$cshow :: DateTime -> String
showsPrec :: Int -> DateTime -> ShowS
$cshowsPrec :: Int -> DateTime -> ShowS
Show, Typeable, ByteString -> Either Text DateTime
Text -> Either Text DateTime
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text DateTime
$cparseQueryParam :: Text -> Either Text DateTime
parseHeader :: ByteString -> Either Text DateTime
$cparseHeader :: ByteString -> Either Text DateTime
parseUrlPiece :: Text -> Either Text DateTime
$cparseUrlPiece :: Text -> Either Text DateTime
FromHttpApiData, DateTime -> Builder
DateTime -> ByteString
DateTime -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: DateTime -> Text
$ctoQueryParam :: DateTime -> Text
toHeader :: DateTime -> ByteString
$ctoHeader :: DateTime -> ByteString
toEncodedUrlPiece :: DateTime -> Builder
$ctoEncodedUrlPiece :: DateTime -> Builder
toUrlPiece :: DateTime -> Text
$ctoUrlPiece :: DateTime -> Text
ToHttpApiData)

deriveJSON defaultOptions ''DateTime


newtype ZonedDateTime = ZonedDateTime
  { ZonedDateTime -> Maybe ZonedTime
dateTime :: Maybe ZonedTime
  } deriving (forall x. Rep ZonedDateTime x -> ZonedDateTime
forall x. ZonedDateTime -> Rep ZonedDateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ZonedDateTime x -> ZonedDateTime
$cfrom :: forall x. ZonedDateTime -> Rep ZonedDateTime x
Generic, Int -> ZonedDateTime -> ShowS
[ZonedDateTime] -> ShowS
ZonedDateTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZonedDateTime] -> ShowS
$cshowList :: [ZonedDateTime] -> ShowS
show :: ZonedDateTime -> String
$cshow :: ZonedDateTime -> String
showsPrec :: Int -> ZonedDateTime -> ShowS
$cshowsPrec :: Int -> ZonedDateTime -> ShowS
Show, Typeable, ByteString -> Either Text ZonedDateTime
Text -> Either Text ZonedDateTime
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text ZonedDateTime
$cparseQueryParam :: Text -> Either Text ZonedDateTime
parseHeader :: ByteString -> Either Text ZonedDateTime
$cparseHeader :: ByteString -> Either Text ZonedDateTime
parseUrlPiece :: Text -> Either Text ZonedDateTime
$cparseUrlPiece :: Text -> Either Text ZonedDateTime
FromHttpApiData, ZonedDateTime -> Builder
ZonedDateTime -> ByteString
ZonedDateTime -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ZonedDateTime -> Text
$ctoQueryParam :: ZonedDateTime -> Text
toHeader :: ZonedDateTime -> ByteString
$ctoHeader :: ZonedDateTime -> ByteString
toEncodedUrlPiece :: ZonedDateTime -> Builder
$ctoEncodedUrlPiece :: ZonedDateTime -> Builder
toUrlPiece :: ZonedDateTime -> Text
$ctoUrlPiece :: ZonedDateTime -> Text
ToHttpApiData)

deriveJSON defaultOptions ''ZonedDateTime

instance Eq ZonedDateTime where
  == :: ZonedDateTime -> ZonedDateTime -> Bool
(==) =
    (\ZonedDateTime
x ZonedDateTime
y ->
      let
        toUTC :: ZonedDateTime -> Maybe UTCTime
        toUTC :: ZonedDateTime -> Maybe UTCTime
toUTC (ZonedDateTime Maybe ZonedTime
z) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC Maybe ZonedTime
z
      in
        (ZonedDateTime -> Maybe UTCTime
toUTC ZonedDateTime
x) forall a. Eq a => a -> a -> Bool
== (ZonedDateTime -> Maybe UTCTime
toUTC ZonedDateTime
y)
    )

data ExtendedProperties = ExtendedProperties
  { ExtendedProperties -> HashMap Text Text
private :: HashMap Text Text
  , ExtendedProperties -> HashMap Text Text
shared :: HashMap Text Text
  } deriving (ExtendedProperties -> ExtendedProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedProperties -> ExtendedProperties -> Bool
$c/= :: ExtendedProperties -> ExtendedProperties -> Bool
== :: ExtendedProperties -> ExtendedProperties -> Bool
$c== :: ExtendedProperties -> ExtendedProperties -> Bool
Eq, forall x. Rep ExtendedProperties x -> ExtendedProperties
forall x. ExtendedProperties -> Rep ExtendedProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtendedProperties x -> ExtendedProperties
$cfrom :: forall x. ExtendedProperties -> Rep ExtendedProperties x
Generic, Int -> ExtendedProperties -> ShowS
[ExtendedProperties] -> ShowS
ExtendedProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedProperties] -> ShowS
$cshowList :: [ExtendedProperties] -> ShowS
show :: ExtendedProperties -> String
$cshow :: ExtendedProperties -> String
showsPrec :: Int -> ExtendedProperties -> ShowS
$cshowsPrec :: Int -> ExtendedProperties -> ShowS
Show, Typeable)

instance FromJSON ExtendedProperties where
  parseJSON :: Value -> Parser ExtendedProperties
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtendedProperties" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    HashMap Text Text -> HashMap Text Text -> ExtendedProperties
ExtendedProperties
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a -> a
fromMaybe forall k v. HashMap k v
HashMap.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a -> a
fromMaybe forall k v. HashMap k v
HashMap.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"shared")

data CalendarEvent = CalendarEvent
  { CalendarEvent -> Text
status :: Text
  , CalendarEvent -> Account
organizer :: Account
  , CalendarEvent -> Account
creator :: Account
  , CalendarEvent -> Maybe [Account]
attendees :: Maybe [Account]
  , CalendarEvent -> Maybe Text
summary :: Maybe Text
  , CalendarEvent -> Maybe Text
description :: Maybe Text
  , CalendarEvent -> Maybe ZonedDateTime
start :: Maybe ZonedDateTime
  , CalendarEvent -> Maybe ZonedDateTime
end :: Maybe ZonedDateTime
  , CalendarEvent -> Maybe ExtendedProperties
extendedProperties :: Maybe ExtendedProperties
  } deriving (CalendarEvent -> CalendarEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarEvent -> CalendarEvent -> Bool
$c/= :: CalendarEvent -> CalendarEvent -> Bool
== :: CalendarEvent -> CalendarEvent -> Bool
$c== :: CalendarEvent -> CalendarEvent -> Bool
Eq, forall x. Rep CalendarEvent x -> CalendarEvent
forall x. CalendarEvent -> Rep CalendarEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalendarEvent x -> CalendarEvent
$cfrom :: forall x. CalendarEvent -> Rep CalendarEvent x
Generic, Int -> CalendarEvent -> ShowS
[CalendarEvent] -> ShowS
CalendarEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarEvent] -> ShowS
$cshowList :: [CalendarEvent] -> ShowS
show :: CalendarEvent -> String
$cshow :: CalendarEvent -> String
showsPrec :: Int -> CalendarEvent -> ShowS
$cshowsPrec :: Int -> CalendarEvent -> ShowS
Show, Typeable)

deriveFromJSON defaultOptions ''CalendarEvent


data CalendarEventList = CalendarEventList
  { CalendarEventList -> Text
kind :: Text
  , CalendarEventList -> Text
summary :: Text
  , CalendarEventList -> [CalendarEvent]
items :: [CalendarEvent]
  } deriving (CalendarEventList -> CalendarEventList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarEventList -> CalendarEventList -> Bool
$c/= :: CalendarEventList -> CalendarEventList -> Bool
== :: CalendarEventList -> CalendarEventList -> Bool
$c== :: CalendarEventList -> CalendarEventList -> Bool
Eq, forall x. Rep CalendarEventList x -> CalendarEventList
forall x. CalendarEventList -> Rep CalendarEventList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalendarEventList x -> CalendarEventList
$cfrom :: forall x. CalendarEventList -> Rep CalendarEventList x
Generic, Int -> CalendarEventList -> ShowS
[CalendarEventList] -> ShowS
CalendarEventList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarEventList] -> ShowS
$cshowList :: [CalendarEventList] -> ShowS
show :: CalendarEventList -> String
$cshow :: CalendarEventList -> String
showsPrec :: Int -> CalendarEventList -> ShowS
$cshowsPrec :: Int -> CalendarEventList -> ShowS
Show, Typeable)

deriveFromJSON defaultOptions ''CalendarEventList


data GmailSend = GmailSend
  { GmailSend -> Text
id :: Text
  } deriving (GmailSend -> GmailSend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailSend -> GmailSend -> Bool
$c/= :: GmailSend -> GmailSend -> Bool
== :: GmailSend -> GmailSend -> Bool
$c== :: GmailSend -> GmailSend -> Bool
Eq, forall x. Rep GmailSend x -> GmailSend
forall x. GmailSend -> Rep GmailSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailSend x -> GmailSend
$cfrom :: forall x. GmailSend -> Rep GmailSend x
Generic, Int -> GmailSend -> ShowS
[GmailSend] -> ShowS
GmailSend -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailSend] -> ShowS
$cshowList :: [GmailSend] -> ShowS
show :: GmailSend -> String
$cshow :: GmailSend -> String
showsPrec :: Int -> GmailSend -> ShowS
$cshowsPrec :: Int -> GmailSend -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''GmailSend

instance FromForm GmailSend

instance ToForm GmailSend

data GmailMessage = GmailMessage
  { GmailMessage -> Text
id :: Text
  , GmailMessage -> Text
threadId :: Text
  , GmailMessage -> Maybe Text
snippet :: Maybe Text
  } deriving (GmailMessage -> GmailMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailMessage -> GmailMessage -> Bool
$c/= :: GmailMessage -> GmailMessage -> Bool
== :: GmailMessage -> GmailMessage -> Bool
$c== :: GmailMessage -> GmailMessage -> Bool
Eq, forall x. Rep GmailMessage x -> GmailMessage
forall x. GmailMessage -> Rep GmailMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailMessage x -> GmailMessage
$cfrom :: forall x. GmailMessage -> Rep GmailMessage x
Generic, Int -> GmailMessage -> ShowS
[GmailMessage] -> ShowS
GmailMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailMessage] -> ShowS
$cshowList :: [GmailMessage] -> ShowS
show :: GmailMessage -> String
$cshow :: GmailMessage -> String
showsPrec :: Int -> GmailMessage -> ShowS
$cshowsPrec :: Int -> GmailMessage -> ShowS
Show, Typeable)
deriveJSON defaultOptions ''GmailMessage

instance FromForm GmailMessage

instance ToForm GmailMessage

data GmailList = GmailList
  { GmailList -> [GmailMessage]
messages :: [GmailMessage]
  } deriving (GmailList -> GmailList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailList -> GmailList -> Bool
$c/= :: GmailList -> GmailList -> Bool
== :: GmailList -> GmailList -> Bool
$c== :: GmailList -> GmailList -> Bool
Eq, forall x. Rep GmailList x -> GmailList
forall x. GmailList -> Rep GmailList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailList x -> GmailList
$cfrom :: forall x. GmailList -> Rep GmailList x
Generic, Int -> GmailList -> ShowS
[GmailList] -> ShowS
GmailList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailList] -> ShowS
$cshowList :: [GmailList] -> ShowS
show :: GmailList -> String
$cshow :: GmailList -> String
showsPrec :: Int -> GmailList -> ShowS
$cshowsPrec :: Int -> GmailList -> ShowS
Show, Typeable)
deriveJSON defaultOptions ''GmailList

data FileResource = FileResource
  { FileResource -> Text
kind :: Text
  , FileResource -> FileId
id :: FileId
  , FileResource -> Text
name :: Text
  , FileResource -> MediaType
mimeType :: MediaType
  } deriving (FileResource -> FileResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileResource -> FileResource -> Bool
$c/= :: FileResource -> FileResource -> Bool
== :: FileResource -> FileResource -> Bool
$c== :: FileResource -> FileResource -> Bool
Eq, forall x. Rep FileResource x -> FileResource
forall x. FileResource -> Rep FileResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileResource x -> FileResource
$cfrom :: forall x. FileResource -> Rep FileResource x
Generic, Int -> FileResource -> ShowS
[FileResource] -> ShowS
FileResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileResource] -> ShowS
$cshowList :: [FileResource] -> ShowS
show :: FileResource -> String
$cshow :: FileResource -> String
showsPrec :: Int -> FileResource -> ShowS
$cshowsPrec :: Int -> FileResource -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''FileResource


data FileList = FileList
  { FileList -> Text
kind :: Text
  , FileList -> [FileResource]
files :: [FileResource]
  } deriving (FileList -> FileList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileList -> FileList -> Bool
$c/= :: FileList -> FileList -> Bool
== :: FileList -> FileList -> Bool
$c== :: FileList -> FileList -> Bool
Eq, forall x. Rep FileList x -> FileList
forall x. FileList -> Rep FileList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileList x -> FileList
$cfrom :: forall x. FileList -> Rep FileList x
Generic, Int -> FileList -> ShowS
[FileList] -> ShowS
FileList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileList] -> ShowS
$cshowList :: [FileList] -> ShowS
show :: FileList -> String
$cshow :: FileList -> String
showsPrec :: Int -> FileList -> ShowS
$cshowsPrec :: Int -> FileList -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''FileList