project-m36
project-m36 copied to clipboard
agentm
Making `RelationalError` extendable/customizeable
Given that most API calls take a Connection and SessionId and return an Either RelationalError a result type, I have made a ReaderT + ExceptT monad stack and wrapped the API calls in it. Like this:
data DBEnv = DBEnv { getHead :: Text
, getConnection :: Connection
, getSessionId :: SessionId
}
type Action a = ReaderT DBEnv (ExceptT RelationalError IO) a
connInfo :: ConnectionInfo
connInfo = RemoteConnectionInfo
"my-db"
"127.0.0.1"
"6543"
emptyNotificationCallback
conn :: IO Connection
conn = handleIOError $ connectProjectM36 connInfo
handleIOError :: Show e => IO (Either e a) -> IO a
handleIOError m = do
v <- m
handleError v
handleError :: Show e => Either e a -> IO a
handleError eErr = case eErr of
Left err -> print err >> error "Died due to errors."
Right v -> pure v
The wrapped API calls look like this:
execRelExp :: RelationalExpr -> Action Relation
execRelExp rExp = do
env <- ask
lift
$ ExceptT
$ executeRelationalExpr (getSessionId env) (getConnection env) rExp
Then I use runDB to run the stack:
runDB :: Action a -> IO (Either RelationalError a)
runDB a = do
c <- liftIO conn
sessionId <- liftIO $ createSessionAtHead c "master"
case sessionId of
Right sid -> withTransaction
sid
c
(runExceptT
(runReaderT
a
DBEnv { getHead = "master", getConnection = c, getSessionId = sid }))
(autoMergeToHead sid c UnionMergeStrategy "master")
Left e -> return $ Left e
Now let's say I want a function that given a RelVar name, returns its contents. But it also makes sure the user making the call has read access to that RelVar. To do this, I would do something like this:
checkReadAccess :: UserId -> RelVarName -> Action Bool
checkReadAccess uid rv = ... -- see if the user has access to that rel var
getRelVar :: RelVarName -> Action Relation
getRelVar rv = do
let userId = ... -- get user ID from http session or something
hasReadAccess <- checkReadAccess userId rv
if hasReadAccess
then execRelExp $ RelationVariable rv ()
else throwError (AccessError userId rv) -- need to signal this problem somehow
This whole thing can go wrong in multiple ways, some of which come from Project:M36 and some are app specific. (i.e. rel var is not defined or user is not logged in or user has no read access). If somehow RelationalError could be extended to allow for app specific errors, things could become very easy in monad stacks and very composable in general.
So far I can't think of a way to do this cleanly. Any suggestions are welcome!
How about using sum types to extend errors?
data AllErrors = DBError RelationalError | AppError AppError
data AppError = AccessError UserID RelVarName
type Action a = ReaderT DBEnv (ExceptT AllErrors IO) a
And this way, you can throw your customized errors in your monad.
throwError (AppError (AccessError userId rv))
@YuMingLiao You're right, this would work. I was hoping for something that is usable out of the box, so that I could completely separate my lower level functions from the application logic. For example if I use AllErrors, then my Action type would have to change and the wrapped API calls would have to change, and in general my data layer would not be agnostic about what the application might be doing. I wouldn't be able to put my data layer in a separate library for example.
Maybe TypeFamilies or type classes or some Haskell type system magic can solve it, but I'm not experienced enough to think of something.
In any case, if something like the above is not possible, I think I will have to do it your way. I would also like to hear what @agentm thinks about this. And thanks for the reply!
@farzadbekran Type famlies! of course...
OpenErrorLibrary.hs -- like your data layer in a separate library
{-# LANGUAGE TypeFamilies #-}
module OpenErrorLibrary where
type family Error e
type instance Error RelationalError = RelationalError
a :: Error RelationalError
a = ...
OpenErrorUser.hs
{-# LANGUAGE TypeFamilies #-}
import OpenErrorLibrary
data AppError = ... deriving Show
type instance Error AppError = AppError
type instance Error (Either AppError RelationalError) = Either AppError RelationalError
b :: Error AppErrpr
b = ...
c :: Error (Either AppError RelationalError)
c = ...
type Action e a = ReaderT DBEnv (ExceptT (Error e) IO) a
type Action (Error RelationalError) a is for your data layer. Your data layer would be agnostic about the app.
type Action (Error (Either AppError RelationalError)) a or type Action (Error AppError)) a would be your app layer.
In this way, you change less things. You abstract Action type and runDB type, but need not change your old, relational-error-related-only, data-level wrapped api calls (if I understand you correctly).
@YuMingLiao Yup, I think this does it. I'll try this tomorrow and let you know how it goes. Thanks again!
@YuMingLiao I failed to make Actions composable using TypeFamilies but I came up with a solution which does not require any changes in the Project:M36. Let me know what you think.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
import Control.Monad.Except
import Control.Monad.Reader
-------- this would be defined in Project:M36 (RelationalError)
data DBError = E1 | E2 String
deriving (Show)
dbAPI :: Int -> IO (Either DBError String)
dbAPI i =
if i > 0
then return $ Right "OK"
else return $ Left $ E2 "Negative Int Error!"
----------------- My Data layer begins here
data CombinedErrors where
DBE :: DBError -> CombinedErrors
UE :: Show e => e -> CombinedErrors
deriving instance Show CombinedErrors
newtype DBEnv = DBEnv { getHead :: String }
type Action a = ReaderT DBEnv (ExceptT CombinedErrors IO) a
class Actionable e a where
toActionIO :: IO (Either e a) -> Action a
toAction :: Either e a -> Action a
runAction :: Action a -> IO (Either CombinedErrors a)
runAction action = runExceptT (runReaderT action (DBEnv "test"))
instance Actionable DBError a where
toActionIO a = do
v <- liftIO a
case v of
Left l -> liftEither $ Left $ DBE l
Right r -> liftEither $ Right r
toAction a = do
case a of
Left l -> liftEither $ Left $ DBE l
Right r -> liftEither $ Right r
wrappedAPI :: Int -> Action String
wrappedAPI i = toActionIO $ dbAPI i
----------------- My App layer begins here
data UserError = UE1 | UE2 String
deriving (Show)
instance Actionable UserError a where
toActionIO a = do
v <- liftIO a
case v of
Left l -> liftEither $ Left $ UE l
Right r -> liftEither $ Right r
toAction a = do
case a of
Left l -> liftEither $ Left $ UE l
Right r -> liftEither $ Right r
appFn :: Int -> Action String
appFn i = do
if i <= 100
then wrappedAPI i
else toAction $ Left $ UE2 "Int Is Too Large!"
--------------- all compose relatively well now
test :: Int -> IO (Either CombinedErrors (String, String))
test i = runAction $ do
r1 <- appFn i
r2 <- wrappedAPI i
return (r1, r2)
Oh! right, IO is the real tricky thing.
Brilliant! Now you can have IO/pure expressions with any error and compose them together later in your Action. Thanks for sharing!
This is not directly related, but there is also the project-m36-typed project which provides a more strongly typed means of interacting with the Project:M36 client library.
