According to https://hackage.haskell.org/package/ConfigFile-1.0.5/docs/Data-ConfigFile.html, the package will convert a value in a config. file to a Bool. The following code:
{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ConfigFile as DC
import qualified Control.Monad.Except as CME
-- | The foundation object
data JRState = JRState {
secureOnly :: Bool -- ^ restrict connections to HTTPS
}
main :: IO ()
main = (CME.runExceptT $ pipe (JRState False)) >>= estate
estate :: Show t => Either t JRState -> IO ()
estate (Right state) = return ()
estate (Left err) = do
putStrLn $ "<<" ++ show err ++ ">>"
return ()
pipe :: (CME.MonadError DC.CPError m, CME.MonadIO m) => JRState -> m JRState
pipe site = do
cp <- CME.join $ CME.liftIO $ return $ DC.readstring DC.emptyCP{DC.optionxform=id} "secureSession = True\n"
DC.get cp "DEFAULT" "secureSession" >>= return . nubb where
nubb (Left err) = error err
nubb (Right value) = site{secureOnly = value}
when run, produces
<<(ParseError "couldn't parse value True from (DEFAULT/secureSession)","genericget")>>
which has obviously come from the putStrLn in estate. But I would expect that the extraction of the value, in pipe and nubb (silly names, I know) would force a Boolean context and thus force the conversion of the True string to a Bool. I've tried 1 and Yes with the same result. What's going on?
Here is a more minimal program with similarly problematic behavior:
import qualified Data.ConfigFile as DC
import qualified Control.Monad.Except as CME
main = CME.runExceptT pipe >>= print
pipe = do
cp <- DC.readstring DC.emptyCP{DC.optionxform=id} "secureSession = True\n"
DC.get cp "DEFAULT" "secureSession" >>= nubb
nubb :: Either String Bool -> m Bool
nubb = undefined
When it's stripped down to this bare-bones form, it's obvious what has gone wrong: you are asking DC.get to return an Either String Bool when in fact you should simply be asking it to return a Bool. Simple fix for the stripped-down version is to eliminate the >>= nubb part of that line entirely; it should be easy to translate this fix back into your bigger context.
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.
I have a function "management" that checks parameters and return a Maybe (String):
If there are not parameter -> return Nothing
If my parameter is equal to "-h" -> Return a string help
My problem arrived when I get a file and check if this file exists.
Couldn't match expected type ‘Maybe String’
with actual type ‘IO (Either e0 a2)’
managagment :: [String] -> Maybe (String)
managagment [] = Nothing
managagment ["-h"] = Just (help)
managagment [file] = try $ readFile file >>= \result -> case result of
Left e -> Nothing
Right content -> Just (content)
There are several problems
Function application ($) is lower precedence than bind (>>=)
You said:
try $ readFile file >>= \res...
Which means
try ( readFile file >>= \res... )
But you wanted:
try ( readFile file ) >>= \res...
IO (Maybe a) and Maybe a are distinct
You have a function using IO (via readFile and try) but many of the cases do not return an IO result (Nothing and Just content).
Solution: Return via return Nothing or pure Nothing to lift a value into the IO monad.
The exception type was ambiguous
The try function can catch any exception type, just look at the signature:
try :: Exception e => IO a -> IO (Either e a)
When you totally ignore the exception you leave the type checker with no information to decide what e should be. In these situations an explicit type signature is useful, such as:
Left (e::SomeException) -> pure Nothing
managagment is partial
managagment ["a","b"] is undefined as is any input list of length over one. Consider a final equational definition of:
managagment _ = managagment ["-h"]
Or more directly:
managagment _ = pure $ Just help
Style and other notes
managagment should probably management
Just (foo) is generally Just foo
help is not a function that returns a String. It is a value of type String.
The example was not complete, missing imports and help.
Fixed Code
Consider instead:
#!/usr/bin/env cabal
{- cabal:
build-depends: base
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
import Control.Exception (try, SomeException)
main :: IO ()
main = print =<< management []
help :: String
help = "so helpful"
management :: [String] -> IO (Maybe String)
management [] = pure Nothing
management ["-h"] = pure $ Just help
management [file] =
try (readFile file) >>=
\case
Left (e::SomeException) -> pure Nothing
Right content -> pure $ Just content
management _ = pure $ Just help
And test as such:
% chmod +x x.hs
% ./x.hs
I have a question regarding use of Exceptions with a transformer stack.
I am a trying to develop some networking software, specifically implement
the GTP control protocol on S5 interface.
I am finding it difficult to get Exceptions work the transformer stack.
import Control.Monad (unless)
import Control.Exception
....
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
...
data GtpcModSt = GtpcModSt { sock :: Socket
, rcvdBytes :: BS.ByteString
, s5cTeidKey :: Word32
---- ....
} --deriving (Show)
type EvalGtpC a = (StateT GtpcModSt (ExceptT GtpcExceptions IO )) a
-- deriving (Functor, Applicative, Monad)
gtpcProcess = loop
where loop = do
rcvAndProcessGtpc `catch` (\e -> do
print "Exception handler"
print (e :: SomeException))
loop
rcvAndProcessGtpc :: EvalGtpC ()
rcvAndProcessGtpc = do
sock <- gets sock
(msg, addr) <- liftIO $ recvFrom sock 1000
modify (\x -> x {rcvdBytes = msg, sndrAddr = addr})
processMsg
processMsg :: EvalGtpC ()
processMsg = do
-- validateSrc
-----
--....
msg <- gets gtpMsg
processGtpc $ msgType msg
-- createSessionRequest
processGtpc :: Word8 -> EvalGtpC ()
processGtpc 32 = do
myState#GtpcModSt {..} <- get
.....
sessParams <- return $ foldl ieInfo (SessionParams { imsi = Nothing
, mei = Nothing
, msisdn = Nothing
, senderFteidKey = Nothing
, senderIpV4Addr = Nothing
, senderIpV6Addr = Nothing
, pgwFteidKey = Nothing
, pgwIpV4Addr = Nothing
, pgwIpV6Addr = Nothing
, apn = Nothing
, paaPdnType = Nothing
, pco = Nothing
, bearerContext = []
, unDecodedIe = []
, unSupportedIe = []
}) $ msgIeList gtpMsg
ueApn <-return $ fromMaybe (throwE BadIe) (apn sessParams)
apnCfg <- return $ fromMaybe (throw BadIe) $ Map.lookup ueApn apnProfile
thisSndrFteidKey <-return $ fromMaybe (throw BadIe) (senderFteidKey sessParams)
I think that I should use throwE/catchE from Control.Monad.Trans.Except. However, throwE does not even compile when used with my transformer monad, as shown here:
apnCfg <- return $ fromMaybe (throw UnknownApn) $ Map.lookup ueApn apnProfile
Using throw from Control.Exception gets past the compilation stage but I am not sure it will work.
Should I not be using Exception in a transformer monad that has IO as its base?
I think that I should use throwE/catchE from Control.Monad.Trans.Except. However, throwE does not even compile when used with my transformer monad, as shown here:
apnCfg <- return $ fromMaybe (throw UnknownApn) $ Map.lookup ueApn apnProfile
Using throw from Control.Exception gets past the compilation stage but I am not sure it will work.
This can be solved by following the types. In your do-block, we have:
-- I won't use the synonym here, for the sake of explicitness:
return :: a -> StateT GtpcModSt (ExceptT GtpcExceptions IO) a
The type of throwE is:
throwE :: Monad m => e -> ExceptT e m a
That being so, what you want is:
apnCfg <- maybe (lift $ throwE UnknownApn) return $ Map.lookup ueApn apnProfile
Firstly, you only need return if you aren't throwing (maybe is more convenient than fromMaybe for expressing that). Secondly, throwE produces an ExceptT computation that you need to lift to the outer, StateT layer. You can make the lift implicit by using mtl instead of transformers directly. To do that, change your imports from...
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Except
... to:
import Control.Monad.State.Strict
import Control.Monad.Except
Then you can simply write (using the throwError method from MonadError):
apnCfg <- maybe (throwError UnknownApn) return $ Map.lookup ueApn apnProfile
While doing some TTD in Haskell, I recently developed the following function:
import Test.HUnit
import Data.Typeable
import Control.Exception
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun = catch (fun >> assertFailure msg) handle
where
msg = show errType ++ " exception was not raised!"
handle (SomeException e) [...]
The function takes a Type representation of an expected exception and an IO action. The problem is that most of the time I don't get the exception thrown even though I should have been, because of laziness. Often failing parts of fun are actually never evaluated here.
To remedy this i tried to replace (fun >> assertFailure msg) with (seq fun $ assertFailure msg). I also tried to enable BangPatterns extension and put a bang before fun binding, but none of it helped. So how can I really force Haskell to evaluate fun strictly?
You have to distinguish between:
Evaluating the value of type IO a
Running the action represented by it, which may have side effects and returns a value of type a, and
Evaluating the result of type a (or parts of it).
These always happen in that order, but not necessarily all of it. The code
foo1 :: IO a -> IO ()
foo1 f = do
seq f (putStrLn "done")
will do only the first, while
foo2 :: IO a -> IO ()
foo2 f = do
f -- equivalent to _ <- f
putStrLn "done"
also does the second and finally
foo3 :: IO a -> IO ()
foo3 f = do
x <- f
seq x $ putStrLn "done"
also does the third (but the usual caveats of using seq on a complex data type like lists apply).
Try these arguments and observe that foo1, foo2 and foo3 treat them differently.
f1 = error "I am not a value"
f2 = fix id -- neither am I
f3 = do {putStrLn "Something is printed"; return 42}
f4 = do {putStrLn "Something is printed"; return (error "x has been evaluated")}
f5 = do {putStrLn "Something is printed"; return (Just (error "x has been deeply evaluated"))}
You probably need to force the value to its normal form, not just its weak head normal form. For example, evaluating Just (error "foo") to WHNF won't trigger the exception, it'll just evaluate Just. I'd use the combination of evaluate (which allows to properly sequence forced evaluation with IO actions) and rnf (or force if you'd need the value for something):
assertException :: (Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
catch (fun >>= evaluate . rnf >> assertFailure msg) handle
where ...
However, be careful, as assertFailure is implemented using exceptions, so wrapping into the catch block might catch it as well. So I'd suggest to evaluate the computation using try and call assertFailure outside the try block:
import Test.HUnit
import Data.Typeable
import Control.DeepSeq
import Control.Exception
assertException :: (NFData a, Show a) => TypeRep -> IO a -> Assertion
assertException errType fun =
(try (fun >>= evaluate . rnf) :: IO (Either SomeException ())) >>= check
where
check (Right _) =
assertFailure $ show errType ++ " exception was not raised!"
check (Left (SomeException ex))
| typeOf ex == errType = return () -- the expected exception
| otherwise = assertFailure
$ show ex ++ " is not " ++ show errType
It seems to me that exceptions in Haskell can be caught only immediately after they're thrown and are not propagated as in Java or Python. A short example illustrating this is below:
{-# LANGUAGE DeriveDataTypeable #-}
import System.IO
import Control.Monad
import Control.Exception
import Data.Typeable
data MyException = NoParseException String deriving (Show, Typeable)
instance Exception MyException
-- Prompt consists of two functions:
-- The first converts an output paramter to String being printed to the screen.
-- The second parses user's input.
data Prompt o i = Prompt (o -> String) (String -> i)
-- runPrompt accepts a Prompt and an output parameter. It converts the latter
-- to an output string using the first function passed in Prompt, then runs
-- getline and returns user's input parsed with the second function passed
-- in Prompt.
runPrompt :: Prompt o i -> o -> IO i
runPrompt (Prompt ofun ifun) o = do
putStr (ofun o)
hFlush stdout
liftM ifun getLine
myPrompt = Prompt (const "> ") (\s -> if s == ""
then throw $ NoParseException s
else s)
handleEx :: MyException -> IO String
handleEx (NoParseException s) = return ("Illegal string: " ++ s)
main = catch (runPrompt myPrompt ()) handleEx >>= putStrLn
After running the program, when you just press [Enter] whithout typing anything, I supposed to see: Illegal string: in the output. Instead there appears: prog: NoParseException "". Suppose now that Prompt type and runPrompt function are defined in common library outside the module and cannot be changed to handle the exception in functions passed to Prompt constructor. How can I handle the exception without changing the runPrompt?
I thought about adding the third field to Prompt to inject exception-handling function this way, but it seems ugly to me. Is there a better choice?
The problem you're having is because you're throwing your exception in pure code: the type of throw is Exception e => e -> a. Exceptions in pure code are imprecise, and do not guarantee ordering with respect to IO operations. So the catch doesn't see the pure throw. To fix that, you can use evaluate :: a -> IO a, which "can be used to order evaluation with respect to other IO operations" (from the docs). evaluate is like return, but it forces evaluation at the same time. Thus, you can replace liftM ifun getLine with evaluate . ifun =<< getline, which forces ifun to have been evaluated during runPrompt IO action. (Recall that liftM f mx = return . f =<< mx, so this is the same but with more control over evaluation.) And without changing anything else, you'll get the right answer:
*Main> :main
>
Illegal string:
Really, though, this isn't where I'd use exceptions. People don't use exceptions all that much in Haskell code, and particularly not in pure code. I'd much rather write Prompt so that the input function's potential failure would be encoded in the type:
data Prompt o i = Prompt (o -> String) (String -> Either MyException i)
Then, running the prompt would just return an Either:
runPrompt :: Prompt o i -> o -> IO (Either MyException i)
runPrompt (Prompt ofun ifun) o = do putStr $ ofun o
hFlush stdout
ifun `liftM` getLine
We'd tweak myPrompt to use Left and Right instead of throw:
myPrompt :: Prompt a String
myPrompt = Prompt (const "> ") $ \s ->
if null s
then Left $ NoParseException s
else Right s
And then we use either :: (a -> c) -> (b -> c) -> Either a b -> c to handle the exception.
handleEx :: MyException -> IO String
handleEx (NoParseException s) = return $ "Illegal string: " ++ s
main :: IO ()
main = putStrLn =<< either handleEx return =<< runPrompt myPrompt ()
(Additional, unrelated, note: you'll notice I made some stylistic changes here. The only one I'd say is truly important is to use null s, not s == "".)
If you really want the old behavior back at the top level, you can write runPromptException :: Prompt o i -> o -> IO i which throws the Left case as an exception:
runPromptException :: Prompt o i -> o -> IO i
runPromptException p o = either throwIO return =<< runPrompt p o
We don't need to use evaluate here because we're using throwIO, which is for throwing precise exceptions inside IO computations. With this, your old main function will work fine.
If you look at the type of myPrompt, you’ll see that it’s Prompt o String, i.e. not in IO. For the smallest fix:
{-# LANGUAGE DeriveDataTypeable #-}
import System.IO
import Control.Monad
import Control.Exception
import Data.Typeable
data MyException = NoParseException String deriving (Show, Typeable)
instance Exception MyException
-- Prompt consists of two functions:
-- The first converts an output paramter to String being printed to the screen.
-- The second parses user's input.
data Prompt o i = Prompt (o -> String) (String -> IO i)
-- runPrompt accepts a Prompt and an output parameter. It converts the latter
-- to an output string using the first function passed in Prompt, then runs
-- getline and returns user's input parsed with the second function passed
-- in Prompt.
runPrompt :: Prompt o i -> o -> IO i
runPrompt (Prompt ofun ifun) o = do
putStr (ofun o)
hFlush stdout
getLine >>= ifun
myPrompt :: Prompt o String
myPrompt = Prompt (const "> ") (\s -> if s == ""
then throw $ NoParseException s
else return s)
handleEx :: MyException -> IO String
handleEx (NoParseException s) = return ("Illegal string: " ++ s)
main = catch (runPrompt myPrompt ()) handleEx >>= putStrLn
Though it might be more appropriate it to be Prompt o i e = Prompt (o -> String) (String -> Either i e).