{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module IntelliMonad.Persist where

import Control.Monad.IO.Class
import Data.List (maximumBy)
import qualified Data.Set as S
import Data.Text (Text)
import Database.Persist
import Database.Persist.Sqlite
import IntelliMonad.Types

data StatelessConf = StatelessConf

class PersistentBackend p where
  type Conn p
  config :: p
  setup :: (MonadIO m, MonadFail m) => p -> m (Maybe (Conn p))
  initialize :: (MonadIO m, MonadFail m) => Conn p -> Context -> m ()
  load :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m (Maybe Context)
  loadByKey :: (MonadIO m, MonadFail m) => Conn p -> (Key Context) -> m (Maybe Context)
  save :: (MonadIO m, MonadFail m) => Conn p -> Context -> m (Maybe (Key Context))
  saveContents :: (MonadIO m, MonadFail m) => Conn p -> [Content] -> m ()
  listSessions :: (MonadIO m, MonadFail m) => Conn p -> m [Text]
  deleteSession :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m ()

instance PersistentBackend SqliteConf where
  type Conn SqliteConf = ConnectionPool
  config :: SqliteConf
config =
    SqliteConf
      { sqlDatabase :: SessionName
sqlDatabase = SessionName
"intelli-monad.sqlite3",
        sqlPoolSize :: Int
sqlPoolSize = Int
5
      }
  setup :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SqliteConf -> m (Maybe (Conn SqliteConf))
setup SqliteConf
p = do
    ConnectionPool
conn <- IO ConnectionPool -> m ConnectionPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectionPool -> m ConnectionPool)
-> IO ConnectionPool -> m ConnectionPool
forall a b. (a -> b) -> a -> b
$ SqliteConf -> IO (PersistConfigPool SqliteConf)
forall c. PersistConfig c => c -> IO (PersistConfigPool c)
createPoolConfig SqliteConf
p
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO ()
-> PersistConfigPool SqliteConf
-> IO ()
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool SqliteConf
p (Migration -> ReaderT SqlBackend IO ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll) PersistConfigPool SqliteConf
ConnectionPool
conn
    Maybe ConnectionPool -> m (Maybe ConnectionPool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ConnectionPool -> m (Maybe ConnectionPool))
-> Maybe ConnectionPool -> m (Maybe ConnectionPool)
forall a b. (a -> b) -> a -> b
$ ConnectionPool -> Maybe ConnectionPool
forall a. a -> Maybe a
Just ConnectionPool
conn
  initialize :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> Context -> m ()
initialize Conn SqliteConf
conn Context
context = do
    Key Context
_ <- IO (Key Context) -> m (Key Context)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Key Context) -> m (Key Context))
-> IO (Key Context) -> m (Key Context)
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO (Key Context)
-> PersistConfigPool SqliteConf
-> IO (Key Context)
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) (Context -> ReaderT SqlBackend IO (Key Context)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert Context
context) PersistConfigPool SqliteConf
Conn SqliteConf
conn
    () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  load :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> SessionName -> m (Maybe Context)
load Conn SqliteConf
conn SessionName
sessionName = do
    ([Entity Context]
a :: [Entity Context]) <- IO [Entity Context] -> m [Entity Context]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Entity Context] -> m [Entity Context])
-> IO [Entity Context] -> m [Entity Context]
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO [Entity Context]
-> PersistConfigPool SqliteConf
-> IO [Entity Context]
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) ([Filter Context]
-> [SelectOpt Context] -> ReaderT SqlBackend IO [Entity Context]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Context SessionName
forall typ. (typ ~ SessionName) => EntityField Context typ
ContextSessionName EntityField Context SessionName -> SessionName -> Filter Context
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SessionName
sessionName] []) PersistConfigPool SqliteConf
Conn SqliteConf
conn
    if [Entity Context] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity Context]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
forall a. Maybe a
Nothing
      else Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Context -> m (Maybe Context))
