Haskell enumerators, odd errors - haskell

I'm trying to figure out how enumerators work, and therefore testing the enumerator library. I have a snippet which compiles on my desktop computer, but complains about No instance for MonadIO. Am I way off on how to use the enumerator library or is something amiss with my laptop?
iterateetests.hs:29:17:
No instance for (MonadIO (Iteratee Int IO))
arising from a use of `enumeratorFile' at iterateetests.hs:29:17-32
Possible fix:
add an instance declaration for (MonadIO (Iteratee Int IO))
In the first argument of `(==<<)', namely `enumeratorFile h'
In the first argument of `run_', namely
`(enumeratorFile h ==<< summer)'
In the expression: run_ (enumeratorFile h ==<< summer)
And the code
import Data.Enumerator
import qualified Data.Enumerator.List as EL
import System.IO
import Control.Exception.Base
import Control.Monad.Trans
summer :: (Monad m) => Iteratee Int m Int
summer = do
m <- EL.head
case m of
Nothing -> return 0
Just i -> do
rest <- summer
return (i+rest)
enumeratorFile h (Continue k) = do
e <- liftIO (hIsEOF h)
if e
then k EOF
else do
l <- liftIO $ hGetLine h
k (Chunks [read l]) >>== enumeratorFile h
enumeratorFile _ step = returnI step
main = do
bracket
(openFile "numberlist" ReadMode)
(hClose)
(\h -> run_ (enumeratorFile h ==<< summer))

Try changing the import of:
import Control.Monad.Trans
to
import Control.Monad.IO.Class
It may be that you have an older version of mtl installed, and therefore have different MonadIO typeclasses between Control.Monad.Trans and Data.Enumerator.

Related

catching state that is changed by execStateT

I am very new to Haskell. Recently, I had to work with it for my project.
I have a certain code which is evaluating some state using execStateT and I want to catch each state change and return it.
I have tried to understand what execStateT and the flow of the code, but I am failing at certain places, where I couldn't understand how to get the thing I really want.
Maybe due to a somewhat RAW understanding of monads and other concepts, I am finding a need to change the whole structure of the code.
In the upcoming code, I tried to use par to create a file and write the state of a variable into that file, and so it doesn't affect the actual work of the code. But it didn't create a file and write the inputs into it.
I am facing the following code
campaign u v w ts d = let d' = fromMaybe defaultDict d in fmap (fromMaybe mempty) (view (hasLens . to knownCoverage)) >>= \c -> do
g <- view (hasLens . to seed)
let g' = mkStdGen $ fromMaybe (d' ^. defSeed) g
execStateT (evalRandT runCampaign g') (Campaign ((,Open (-1)) <$> ts) c d') where
step = runUpdate (updateTest v Nothing) >> lift u >> runCampaign
runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
update c = view hasLens >>= \(CampaignConf tl q sl _ _) ->
if | any (\case Open n -> n < tl; _ -> False) c -> callseq v w q >> step
| any (\case Large n _ -> n < sl; _ -> False) c -> step
| otherwise -> lift u
What I want here is find some way to look at the changes in variable v, to do my further work. This can be done either by writing a variable into a file or returning it to the console.
Thanks for help!
[Edit 1]
Here are the imports I am making:
import Control.Lens
import Control.Monad (liftM2, replicateM, when)
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Monad.Random.Strict (MonadRandom, RandT, evalRandT)
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.State.Strict (MonadState(..), StateT, evalStateT, execStateT)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Random.Strict (liftCatch)
import Data.Aeson (ToJSON(..), object)
import Data.Bool (bool)
import Data.Either (lefts)
import Data.Foldable (toList)
import Data.Map (Map, mapKeys, unionWith)
import Data.Maybe (fromMaybe, isNothing, maybeToList)
import Data.Ord (comparing)
import Data.Has (Has(..))
import Data.Set (Set, union)
import Data.Text (unpack)
import EVM
import EVM.Types (W256)
import Numeric (showHex)
import System.Random (mkStdGen)
Here's one approach. Suppose you have a class for monads supporting logging of messages with a certain type (MonadLogger is one, but I don't know enough about it to use it here). I'll just use a hypothetical CanLog class. Now you can write
newtype LStateT s m a = LStateT
{runLStateT :: StateT s m a}
deriving (Functor, Applicative, Monad)
instance CanLog s m => MonadState s (LStateT s m) where
get = LStateT get
put x = LStateT $ do
lift $ -- Log the state transition
put x

