Drop vestigial FileSystem effect requirement
This commit is contained in:
parent
715efce723
commit
f38e5bc5f5
@ -11,9 +11,7 @@ import Database.PostgreSQL.Simple.FromRow (FromRow, field, fromRow)
|
|||||||
import Database.PostgreSQL.Simple.ToField (ToField, toField)
|
import Database.PostgreSQL.Simple.ToField (ToField, toField)
|
||||||
import Database.PostgreSQL.Simple.ToRow (ToRow, toRow)
|
import Database.PostgreSQL.Simple.ToRow (ToRow, toRow)
|
||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.Dispatch.Dynamic
|
|
||||||
import Effectful.Error.Static (Error, throwError)
|
import Effectful.Error.Static (Error, throwError)
|
||||||
import Effectful.FileSystem (FileSystem)
|
|
||||||
import Effectful.Reader.Static (Reader)
|
import Effectful.Reader.Static (Reader)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Servant hiding ((:>), throwError)
|
import Servant hiding ((:>), throwError)
|
||||||
@ -21,8 +19,7 @@ import Servant hiding ((:>), throwError)
|
|||||||
--
|
--
|
||||||
-- Core data types
|
-- Core data types
|
||||||
--
|
--
|
||||||
type AppEff = Eff '[ FileSystem
|
type AppEff = Eff '[ Logger
|
||||||
, Logger
|
|
||||||
, Database
|
, Database
|
||||||
, Reader AppEnv
|
, Reader AppEnv
|
||||||
, Error ServerError
|
, Error ServerError
|
||||||
@ -51,6 +48,8 @@ instance ToJSON User
|
|||||||
instance FromJSON User
|
instance FromJSON User
|
||||||
|
|
||||||
data Database :: Effect where
|
data Database :: Effect where
|
||||||
|
DatabaseInit
|
||||||
|
:: Database (Eff es) ()
|
||||||
DatabaseRead
|
DatabaseRead
|
||||||
:: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
|
:: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
|
||||||
DatabaseRead_
|
DatabaseRead_
|
||||||
|
@ -38,7 +38,7 @@ databaseWrite
|
|||||||
databaseWrite = send . DatabaseWrite
|
databaseWrite = send . DatabaseWrite
|
||||||
|
|
||||||
runDatabaseDebug :: DatabaseExeEffects es => Eff (Database : es) a -> Eff es a
|
runDatabaseDebug :: DatabaseExeEffects es => Eff (Database : es) a -> Eff es a
|
||||||
runDatabaseDebug = interpret $ \_ -> \case
|
runDatabaseDebug = interpret $ \ -> \case
|
||||||
DatabaseRead (statement, values) -> do
|
DatabaseRead (statement, values) -> do
|
||||||
liftIOE $ putStrLn
|
liftIOE $ putStrLn
|
||||||
$ "Mocked a READ database operation with statement:\n"
|
$ "Mocked a READ database operation with statement:\n"
|
||||||
|
@ -9,8 +9,6 @@ import Data.List
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.Error.Static (Error, throwError)
|
import Effectful.Error.Static (Error, throwError)
|
||||||
import Effectful.FileSystem
|
|
||||||
import Effectful.FileSystem.IO.ByteString as EBS
|
|
||||||
import Servant hiding ((:>), throwError)
|
import Servant hiding ((:>), throwError)
|
||||||
import qualified Servant as S
|
import qualified Servant as S
|
||||||
|
|
||||||
|
@ -7,7 +7,6 @@ import Data.Time (getCurrentTime, UTCTime)
|
|||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.Dispatch.Dynamic
|
import Effectful.Dispatch.Dynamic
|
||||||
import Effectful.Error.Static (Error, throwError)
|
import Effectful.Error.Static (Error, throwError)
|
||||||
import Effectful.FileSystem
|
|
||||||
import Effectful.Reader.Static
|
import Effectful.Reader.Static
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Servant hiding ((:>))
|
import Servant hiding ((:>))
|
||||||
|
@ -10,7 +10,6 @@ import Control.Monad.Except (ExceptT (ExceptT))
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Effectful
|
import Effectful
|
||||||
import Effectful.Error.Static (Error, runErrorNoCallStack, throwError)
|
import Effectful.Error.Static (Error, runErrorNoCallStack, throwError)
|
||||||
import Effectful.FileSystem
|
|
||||||
import Effectful.Reader.Static
|
import Effectful.Reader.Static
|
||||||
import Network.Wai.Handler.Warp (run)
|
import Network.Wai.Handler.Warp (run)
|
||||||
import Servant hiding ((:>), throwError)
|
import Servant hiding ((:>), throwError)
|
||||||
@ -23,7 +22,7 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
pool <- createConnectionPool
|
pool <- createConnectionPool
|
||||||
let env = AppEnv { pool = pool }
|
let env = AppEnv { pool = pool }
|
||||||
run port $ serve proxy $ app env
|
run port . serve proxy $ app env
|
||||||
|
|
||||||
app :: AppEnv -> Server AppAPI
|
app :: AppEnv -> Server AppAPI
|
||||||
app env = transformEff env
|
app env = transformEff env
|
||||||
@ -42,7 +41,6 @@ transformEff env = hoistServer proxy
|
|||||||
. runReader env
|
. runReader env
|
||||||
. runDatabaseIO
|
. runDatabaseIO
|
||||||
. runLoggerPSQL
|
. runLoggerPSQL
|
||||||
. runFileSystem
|
|
||||||
|
|
||||||
port :: Int
|
port :: Int
|
||||||
port = 8080
|
port = 8080
|
||||||
|
Loading…
x
Reference in New Issue
Block a user