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
Related
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.
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?
I'm currently learning about free monads and I was toying with probably the simplest and most common example out there – Teletype:
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Free
data TeletypeF a = Put String a
| Get (String -> a)
deriving Functor
type Teletype = Free TeletypeF
Many tutorials interpret Teletype programs in the IO monad. For example:
-- Utilities
get = liftF $ Get id
put s = liftF $ Put s ()
-- Sample programs
echo :: Teletype ()
echo = do word <- get
if word == "\04" -- Ctrl-D
then return ()
else put word >> echo
hello :: Teletype ()
hello = do put "What is your name?"
name <- get
put "What is your age?"
age <- get
put ("Hello, " ++ name ++ "!")
put ("You are " ++ age ++ " years old!")
-- Interpret to IO
interpIO :: Teletype a -> IO a
interpIO = foldFree lift
where
lift (Put s a) = putStrLn s >> return a
lift (Get f) = getLine >>= return . f
I was trying to interpret it in a different monad, namely the RWS monad.
This idea was motivated by the last exercise from this assignment.
I'm using the RWS datatype to fetch input from the Reader part and accumulate output in the State part.
But, unfortunately, I'm not able to get it working. Here is my attempt so far:
import Control.Monad.Trans.RWS.Lazy hiding (get, put)
type TeletypeRWS = RWS [String] () [String]
-- Interpret to TeletypeRWS
interpRWS :: Teletype a -> TeletypeRWS a
interpRWS = foldFree lift
where
lift (Put s a) = state (\t -> ((), t ++ [s])) >> return a
lift (Get f) = reader head >>= local tail . return . f -- This is wrong
mockConsole :: Teletype a -> [String] -> (a, [String])
mockConsole p inp = (a, s)
where
(a, s, _) = runRWS (interpRWS p) inp []
When running the TeletypeRWS "programs", the first value in the environment is not removed:
*Main> mockConsole hello ["john", "18"]
((),["What is your name?","What is your age?","Hello, john!","You are john years old!"])
I am a bit uneasy about updating the Reader, but I don't know how else I can access the next value in the list. The type of TeletypeRWS was chosen based on the exercise mentioned above – so I assume it should be possible to implement interpRWS.
We can't use foldFree: it needs to be parametric in the continuation, so we can't apply local there. In contrast, iterM explicitly gives us the actual continuation without generalization, so this will work.
interpRWS = iterM lift where
lift (Put s a) = modify (\t -> t ++ [s]) >> a
lift (Get f) = reader head >>= local tail . f
EDITED 2015-11-29: see bottom
I'm trying to write an application that has a do-last-action-again button. The command in question can ask for input, and my thought for how to accomplish this was to just rerun the resulting monad with memoized IO.
There are lots of posts on SO with similar questions, but none of the solutions seem to work here.
I lifted the memoIO code from this SO answer, and changed the implementation to run over MonadIO.
-- Memoize an IO function
memoIO :: MonadIO m => m a -> m (m a)
memoIO action = do
ref <- liftIO $ newMVar Nothing
return $ do
x <- maybe action return =<< liftIO (takeMVar ref)
liftIO . putMVar ref $ Just x
return x
I've got a small repro of my app's approach, the only real difference being my app has a big transformer stack instead of just running in IO:
-- Global variable to contain the action we want to repeat
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
-- Run an action and store it as the action to repeat
repeatable :: IO String -> IO String
repeatable action = do
writeIORef actionToRepeat action
action
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
The idea being I can store an action with memoized IO in an IORef (via repeatable) when I record what was last done, and then do it again it out with doRepeat.
I test this via:
-- IO function to memoize
getName :: IO String
getName = do
putStr "name> "
getLine
main :: IO ()
main = do
repeatable $ do
memoized <- memoIO getName
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
with expected output:
name> isovector
hello isovector
hello isovector
but actual output:
name> isovector
hello isovector
name> wasnt memoized
hello wasnt memoized
I'm not entirely sure what the issue is, or even how to go about debugging this. Gun to my head, I'd assume lazy evaluation is biting me somewhere, but I can't figure out where.
Thanks in advance!
EDIT 2015-11-29: My intended use case for this is to implement the repeat last change operator in a vim-clone. Each action can perform an arbitrary number of arbitrary IO calls, and I would like it to be able to specify which ones should be memoized (reading a file, probably not. asking the user for input, yes).
the problem is in main you are creating a new memo each time you call the action
you need to move memoized <- memoIO getName up above the action
main :: IO ()
main = do
memoized <- memoIO getName --moved above repeatable $ do
repeatable $ do
--it was here
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
edit: is this acceptable
import Data.IORef
import System.IO.Unsafe
{-# NOINLINE actionToRepeat #-}
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
type Repeatable a = IO (IO a)
-- Run an action and store the Repeatable part of the action
repeatable :: Repeatable String -> IO String
repeatable action = do
repeatAction <- action
writeIORef actionToRepeat repeatAction
repeatAction
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
-- everything before (return $ do) is run just once
hello :: Repeatable String
hello = do
putStr "name> "
name <- getLine
return $ do
putStr "hello "
putStrLn name
return name
main :: IO ()
main = do
repeatable hello
doRepeat
return ()
I came up with a solution. It requires wrapping the original monad in a new transformer which records the results of IO and injects them the next time the underlying monad is run.
Posting it here so my answer is complete.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (Applicative(..))
import Data.Dynamic
import Data.Maybe (fromJust)
import Control.Monad.RWS
-- | A monad transformer adding the ability to record the results
-- of IO actions and later replay them.
newtype ReplayT m a =
ReplayT { runReplayT :: RWST () [Dynamic] [Dynamic] m a }
deriving ( Functor
, Applicative
, Monad
, MonadIO
, MonadState [Dynamic]
, MonadWriter [Dynamic]
, MonadTrans
)
-- | Removes the first element from a list State and returns it.
dequeue :: MonadState [r] m
=> m (Maybe r)
dequeue = do
get >>= \case
[] -> return Nothing
(x:xs) -> do
put xs
return $ Just x
-- | Marks an IO action to be memoized after its first invocation.
sample :: ( MonadIO m
, Typeable r)
=> IO r
-> ReplayT m r
sample action = do
a <- dequeue >>= \case
Just x -> return . fromJust $ fromDynamic x
Nothing -> liftIO action
tell [toDyn a]
return a
-- | Runs an action and records all of its sampled IO. Returns a
-- action which when invoked will use the recorded IO.
record :: Monad m
=> ReplayT m a
-> m (m a)
record action = do
(a, w) <- evalRWST (runReplayT action) () []
return $ do
evalRWST (runReplayT action) () w
return a
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.)