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.
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'm trying to get logging-error working with pipes. I'm nearly there—in the sense that I have something working—but I don't think it's quite right and I don't know how to fix it. The code:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Main where
import Protolude hiding ((<>), empty, for, get)
import Control.Monad.Log
import Text.PrettyPrint.Leijen.Text
import Pipes
testApp :: (MonadIO m, MonadLog (WithSeverity Doc) m) => m ()
testApp = logInfo $ textStrict "Logging works. Yah!"
printMessage :: (MonadIO m, MonadLog (WithSeverity Doc) m) => Consumer Text m ()
printMessage = forever $ await >>= putStrLn
readInputMessage :: (MonadIO m, MonadLog (WithSeverity Doc) m) => Producer Text m ()
readInputMessage = forever action
where
action = do
liftIO $ putStr ("> " :: Text)
liftIO getLine >>= yield
lift $ logInfo $ text "Waits with abated breath"
runMyLogging :: MonadIO m => LoggingT (WithSeverity Doc) m a -> m a
runMyLogging f = runLoggingT f (print . renderWithSeverity identity)
runPipesApp :: IO ()
runPipesApp = runMyLogging $ runEffect $
readInputMessage
>-> printMessage
runTestApp :: IO ()
runTestApp = runMyLogging testApp
main :: IO ()
main = do
runTestApp
runPipesApp
In readInputMessage I need to lift logInfo otherwise it won't compile. However testApp logInfo dosen't need to be lift'ed. Why do I need to lift in one but not the other?
Without lift this is the compilation error:
/home/rgh/dev/haskell/fa-logging/app/Main.hs:29:7: error:
• Could not deduce (MonadLog
(WithSeverity Doc) (Pipes.Proxy X () () Text m))
arising from a use of ‘logInfo’
from the context: (MonadIO m, MonadLog (WithSeverity Doc) m)
bound by the type signature for:
readInputMessage :: forall (m :: * -> *).
(MonadIO m, MonadLog (WithSeverity Doc) m) =>
Producer Text m ()
at app/Main.hs:23:1-84
• In a stmt of a 'do' block:
logInfo $ text "Waits with abated breath"
In the expression:
do liftIO $ putStr ("> " :: Text)
liftIO getLine >>= yield
logInfo $ text "Waits with abated breath"
In an equation for ‘action’:
action
= do liftIO $ putStr ("> " :: Text)
liftIO getLine >>= yield
logInfo $ text "Waits with abated breath"
|
29 | logInfo $ text "Waits with abated breath"
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- While building package fa-logging-0.0.0 using:
/srv/cache/rgh/.stack/setup-exe-cache/x86_64-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.0.2_ghc-8.2.1 --builddir=.stack-work/dist/x86_64-linux-nopie/Cabal-2.0.0.2 build lib:fa-logging exe:fa-logging --ghc-options " -ddump-hi -ddump-to-file"
Process exited with code: ExitFailure 1
I think it's not compiling because the compiler can't work out what type m is but I don't know how to fix it.
The problem is that the types in pipes aren't instances of MonadLog. In testApp, you've declared
(MonadLog (WithSeverity Doc) m) => m ()
So we are in an instance of MonadLog. Comparatively, for readInputMessage, you've declared
(MonadLog (WithSeverity Doc) m) => Producer Text m ()
So the type m is an instance of MonadLog, but we're not in type m (). We're in type Producer Text m (). Using lift then takes us into the m monad, which is what you've observed.
The solution is to make the Pipes types members of MonadLog when it's inner monad is. If you're willing to put up with orphan instances, you can write something similar to the code below.
instance (MonadLog m) => MonadLog Proxy a' a b' b m r where
askLogger = lift askLogger
localLogger f = lift . localLogger x
This should allow you to use MonadLog in any of the Pipes types as long as the inner monad is also a MonadLog.
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
I'm trying to marry the approach given at http://lexi-lambda.github.io/blog/2016/06/12/four-months-with-haskell/ (section titled "Typeclasses can emulate effects") with some sort of homegrown reader monad.
The overall problem I'm trying to solve is to avoid passing around a configuration variable to almost ever function in my app. And the reason I can't use a ReaderT is because a lot of my functions are in SqlPersistT, which itself uses a ReaderT internally. The other reason is to learn all this mental gymnastics better.
My two questions are given as comments in the code below. Reproducing them here as well:
What is the most appropriate way to define NwMonad?
Consequently, how do define NwMonad as an instance of HasNwConfig? How to write the function body of askNwConfig?
How do I finally call runNwMonad? What will be its arguments?
Here's the code:
data NwConfig = NwConfig {
_googleClientId :: T.Text,
_googleClientSecret :: T.Text,
_tgramBotToken :: String,
_aria2Command :: String,
_aria2DownloadDir :: String
}
$(makeLenses ''NwConfig)
instance Default NwConfig where
def = NwConfig{}
class MonadIO m => HasNwConfig m where
askNwConfig :: m NwConfig
startAria2 :: (HasNwConfig m) => m Sytem.Process.ProcessHandle
cfg <- askNwConfig
(_, _, _, processHandle) <- createProcess $ proc (cfg ^. aria2Command) []
return processHandle
-- QUESTION: Is this correct?
data NwMonad a = NwMonad{runNwMonad :: (NwConfig -> IO a)}
deriving (Functor, Applicative, Monad, MonadIO)
-- Or is this the way to do it?
data NwMonad a = NwMonad{runNwMonad :: IO a, nwConfig :: NwConfig}
deriving (Functor, Applicative, Monad, MonadIO)
instance HasNwConfig NwMonad where
askNwConfig = return . nwConfig -- QUESTION: How to write this?
main :: IO ()
main = do
[cId, cSecret, botToken] <- sequence [getEnv "GOOGLE_CLIENT_ID", getEnv "GOOGLE_CLIENT_SECRET", getEnv "TELEGRAM_TOKEN"]
let cfg = (def :: NwConfig)
& googleClientId .~ (T.pack cId)
& googleClientSecret .~ (T.pack cSecret)
& tgramBotToken .~ botToken
& aria2Command .~ "/Users/saurabhnanda/projects/nightwatch/aria2-1.19.3/bin/aria2c"
-- QUESTION: How do I use this now?
runNwMonad $ (?????) $ startAria2
Here's some code which shows how to work with multiple Reader environments in the same transformer stack. Here BaseMonad is like your SqlPersistT:
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.IO.Class
type BaseMonad = ReaderT String IO
type NwMonad = ReaderT Int BaseMonad
askString :: NwMonad String
askString = lift ask
askInt :: NwMonad Int
askInt = ask
startAria :: NwMonad ()
startAria = do
i <- askInt
s <- askString
liftIO $ putStrLn $ "i: " ++ show i ++ " s: " ++ s
main = do
let cfg = 10 -- i.e. your google client data
s = "asd" -- whatever is needed for SqlPersistT
runReaderT (runReaderT startAria cfg) s
Here's some code using the SqlPersisT type and runSqlConn:
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.IO.Class
import Database.Persist.Sql
data Config = Config { _clientId :: String }
type BaseMonad = SqlPersistT IO
type NwMonad = ReaderT Config BaseMonad
askBackend:: NwMonad SqlBackend
askBackend = lift ask
askConfig :: NwMonad Config
askConfig = ask
startAria :: NwMonad ()
startAria = do
cfg <- askConfig
liftIO $ putStrLn $ "client id: " ++ (_clientId cfg)
main = do
let cfg = Config "foobar"
backend = undefined :: SqlBackend -- however you get this
sqlComputation = runReaderT startAria cfg :: SqlPersistT IO ()
runSqlConn sqlComputation backend :: IO ()
Update
The type of the environment doesn't matter.
import Control.Monad.Reader
import Control.Monad.IO.Class
type Level1 = ReaderT Int IO
type Level2 = ReaderT Int Level1
type Level3 = ReaderT Int Level2
ask3 :: Level3 Int
ask3 = ask
ask2 :: Level3 Int
ask2 = lift ask
ask1 :: Level3 Int
ask1 = lift $ lift $ ask
doit :: Level3 ()
doit = do
r1 <- ask1
r2 <- ask2
r3 <- ask3
liftIO $ print (r1, r2, r3)
main = do
runReaderT (runReaderT (runReaderT doit 333) 222) 111
I'm trying to build a UI with the VTY-UI library.
I'm also using a custom monad (a few monads stacked on top of eachother).
For regular IO functions, this is not a problem. I can just lift them into my monad. However, the VTY-UI function onActivate has this type signature:
onActivate :: Widget Edit -> (Widget Edit -> IO ()) -> IO ()
Is there a way to turn a Widget Edit -> MyMonad () function into a (Widget Edit -> IO ()) without having to wrap and unwrap my monad?
I'd rather not rewrite all the library's type signatures to be MonadIO m => m () instead of IO ().
The function liftBaseOpDiscard from monad-control seems to do the trick:
import Control.Monad.Trans.Control
type MyMonad a = ReaderT Int (StateT Int IO) a
onActivate' :: Widget Edit -> (Widget Edit -> MyMonad ()) -> MyMonad ()
onActivate' = liftBaseOpDiscard . onActivate
This function has a MonadBaseControl constraint, but ReaderT and StateT on top IO already have instances for that typeclass.
As the documentation for liftBaseOpDiscard mentions, changes to the state inside the callback will be discarded.
MonadBaseControl lets you temporarily hide the upper layers of a monad stack into a value of the base monad of the stack (liftBaseWith) and afterwards pop them again, if needed (restoreM).
Edit: If we need to preserve effects that take place inside the callback (like changes in the state) one solution is to "mimic" state by using an IORef as the environment of a ReaderT. Values written into the IORef are not discarded. The monad-unlift package is built around this idea. An example:
import Control.Monad.Trans.Unlift
import Control.Monad.Trans.RWS.Ref
import Data.IORef
-- use IORefs for the environment and the state
type MyMonad a = RWSRefT IORef IORef Int () Int IO a
onActivate' :: Widget Edit -> (Widget Edit -> MyMonad ()) -> MyMonad ()
onActivate' we f = do
-- the run function will unlift into IO
UnliftBase run <- askUnliftBase
-- There's no need to manually "restore" the stack using
-- restoreM, because the changes go through the IORefs
liftBase $ onActivate we (run . f)
The monad can be run afterwards using runRWSIORefT.
For the state part: you can use this module. Thanks to whoever realized that making get and put polymorphic was a good idea.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module IState where
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Trans.Class
import Control.Applicative
import Data.IORef
newtype IState s m a = IState (ReaderT (IORef s) m a)
runIState (IState a) s = do
sr <- liftIO $ newIORef s
runReaderT a sr
runIStateRef (IState a) r = runReaderT a r
instance (Monad m) => Monad (IState s m) where
return = IState . return
(IState a) >>= f = let
f' i = let (IState i') = f i in i'
in IState (a >>= f')
instance (Monad m,Functor m) => Applicative (IState s m) where
pure = return
(<*>) = ap
instance (Functor m) => Functor (IState s m) where
fmap f (IState a) = IState (fmap f a)
instance (MonadIO m) => MonadIO (IState s m) where
liftIO = lift . liftIO
instance (MonadState s' m) => MonadState s' (IState s m) where
get = lift get
put = lift . put
-- Because of this instance IState is almost a drop-in replacement for StateT
instance (MonadIO m) => MonadState s (IState s m) where
get = IState $ do
r <- ask
liftIO $ readIORef r
put v = IState $ do
r <- ask
liftIO $ writeIORef r v
instance MonadTrans (IState s) where
lift a = IState (lift a)
I managed to implement the suggestion mentioned in the comments of the question.
I give vty callbacks in IO that sends events down a Chan. Then i have another thread listening for those events and executing the appropriate actions in my own monad.