-> Maybe Context -> m (Maybe Context)
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Context
forall a. a -> Maybe a
Just (Context -> Maybe Context) -> Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ (Context -> Context -> Ordering) -> [Context] -> Context
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\Context
a0 Context
a1 -> UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Context -> UTCTime
contextCreated Context
a1) (Context -> UTCTime
contextCreated Context
a0)) ([Context] -> Context) -> [Context] -> Context
forall a b. (a -> b) -> a -> b
$ (Entity Context -> Context) -> [Entity Context] -> [Context]
forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key Context
_ Context
v) -> Context
v) [Entity Context]
a

  loadByKey :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> Key Context -> m (Maybe Context)
loadByKey Conn SqliteConf
conn Key Context
key = do
    ([Entity Context]
a :: [Entity Context]) <- IO [Entity Context] -> m [Entity Context]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Entity Context] -> m [Entity Context])
-> IO [Entity Context] -> m [Entity Context]
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO [Entity Context]
-> PersistConfigPool SqliteConf
-> IO [Entity Context]
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) ([Filter Context]
-> [SelectOpt Context] -> ReaderT SqlBackend IO [Entity Context]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Context (Key Context)
forall typ. (typ ~ Key Context) => EntityField Context typ
ContextId EntityField Context (Key Context) -> Key Context -> Filter Context
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Context
key] []) PersistConfigPool SqliteConf
Conn SqliteConf
conn
    if [Entity Context] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity Context]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
forall a. Maybe a
Nothing
      else Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Context -> m (Maybe Context))
-> Maybe Context -> m (Maybe Context)
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Context
forall a. a -> Maybe a
Just (Context -> Maybe Context) -> Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ (Context -> Context -> Ordering) -> [Context] -> Context
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\Context
a0 Context
a1 -> UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Context -> UTCTime
contextCreated Context
a1) (Context -> UTCTime
contextCreated Context
a0)) ([Context] -> Context) -> [Context] -> Context
forall a b. (a -> b) -> a -> b
$ (Entity Context -> Context) -> [Entity Context] -> [Context]
forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key Context
_ Context
v) -> Context
v) [Entity Context]
a

  save :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> Context -> m (Maybe (Key Context))
save Conn SqliteConf
conn Context
context = do
    IO (Maybe (Key Context)) -> m (Maybe (Key Context))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Key Context)) -> m (Maybe (Key Context)))
-> IO (Maybe (Key Context)) -> m (Maybe (Key Context))
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO (Maybe (Key Context))
-> PersistConfigPool SqliteConf
-> IO (Maybe (Key Context))
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) (Key Context -> Maybe (Key Context)
forall a. a -> Maybe a
Just (Key Context -> Maybe (Key Context))
-> ReaderT SqlBackend IO (Key Context)
-> ReaderT SqlBackend IO (Maybe (Key Context))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> ReaderT SqlBackend IO (Key Context)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend m (Key record)
insert Context
context) PersistConfigPool SqliteConf
Conn SqliteConf
conn

  saveContents :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> [Content] -> m ()
saveContents Conn SqliteConf
conn [Content]
contents = do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO ()
-> PersistConfigPool SqliteConf
-> IO ()
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) ([Content] -> ReaderT SqlBackend IO ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
[record] -> ReaderT SqlBackend m ()
putMany [Content]
contents) PersistConfigPool SqliteConf
Conn SqliteConf
conn

  listSessions :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> m [SessionName]
listSessions Conn SqliteConf
conn = do
    ([Entity Context]
a :: [Entity Context]) <- IO [Entity Context] -> m [Entity Context]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Entity Context] -> m [Entity Context])
-> IO [Entity Context] -> m [Entity Context]
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO [Entity Context]
-> PersistConfigPool SqliteConf
-> IO [Entity Context]
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) ([Filter Context]
-> [SelectOpt Context] -> ReaderT SqlBackend IO [Entity Context]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []) PersistConfigPool SqliteConf
Conn SqliteConf
conn
    [SessionName] -> m [SessionName]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SessionName] -> m [SessionName])