How to make MonadError work with ghcjs/reflex

I'm struggling to compile the following program:
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
import Reflex.Dom
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
-- let t = (T.pack "this program works if you replace the line below with this")
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
text t
however this similar version works with vanilla ghc
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
body
body = do
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
T.putStrLn t
The compiler says something is ambiguous and I'm not really sure how to implement these to work.
The type variable ‘e0’ is ambiguous
Relevant bindings include body :: m () (bound at reflex.hs:14:1)
These potential instances exist:
instance [safe] Control.Monad.Error.Class.MonadError e (Either e)
-- Defined in ‘Control.Monad.Error.Class’
...plus 13 instances involving out-of-scope types
instance [safe] Control.Monad.Error.Class.MonadError
GHC.IO.Exception.IOException IO
-- Defined in ‘Control.Monad.Error.Class’
instance [safe] (Monad m, Control.Monad.Trans.Error.Error e) =>
Control.Monad.Error.Class.MonadError
e (Control.Monad.Trans.Error.ErrorT e m)
-- Defined in ‘Control.Monad.Error.Class’
FYI: I haven't fully grasped Monads yet and easily get scared with these errors. Help!
In the ghc version, importString is operating in the context of an IO monad do statement . importString is capable of returning a value in the IO monad so the compiler is happy
In the ghcjs version, importString is operating in the context of an m monad do statement (m is specified in the declaration of body ). importString has no way to return a value in the m monad so the compiler complains.
You can get around this by using liftIO to change an IO monad value to a m monad value. Here's your code with this change and a few other changes that I made to help myself understand the code.
import Data.Maybe
import qualified Data.Text as T
import Data.URLEncoded as DU
import Reflex.Dom
import Control.Monad.Trans as CMT
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
let istr = CMT.liftIO $ DU.importString (T.unpack url)
t <- fmap (T.pack . fromMaybe "" . DU.lookup "parm2") istr
text t

Join two consumers into a single consumer that returns multiple values?

