Context
I have some monadic functions for an interpreter that I'm trying to test with HSpec. They run with the following monad stack:
type AppState = StateT InterpreterState (ExceptT Events IO)
type AppReturn a = Either Events (a, PState)
runApp :: AppState a -> IO (AppReturn a)
runApp f = runExceptT (runStateT f new)
Here's an example of a simple one:
mustEvalExpr :: Expr -> S.AppState (S.Value)
mustEvalExpr e = do
val <- evalExpr e
case val of
Just val' -> return val'
Nothing -> throw $ S.CannotEval e
The problem is that HSpec has its own context (IO ()), so I have to translate between the two contexts.
Current Approach
I'm using HSpec, and I wrote a transformer function to get a runApp context from within the HSpec context.
-- imports omitted
extract :: S.AppReturn a -> a
extract st = case st of
Right (a, _) -> a
Left ev -> throw ev
run :: (S.AppReturn a -> b) -> S.AppState a -> IO b
run extractor fn = do
state <- S.runApp fn
return $ extractor state
So my Spec looks like this:
spec :: Spec
spec = do
describe "mustEvalExpr" $ do
let badExpr = D.VarExpr $ D.Id "doesntExist"
goodExpr = D.IntExpr 1
val = S.IntValue 1
it "should evaluate and return expression if its a Just" $ do
(run extract $ do
I.mustEvalExpr goodExpr
) >>= (`shouldBe` val)
it "should throw error if it gets a Nothing" $ do
(run extract $ do
I.mustEvalExpr badExpr
) `shouldThrow` anyException
Question
Is this the best I can do? I feel like run extract $ do is fine, and I think it's good to be explicit when things are complicated.
But I was wondering if there was a way I can integrate with HSpec, or if there's a best-practice for this problem that doesn't require custom code?
Related
I'm trying to write an interpreter for a simple embedded scripting language.
The core of it is the eval function, which has the following signature.
type EvalState = () --for later
type EvalResult = State EvalState (IO (Either T.Text Value))
eval :: Expr -> EvalResult
The result type is like this because it is statefull, eval should be able todo IO and it can fail.
There are two datatypes: Expressions and Values and eval converts expression to values. For simple expressions, literals of primitive data types, it's implemented like this:
ok :: Value -> EvalResult
ok val = state (return . Right $ val,)
eval :: Expr -> EvalResult
eval (StrLit t) = ok (StrVal t)
eval (SymLit t) = ok (SymbolVal t)
eval (IntLit i) = ok (IntVal i)
eval (FloatLit f) = ok (FloatVal f)
My problem now is implementing eval for the list literal. Currently my code looks like this:
eval (ListLit elems) = do
elems <- mapM eval elems
do
opts <- sequence elems
return $ fmap (Right . ListVal . V.fromList) (sequence opts)
And this produces the following error:
/home/felix/git/vmail/src/Interpreter/EvalAst.hs:37:13: error:
• Couldn't match type ‘IO’
with ‘StateT EvalState Data.Functor.Identity.Identity’
Expected: StateT
EvalState Data.Functor.Identity.Identity [Either T.Text Value]
Actual: IO [Either T.Text Value]
• In a stmt of a 'do' block: opts <- sequence elems
In a stmt of a 'do' block:
do opts <- sequence elems
fmap (Right . ListVal . V.fromList) (sequence opts)
In the expression:
do elems <- mapM eval elems
do opts <- sequence elems
fmap (Right . ListVal . V.fromList) (sequence opts)
|
37 | opts <- sequence elems
| ^^^^^^^^^^^^^^
My problem is that I'm not understanding this error. My thinking goes like this: the first do puts me in the State monad, so I shold be able to "extract" the results from mapM eval elems which I expect to be [ IO (Either ...) ] The next do should put me in the IO monad (because that's the next inner type in the result type), so I should be able to extract IO values, and as far as I understood it, sequence elems should give me a IO [ Either ... ] which I can then extract, so what is my mistake?
Monad do not compose, in general. I think you are being bit by this.
In general, if m and n are monads, we can not write m (n a) for a monadic action that mixes the features of m and n. In general, it could even fail to be a monad.
In your case, you are using something like State A (IO B) hoping to be able to access the state of type A and still do IO, but that's not the case.
Indeed, by definition we have (up to some wrappers):
State a b = a -> (a,b)
| | |-- result
| |-- new state
|-- old state
which in your case State A (IO B) it becomes
State A (IO B) = A -> (A, IO B)
| | |-- result
| |-- new state
|-- old state
Here, we can see that the new state must be generated without doing IO at all! This is a computation which forces the new state and the IO effects to be completely separated. It effectively behaves as if we had two separate functions
A -> A -- state update, no IO here
A -> IO B -- IO depending on the old state
Likely, that's not what you actually want. That is probably something like
A -> IO (A, B)
allowing the new state to be generated after IO is done.
To obtain that type, you can not nest monads, but you need a monad transformer like StateT:
StateT A IO B = A -> IO (A, B)
This is a monad. You will probably need to use lift or liftIO to convert IO actions to this type, but it should behave as desired.
In our haskell code base, business logic is interlaved with tracing and logging code. This can obscure the business logic and make it harder to understand and debug. I am looking for ideas how to reduce the code footprint of logging and tracing to make the business logic stick out more.
Our code currently mostly looks roughly like this:
someFunction a b cs =
withTaggedSpan tracer "TRACE_someFunction" [("arg_b", show b)] $ do
logDebug logger $ "someFunction start: " <> show (trimDownC <$> cs)
result <- do ... some business logic ...
if isError result then
logError logger $ "someFunction error: " <> show result
else
logDebug logger $ "someFunction success: " <> show (trimDownResult result)
One observation is that whe mostly trace the entire function body and log at beginning and end. This should allow combining tracing and logging into single helper and automatically extract function name and names of captured values via meta programming. I have used AST transforming compile time macros and runtime introspection in other languges before but not Haskell.
What are good ways to do this using Template Haskell, HasCallStack or other options?
(Cross posted at https://www.reddit.com/r/haskell/comments/gdfu52/extracting_context_for_tracinglogging_via_haskell/)
Let's assume for simplicity that the functions in your business logic are of the form:
_foo :: Int -> String -> ReaderT env IO ()
_bar :: Int -> ExceptT String (ReaderT env IO) Int
That is, they return values in a ReaderT transformer over IO, or perhaps also throw errors using ExceptT. (Actually that ReaderT transformer isn't required right now, but it'll come in handy later).
We could define a traced function like this:
{-# LANGUAGE FlexibleInstances #-}
import Data.Void (absurd)
import Control.Monad.IO.Class
import Control.Monad.Reader -- from "mtl"
import Control.Monad.Trans -- from "transformers"
import Control.Monad.Trans.Except
traced :: Traceable t => Name -> t -> t
traced name = _traced name []
type Name = String
type Arg = String
class Traceable t where
_traced :: Name -> [Arg] -> t -> t
instance Show r => Traceable (ReaderT env IO r) where
_traced msg args t = either absurd id <$> runExceptT (_traced msg args (lift t))
instance (Show e, Show r) => Traceable (ExceptT e (ReaderT env IO) r) where
_traced msg args t =
do
liftIO $ putStrLn $ msg ++ " invoked with args " ++ show args
let mapExits m = do
e <- m
case e of
Left err -> do
liftIO $ putStrLn $ msg ++ " failed with error " ++ show err
return $ Left err
Right r -> do
liftIO $ putStrLn $ msg ++ " exited with value " ++ show r
return $ Right r
mapExceptT (mapReaderT mapExits) t
instance (Show arg, Traceable t) => Traceable (arg -> t) where
_traced msg args f = \arg -> _traced msg (args ++ [show arg]) (f arg)
This solution is still a bit unsatisfactory because, for functions that call other functions, we must decide at the outset if we want the traced version of the called functions or not.
One thing we could try—although more invasive to the code—is to put our functions in a record, and make the environment of the ReaderT equal to that same record. Something like this:
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
-- from "red-black-record"
import Data.RBR (FromRecord (..), IsRecordType, ToRecord (..))
data MyAPI = MyAPI
{ foo :: Int -> String -> ReaderT MyAPI IO (),
bar :: Int -> ExceptT String (ReaderT MyAPI IO) Int,
baz :: Bool -> ExceptT String (ReaderT MyAPI IO) ()
}
deriving (Generic, FromRecord, ToRecord)
An then use some generics utility library (here red-black-record) to write a function that says: "if every function in your record is Traceable, I will give you another record where all the functions are traced":
import Data.Kind
import Data.Proxy
import Data.Monoid (Endo(..))
import GHC.TypeLits
import Data.RBR
( I (..),
KeyValueConstraints,
KeysValuesAll,
Maplike,
cpure'_Record,
liftA2_Record,
)
traceAPI ::
( IsRecordType r t,
Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Traceable) t
) =>
r ->
r
traceAPI =
let transforms =
cpure'_Record (Proxy #Traceable) $
\fieldName -> Endo (traced fieldName)
applyTraced (Endo endo) (I v) = I (endo v)
in fromRecord . liftA2_Record applyTraced transforms . toRecord
-- small helper function to help invoke the functions in the record
call :: MonadReader env m => (env -> f) -> (f -> m r) -> m r
call getter execute = do
f <- asks getter
execute f
Alternatively, in order to avoid magic, such function could we written by hand for each particular API record.
Putting it to work:
main :: IO ()
main = do
let api =
traceAPI $
MyAPI
{ foo = \_ _ ->
do liftIO $ putStrLn "this is foo",
bar = \_ ->
do
liftIO $ putStrLn "this is bar"
return 5,
baz = \_ ->
do
call foo $ \f -> lift $ f 0 "fooarg"
call bar $ \f -> f 23
throwE "oops"
}
flip runReaderT api $ runExceptT $ baz api False
pure ()
-- baz invoked with args ["False"]
-- foo invoked with args ["0","\"fooarg\""]
-- this is foo
-- foo exited with value ()
-- bar invoked with args ["23"]
-- this is bar
-- bar exited with value 5
-- baz failed with error "oops"
Pure functions are deterministic. If you know what went into them, you can always reproduce the result. Thus, you shouldn't need a lot of logging inside the main parts of a functional code base.
Log the impure actions only, and architect your code into a pure core with a small imperative shell. Log only the impure actions that take place in the shell. I've described the technique in a blog post here.
1) I need to pass a field constructor parameter to a function. I made some tests but i was unable to do so. Is it possible? Otherwise, is it possible with lens package?
2) Is it possible in a MonadState to modify a field using modify? (I made a few attempts, but without success. For example: modify (second = "x") does not work.
import Control.Monad.State
data Test = Test {first :: Int, second :: String} deriving Show
dataTest = Test {first = 1, second = ""}
test1 = runStateT modif1 dataTest -- OK
test2 = runStateT (modif2 "!") dataTest -- OK
test3 = runStateT (modif3 second) dataTest -- WRONG
-- modif1 :: StateT Test IO ()
modif1 = do
st <- get
r <- lift getLine
put $ st {second = "x" ++ r}
-- modif2 :: String -> StateT Test IO ()
modif2 s = do
stat <- get
r <- lift getLine
put $ stat {second = "x" ++ r ++ s}
-- modif3 :: ???? -> StateT Test IO ()
modif3 fc = do
stat <- get
r <- lift getLine
put $ stat {fc = "x" ++ r}
-- When i try to load the module, this is the result:
-- ghc > Failed:
-- ProvaRecord.hs:33:16:`fc' is not a (visible) constructor field name
As you said, you're probably looking for lenses. A lens is a value that allows to read, set or modify a given field. Usually with Control.Lens, you define fields with underscores and you use makeLenses to create full-featured lenses.
There are many combinators that allow lenses to be used together within MonadState. In your case we can use %=, which in this case would be specialized to type
(MonadState s m) => Lens' s b -> (b -> b) -> m ()
which modifies a state value using a given lens and a function that operates on the inside value.
Your example could be rewritten using lenses as follows:
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
data Test = Test { _first :: Int
, _second :: String
}
deriving Show
-- Generate `first` and `second` lenses.
$(makeLenses ''Test)
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
r <- lift getLine
l %= (++ r)
dataTest :: Test
dataTest = Test { _first = 1, _second = "" }
test :: IO Test
test = execStateT (modif second) dataTest
i have the following set of actions:
action1 :: IO Bool
action2 :: IO Bool
action3 :: IO Bool
some actions are just composition of another actions
complexAction = do
action1
action2
action3
What i need is the construction that checks result of each action and returns False in a case of false. I can do it manually but i know for sure that haskell does have tools to get rid of that kind of boilerplate.
The simplest way is
complexAction = fmap and (sequence [action1, action2, action3])
But you could also write your own combinator to stop after the first action:
(>>/) :: Monad m => m Bool -> m Bool -> m Bool
a >>/ b = do
yes <- a
if yes then b else return False
You'd want to declare the fixity to make it associative
infixl 1 >>/
Then you can do
complexAction = action1 >>/ action2 >>/ action3
I'd suggest you to use MaybeT monad transformer instead. Using it has many advantages over just returning IO Bool:
Your actions can have different types and return values (not just true/false). If you don't need any results, just use MaybeT IO ().
Later ones can depend on results of preceding ones.
Since MaybeT produces monads that are instances of MonadPlus, you can use all monad plus operations. Namely mzero for a failed action and x mplus y, which will run y iff x fails.
A slight disadvantage is that you have to lift all IO actions to MaybeT IO. This can be solved by writing your actions as MonadIO m => ... -> m a instead of ... -> IO a.
For example:
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
-- Lift print and putStrLn
print' :: (MonadIO m, Show a) => a -> m ()
print' = liftIO . print
putStrLn' :: (MonadIO m) => String -> m ()
putStrLn' = liftIO . putStrLn
-- Add something to an argument
plus1, plus3 :: Int -> MaybeT IO Int
plus1 n = print' "+1" >> return (n + 1)
plus3 n = print' "+3" >> return (n + 3)
-- Ignore an argument and fail
justFail :: Int -> MaybeT IO a
justFail _ = mzero
-- This action just succeeds with () or fails.
complexAction :: MaybeT IO ()
complexAction = do
i <- plus1 0
justFail i -- or comment this line out <----------------<
j <- plus3 i
print' j
-- You could use this to convert your actions to MaybeT IO:
boolIOToMaybeT :: IO Bool -> MaybeT IO ()
boolIOToMaybeT x = do
r <- lift x
if r then return () else mzero
-- Or you could have even more general version that works with other
-- transformers as well:
boolIOToMaybeT' :: (MonadIO m, MonadPlus m) => IO Bool -> m ()
boolIOToMaybeT' x = do
r <- liftIO x
if r then return () else mzero
main :: IO ()
main = runMaybeT complexAction >>= print'
As Petr says, for anything but a narrow and contained case, you're almost certainly better off wiring your code for proper error handling from the outset. I know I've often regretted not doing this, condemning myself to some very tedious refactoring.
If I may, I'd like to recommend Gabriel Gonzalez's errors package, which imposes a little more coherence on Haskell's various error-handling mechanisms than has been traditional. It allows you to plumb Eithers through your code, and Either is a good type for capturing errors. (By contrast, Maybe will lose information on the error side.) Once you've installed the package, you can write things like this:
module Errors where
import Control.Error
import Data.Traversable (traverse)
data OK = OK Int deriving (Show)
action1, action2, action3 :: IO (Either String OK)
action1 = putStrLn "Running action 1" >> return (Right $ OK 1)
action2 = putStrLn "Running action 2" >> return (Right $ OK 2)
action3 = putStrLn "Running action 3" >> return (Left "Oops on 3")
runStoppingAtFirstError :: [IO (Either String OK)] -> IO (Either String [OK])
runStoppingAtFirstError = runEitherT . traverse EitherT
...with output like
*Errors> runStoppingAtFirstError [action1, action2]
Running action 1
Running action 2
Right [OK 1,OK 2]
*Errors> runStoppingAtFirstError [action1, action3, action2]
Running action 1
Running action 3
Left "Oops on 3"
(But note that the computation here stops at the first error and doesn't soldier on until the bitter end -- which might not be what you had wanted. The errors package is certainly wide-ranging enough that many other variations are possible.)
parseSource :: String -> Either ParserError Mod.Module
parseSource src = do
(imports, rest) <- parseImports (Lex.lexSource src)
bindings <- mapM parseBinding rest
buildModule imports bindings
I need to make the above return an IO (Either ParserError Mod.Module) as the buildModule statement at the end will need to perform some IO functions (reading files). The problem i have is that when i make it an IO function, i can no longer do the bind(wrong term?) <- operations.
What is the simplest way to make this work?
Take a look at defining your problem in terms of ErrorT ParseError IO.
I couldn't find a combinator to lift a pure Either computation into the ErrorT monad, so I wrote one called liftError. I fleshed out your example with dummy types and implementations. The main runs the parser twice, once with input that throws a ParserError, and once which succeeds with an IO side-effect. In order for ErrorT ParserError IO to be a Monad, ParserError must be an instance of Error (so that it is possible to implement fail).
import Control.Monad.Error
type ParserMonad = ErrorT ParserError IO
data ParserError = ParserError1 | ParserError2 | ParserError3
deriving(Show)
data Module = Module
deriving(Show)
data Import = Import
deriving(Show)
data Binding = Binding
deriving(Show)
instance Error ParserError where
noMsg = undefined
-- lift a pure Either into the ErrorT monad
liftError :: Monad m => Either e a -> ErrorT e m a
liftError = ErrorT . return
parseSource :: String -> ParserMonad Module
parseSource src = do
(imports, rest) <- liftError $ parseImports (lexSource src)
bindings <- liftError $ mapM parseBinding rest
buildModule imports bindings
lexSource :: String -> [String]
lexSource = return
parseImports :: [String] -> Either ParserError ([Import], [String])
parseImports toks = do{ when (null toks) $ throwError ParserError1
; return ([Import], toks)
}
parseBinding :: String -> Either ParserError Binding
parseBinding b = do{ when (b == "hello") $ throwError ParserError2
; return Binding
}
buildModule :: [Import] -> [Binding] -> ParserMonad Module
buildModule i b = do{ liftIO $ print "hello"
; when (null b) $ throwError ParserError3
; return Module
}
main = mapM (runErrorT . parseSource) ["hello", "world"]