-> [SessionName] -> m [SessionName]
forall a b. (a -> b) -> a -> b
$ Set SessionName -> [SessionName]
forall a. Set a -> [a]
S.toList (Set SessionName -> [SessionName])
-> Set SessionName -> [SessionName]
forall a b. (a -> b) -> a -> b
$ [SessionName] -> Set SessionName
forall a. Ord a => [a] -> Set a
S.fromList ([SessionName] -> Set SessionName)
-> [SessionName] -> Set SessionName
forall a b. (a -> b) -> a -> b
$ (Entity Context -> SessionName)
-> [Entity Context] -> [SessionName]
forall a b. (a -> b) -> [a] -> [b]
map (\(Entity Key Context
_ Context
v) -> Context -> SessionName
contextSessionName Context
v) [Entity Context]
a

  deleteSession :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn SqliteConf -> SessionName -> m ()
deleteSession Conn SqliteConf
conn SessionName
sessionName = do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SqliteConf
-> PersistConfigBackend SqliteConf IO ()
-> PersistConfigPool SqliteConf
-> IO ()
forall c (m :: * -> *) a.
(PersistConfig c, MonadUnliftIO m) =>
c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool (forall p. PersistentBackend p => p
config @SqliteConf) ([Filter Context] -> ReaderT SqlBackend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record SqlBackend) =>
[Filter record] -> ReaderT SqlBackend m ()
deleteWhere [EntityField Context SessionName
forall typ. (typ ~ SessionName) => EntityField Context typ
ContextSessionName EntityField Context SessionName -> SessionName -> Filter Context
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SessionName
sessionName]) PersistConfigPool SqliteConf
Conn SqliteConf
conn

instance PersistentBackend StatelessConf where
  type Conn StatelessConf = ()
  config :: StatelessConf
config = StatelessConf
StatelessConf
  setup :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
StatelessConf -> m (Maybe (Conn StatelessConf))
setup StatelessConf
_ = Maybe (Conn StatelessConf) -> m (Maybe (Conn StatelessConf))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Conn StatelessConf) -> m (Maybe (Conn StatelessConf)))
-> Maybe (Conn StatelessConf) -> m (Maybe (Conn StatelessConf))
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
  initialize :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> Context -> m ()
initialize Conn StatelessConf
_ Context
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  load :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> SessionName -> m (Maybe Context)
load Conn StatelessConf
_ SessionName
_ = Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
forall a. Maybe a
Nothing
  loadByKey :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> Key Context -> m (Maybe Context)
loadByKey Conn StatelessConf
_ Key Context
_ = Maybe Context -> m (Maybe Context)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
forall a. Maybe a
Nothing
  save :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> Context -> m (Maybe (Key Context))
save Conn StatelessConf
_ Context
_ = Maybe (Key Context) -> m (Maybe (Key Context))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key Context)
forall a. Maybe a
Nothing
  saveContents :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> [Content] -> m ()
saveContents Conn StatelessConf
_ [Content]
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  listSessions :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> m [SessionName]
listSessions Conn StatelessConf
_ = [SessionName] -> m [SessionName]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  deleteSession :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Conn StatelessConf -> SessionName -> m ()
deleteSession Conn StatelessConf
_ SessionName
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

withDB :: forall p m a. (MonadIO m, MonadFail m, PersistentBackend p) => (Conn p -> m a) -> m a
withDB :: forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB Conn p -> m a
func =
  p -> m (Maybe (Conn p))
forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
p -> m (Maybe (Conn p))
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
p -> m (Maybe (Conn p))
setup (forall p. PersistentBackend p => p
config @p) m (Maybe (Conn p)) -> (Maybe (Conn p) -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Conn p)
Nothing -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can not open a database."
    Just (Conn p
conn :: Conn p) -> Conn p -> m a
func Conn p
conn