I have been experimenting with the new pipes-http package and I had a thought. I have two parsers for a web page, one that returns line items and another a number from elsewhere in the page. When I grab the page, it'd be nice to string these parsers together and get their results at the same time from the same bytestring producer, rather than fetching the page twice or fetching all the html into memory and parsing it twice.
In other words, say you have two Consumers:
c1 :: Consumer a m r1
c2 :: Consumer a m r2
Is it possible to make a function like this:
combineConsumers :: Consumer a m r1 -> Consumer a m r2 -> Consumer a m (r1, r2)
combineConsumers = undefined
I have tried a few things, but I can't figure it out. I understand if it isn't possible, but it would be convenient.
Edit:
I'm sorry it turns out I was making an assumption about pipes-attoparsec, due to my experience with conduit-attoparsec that caused me to ask the wrong question. Pipes-attoparsec turns an attoparsec into a pipes Parser when I just assumed that it would return a pipes Consumer. That means that I can't actually turn two attoparsec parsers into consumers that take text and return a result, then use them with the plain old pipes ecosystem. I'm sorry but I just don't understand pipes-parse.
Even though it doesn't help me, Arthur's answer is pretty much what I envisioned when I asked the question, and I'll probably end up using his solution in the future. In the meantime I'm just going to use conduit.
It the results are "monoidal", you can use the tee function from the Pipes prelude, in combination with a WriterT.
{-# LANGUAGE OverloadedStrings #-}
import Data.Monoid
import Control.Monad
import Control.Monad.Writer
import Control.Monad.Writer.Class
import Pipes
import qualified Pipes.Prelude as P
import qualified Data.Text as T
textSource :: Producer T.Text IO ()
textSource = yield "foo" >> yield "bar" >> yield "foo" >> yield "nah"
counter :: Monoid w => T.Text
-> (T.Text -> w)
-> Consumer T.Text (WriterT w IO) ()
counter word inject = P.filter (==word) >-> P.mapM (tell . inject) >-> P.drain
main :: IO ()
main = do
result <-runWriterT $ runEffect $
hoist lift textSource >->
P.tee (counter "foo" inject1) >-> (counter "bar" inject2)
putStrLn . show $ result
where
inject1 _ = (,) (Sum 1) mempty
inject2 _ = (,) mempty (Sum 1)
Update: As mentioned in a comment, the real problem I see is that in pipes parsers aren't Consumers. And how can you run two parsers concurrently if they have different behaviours regarding leftovers? What happens if one of the parsers wants to "un-draw" some text and the other parser doesn't?
One possible solution is to run the parsers in a truly concurrent manner, in different threads. The primitives in the pipes-concurrency package let you "duplicate" a Producer by writing the same data to two different mailboxes. And then each parser can do whatever it wants with its own copy of the producer. Here's an example which also uses the pipes-parse, pipes-attoparsec and async packages:
{-# LANGUAGE OverloadedStrings #-}
import Data.Monoid
import qualified Data.Text as T
import Data.Attoparsec.Text hiding (takeWhile)
import Data.Attoparsec.Combinator
import Control.Applicative
import Control.Monad
import Control.Monad.State.Strict
import Pipes
import qualified Pipes.Prelude as P
import qualified Pipes.Attoparsec as P
import qualified Pipes.Concurrent as P
import qualified Control.Concurrent.Async as A
parseChars :: Char -> Parser [Char]
parseChars c = fmap mconcat $
many (notChar c) *> many1 (some (char c) <* many (notChar c))
textSource :: Producer T.Text IO ()
textSource = yield "foo" >> yield "bar" >> yield "foo" >> yield "nah"
parseConc :: Producer T.Text IO ()
-> Parser a
-> Parser b
-> IO (Either P.ParsingError a,Either P.ParsingError b)
parseConc producer parser1 parser2 = do
(outbox1,inbox1,seal1) <- P.spawn' P.Unbounded
(outbox2,inbox2,seal2) <- P.spawn' P.Unbounded
feeding <- A.async $ runEffect $ producer >-> P.tee (P.toOutput outbox1)
>-> P.toOutput outbox2
sealing <- A.async $ A.wait feeding >> P.atomically seal1 >> P.atomically seal2
r <- A.runConcurrently $
(,) <$> (A.Concurrently $ parseInbox parser1 inbox1)
<*> (A.Concurrently $ parseInbox parser2 inbox2)
A.wait sealing
return r
where
parseInbox parser inbox = evalStateT (P.parse parser) (P.fromInput inbox)
main :: IO ()
main = do
(Right a, Right b) <- parseConc textSource (parseChars 'o') (parseChars 'a')
putStrLn . show $ (a,b)
The result is:
("oooo","aa")
I'm not sure how much overhead this approach introduces.
I think something is wrong with the way you are going about this, for the reasons Davorak mentions in his remark. But if you really need such a function, you can define it.
import Pipes.Internal
import Pipes.Core
zipConsumers :: Monad m => Consumer a m r -> Consumer a m s -> Consumer a m (r,s)
zipConsumers p q = go (p,q) where
go (p,q) = case (p,q) of
(Pure r , Pure s) -> Pure (r,s)
(M mpr , ps) -> M (do pr <- mpr
return (go (pr, ps)))
(pr , M mps) -> M (do ps <- mps
return (go (pr, ps)))
(Request _ f, Request _ g) -> Request () (\a -> go (f a, g a))
(Request _ f, Pure s) -> Request () (\a -> do r <- f a
return (r, s))
(Pure r , Request _ g) -> Request () (\a -> do s <- g a
return (r,s))
(Respond x _, _ ) -> closed x
(_ , Respond y _) -> closed y
If you are 'zipping' consumers without using their return value, only their 'effects' you can just use tee consumer1 >-> consumer2
The idiomatic solution is to rewrite your Consumers as a Fold or FoldM from the foldl library and then combine them using Applicative style. You can then convert this combined fold to one that works on pipes.
Let's assume that you either have two Folds:
fold1 :: Fold a r1
fold2 :: Fold a r2
... or two FoldMs:
foldM1 :: Monad m => FoldM a m r1
foldM2 :: Monad m => FoldM a m r2
Then you combine these into a single Fold/FoldM using Applicative style:
import Control.Applicative
foldBoth :: Fold a (r1, r2)
foldBoth = (,) <$> fold1 <*> fold2
foldBothM :: Monad m => FoldM a m (r1, r2)
foldBothM = (,) <$> foldM1 <*> foldM2
-- or: foldBoth = liftA2 (,) fold1 fold2
-- foldMBoth = liftA2 (,) foldM1 foldM2
You can turn either fold into a Pipes.Prelude-style fold or a Parser. Here are the necessary conversion functions:
import Control.Foldl (purely, impurely)
import qualified Pipes.Prelude as Pipes
import qualified Pipes.Parse as Parse
purely Pipes.fold
:: Monad m => Fold a b -> Producer a m () -> m b
impurely Pipes.foldM
:: Monad m => FoldM m a b -> Producer a m () -> m b
purely Parse.foldAll
:: Monad m => Fold a b -> Parser a m r
impurely Parse.foldMAll
:: Monad m => FoldM a m b -> Parser a m r
The reason for the purely and impurely functions is so that foldl and pipes can interoperate without either one incurring a dependency on the other. Also, they allow libraries other than pipes (like conduit) to reuse foldl without a dependency, too (Hint hint, #MichaelSnoyman).
I apologize that this feature is not documented, mainly because it took me a while to figure out how to get pipes and foldl to interoperate in a dependency-free manner, and that was after I wrote the pipes tutorial. I will update the tutorial to point out this trick.
To learn how to use foldl, just read the documentation in the main module. It's a very small and easy-to-learn library.
For what it's worth, in the conduit world, the relevant function is zipSinks. There might be some way to adapt this function to work for pipes, but automatic termination may get in the way.
Consumer forms a Monad so
combineConsumers = liftM2 (,)
will type check. Unfortunately, the semantics might be unlike what you're expecting: the first consumer will run to completion and then the second.

How to number lines read from a file using conduits?

I'm a Haskell beginner trying to wrap my head around the conduit library.
I've tried something like this, but it does not compile:
import Data.Conduit
import Data.Conduit.Binary as CB
import Data.ByteString.Char8 as BS
numberLine :: Monad m => Conduit BS.ByteString m BS.ByteString
numberLine = conduitState 0 push close
where
push lno input = return $ StateProducing (lno + 1) [BS.pack (show lno ++ BS.unpack input)]
close state = return state
main = do
runResourceT $ CB.sourceFile "wp.txt" $= CB.lines $= numberLine $$ CB.sinkFile "test.txt"
It seems that the state in conduitState must be of the same type as the conduit's input type. Or at least that's what I understand from the error message:
$ ghc --make exp.hs
[1 of 1] Compiling Main ( exp.hs, exp.o )
exp.hs:8:27:
Could not deduce (Num [ByteString]) arising from the literal `0'
from the context (Monad m)
bound by the type signature for
numberLine :: Monad m => Conduit ByteString m ByteString
at exp.hs:(8,1)-(11,30)
Possible fix:
add (Num [ByteString]) to the context of
the type signature for
numberLine :: Monad m => Conduit ByteString m ByteString
or add an instance declaration for (Num [ByteString])
In the first argument of `conduitState', namely `0'
In the expression: conduitState 0 push close
In an equation for `numberLine':
numberLine
= conduitState 0 push close
where
push lno input
= return
$ StateProducing (lno + 1) [pack (show lno ++ unpack input)]
close state = return state
How can this be done using conduits? I want to read lines from a file and append a line number to each line.
Yes, it can be done. I prefer to use the helper functions in Data.Conduit.List and also avoid Data.ByteString.Char8 if at all possible. I'm assuming your file is UTF-8 encoded.
import Data.Conduit
import Data.Conduit.Binary as CB
import Data.Conduit.List as Cl
import Data.Conduit.Text as Ct
import Data.Monoid ((<>))
import Data.Text as T
numberLine :: Monad m => Conduit Text m Text
numberLine = Cl.concatMapAccum step 0 where
format input lno = T.pack (show lno) <> T.pack " " <> input <> T.pack "\n"
step input lno = (lno+1, [format input lno])
main :: IO ()
main =
runResourceT
$ CB.sourceFile "wp.txt"
$$ Ct.decode Ct.utf8
=$ Ct.lines
=$ numberLine
=$ Ct.encode Ct.utf8
=$ CB.sinkFile "test.txt"
close state = return state
Herein lies the type error. Your close function should have type (state -> m [output]) (as per the docs). In your case state = Int (you may want to add type annotations to make sure it selects Int) and output = BS.ByteString, so probably just return the empty list, since at the point of closing the conduit, you haven't really saved any ByteStrings to produce or anything like that.
close _ = return []
Especially note from the docs for that argument:
The state need not be returned, since it will not be used again
An alternative solution with pipes 3.0, though it does use string instead of ByteString. The main advantage in my mind is being able to use the normal state monad methods get and put. Another benefit is that the starting line number is not hidden in the addLineNumber(numberLine) so it is easier to start at any given line number.
import System.IO
import Data.Monoid ((<>))
import Control.Proxy
import qualified Control.Proxy.Trans.State as S
addLineNumber r = forever $ do
n <- S.get
line <- request r -- request line from file
respond $ show n <> " " <> line
S.put (n + 1) -- increments line counter
main =
withFile "wp.txt" ReadMode $ \fin ->
withFile "test.txt" WriteMode $ \fout ->
runProxy $ S.execStateK 1 -- start at line number at 1
$ hGetLineS fin >-> addLineNumber >-> hPutStrLnD fout
Find out how to do more fine grained resource management at the announce blog post of pipes-safe..

How to catch an exception inside runResourceT

I would like to catch an exception inside runResourceT without releasing the resource, but the function catch runs the computation inside IO. Is there a way to catch an exception inside runResourceT, or what is the recommended way to refactor the code ?
Thank you for your help.
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Control.Exception as EX
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
type Resource = String
allocResource :: IO Resource
allocResource = let r = "Resource"
in putStrLn (r ++ " opened.") >> return r
closeResource :: Resource -> IO ()
closeResource r = putStrLn $ r ++ " closed."
withResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => (Resource -> ResourceT m a) -> m a
withResource f = runResourceT $ do
(_, r) <- allocate allocResource closeResource
f r
useResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => Resource -> ResourceT m Int
useResource r = liftIO $ putStrLn ("Using " ++ r) >> return 1
main :: IO ()
main = do
putStrLn "Start..."
withResource $ \r -> do
x <- useResource r
{-- This does not compile as the catch computation runs inside IO
y <- liftIO $ EX.catch (useResource r)
(\e -> do putStrLn $ show (e::SomeException)
return 0)
--}
return ()
putStrLn "Done."
ResourceT is an instance of MonadBaseControl from the monad-control package, which is designed for lifting control structures like forkIO and catch into transformed monads.
The lifted-base package, which is built on top of monad-control, contains modules with versions of standard control structures that work in any MonadBaseControl. For exception handling, you can use the functions in the Control.Exception.Lifted module. So, just import qualified Control.Exception.Lifted as EX1 instead, and your code should work fine.
1 Note the qualified here; quite confusingly, import A as B actually imports all of the definitions in A into scope, and simply defines B as an alias for the module! You need to use qualified to ensure that the definitions are not brought into scope, and are instead accessed exclusively through the B alias.
As an alternative approach, you can use the MonadCatch instance of ResourceT, found in the exceptions package. You simply need to substitute the generalized version of catch from Control.Monad.Catch:
import Control.Monad.Catch
…
main = do
…
withResource $ \r -> do
…
y <- Control.Monad.Catch.catch (useResource r) (\e -> …)

Resources