So this is going to be a bit long, because I'm not sure how to frame this question more generally. The good news is that I have a code sample at the bottom of the question, the idea is just to make it build & elegant :-)
I have a couple of functions which have signatures like:
calledFunction
:: (MonadReader env m, HasToken env, MonadIO m)
=> m (Either MyError MyResult)
calledFunction2
:: (MonadReader env m, HasToken env, MonadIO m)
=> m (Either MyError MyResult2)
And I'd like to get in the end a result of type ExceptT String IO MyResult3 which I get by combining MyResult & MyResult2.
Now it's very nice that calledFunction returns an Either because I can leverage:
ExceptT :: m (Either e a) -> ExceptT e m a
And I just type EitherT calledFunction and I won't have anymore m (Either MyError MyResult) but straight ExceptT MyError m MyResult). Progress!
But I also need to give to calledFunction the reader context it wants. Now, I would do that with runReaderT. I have now come to the ExceptT MyError m MyResult transformer stack, so naturally the ReaderT should go where the m is.. So ExceptT MyError (ReaderT Config IO) MyResult...
Except, how do I 'fill in' the readerT with the value to read, since it's at the bottom of the transformer stack? And if I reverse the stack to have the reader at the toplevel, then runReaderT comes naturally, but I don't see how to use EitherT to transform my Either in an ExceptT elegantly...
import Control.Monad.Reader
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import Control.Error -- 'error' package
class HasToken a where
getToken :: a -> String
data Config = Config String
instance HasToken Config where
getToken (Config x) = x
data MyError = MyError String deriving Show
data MyResult = MyResult String
data MyResult2 = MyResult2 String
data MyResult3 = MyResult3 MyResult MyResult2
calledFunction
:: (MonadReader env m, HasToken env, MonadIO m)
=> m (Either MyError MyResult)
calledFunction = undefined
calledFunction2
:: (MonadReader env m, HasToken env, MonadIO m)
=> m (Either MyError MyResult2)
calledFunction2 = undefined
cfg = Config "test"
main = undefined
test :: ExceptT MyError IO MyResult3
test = do
-- calling runReaderT each time defeats the purpose..
r1 <- ExceptT (runReaderT calledFunction cfg)
r2 <- ExceptT (runReaderT calledFunction2 cfg)
return $ MyResult3 r1 r2
test1 = runReaderT test2 cfg
test2 :: ReaderT Config (ExceptT MyError IO) MyResult3
test2 = do
-- how to make this compile?
let cfg = Config "test"
r1 <- ExceptT calledFunction
r2 <- ExceptT calledFunction2
return $ MyResult3 r1 r2
You can use hoist from Control.Monad.Morph to run the Reader below the ExceptT:
ghci> let foo = undefined :: ExceptT () (ReaderT () IO) ()
ghci> :t hoist (flip runReaderT ()) foo
hoist (flip runReaderT ()) foo :: ExceptT () IO ()
It's also easy to do it yourself, you just have to unwrap with runExceptT, supply the environment with runReader, and re-wrap the result in the ExceptT constructor:
ghci> :t \env -> ExceptT . flip runReaderT env . runExceptT
\env -> ExceptT . flip runReaderT env . runExceptT
:: r -> ExceptT e (ReaderT r m) a -> ExceptT e m a
Related
I have the following little working program:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T
main :: IO ()
main = do
_ <- execStateT loop 0
return ()
loop :: StateT Int IO ()
loop = do
liftIO $ putStrLn "Enter a Number"
line <- liftIO $ T.getLine
let ts = T.words line
checkFoo ts
loop
checkFoo :: (MonadState Int m, MonadIO m) => [T.Text] -> m()
checkFoo strs = liftIO (runExceptT
(check1 strs >>= checkNum >>= doFoo)) >>= result
where
doFoo n = liftIO $ putStrLn $ "Your number: " <> show n
check1 :: [a] -> ExceptT T.Text IO a
check1 ts =
if length ts == 1
then return $ head ts
else throwError "1 number please"
checkNum :: T.Text -> ExceptT T.Text IO Int
checkNum t = case T.decimal t of
Left _ -> throwError "input isn't a number"
Right (d, _) -> return $ d
result :: (MonadState Int m, MonadIO m) => Either T.Text () -> m ()
result (Left e) = liftIO $ T.putStrLn e
result (Right _) = return ()
Now I would like to access the value of the State Monad in the subfunction doFoo of my function checkFoo. eg:
doFoo n =
old <- lift get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
lift $ put s
pure ()
I get the following error:
Main.hs:26:35: error:
• Could not deduce (MonadState a0 IO) arising from a use of ‘doFoo’
from the context: (MonadState Int m, MonadIO m)
bound by the type signature for:
checkFoo :: forall (m :: * -> *).
(MonadState Int m, MonadIO m) =>
[T.Text] -> m ()
at Main.hs:24:1-60
The type variable ‘a0’ is ambiguous
• In the second argument of ‘(>>=)’, namely ‘doFoo’
In the first argument of ‘runExceptT’, namely
‘(check1 strs >>= checkNum >>= doFoo)’
In the first argument of ‘liftIO’, namely
‘(runExceptT (check1 strs >>= checkNum >>= doFoo))’
|
26 | (check1 strs >>= checkNum >>= doFoo)) >>= result
Why is this not working? What are the necessary changes to make this working?
The problem is that when you write the expression:
check1 strs >>= checkNum >>= doFoo
this requires that each of these operations is an action is the same monad. The monad for the first two is:
ExceptT T.Text IO
which implies a type signature for doFoo:
doFoo :: Int -> ExceptT T.Text IO ()
but then you try to lift put and get operations in your revised doFoo definition. The error message is telling you that these operations aren't supported by the stateless monad ExceptT T.Text IO.
The least disruptive fix is probably to modify the type signatures for check1 and checkNum to generalize them over any MonadIO m:
check1 :: (MonadIO m) => [a] -> ExceptT T.Text m a
checkNum :: (MonadIO m) => T.Text -> ExceptT T.Text m Int
Then, checkFoo can be written as follows, without the liftIO before runExcept. I've also removed the lift before get and put. They aren't necessary, as get and put automatically lift themselves to the closest containing StateT transformer.
checkFoo :: (MonadState Int m, MonadIO m) => [T.Text] -> m ()
checkFoo strs = runExceptT (check1 strs >>= checkNum >>= doFoo) >>= result
where
-- doFoo :: (MonadState Int m, MonadIO m) => Int -> m ()
doFoo n = do
old <- get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
put s
pure ()
This version runs the pipeline check1 strs >>= checkNum >>= doFoo in the monad ExceptT T.Text m where m is the same monad (MonadState Int m, MonadIO m) => m that appears in checkFoo's type signature. The result is passed to result :: (MonadIO m) => Either T.Text () -> m () again for that same monad m. In your code, checkFoo is called at m ~ StateT Int IO, which satisfies the constraints MonadState Int m and MonadIO m, so all is well with the type checker.
The full revised example:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T
main :: IO ()
main = do
_ <- execStateT loop 0
return ()
loop :: StateT Int IO ()
loop = do
liftIO $ putStrLn "Enter a Number"
line <- liftIO $ T.getLine
let ts = T.words line
checkFoo ts
loop
checkFoo :: (MonadState Int m, MonadIO m) => [T.Text] -> m ()
checkFoo strs = runExceptT (check1 strs >>= checkNum >>= doFoo) >>= result
where
-- doFoo :: (MonadState Int m, MonadIO m) => Int -> m ()
doFoo n = do
old <- get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
put s
pure ()
check1 :: (MonadIO m) => [a] -> ExceptT T.Text m a
check1 ts =
if length ts == 1
then return $ head ts
else throwError "1 number please"
checkNum :: (MonadIO m) => T.Text -> ExceptT T.Text m Int
checkNum t = case T.decimal t of
Left _ -> throwError "input isn't a number"
Right (d, _) -> return $ d
result :: (MonadState Int m, MonadIO m) => Either T.Text () -> m ()
result (Left e) = liftIO $ T.putStrLn e
result (Right _) = return ()
The problem here are the type annotations for check1 and checkNum. They don't mention the State Int monad. They should be:
check1 :: [a] -> ExceptT T.Text (StateT Int IO) a
checkNum :: T.Text -> ExceptT T.Text (StateT Int IO) Int
Then the code for checkFoo should be:
checkFoo strs = (runExceptT
(check1 strs >>= checkNum >>= doFoo)) >>= result
I build a project based on the ReaderT design pattern. Instead of using a typeclass approach for dependency injection, I choose to use simple injection of handlers as function arguments. This part works fine as one is able to construct a dependency tree statically and define an environment dynamically.
The environment may contain configuration as well as a logging effect :: String -> IO (), an effect of time :: IO UTCDate etc. Consider the following minified example
import Control.Monad.Reader (runReaderT, liftIO, reader, MonadReader, MonadIO)
data SomeEnv
= SomeEnv
{ a :: Int
, logger :: String -> IO ()
}
class HasLogger a where
getLogger :: a -> (String -> IO())
instance HasLogger SomeEnv where
getLogger = logger
myFun :: (MonadIO m, MonadReader e m, HasLogger e) => Int -> m Int
myFun x = do
logger <- reader getLogger
liftIO $ logger "I'm going to multiply a number by itself!"
return $ x * x
doIt :: IO Int
doIt = runReaderT (myFun 1337) (SomeEnv 13 putStrLn)
Is it possible to generalize over the effect of the logger?
logger :: String -> m ()
With the motivation to use a logger which fits into the monad stack
myFun x = do
logger <- reader getLogger
logger "I'm going to multiply a number by itself!"
return $ x * x
We could try the following changes:
Parameterize the environment record with the "base" monad.
Make HasLogger a two-parameter typeclass that relates the environment to the "base" monad.
Something like this:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneKindSignatures #-}
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Kind (Constraint, Type)
type RT m = ReaderT (SomeEnv m) m
type SomeEnv :: (Type -> Type) -> Type
data SomeEnv m = SomeEnv
{ a :: Int,
logger :: String -> RT m (),
-- I'm putting the main fuction in the record,
-- perhaps we'll want to inject it into other logic, later.
myFun :: Int -> RT m Int
}
type HasLogger :: Type -> (Type -> Type) -> Constraint
class HasLogger r m | r -> m where
getLogger :: r -> String -> m ()
instance HasLogger (SomeEnv m) (RT m) where
getLogger = logger
_myFun :: (MonadReader e m, HasLogger e m) => Int -> m Int
_myFun x = do
logger <- reader getLogger
logger "I'm going to multiply a number by itself!"
return $ x * x
Now _myFun doesn't have the MonadIO constraint.
We can create a sample environment and run myFun:
env =
SomeEnv
{ a = 13,
logger = liftIO . putStrLn,
myFun = _myFun
}
doIt :: IO Int
doIt = runReaderT (myFun env 1337) env
One disadvantage of this solution is that the function signatures in the environment become more involved, even with the RT type synonym.
Edit: In order to simplify the signatures in the environment, I tried these alternative definitions:
type SomeEnv :: (Type -> Type) -> Type
data SomeEnv m = SomeEnv
{ a :: Int,
logger :: String -> m (), -- no more annoying ReaderT here.
myFun :: Int -> m Int
}
instance HasLogger (SomeEnv m) m where
getLogger = logger
-- Yeah, scary. This newtype seems necessary to avoid an "infinite type" error.
-- Only needs to be defined once. Could we avoid it completely?
type DepT :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type
newtype DepT env m r = DepT { runDepT :: ReaderT (env (DepT env m)) m r }
deriving (Functor,Applicative,Monad,MonadIO,MonadReader (env (DepT env m)))
instance MonadTrans (DepT env) where
lift = DepT . lift
env' :: SomeEnv (DepT SomeEnv IO) -- only the signature changes here
env' =
SomeEnv
{ a = 13,
logger = liftIO . putStrLn,
myFun = _myFun
}
doIt :: IO Int
doIt = runReaderT (runDepT (myFun env' 1337)) env'
DepT is basically a ReaderT, but one aware that its environment is parameterized by DeptT itself. It has the usual instances.
_myFun doesn't need to change in this alternative definition.
I want to summarize some results from applying danidiaz approach.
As my project is currently at a GHC version which does not support the second approach, I've followed the first approach. The application consists out of two sub-applications
a servant application
type RT m = ReaderT (Env m) m
an internal application
type HRT m = CFSM.HouseT (ReaderT (AutomationEnvironment m) m)
the first approach avoids infinite recursive types at the cost of a relation between the monadic stack and the environment.
As the sub-applications use different monadic stacks, specific environment had to be introduced. It seems that this is avoidable by the second approach due to the introduction of DepT.
MonadIO constraints could be removed from functions, for example
mkPostStatusService
:: (MonadIO m, MonadThrow m, MonadReader e m, HasCurrentTime e, HasRandomUUID e)
=> C.InsertStatusRepository m
-> PostStatusService m
became
mkPostStatusService
:: (MonadThrow m, MonadReader e m, HasCurrentTime e m, HasRandomUUID e m)
=> C.InsertStatusRepository m
-> PostStatusService m
Because the environment relates to the application stack, join is the substitute for liftIO
currentTime <- reader getCurrentTime >>= liftIO
-- becomes
currentTime <- join (reader getCurrentTime)
For unit testing, mock environments are constructed. Due to the removal of MonadIO, the mock environment can be constructed without side-effect monads.
An inspection of services which had MonadIO and MonadThrow were previously performed by defining mock environments like
data DummyEnvironment = DummyEnvironment (IO T.UTCTime) (IO U.UUID)
instance HasCurrentTime DummyEnvironment where
getCurrentTime (DummyEnvironment t _) = t
instance HasRandomUUID DummyEnvironment where
getRandomUUID (DummyEnvironment _ u) = u
with the new approach, the side-effects could be remove
type RT = ReaderT DummyEnvironment (CatchT Identity)
data DummyEnvironment = DummyEnvironment (RT T.UTCTime) (RT U.UUID)
instance HasCurrentTime DummyEnvironment RT where
getCurrentTime (DummyEnvironment t _) = t
instance HasRandomUUID DummyEnvironment RT where
getRandomUUID (DummyEnvironment _ u) = u
As I pointed out, the first approach connects the environment to a specific stack, thus the stack defines the environment.
Next step will be integrating the second approach as it seems to decouple the stack from the environment again using DepT.
I'm using Control.Monad.Except and am stuck in a place where I have to force execution of an ExceptT AppError m a action to obtain an IO action, and then to wrap it back again into an ExceptT AppErr m a. If you're wondering why this is required, it is because the underlying library function that I need to run, only accepts IO action. In this case it would be Database.PostgreSQL.Simple.withTransaction :: Connection -> IO a -> IO a
How do I write the conceptual equivalent of the following:
type AppM = ExceptT AppError (ReaderT Env (LoggingT IO))
runAppM :: Env -> AppM a -> a
withTransaction :: AppM a -> AppM a
withTransaction appm = do
conn <- getDbConnection
env <- getEnv
liftIO $ PGS.withTransaction conn $ runAppM appm
Here's the error that I'm getting:
Excepted type: ExceptT AppError (ReadertT Env (LoggingT IO)) a
Actual type: ExceptT AppError (ReadertT Env (LoggingT IO)) (Either AppError a)
Use the constructor ExceptT : m (Either e a) -> ExceptT e m a
withTransaction :: AppM a -> AppM a
withTransaction appm = do
conn <- getDbConnection
env <- getEnv
ExceptT $ PGS.withTransaction conn $ runAppM appm
This is a contrieved example using Reader Transformer:
{-# LANGUAGE UnicodeSyntax #-}
import Control.Monad.Reader
import Data.Char
conv ∷ Int → ReaderT Char Maybe String
conv n = do
yn ← ask
if yn == 'y'
then return $ chr n : " with Yes"
else lift Nothing
-- runReaderT (conv 98) 'y' Just "b with Yes"
-- runReaderT (conv 98) '#' Nothing
inspect ∷ ReaderT Char Maybe String → Bool
-- EDITED: as per suggestions, the correct type is monadic:
inspect ∷ ReaderT Char Maybe String → ReaderT Char Maybe Bool
inspect is supposed to check whether the value inside is Nothing. Can it be done, or I am having "design issues"?
ReaderT is exactly
newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
-- a function that reads the environment^ |
-- and returns an m a^
For ReaderT r Maybe a it's a function that reads the environment and returns a Maybe a. You can make a function that reads the environment and checks if the result is Nothing by composing this function with another function that checks whether the result is Nothing. To check whether a Maybe a is nothing, we can use isJust, and to pack the resulting Bool back into a Maybe Bool we'd use return.
inspect :: ReaderT r Maybe a -> ReaderT r Maybe Bool
inspect (ReaderT f) = ReaderT $ return . isJust . f
transformers provides a function, mapReaderT that lets us manipulate the computation inside a ReaderT
mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT f m = ReaderT $ f . runReaderT m
mapReaderT just composes the function provided as its first argument with the function inside the ReaderT (runReaderT unwraps the function inside a ReaderT). You can use mapReaderT to write inspect more elegantly.
inspect :: ReaderT r Maybe a -> ReaderT r Maybe Bool
inspect = mapReaderT (return . isJust)
Maybe I'm doing something stupid here, but I'm getting:
No instance for (MonadException Ti)
arising from a use of `getInputLine'
in the code sample:
module Foo where
import System.Console.Haskeline
import System.Console.Haskeline.MonadException
import Control.Monad.State
import Control.Monad.IO.Class
type Ti = StateT Int IO
action :: String -> Ti ()
action s = do
n <- get
lift $ putStrLn $ show n ++ ": " ++ s
repl :: InputT Ti ()
repl = do
minput <- getInputLine "?"
case minput of
Nothing -> return ()
Just input -> lift (action input) >> repl
Now, System.Console.Haskeline.MonadException defines
MonadException IO
(MonadIO (StateT s m), MonadException m) => MonadException (StateT s m)
and Control.Monad.IO.Class:
MonadIO IO
MonadIO m => MonadIO (StateT s m)
So, shouldn't it deduce the instance for Ti automatically?
There is no instance for the Lazy state transformer, just the strict one. Use import Control.Monad.State.Strict.