{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}

{- |
Module      :  Google.Type

Define basic data types.
-}
module Google.Type
  ( FileId(..)
  , MediaType(..)
  , MediaContent(..)
  , Metadata(..)
  , Arbitrary
  , Multipart
  , ConversionFormat(..)
  , SortKey(..)
  , QueryString(..)
  , Order(..)
  , LabelId(..)
  ) where

import Data.Aeson.TH (Options(..), defaultOptions, deriveJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Char (toLower)
import Data.List.NonEmpty (NonEmpty((:|)))
#if !MIN_VERSION_base(4, 11, 0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text, intercalate)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Network.HTTP.Media ((//), (/:))
import qualified Network.HTTP.Media as Media
import Servant.API (Accept(..), MimeUnrender(..))
import Web.HttpApiData (ToHttpApiData(..), toUrlPieces)


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

deriveJSON defaultOptions {unwrapUnaryRecords = True} ''FileId


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

deriveJSON defaultOptions {unwrapUnaryRecords = True} ''MediaType


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


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

deriveJSON defaultOptions ''Metadata


data Arbitrary

instance Accept Arbitrary where
  contentTypes :: Proxy Arbitrary -> NonEmpty MediaType
contentTypes Proxy Arbitrary
_ =
    ConversionFormat -> MediaType
fromFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ConversionFormat
FormatHtml forall a. a -> [a] -> NonEmpty a
:|
        [ ConversionFormat
FormatHtmlZipped
        , ConversionFormat
FormatPlainText
        , ConversionFormat
FormatRichText
        , ConversionFormat
FormatOpenOfficeDoc
        , ConversionFormat
FormatPdf
        , ConversionFormat
FormatMsWordDoc
        , ConversionFormat
FormatEpub
        ]

instance MimeUnrender Arbitrary MediaContent where
  mimeUnrender :: Proxy Arbitrary -> ByteString -> Either String MediaContent
mimeUnrender Proxy Arbitrary
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MediaContent
MediaContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict


data Multipart

instance Accept Multipart where
  contentType :: Proxy Multipart -> MediaType
contentType Proxy Multipart
_ = ByteString
"multipart" ByteString -> ByteString -> MediaType
// ByteString
"related" MediaType -> (ByteString, ByteString) -> MediaType
/: (ByteString
"boundary", ByteString
"314159265358979323846")


-- https://developers.google.com/drive/api/v3/ref-export-formats
data ConversionFormat
  = FormatHtml
  | FormatHtmlZipped
  | FormatPlainText
  | FormatRichText
  | FormatOpenOfficeDoc
  | FormatPdf
  | FormatMsWordDoc
  | FormatEpub
  | FormatMsExcel
  | FormatOpenOfficeSheet
  | FormatCsv
  | FormatTsv
  | FormatJpeg
  | FormatPng
  | FormatSvg
  | FormatMsPowerPoint
  | FormatMsOfficePresentation
  | FormatJson
  deriving (ConversionFormat -> ConversionFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConversionFormat -> ConversionFormat -> Bool
$c/= :: ConversionFormat -> ConversionFormat -> Bool
== :: ConversionFormat -> ConversionFormat -> Bool
$c== :: ConversionFormat -> ConversionFormat -> Bool
Eq, forall x. Rep ConversionFormat x -> ConversionFormat
forall x. ConversionFormat -> Rep ConversionFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConversionFormat x -> ConversionFormat
$cfrom :: forall x. ConversionFormat -> Rep ConversionFormat x
Generic, Int -> ConversionFormat -> ShowS
[ConversionFormat] -> ShowS
ConversionFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversionFormat] -> ShowS
$cshowList :: [ConversionFormat] -> ShowS
show :: ConversionFormat -> String
$cshow :: ConversionFormat -> String
showsPrec :: Int -> ConversionFormat -> ShowS
$cshowsPrec :: Int -> ConversionFormat -> ShowS
Show, Typeable)

fromFormat :: ConversionFormat -> Media.MediaType
fromFormat :: ConversionFormat -> MediaType
fromFormat ConversionFormat
FormatHtml                 = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"html"
fromFormat ConversionFormat
FormatHtmlZipped           = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"zip"
fromFormat ConversionFormat
FormatPlainText            = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"plain"
fromFormat ConversionFormat
FormatRichText             = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"rtf"
fromFormat ConversionFormat
FormatOpenOfficeDoc        = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.oasis.opendocument.text"
fromFormat ConversionFormat
FormatPdf                  = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"pdf"
fromFormat ConversionFormat
FormatMsWordDoc            = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.openxmlformats-officedocument.wordprocessingml.document"
fromFormat ConversionFormat
FormatEpub                 = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"epub+zip"
fromFormat ConversionFormat
FormatMsExcel              = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.openxmlformats-officedocument.spreadsheetml.sheet"
fromFormat ConversionFormat
FormatOpenOfficeSheet      = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"x-vnd.oasis.opendocument.spreadsheet"
fromFormat ConversionFormat
FormatCsv                  = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"csv"
fromFormat ConversionFormat
FormatTsv                  = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"tab-separated-values"
fromFormat ConversionFormat
FormatJpeg                 = ByteString
"image" ByteString -> ByteString -> MediaType
// ByteString
"jpeg"
fromFormat ConversionFormat
FormatPng                  = ByteString
"image" ByteString -> ByteString -> MediaType
// ByteString
"png"
fromFormat ConversionFormat
FormatSvg                  = ByteString
"image" ByteString -> ByteString -> MediaType
// ByteString
"svg+xml"
fromFormat ConversionFormat
FormatMsPowerPoint         = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.openxmlformats-officedocument.presentationml.presentation"
fromFormat ConversionFormat
FormatMsOfficePresentation = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.openxmlformavnd.oasis.opendocument.presentation"
fromFormat ConversionFormat
FormatJson                 = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.google-apps.script+json"

