{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Firestore
(
Document (..),
Value (..),
FireStore,
runFireStore,
defaultEnvironment,
listAllDocuments,
patchDocument,
module Database.Firestore.Types,
)
where
import Control.Lens ((&), (.~), (<&>), (^.))
import Control.Monad.Trans.Resource
import Data.Data
import qualified Data.Text as Text
import Database.Firestore.Internal
import Database.Firestore.Types
import Network.Google (AllowScopes, HasEnv)
import qualified Network.Google as Google
import qualified Network.Google.Auth.Scope as Google
import qualified Network.Google.FireStore as FireStore
import System.IO (stderr)
defaultEnvironment :: IO (Google.Env FireStoreScope)
defaultEnvironment :: IO (Env FireStoreScope)
defaultEnvironment = do
Logger
lgr <- LogLevel -> Handle -> IO Logger
forall (m :: * -> *). MonadIO m => LogLevel -> Handle -> m Logger
Google.newLogger LogLevel
Google.Trace Handle
stderr
Manager
mgr <- ManagerSettings -> IO Manager
Google.newManager ManagerSettings
Google.tlsManagerSettings
Credentials FireStoreScope
crd <- Manager -> IO (Credentials FireStoreScope)
forall (m :: * -> *) (s :: [Symbol]).
(MonadIO m, MonadCatch m) =>
Manager -> m (Credentials s)
Google.getApplicationDefault Manager
mgr
Credentials FireStoreScope
-> Logger -> Manager -> IO (Env FireStoreScope)
forall (m :: * -> *) (s :: [Symbol]).
(MonadIO m, MonadCatch m, AllowScopes s) =>
Credentials s -> Logger -> Manager -> m (Env s)
Google.newEnvWith Credentials FireStoreScope
crd Logger
lgr Manager
mgr IO (Env FireStoreScope)
-> (Env FireStoreScope -> Env FireStoreScope)
-> IO (Env FireStoreScope)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Proxy FireStoreScope -> Identity (Proxy FireStoreScope))
-> Env FireStoreScope -> Identity (Env FireStoreScope)
forall (s :: [Symbol]) a. HasEnv s a => Lens' a (Proxy s)
Google.envScopes ((Proxy FireStoreScope -> Identity (Proxy FireStoreScope))
-> Env FireStoreScope -> Identity (Env FireStoreScope))
-> Proxy FireStoreScope -> Env FireStoreScope -> Env FireStoreScope
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy FireStoreScope
forall k (t :: k). Proxy t
Proxy @FireStoreScope)
runFireStore ::
( MonadUnliftIO m,
HasEnv s env,
AllowScopes s,
Google.HasScope' s FireStoreScope ~ 'True
) =>
env ->
Text.Text ->
FireStore a ->
m a
runFireStore :: env -> Text -> FireStore a -> m a
runFireStore env
env Text
project (FireStore Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m a
_action) = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT m a -> m a) -> ResourceT m a -> m a
forall a b. (a -> b) -> a -> b
$ env -> Google s a -> ResourceT m a
forall (m :: * -> *) (s :: [Symbol]) r a.
(MonadResource m, HasEnv s r) =>
r -> Google s a -> m a
Google.runGoogle env
env (Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m a
_action Text
project)
listDocumentsOnePage :: Text.Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage :: Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage Text
collectionName Maybe PageToken
np =
do
ListDocumentsResponse
res <- (Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m ListDocumentsResponse)
-> FireStore ListDocumentsResponse
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 ListDocumentsResponse)
-> FireStore ListDocumentsResponse)
-> (Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m ListDocumentsResponse)
-> FireStore ListDocumentsResponse
forall a b. (a -> b) -> a -> b
$
\Text
projectName ->
Text -> Text -> ProjectsDatabasesDocumentsList
FireStore.projectsDatabasesDocumentsList
(Text
"projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/databases/(default)/documents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
collectionName)
Text
""
ProjectsDatabasesDocumentsList
-> (ProjectsDatabasesDocumentsList
-> ProjectsDatabasesDocumentsList)
-> ProjectsDatabasesDocumentsList
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> ProjectsDatabasesDocumentsList
-> Identity ProjectsDatabasesDocumentsList
Lens' ProjectsDatabasesDocumentsList (Maybe Text)
FireStore.pPageToken ((Maybe Text -> Identity (Maybe Text))
-> ProjectsDatabasesDocumentsList
-> Identity ProjectsDatabasesDocumentsList)
-> Maybe Text
-> ProjectsDatabasesDocumentsList
-> ProjectsDatabasesDocumentsList
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PageToken -> Text) -> Maybe PageToken -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PageToken -> Text
_unPageToken Maybe PageToken
np
ProjectsDatabasesDocumentsList
-> (ProjectsDatabasesDocumentsList -> m ListDocumentsResponse)
-> m ListDocumentsResponse
forall a b. a -> (a -> b) -> b
& ProjectsDatabasesDocumentsList -> m ListDocumentsResponse
forall (s :: [Symbol]) (m :: * -> *) a.
(MonadGoogle s m, HasScope s a, GoogleRequest a) =>
a -> m (Rs a)
Google.send
([Document], Maybe PageToken)
-> FireStore ([Document], Maybe PageToken)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Document -> Document) -> [Document] -> [Document]
forall a b. (a -> b) -> [a] -> [b]
map Document -> Document
parseDocument ([Document] -> [Document]) -> [Document] -> [Document]
forall a b. (a -> b) -> a -> b
$ ListDocumentsResponse
res ListDocumentsResponse
-> Getting [Document] ListDocumentsResponse [Document]
-> [Document]
forall s a. s -> Getting a s a -> a
^. Getting [Document] ListDocumentsResponse [Document]
Lens' ListDocumentsResponse [Document]
FireStore.ldrDocuments, Text -> PageToken
PageToken (Text -> PageToken) -> Maybe Text -> Maybe PageToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListDocumentsResponse
res ListDocumentsResponse
-> Getting (Maybe Text) ListDocumentsResponse (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ListDocumentsResponse (Maybe Text)
Lens' ListDocumentsResponse (Maybe Text)
FireStore.ldrNextPageToken)
listAllDocuments :: Text.Text -> FireStore [Document]
listAllDocuments :: Text -> FireStore [Document]
listAllDocuments Text
collectionName = Maybe PageToken -> FireStore [Document]
getPage Maybe PageToken
forall a. Maybe a
Nothing
where
getPage :: Maybe PageToken -> FireStore [Document]
getPage Maybe PageToken
pt =
do
([Document]
res, Maybe PageToken
np) <- Text -> Maybe PageToken -> FireStore ([Document], Maybe PageToken)
listDocumentsOnePage Text
collectionName Maybe PageToken
pt
case Maybe PageToken
np of
Maybe PageToken
Nothing -> [Document] -> FireStore [Document]
forall (m :: * -> *) a. Monad m => a -> m a
return [Document]
res
Just PageToken
pt' -> ([Document]
res [Document] -> [Document] -> [Document]
forall a. [a] -> [a] -> [a]
++) ([Document] -> [Document])
-> FireStore [Document] -> FireStore [Document]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PageToken -> FireStore [Document]
getPage (PageToken -> Maybe PageToken
forall a. a -> Maybe a
Just PageToken
pt')
patchDocument :: Text.Text -> Document -> FireStore Document
patchDocument :: Text -> Document -> FireStore Document
patchDocument Text
path Document
document =
do
Document
res <- (Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m Document)
-> FireStore Document
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 Document)
-> FireStore Document)
-> (Text
-> forall (m :: * -> *) (s :: [Symbol]).
(Monad m, MonadGoogle s m, HasScope' s FireStoreScope ~ 'True) =>
m Document)
-> FireStore Document
forall a b. (a -> b) -> a -> b
$
\Text
projectName ->
Document -> Text -> ProjectsDatabasesDocumentsPatch
FireStore.projectsDatabasesDocumentsPatch
(Document -> Document
buildDocument Document
document)
(Text
"projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/databases/(default)/documents/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
ProjectsDatabasesDocumentsPatch
-> (ProjectsDatabasesDocumentsPatch -> m Document) -> m Document
forall a b. a -> (a -> b) -> b
& ProjectsDatabasesDocumentsPatch -> m Document
forall (s :: [Symbol]) (m :: * -> *) a.
(MonadGoogle s m, HasScope s a, GoogleRequest a) =>
a -> m (Rs a)
Google.send
Document -> FireStore Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> FireStore Document) -> Document -> FireStore Document
forall a b. (a -> b) -> a -> b
$ Document -> Document
parseDocument Document
res