1
1
mirror of https://github.com/qfpl/applied-fp-course.git synced 2024-11-30 12:23:25 +03:00

More comments in DB.hs

Some clean up to replace use of `either` when `first` would do.
This commit is contained in:
Sean Chalmers 2017-08-19 07:31:12 +10:00
parent bb6572f434
commit 3a6ebcb01d
2 changed files with 9 additions and 3 deletions

View File

@ -89,6 +89,11 @@ runDb
-> AppM a
runDb a = do
db <- asks ( dbConn . envDb )
-- We use the liftDb function to take the IO (Either SQLiteResponse a) and
-- convert it into an `m (Either Error a)` so that it matches the requirements
-- to be in our AppM, we then lean on the ExceptT functionality and use our
-- helper to either `throwError` with any DB errors that have made it this far
-- or simply return the desired value.
liftDb db >>= throwL
-- Or alternatively, if you hate variables...
-- asks (dbConn.envDb) >>= ( liftDb >=> throwL )

View File

@ -6,12 +6,13 @@ module FirstApp.Main
) where
import Control.Monad.Except (ExceptT (ExceptT),
runExceptT, withExceptT)
runExceptT)
import Control.Monad.IO.Class (liftIO)
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Data.Bifunctor (first)
import Data.Either (Either (..), either)
import Data.Text (Text)
@ -68,8 +69,7 @@ prepareAppReqs = runExceptT $ do
pure $ Env cfg db
where
toStartUpErr e =
withExceptT e -- apply our error constructor to unify the error types to StartUpError
. ExceptT -- convert our function to an ExceptT with the constructor
ExceptT . fmap (first e)
-- Take our possibly failing configuration/db functions with their unique
-- error types and turn them into a consistently typed ExceptT. We can then
@ -134,6 +134,7 @@ mkAddRequest
-> Either Error RqType
mkAddRequest ti c = AddRq
<$> mkTopic ti
-- Got string types...
<*> (mkCommentText . decodeUtf8 $ LBS.toStrict c)
mkViewRequest