instance ToHttpApiData ConversionFormat where
  toUrlPiece :: ConversionFormat -> Text
toUrlPiece = forall a. ToHttpApiData a => a -> Text
toUrlPiece forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionFormat -> MediaType
fromFormat


data SortKey
  = CreatedTime
  | Folder
  | ModifiedByMeTime
  | ModifiedTime
  | Name
  | NameNatural
  | QuotaBytesUsed
  | Recency
  | SsharedWithMeTime
  | Starred
  | ViewedByMeTime
  deriving (SortKey -> SortKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortKey -> SortKey -> Bool
$c/= :: SortKey -> SortKey -> Bool
== :: SortKey -> SortKey -> Bool
$c== :: SortKey -> SortKey -> Bool
Eq, forall x. Rep SortKey x -> SortKey
forall x. SortKey -> Rep SortKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SortKey x -> SortKey
$cfrom :: forall x. SortKey -> Rep SortKey x
Generic, Int -> SortKey -> ShowS
[SortKey] -> ShowS
SortKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortKey] -> ShowS
$cshowList :: [SortKey] -> ShowS
show :: SortKey -> String
$cshow :: SortKey -> String
showsPrec :: Int -> SortKey -> ShowS
$cshowsPrec :: Int -> SortKey -> ShowS
Show, Typeable)

instance ToHttpApiData SortKey where
  toUrlPiece :: SortKey -> Text
toUrlPiece SortKey
NameNatural = Text
"name_natural"
  toUrlPiece SortKey
key         = forall a. ToHttpApiData a => a -> Text
toUrlPiece forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
headToLower forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SortKey
key
    where
      headToLower :: String -> String
      headToLower :: ShowS
headToLower [] = []
      headToLower (Char
x : String
xs) = Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: String
xs


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

deriveJSON defaultOptions {unwrapUnaryRecords = True} ''QueryString


data Order
  = Asc SortKey
  | Desc SortKey
  deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, forall x. Rep Order x -> Order
forall x. Order -> Rep Order x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Order x -> Order
$cfrom :: forall x. Order -> Rep Order x
Generic, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, Typeable)

instance ToHttpApiData Order where
  toUrlPiece :: Order -> Text
toUrlPiece (Asc SortKey
key)  = forall a. ToHttpApiData a => a -> Text
toUrlPiece SortKey
key
  toUrlPiece (Desc SortKey
key) = forall a. ToHttpApiData a => a -> Text
toUrlPiece SortKey
key forall a. Semigroup a => a -> a -> a
<> Text
" desc"

instance ToHttpApiData [Order] where
  toUrlPiece :: [Order] -> 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 LabelId = LabelId Text
  deriving (LabelId -> LabelId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelId -> LabelId -> Bool
$c/= :: LabelId -> LabelId -> Bool
== :: LabelId -> LabelId -> Bool
$c== :: LabelId -> LabelId -> Bool
Eq, forall x. Rep LabelId x -> LabelId
forall x. LabelId -> Rep LabelId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LabelId x -> LabelId
$cfrom :: forall x. LabelId -> Rep LabelId x
Generic, Int -> LabelId -> ShowS
[LabelId] -> ShowS
LabelId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelId] -> ShowS
$cshowList :: [LabelId] -> ShowS
show :: LabelId -> String
$cshow :: LabelId -> String
showsPrec :: Int -> LabelId -> ShowS
$cshowsPrec :: Int -> LabelId -> ShowS
Show, Typeable, LabelId -> Builder
LabelId -> ByteString
LabelId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: LabelId -> Text
$ctoQueryParam :: LabelId -> Text
toHeader :: LabelId -> ByteString
$ctoHeader :: LabelId -> ByteString
toEncodedUrlPiece :: LabelId -> Builder
$ctoEncodedUrlPiece :: LabelId -> Builder
toUrlPiece :: LabelId -> Text
$ctoUrlPiece :: LabelId -> Text
ToHttpApiData)

instance ToHttpApiData [LabelId] where
  toUrlPiece :: [LabelId] -> 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