52 lines
1.7 KiB
Haskell
52 lines
1.7 KiB
Haskell
module Handlers where
|
|
|
|
import Core
|
|
import Database
|
|
import Logger
|
|
import Views as V
|
|
|
|
import qualified Data.ByteString.Char8 as C
|
|
import Data.List
|
|
import qualified Data.Text as T
|
|
import Effectful
|
|
import Effectful.Error.Static (Error, throwError)
|
|
import Lucid (Html)
|
|
import Servant hiding ((:>), throwError)
|
|
import Servant.HTML.Lucid
|
|
|
|
-- Type synonym for common CRUD constraints like interacting with a database,
|
|
-- logging, and the possibility to throw an error.
|
|
type CRUD es = ( Database :> es, Logger :> es, Error ServerError :> es )
|
|
|
|
-- Remember to drop effect constraints you don't need!
|
|
rootHandler :: (Logger :> es, Error ServerError :> es)
|
|
=> Eff es (Html ())
|
|
rootHandler = (writeLog Info "Hit the root!")
|
|
>>= \_ -> return V.root
|
|
|
|
userListHandler :: CRUD es
|
|
=> Eff es (Html ())
|
|
userListHandler = do
|
|
users <- databaseRead_ "SELECT id, name FROM users"
|
|
writeLog Info "Selected all users!"
|
|
return $ V.baseDoc $ case users of
|
|
[] -> warning "No users found"
|
|
_ -> foldMap userHtml users
|
|
|
|
userGetHandler :: CRUD es
|
|
=> UserId -> Eff es User
|
|
userGetHandler userId = databaseRead (queryUser userId) >>= \mUser ->
|
|
case mUser of
|
|
(a:_) -> pure a
|
|
[] -> pure (User (UserId 0) "No user found")
|
|
|
|
userPostHandler :: CRUD es
|
|
=> T.Text -> Eff es NoContent
|
|
userPostHandler name =
|
|
databaseWrite (writeUser name) >>= \_ -> return NoContent
|
|
|
|
userDeleteHandler :: CRUD es
|
|
=> UserId -> Eff es NoContent
|
|
userDeleteHandler userId =
|
|
databaseWrite (deleteUser userId) >>= \_ -> return NoContent
|