IO inside the Get Monad - haskell
So my problem is as follows. I'm trying to implement a streaming parser for RDB files (the dump files that Redis produces). I want to implement a function similar to mapM_ whereby I can , say print out each object represented in the dump file as it is parsed. However, I can't seem to get it to operate in constant space. I find that what is happening is that I'm building a large IO() thunk inside of the Get monad, returning from the Get monad and then executing the IO. Is there anyway to stream my objects as they are parsed to print and then discard them? I've tried Enumerators and Conduits but I haven't seen any real gain. Here is what I have so far:
loadObjs_ :: (Monad m) => (Maybe Integer -> BL8.ByteString -> RDBObj -> Get (m a)) -> Get (m a)
loadObjs_ f = do
code <- lookAhead getWord8
case code of
0xfd -> do
skip 1
expire <- loadTime
getPairs_ f (Just expire)
0xfc -> do
skip 1
expire <- loadTimeMs
getPairs_ f (Just expire)
0xfe -> f Nothing "Switching Database" RDBNull
0xff -> f Nothing "" RDBNull
_ -> getPairs_ f Nothing
getPairs_ :: (Monad m) => (Maybe Integer -> BL8.ByteString -> RDBObj -> Get (m a)) -> Maybe Integer -> Get (m a)
getPairs_ f ex = do
!t <- getWord8
!key <- loadStringObj False
!obj <- loadObj t
!rest <- loadObjs_ f
!out <- f ex key obj
return (out >> rest)
(loadObj does the actual parsing of a single object but I believe that whatever I need to fix the streaming to operate in constant or near-constant memory is at a higher level in the iteration than loadObj)
getDBs_ :: (Monad m) => (Maybe Integer -> BL8.ByteString -> RDBObj -> Get (m a)) -> Get (m a)
getDBs_ f = do
opc <- lookAhead getWord8
if opc == opcodeSelectdb
then do
skip 1
(isEncType,dbnum) <- loadLen
objs <- loadObjs_ f
rest <- getDBs_ f
return (objs >> rest)
else f Nothing "EOF" RDBNull
processRDB_ :: (Monad m) => (Maybe Integer -> BL8.ByteString -> RDBObj -> Get (m a)) -> Get (m a)
processRDB_ f = do
header <- getBytes 9
dbs <- getDBs_ f
eof <- getWord8
return (dbs)
printRDBObj :: Maybe Integer -> BL8.ByteString -> RDBObj -> Get (IO ())
printRDBObj (Just exp) key obj = return $ (print ("Expires: " ++ show exp) >>
print ("Key: " ++ (BL8.unpack key)) >>
print ("Obj: " ++ show obj))
printRDBObj Nothing key RDBNull = return $ (print $ BL8.unpack key)
printRDBObj Nothing key obj = return $ (print ("Key: " ++ (BL8.unpack key)) >>
print ("Obj: " ++ show obj))
main = do
testf <- BL8.readFile "./dump.rdb"
runGet (processRDB_ printRDBObj) testf
Thanks all in advance.
Best,
Erik
EDIT: Here is my attempt to parse the objects into a lazy list and then IO over the lazy list.
processRDB :: Get [RDBObj]
processRDB = do
header <- getBytes 9
dbs <- getDBs
eof <- getWord8
return (dbs)
main = do
testf <- BL8.readFile "./dump.rdb"
mapM_ (print . show) $ runGet processRDB testf
If I understand your code correctly, you are trying to convert the file contents into IO actions incrementally, in the hope of then executing those actions incrementally.
A better approach would be to have your parser return a lazy list of objects which you then print out.
Related
reading files in Haskell IO Monads
Hello everyone I am beginner in Haskell, I have a dat file that contains
[("img0.bmp", [0,0])
,("img1.bmp", [0,1])
,("img2.bmp", [1,0])
,("img3.bmp", [1,1])]
the strings are images files in a folder so basically I need to read file including many files as inputs , I am trying to have at the end [([Double],[Double])] extracting matrix from bmp files and turn that into [Double]
I have tried something like this
learnbmp = do
vs <- getArgs
df <- run (readFile (vs!!0))
let ds = Prelude.read df :: [(String,[Double])]
let ns = Prelude.unzip ds
--let a = Prelude.map (\(v) -> toUnboxed (readImageFromBMPa v))(fst ns)
let a = fst ns
let b = snd ns
--let n' = Prelude.map (\(v) -> ((readMatrixfromImage v) ) ) a
let n' = Prelude.map (\(v) -> ((readMatrixfromImage v) ) ) a
let final = Prelude.zip n' b
return final
the type of final is
final :: [(IO (Vector Word8), [Double])]
with the function readMatrixfromImage is defined like this
readMatrixfromImage :: FilePath -> IO (Vector Word8)
readMatrixfromImage image = do
x <- readImageFromBMPa image -- 'x' est alors de type t
let (Right r) = x
let a = toUnboxed r
return a
any help would be appreciated thank you
If you want to obtain the results "wrapped" in the IO monad, you can use mapM :: (Monad m, Traversable t) => (a -> m b) -> t a -> m (t b): learnbmp :: IO [([Double],[Double])] learnbmp = do (v0:_) <- getArgs df <- run (readFile v0) let (a, b) = Prelude.unzip (Prelude.read df :: [(String,[Double])]) (`Prelude.zip` b) <$> mapM readMatrixfromImage a Here the learnbmp thus has type IO [([Double], [Double])]. It is thus an IO action that will result in an item of type [([Double], [Double])], and you can thus use learnbmp in other expressions that result in a type IO a like main.
optparse-applicative with custom monad
I'm trying to use my own monad (instead of IO) with customExecParser https://hackage.haskell.org/package/optparse-applicative-0.15.1.0/docs/Options-Applicative-Extra.html#v:customExecParser.
So I've ended up with (significant function being fff):
data MoscConfig = MoscConfig {
datadir :: FilePath
, config :: FilePath
, pendingPath :: FilePath
, socket :: FilePath
}
type Mosco = StateT MoscConfig IO
main :: IO ()
main = join . customExecParser (prefs showHelpOnError) $
info (helper <*> parser)
( fullDesc
)
fff :: (a1 -> StateT MoscConfig IO a2) -> a1 -> IO a2
fff f = (flip evalStateT (MoscConfig "" "" "" "")) . f
xyzz :: Text -> Mosco ()
xyzz x = do
liftIO $ print x
liftIO $ print "testabcxyz"
xyzz' :: Text -> Text -> Mosco ()
xyzz' x x' = do
liftIO $ print x
liftIO $ print x'
liftIO $ print "testabcxyz"
parser :: Parser (IO ())
parser = do
fff xyzz <$> textOption ( long "zzz" )
<|>
((fmap fff) xyzz')
<$> textOption ( long "zzz" )
<*> textOption ( long "zzz" )
However, the only disadvantage with the above approach is needing to fmap the required number of times (matching the function arguments in xyzz or xyzz). I do recall running into this type of problem before. Is there some way I can avoid this (and just have a single function needing to be called)?
Ideally I'd hope to have a monad transformer for this but unfortunately this seems to be implemented to IO only.
I think this boils down to the question: is there a function fff that can be applied to both of: xyzz :: a -> r xyzz' :: a -> b -> r so that: fff xyzz :: a -> r' fff xyzz' :: a -> b -> r' And the answer is "no", at least not without some type class trickery that isn't worth considering. Instead, assuming your real version of fff doesn't actually do anything with f except compose with it, I guess I would consider writing: fff :: Parser (Mosco a) -> Parser (IO a) fff = fmap $ flip evalStateT (MoscConfig "" "" "" "") parser :: Parser (IO ()) parser = fff (xyzz <$> textOption ( long "zzz" )) <|> fff (xyzz' <$> textOption ( long "zzz" ) <*> textOption ( long "zzz" )) This whole approach seems a little "off", though. Do you really need a MoscConfig available while parsing options? Unless you have a really complicated options parsing problem on your hands, it would be more usual to parse the options directly into an intermediate data structure and then run your Mosco actions against that data structure to modify a MoscConfig state and do IO and so on.
In terms of what I wanted to achieve (being able to just pass parameters to function within the Mosco monad context - moscparams :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Mosco a -> IO a moscparams dd c pp sp x = do ddd <- crFile cd <- pure "not used" ppd <- crDirPending spd <- socketFile evalStateT x $ MoscConfig (maybe ddd cs dd) (maybe cd cs c) (maybe ppd cs pp) (maybe spd cs sp) moscF' :: Text -> Text -> Mosco () moscF' x x' = do liftIO $ print x liftIO $ print x' liftIO $ print "testabcxyz" moscparams' :: Parser (Mosco ()) -> Parser (IO ()) moscparams' x = moscparams <$> optional (textOption ( long "data-dir" )) <*> optional (textOption ( long "config-path" )) <*> optional (textOption ( long "pending-path" )) <*> optional (textOption ( long "socket-path" )) <*> x parser :: Parser (IO ()) parser = do moscparams' (( moscF') <$> textOption ( long "example-param-1" ) <*> textOption ( long "example-param-2" ) )
How to terminate a computation that runs in the `IO` monad?
There is a library that provides a data type F and a function of type ffoldlIO :: (b -> a -> IO b) -> b -> F a -> IO b The function is similar to foldlIO :: (b -> a -> IO b) -> b -> [a] -> IO b foldlIO f a = \xs -> foldr (\x r (!a') -> f a' x >>= r) return xs a I wonder whether foldlIO (and thus ffoldlIO) can run in a short-circuit fashion. Consider this example: example1 :: IO Int example1 = foldlIO (\a x -> if a < 4 then return (a + x) else return a) 0 [1..5] Here foldlIO traverses the entire list, but what if we throw an exception to stop the computation and then catch it? Something like this: data Terminate = Terminate deriving (Show) instance Exception Terminate example2 :: IO Int example2 = do ra <- newIORef 0 let step a x | a' < 4 = return a' | otherwise = writeIORef ra a' >> throwIO Terminate where a' = a + x foldlIO step 0 [1..] `catch` \(_ :: Terminate) -> readIORef ra Is this reliable? Is there a better way to terminate a computation that runs in the IO monad (and no other monad) or am I not supposed to do this at all?
For example, you can use ContT monad transformer like this:
example3 :: IO Int
example3 = flip runContT return . callCC $ \exit -> do
let step a x
| a' < 4 = return a'
| otherwise = exit a'
where a' = a + x
foldM step 0 [1..]
Also, you can define you own version of foldM with posibility of termination.
termFoldM :: (Monad m, Foldable t) =>
((b -> ContT b m c) -> b -> a -> ContT b m b) -> b -> t a -> m b
termFoldM f a t = flip runContT return . callCC $ \exit -> foldM (f exit) a xs
example4 :: IO Int
example4 = termFoldM step 0 [1..]
where
step exit a x
| a' < 4 = return a'
| otherwise = exit a'
where a' = a + x
But this way (with ContT) has one problem. You can't easy do some IO actions. For example, this code will not be compiled, because step function must return value of type ContT Int IO Int not IO Int.
let step a x
| a' < 4 = putStrLn ("'a = " ++ show a') >> return a'
| otherwise = exit a'
where a' = a + x
Fortunately, you can solve this by the lift function, like this:
let step a x
| a' < 4 = lift (putStrLn ("'a = " ++ show a')) >> return a'
| otherwise = exit a'
where a' = a + x
My first answer was not correct. So, I'll try to improve. I think that the use of exceptions to terminate in IO monad is not a hack but it does not look clean. I propose to define the instance MonadCont IO like this: data Terminate = forall a . Terminate a deriving (Typeable) instance Show Terminate where show = const "Terminate" instance Exception Terminate instance MonadCont IO where callCC f = f exit `catch` (\(Terminate x) -> return . unsafeCoerce $ x) where exit = throwIO . Terminate Then you can rewrite your example more cleaner. example :: IO Int example = callCC $ \exit -> do let step a x | a' < 4 = return a' | otherwise = exit a' where a' = a + x foldlIO step 0 [1..] Variant with IOREf. data Terminate = Terminate deriving (Show, Typeable) instance Exception Terminate instance MonadCont IO where callCC f = do ref <- newIORef undefined let exit a = writeIORef ref a >> throwIO Terminate f exit `catch` (\Terminate -> readIORef ref)
A monad for building test data
OK, so I'm trying to write a monad for building test data, but I can't quite get it to work how I want it. It looks something like this:
runBuildM :: [i] -> BuildM i o x -> [o]
-- Given a list of i, build a list of o.
source :: BuildM i o i
-- Fetch unique i.
yield :: o -> BuildM i o ()
-- Return a new o to the caller.
gather :: BuildM i o x -> BuildM i o o
-- Fetch every possible o from sub-computation.
local :: BuildM i o x -> BuildM i o x
-- Isolate any source invocations from the rest of the code.
In other words, it's a supply monad, writer monad and list monad. The idea is that I can write something like this:
build_tests depth = do
local $ do
v <- source
yield v
yield (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ do
t1 <- gather $ build_tests (depth-1)
yield $ "(" ++ t1 ++ ")"
yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
The idea is to generate all possible combinations of data. You can do that just using list comprehensions, but the result ends up syntactically awful. This is much more readable. Unfortunately, it doesn't actually work...
The problem seems to boil down to the local function not behaving correctly. The intention is for any source calls in the sub-computation to have no effect outside of it. (I.e., subsequent calls to source from outside the local block get the first token again.) However, what my implementation of local actually does is reset the next token for everything (i.e., including the contents of the sub-computation). This is clearly incorrect, but I cannot for the life of me bend my mind around how to make it work correctly.
The fact that I'm having this much trouble getting the code to work as required probably means the actual internal representation of my monad is just wrong. Can anybody take a stab at implementing this correctly?
EDIT: I should perhaps have realised this, but I didn't actually specify the expected result I'm trying to get. The above code is supposed to produce this:
["A", "a", "[]", "()", "(A)", "(a)", "[A]", "[a]", "(A, B)", "(A, b)", "(a, B)", "(a, b)"]
It's not super-critical that the results appear in exactly this order. I'd like the single cases to appear before the compound ones, but I'm not too fussed exactly what order the compounds appear. The rule is that the same variable never appears twice in any individual expression.
If we allow the depth to be a bit deeper, we additionally get terms such as
"((A))", "([A])", "[(A)]", "((A, B), C)", "(A, (B, C))"
and so on.
It's clearly broken, but here's what I have so far:
newtype BuildM i o x = BuildM ([i] -> SEQ.Seq ([i], SEQ.Seq o, x))
instance Functor (BuildM i o) where
fmap uf (BuildM sf) =
BuildM $ \ is0 -> do
(is1, os, x) <- sf is0
return (is1, os, uf x)
instance Applicative (BuildM i o) where
pure x = BuildM $ \ is0 -> return (is0, SEQ.empty, x)
BuildM sf1 <*> BuildM sf2 =
BuildM $ \ is1 -> do
(is2, os2, f) <- sf1 is1
(is3, os3, x) <- sf2 is2
return (is3, os2 >< os3, f x)
instance Monad (BuildM i o) where
return = pure
BuildM sf1 >>= uf =
BuildM $ \ is1 -> do
(is2, os2, x) <- sf1 is1
let BuildM sf2 = uf x
(is3, os3, y) <- sf2 is2
return (is3, os2 >< os3, y)
runBuildM :: [i] -> BuildM i o x -> [o]
runBuildM is0 (BuildM sf) =
toList $ do
(is, os, x) <- sf is0
os
source :: BuildM i o i
source =
BuildM $ \ is ->
if null is
then error "AHC.Tests.TestBuilder.source: end of input"
else return (tail is, SEQ.empty, head is)
yield :: o -> BuildM i o ()
yield o = BuildM $ \ is -> return (is, SEQ.singleton o, () )
gather :: BuildM i o x -> BuildM i o' o
gather (BuildM sf1) =
BuildM $ \ is1 -> do
(is2, os2, _) <- sf1 is1
o <- os2
return (is2, SEQ.empty, o)
local :: BuildM i o x -> BuildM i o ()
local (BuildM sf1) =
BuildM $ \ is1 ->
let os = do (is2, os2, x) <- sf1 is1; os2
in return (is1, os, () )
You are trying to reinvent pipes. Your source and yield are pipes await and yield. The other two concerns you are trying to handle are a ReaderT and a WriterT respectively. If you put the entire list of inputs in the environment of the ReaderT you can run local sub computations that start over at the beginning of the list. You can collect all of the results from a sub-computation by adding a WriterT layer to collect the output.
For the nice syntax with gather you are trying to recreate ListT.
Pipes, Readers, and Writers
We're going to use all of the following in very short order.
import Data.Functor.Identity
import Data.Foldable
import Control.Monad
import Control.Monad.Morph
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader hiding (local)
import Control.Monad.Trans.Writer.Strict
import Pipes.Core
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Prelude as P
import Pipes.Lift (runWriterP, runReaderP)
Your builder is a Pipe i o over a Reader [i] which allows you to reset at the beginning of the input. We will define two versions of it, BuildT which is a monad transformer, and BuildM which is a monad. BuildM is jsut the transformer applied to Identity.
type BuildT e i o m r = Pipe i o (ReaderT e m) r
type BuildM e i o r = BuildT e i o Identity r
local runs a builder feeding it the entire input read from the environment. We might want to give this a different name to avoid conflicting with local defined for ReaderT
local :: (Monad m, Foldable f) => BuildT (f i) i o m () -> Proxy a' a () o (ReaderT (f i) m) ()
local subDef = do
e <- lift ask
hoist lift $ runReaderP e $
P.each e >->
subDef
To collect the results of the sub computations, we take advantage of the fact that pipes are so pure that you can swap out the underlying monad provided you have a natural transformation forall x. m x -> n x. The proxies from pipes have an MFunctor instance that provides a function hoist :: (forall x. m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r; it lets us lift all of the underlying monad operations under a pipe to use the pipe over another transformer, in this case WriterT.
collect :: (Monad m) => Proxy a' a () b m r -> Proxy a' a c' c m ([b], r)
collect subDef = do
(r, w) <- runWriterP $
hoist lift subDef //> \x -> lift $ tell (++[x])
return (w [], r)
To run a builder we feed it all of the input from the environment, provide the initial environment, collect the results, and run the entire pipe.
runBuildT :: (Monad m) => [i] -> BuildT [i] i o m () -> m [o]
runBuildT e = runEffect . fmap fst . collect . runReaderP e . local
Running the monad instead of the transformer is just
runBuildM :: [i] -> BuildM [i] i o () -> [o]
runBuildM e = runIdentity . runBuildT e
ListT
This section lets us use do-notation when generating all combinations of things. It's equivalent to using pipes' for in place of each >>= and yield in place of each return.
The syntax that gathers all of the results from a sub computation is reinventing ListT. a ListT m a holds a Producer a m () that only returns data downstream. Pipes that get data from upstream and return data downstream don't fit into the Producer b m (). This will take a bit of conversion.
We can convert a Proxy that has both an upstream and a downstream interface into one with only a downstream interface wrapped around another proxy with the upstream interface. To do so, we hoist the underlying monad into our new inner upstream proxy, then replace all of the requests in the outer downstream proxy with requests lifted from the inner upstream proxy.
floatRespond :: (Monad m) => Proxy a' a b' b m r -> Proxy c' c b' b (Proxy a' a d' d m) r
floatRespond = (lift . request >\\) . hoist lift
These can be converted into a ListT. We'll discard any returned data to get a more polymorphic type.
gather :: (Monad m) => Proxy a' a () b m r -> P.ListT (Proxy a' a c' c m) b
gather = P.Select . floatRespond . (>>= return . const ())
Using ListT is a bit cumbersome to use; you need an mplus between returns to get both outputs. It's frequently convenient to shove a proxy into a ListT so you can lift . yield instead of returning. We are going to discard all our ListT results an rely on the output coming from lift . yield.enumeratejust runs aListT` wrapped around anything, discarding all the results
enumerate = P.runListT
Example
We're now equipped to write and run your example. I thing you mean for source to get one value from the source and for yield to return one value. If you don't need to be able to get values one at a time your question is over-specified and this answer is overkill.
source = P.await
yield = P.yield
In the example, where we use gather to build lists, we run that portion of the code with enumerate and yield results with lift . yield.
import Data.Char
build_tests :: Monad m => Int -> BuildT [String] String String m ()
build_tests depth = do
local $ do
v <- source
yield $ v
yield $ (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ enumerate $ do
t1 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ ")"
lift . yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
If we run this example with the input ["A", "B"] the "B" input is never used because source is only ever used once inside each local.
main = do
putStrLn "Depth 2"
print =<< runBuildT ["A", "B"] (build_tests 2)
putStrLn "Depth 3"
print =<< runBuildT ["A", "B"] (build_tests 3)
The output for depths less than 4 is small enough to repeat here.
["A","a","[]","()"]
Depth 3
["A","a","[]","()","(A)","[A]","(A,A)","(A,a)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,[])","(a,())","([])","[[]]","([],A)","([],a)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),[])","((),())"]
This might be overkill
I suspect that you might have meant for source to get everything from the source.
source = gather P.cat
yield = P.yield
If we use this for the example instead of getting a single item from the source we'll enumerate the first local block and yield results by returning in ListT.
build_tests :: Monad m => Int -> BuildT [String] String String m ()
build_tests depth = do
local $ enumerate $ do
v <- source
lift . yield $ v
lift . yield $ (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ enumerate $ do
t1 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ ")"
lift . yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
This uses both source values when we run the example with two sources.
Depth 2
["A","a","B","b","[]","()"]
Depth 3
["A","a","B","b","[]","()","(A)","[A]","(A,A)","(A,a)","(A,B)","(A,b)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,B)","(a,b)","(a,[])","(a,())","(B)","[B]","(B,A)","(B,a)","(B,B)","(B,b)","(B,[])","(B,())","(b)","[b]","(b,A)","(b,a)","(b,B)","(b,b)","(b,[])","(b,())","([])","[[]]","([],A)","([],a)","([],B)","([],b)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),B)","((),b)","((),[])","((),())"]
If you never get a single value from the source you could just use ListT (ReaderT [i] m) o instead. You might still want a proxy to avoid messing around with mplus.
You are trying to reinvent pipes and some nice syntax for building lists. The problem is much simpler than how you characterize it. The source of strings can be completely separated from building the structures.
You want to generate structures that draw symbols from some source. Without worrying about the source, let's build the structures. Each structure is a Pipe that will draw from some source and yield strings to concatenate together to build the expression.
import Data.Char
import Data.Functor.Identity
import Pipes.Core
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Prelude as P
build_structures :: Int -> [Pipe String String Identity ()]
build_structures depth = gather $ do
yield $ P.take 1
yield $ P.map (map toLower) >-> P.take 1
when (depth > 2) $ do
t1 <- lift $ build_structures (depth - 1)
yield $ P.yield "(" >> t1 >> P.yield ")"
yield $ P.yield "[" >> t1 >> P.yield "]"
t2 <- lift $ build_structures (depth - 1)
yield $ P.yield "(" >> t1 >> P.yield "," >> t2 >> P.yield ")"
This code uses the ContT yield trick from the continuation answer.
We run one of these structures by feeding it the symbols and concatenating the results.
run :: Pipe String String Identity () -> String
run p = concat . P.toList $ P.each symbols >-> p
-- an infinite source of unique symbols
symbols :: [String]
symbols = drop 1 symbols'
where
symbols' = [""] ++ do
tail <- symbols'
first <- ['A'..'Z']
return (first : tail)
The examples produce the desired strings. I'll leave producing the two special cases "[]" and "()", which do not appear in recursive terms, as an exercise.
import Data.Functor
main = do
putStrLn "Depth 2"
print $ run <$> build_structures 2
putStrLn "Depth 3"
print $ run <$> build_structures 3
putStrLn "Depth 4"
print $ run <$> build_structures 4
This results in
Depth 2
["A","a"]
Depth 3
["A","a","(A)","[A]","(A,B)","(A,b)","(a)","[a]","(a,B)","(a,b)"]
Depth 4
["A","a","(A)","[A]","(A,B)","(A,b)","(A,(B))","(A,[B])","(A,(B,C))","(A,(B,c))","(A,(b))","(A,[b])","(A,(b,C))","(A,(b,c))","(a)","[a]","(a,B)","(a,b)","(a,(B))","(a,[B])","(a,(B,C))","(a,(B,c))","(a,(b))","(a,[b])",...
If my other answer is overkill, the continuation monad transformer provides a convenient way to construct any MonadPlus values.
The continuation monad lets us easily capture the idea of doing something mplus the as yet unknown remainder.
import Control.Monad
import Control.Monad.Trans.Cont
once :: MonadPlus m => m a -> ContT a m ()
once m = ContT $ \k -> m `mplus` k ()
Yielding a result is just returning it once.
yield :: MonadPlus m => a -> ContT a m ()
yield = once . return
We can gather up all the results by sticking mzero at the end.
gather :: MonadPlus m => ContT a m r -> m a
gather m = runContT m (const mzero)
Your example is written in terms of yield, gather, once, and lift.
import Data.Char
import Control.Monad.Trans.Class
build_tests :: MonadPlus m => m String -> Int -> ContT String m ()
build_tests source = go
where
go depth = do
once . gather $ do
v <- lift source
yield v
yield (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ do
t1 <- lift . gather $ go (depth-1)
yield $ "(" ++ t1 ++ ")"
yield $ "[" ++ t1 ++ "]"
t2 <- lift . gather $ go (depth-1)
yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
main = print . gather $ build_tests ["A", "B"] 3
This outputs the following:
Depth 2
["A","a","B","b","[]","()"]
Depth 3
["A","a","B","b","[]","()","(A)","[A]","(A,A)","(A,a)","(A,B)","(A,b)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,B)","(a,b)","(a,[])","(a,())","(B)","[B]","(B,A)","(B,a)","(B,B)","(B,b)","(B,[])","(B,())","(b)","[b]","(b,A)","(b,a)","(b,B)","(b,b)","(b,[])","(b,())","([])","[[]]","([],A)","([],a)","([],B)","([],b)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),B)","((),b)","((),[])","((),())"]
I've taken the liberty of getting rid of the requirement to read the original source from the environment for simplicity. You can add a ReaderT to the transformer stack to get it back. I also haven't chosen a list transfomer for you, the example is running using the ordinary list monad. Since it's written in terms of MonadPlus it will work for any (MonadTrans t, MonadPlus (t m)) => t m as well.
List Iterator using ContT
I have a simple list that I would like to iterate over "yield"ing between each element and printing that element to the output. I am trying to use the ContT monad to do this but running into issues. Here's what I have so far: data K a = Nil | K (a,() -> K a) listIterator :: (Monad m) => [r] -> m (K r) listIterator [] = return Nil listIterator (x:xs) = return (ContT (\k -> K (x,k))) >> listIterator xs runIterator :: IO () runIterator = do a <- listIterator ([1,2,3] :: [Int]) let loop Nil = liftIO $ print "nil" loop (K (curr,newI)) = do liftIO $ print curr loop (newI ()) loop a The expected output is: 1 2 3 nil What I get is: nil Any help is appreciated!
listIterator (x:xs) = return (ContT (\k -> K (x,k))) >> listIterator xs does not do what you expect, equational reasoning listIterator (x:xs) = return (ContT (\k -> K (x,k))) >> listIterator xs = (return (ContT (\k -> K (x,k)))) >>= \_ -> listIterator xs = (\_ -> listIterator xs) (ContT (\k -> K (x,k))) = listIterator xs I'm not sure exactly why you want to use an iterator. Haskell is already lazy, so iteration patterns like this are mostly used only when you have resource management issues that need to interact well with a demand driven usage pattern. And, you don't need the continuation monad at all: Instead of writing the K constructor to take a tuple it is more idiomatic to data K a = Nil | K a (() -> K a) intuitively, the type for the listIterator does not use its monadic structure: it just constructs a value, so listIterator ::[r] -> K r listIterator [] = Nil listIterator (x:xs) = K x (\_ -> listIterator xs) now life is trivial runIterator :: IO () runIterator = do let a = listIterator ([1,2,3] :: [Int]) loop Nil = liftIO $ print "nil" loop (K curr newI) = do liftIO $ print curr loop (newI ()) loop a which would probably be best to write without the use of do notation.
This may not be the answer you were looking for, but if you are interested in this style of programming, you should look into pipes and similar libraries. (conduit is the rising star in the "real world", but pipes provides a simpler tool for teaching which is why I use it here.) $ cabal update && cabal install pipes Pipes are like iterators, except they come in three flavors: those that can acquire input (Consumers), those that produce output (Producers), and those that do both (Pipes). If you connect pipes such that the input and output ends are all satisfied, then it is called a "Pipeline", and it is a self-contained unit that can be run without any additional input. Pipe provides a monad instance for convenience in creating pipes. The >+> operator connects two pipes together. import Control.Pipe import Control.Monad.Trans.Class import Control.Monad.IO.Class -- annoyingly, Pipe does not provide a MonadIO instance instance (MonadIO m) => MonadIO (Pipe a b m) where liftIO = lift . liftIO listIterator :: Monad m => [a] -> Producer (Maybe a) m () listIterator (x:xs) = yield (Just x) >> listIterator xs listIterator [] = yield Nothing printer :: (MonadIO m, Show a) => Consumer (Maybe a) m () printer = do mx <- await case mx of Just x -> liftIO (print x) >> printer Nothing -> liftIO (putStrLn "nil") main = runPipe $ listIterator [1, 2, 3] >+> printer The source for Control.Pipe is delightfully simple, especially if you have been reading Gabriel's recent blog posts about Free monads, particularly Why free monads matter and Purify code using free monads.