Last active
July 26, 2017 21:35
-
-
Save sigrlami/9c21e2f0faa7b16d5e931bbfef705911 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- Make use of freer-effects, https://hackage.haskell.org/package/freer-effects | |
-- | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE TypeOperators #-} | |
import Control.Monad.Freer as FF | |
import Control.Monad.Freer.Exception as FF | |
import Control.Monad.Freer.Reader as FF | |
... | |
-- some other imports | |
------------------------------------------------------------------------------------------- | |
-- | The request handler functions, all of which operate in the `Effect` Monad. | |
serverT :: ServerT API Effect | |
serverT = | |
searchForCandidates | |
:<|> statusCnadidate | |
-- handlers implementation | |
-- | Conversion logic between our effect stack and the `Handler` Monad. | |
-- We can: | |
-- - catch any errore thrown within the Effect stack | |
-- - write to the DB | |
-- - rethrow into the `Handler` Monad where `Handler` is just a type alias for `ExceptT`. | |
effToHandler :: Connection -> Effect a -> Handler a | |
effToHandler conn eff = | |
liftIO | |
(runEffect conn eff) >>= either f pure | |
where | |
f err = | |
liftIO (log conn) Fail err) >> throwE err404 | |
-- | Log some event message via the `IO` Monad | |
-- | |
logEvent :: Connection -> T.Text -> T.Text -> IO () | |
logEvent conn category msg = do | |
now <- getCurrentTime | |
execute conn "INSERT INTO events (dt, cat, log) VALUES (?, ?, ?)" $ [T.pack $ show $ now, category, msg] | |
--------------------------------------------------------------------------------- | |
-- | Run full `Effect` stack. | |
-- Useful for bringing actions into the `IO` monad and lifting via `liftIO`. | |
runEffect :: Connection -> Effect a -> IO (Either T.Text a) | |
runEffect conn eff = runM . FF.runError $ FF.runReader eff conn | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment