68 lines
1.9 KiB
Haskell
68 lines
1.9 KiB
Haskell
module Core where
|
|
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import Data.Pool (Pool)
|
|
import qualified Data.Text as T
|
|
import Database.PostgreSQL.Simple (Connection, Query)
|
|
import Database.PostgreSQL.Simple.FromField (FromField)
|
|
import Database.PostgreSQL.Simple.FromRow (FromRow, field, fromRow)
|
|
import Database.PostgreSQL.Simple.ToField (ToField, toField)
|
|
import Database.PostgreSQL.Simple.ToRow (ToRow, toRow)
|
|
import Effectful
|
|
import Effectful.Error.Static (Error)
|
|
import Effectful.Reader.Static (Reader)
|
|
import GHC.Generics (Generic)
|
|
import Servant hiding ((:>))
|
|
import Servant.HTML.Lucid
|
|
|
|
--
|
|
-- Core data types
|
|
--
|
|
type AppEff =
|
|
Eff '[ Logger
|
|
, Database
|
|
, Reader AppEnv
|
|
, Error ServerError
|
|
]
|
|
|
|
data AppEnv = AppEnv { pool :: Maybe (Pool Connection) }
|
|
|
|
newtype UserId = UserId Int
|
|
deriving (Show, Generic, FromField, ToField, FromHttpApiData, ToHttpApiData)
|
|
|
|
data User = User { userId :: UserId, userName :: T.Text}
|
|
deriving (Show, Generic)
|
|
|
|
instance ToJSON UserId
|
|
instance FromJSON UserId
|
|
|
|
instance ToRow UserId
|
|
instance FromRow UserId
|
|
|
|
instance ToJSON User
|
|
instance FromJSON User
|
|
|
|
instance ToRow User where
|
|
toRow (User uid name) = toRow (uid, name)
|
|
instance FromRow User where
|
|
fromRow = User <$> field <*> field
|
|
|
|
data Database :: Effect where
|
|
DatabaseInit
|
|
:: Database (Eff es) ()
|
|
DatabaseRead
|
|
:: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
|
|
DatabaseRead_
|
|
:: (FromRow b) => Query -> Database (Eff es) [b]
|
|
DatabaseWrite
|
|
:: (ToRow a, Show a) => (Query, a) -> Database (Eff es) ()
|
|
|
|
data Logger :: Effect where
|
|
WriteLog :: LogLevel -> String -> Logger (Eff es) ()
|
|
|
|
data LogLevel = Info | Warning | Error
|
|
deriving (Show, Eq)
|
|
|
|
instance ToField LogLevel where
|
|
toField level = toField (T.pack (show level))
|