{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Firestore.Types where

import Control.Lens (makePrisms)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (ToJSON (..))
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics
import Network.Google (MonadGoogle)
import qualified Network.Google.Auth.Scope as Google

type FireStoreScope = '["https://www.googleapis.com/auth/cloud-platform", "https://www.googleapis.com/auth/datastore"]

data Document = Document
  { -- | Don't set it if you want FireStore to generate it for you
    Document -> Maybe Text
name :: Maybe Text,
    Document -> Maybe UTCTime
createTime :: Maybe UTCTime,
    Document -> Maybe UTCTime
updateTime :: Maybe UTCTime,
    Document -> HashMap Text Value
fields :: HM.HashMap Text Value
  }
  deriving (Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
(Int -> Document -> ShowS)
-> (Document -> String) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show, Document -> Document -> Bool
(Document -> Document -> Bool)
-> (Document -> Document -> Bool) -> Eq Document
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Eq, (forall x. Document -> Rep Document x)
-> (forall x. Rep Document x -> Document) -> Generic Document
forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Document x -> Document
$cfrom :: forall x. Document -> Rep Document x
Generic)

data Value
  = GeoPoint Double Double
  | Bytes BS.ByteString
  | Int Integer
  | Timestamp UTCTime
  | Double Double
  | String Text
  | Bool Bool
  | Map (HM.HashMap Text Value)
  | Array [Value]
  | Reference Text
  | Null
  --   Unknown Text
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)

makePrisms ''Value

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON (GeoPoint Double
lat Double
long) = [Double] -> Value
forall a. ToJSON a => a -> Value
toJSON [Double
lat, Double
long]
  toJSON (Bytes ByteString
bs) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString -> String
forall a. Show a => a -> String
show ByteString
bs)
  toJSON (Int Integer
i) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
  toJSON (Timestamp UTCTime
t) = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
t
  toJSON (Double Double
d) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
d
  toJSON (String Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON (Bool Bool
b) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
  toJSON (Map HashMap Text Value
m) = HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap Text Value
m
  toJSON (Array [Value]
xs) = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [Value]
xs
  toJSON (Reference Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON Value
Null = Maybe () -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe ()
forall a. Maybe a
Nothing :: Maybe ())

-- toJSON (Unknown v) = toJSON (show v)

instance ToJSON Document

-- | This is just a convenience monad that allows one to avoid all the gogol machinery.
newtype FireStore a = FireStore
  { FireStore a
-> Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
_action :: Text -> forall m s. (Monad m, MonadGoogle s m, Google.HasScope' s FireStoreScope ~ True) => m a
  }
  deriving (a -> FireStore b -> FireStore a
(a -> b) -> FireStore a -> FireStore b
(forall a b. (a -> b) -> FireStore a -> FireStore b)
-> (forall a b. a -> FireStore b -> FireStore a)
-> Functor FireStore
forall a b. a -> FireStore b -> FireStore a
forall a b. (a -> b) -> FireStore a -> FireStore b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FireStore b -> FireStore a
$c<$ :: forall a b. a -> FireStore b -> FireStore a
fmap :: (a -> b) -> FireStore a -> FireStore b
$cfmap :: forall a b. (a -> b) -> FireStore a -> FireStore b
Functor)

instance Applicative FireStore where
  pure :: a -> FireStore a
pure a
a = (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m a)
 -> FireStore a)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m a)
-> FireStore a
forall a b. (a -> b) -> a -> b
$ m a -> Text -> m a
forall a b. a -> b -> a
const (m a -> Text -> m a) -> m a -> Text -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  FireStore Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m (a -> b)
f <*> :: FireStore (a -> b) -> FireStore a -> FireStore b
<*> FireStore Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
a = (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m b)
-> FireStore b
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m b)
 -> FireStore b)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m b)
-> FireStore b
forall a b. (a -> b) -> a -> b
$ \Text
projectName -> Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m (a -> b)
f Text
projectName m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
a Text
projectName

instance Monad FireStore where
  FireStore Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
f >>= :: FireStore a -> (a -> FireStore b) -> FireStore b
>>= a -> FireStore b
g = (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m b)
-> FireStore b
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m b)
 -> FireStore b)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m b)
-> FireStore b
forall a b. (a -> b) -> a -> b
$ \Text
projectName ->
    do
      a
f' <- Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
f Text
projectName
      FireStore b
-> Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m b
forall a.
FireStore a
-> Text
-> forall (m :: * -> *) (s :: [Symbol]).
   (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
   m a
_action (a -> FireStore b
g a
f') Text
projectName

instance MonadIO FireStore where
  liftIO :: IO a -> FireStore a
liftIO IO a
a = (Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
forall a.
(Text
 -> forall (m :: * -> *) (s :: [Symbol]).
    (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
    m a)
-> FireStore a
FireStore ((Text
  -> forall (m :: * -> *) (s :: [Symbol]).
     (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
     m a)
 -> FireStore a)
-> (Text
    -> forall (m :: * -> *) (s :: [Symbol]).
       (Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
       m a)
-> FireStore a
forall a b. (a -> b) -> a -> b
$ m a -> Text -> m a
forall a b. a -> b -> a
const (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
a)

newtype PageToken = PageToken {PageToken -> Text
_unPageToken :: Text}
  deriving (Int -> PageToken -> ShowS
[PageToken] -> ShowS
PageToken -> String
(Int -> PageToken -> ShowS)
-> (PageToken -> String)
-> ([PageToken] -> ShowS)
-> Show PageToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageToken] -> ShowS
$cshowList :: [PageToken] -> ShowS
show :: PageToken -> String
$cshow :: PageToken -> String
showsPrec :: Int -> PageToken -> ShowS
$cshowsPrec :: Int -> PageToken -> ShowS
Show)