If m2 and m are equal I want to do an IO operation (send out some stuff over the network) that returns nothing and update my map. I have crafted the following code and wonder (1) if this can be refactored into something less clunky (2) why my case expression that should send out the messages does not get evaluated or at least no messages do get send.
If I uncomment the code at the bottom then things do get send as I want to, but of course it is then send out disregarding what the value of m2 is.
main = withSocketsDo $ do
s <- socket AF_INET Datagram defaultProtocol
(q, m) <- newRq
let m2 = appendMsg "first" key m
_ = case m2 of
val | m2 == m -> do let Just messages = Map.lookup ("192.168.1.1", 4711) m in sendq s (B.pack $ unwords messages) "192.168.1.1" 4711
(q4, m4) = case m2 of
val | m2 == m -> deleteRec key q m2
| otherwise -> (q, m2)
--let Just messages = Map.lookup ("192.168.1.1", 4711) m
--sendq s (B.pack $ unwords messages) "192.168.1.1" 4711
I know that _ is not defined for all cases where m2 and m are not equal, but sendq returns IO () and I could not think of something sensible to add here for | otherwise -> that would return the same type.
The two lines of code starting with _ = case m2 of do exactly nothing! This is because the bound value _ never gets evaluated, because it is not used (or even mentioned) anywhere else.
What you are looking for is, I guess, the function when from Control.Monad. It has type Monad m => Bool -> m () -> m(); you could use it as follows:
when (m == m2) (send the messages ...)
but you would have to use it outside the let block, i.e. as part of the main do expression.
One more thing, your code:
(q4, m4) = case m2 of
val | m2 == m -> deleteRec key q m2
| otherwise -> (q, m2)
can be simplified to:
(q4, m4) = if (m2 == m) then deleteRec key q m2 else (q, m2)
Related
I have two conduit sources A and B which I want to merge them into one yielding:
data Result = Left Int | Value Int | Right Int
merge :: Monad m => Source m Int -> Source m Int -> Source Result
merge a b = undefined
such as it:
Consumes values from both a and b
Performs some computation to produce Value Int
As a result of computation either a or b could have a leftover
When one of the sequences is exhausted the result source should keep producing either Left or Right values, (depending on which original source still has values) until both sources are exhausted
I tried implementing it with ZipSource such as:
getZipSource (ZipSource (a =$= CL.map Left) <* ZipSource (b =$= CL.map Right))
but I couldn't figure out how to make it alternate between sources (when I do two awaits) and how to deal with leftovers in a way that I described above.
I also looked at sequenceSources but it doesn't seem to help either.
Can something like that be built with Conduit?
A concrete example would be:
Have two (assumed sorted) Int sources
Get values from both and compare
Yield the min value, subtract it from the biggest and put the remaining back to its stream
Repeat.
The expected output would be:
runConduit $ merge (CL.sourceList [10, 20, 30]) (CL.sourceList [6, 4, 20]) $$ CL.take 10
Value 6 -- 10-6 = 4, 6 yielded, 4 goes back to "a"
Value 4 -- 4-4 = 0, both values are fully consumed
Value 20 -- 20-20 = 0, both values are fully consumed
Left 30 -- "b" has no values, but "a" still yielding
[UPDATE]
The best way I found so far is to write something similar to zipSources tweaking its internals as:
go (Done ()) (HaveOutput src close y) = HaveOutput (go (Done ()) src) close (Nothing, Just y)
go (HaveOutput src close x) (Done ()) = HaveOutput (go src (Done ())) close (Just x, Nothing)
Would it be the right way to go?
I ended up doing this way:
data MergedValue a v b = BackL a v | MergedValue v | BackR v b
data JoinResult a v b = LeftoverL a | JoinValue v | LeftoverR b
joinSources :: Monad m
=> (a -> b -> MergedValue a v b)
-> Source m a
-> Source m b
-> Source m (JoinResult a v b)
joinSources f as bs =
go (newResumableSource as) (newResumableSource bs)
where
go ras rbs = do
(ras', ma) <- lift $ ras $$++ await
(rbs', mb) <- lift $ rbs $$++ await
case (ma, mb) of
(Nothing, Nothing) -> pure ()
(Nothing, Just b) -> yield (LeftoverR b) >> go ras' rbs'
(Just a, Nothing) -> yield (LeftoverL a) >> go ras' rbs'
(Just a, Just b) -> case f a b of
BackL x v -> do
yield (JoinValue v)
(nxt, _) <- lift $ ras' $$++ leftover x
go nxt rbs'
BackR v x -> do
yield (JoinValue v)
(nxt, _) <- lift $ rbs' $$++ leftover x
go ras' nxt
MergedValue v -> yield (JoinValue v) >> go ras' rbs'
For an assignment for FP we have to write a function that runs a state monadic computation given an initial state, and then returns the computed value and the number of operations counted.
Counts looks like this:
data Counts = Counts {
binds :: Int,
returns :: Int,
gets :: Int,
puts :: Int
} deriving (Eq, Show)
Where oneBind = Counts 1 0 0 0 (for example).
There was also an mempty and <*> defined, but I wasn't able to use "mempty" instead of "Counts 0 0 0 0" with initCounts.
The States are defined as:
newtype State' s a = State' { runState' :: (s, Counts) -> (a, s, Counts) }
So far this is what I have got, but I've been stuck at about the same level for a few hours now.
run :: State' s a -> s -> (a, Counts)
run s ns = do
initState <- return ns
initCounts <- return (Counts 0 0 0 0)
newState <- return (runState' s (initState, initCounts))
newCounts <- return (runState' (retCounts newState) (newState, initCounts))
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return (count)
retCounts :: State' s a -> State' s Counts
retCounts st = State' (\ (s, count) -> (calcCounts st, s, count))
calcCounts :: State' s a -> Counts
calcCounts st = undefined
I assume I have to use pattern matching in calcCounts to somehow actually count all the operators/functions, but right now I'm getting a type matching error:
Assignment4.hs:236:47:
Couldn't match expected type ‘State' (a, s, Counts) a0’
with actual type ‘(a, s, Counts)’
Relevant bindings include
newState :: (a, s, Counts) (bound at Assignment4.hs:235:5)
initState :: s (bound at Assignment4.hs:233:5)
ns :: s (bound at Assignment4.hs:232:7)
s :: State' s a (bound at Assignment4.hs:232:5)
run :: State' s a -> s -> (a, Counts)
(bound at Assignment4.hs:232:1)
In the first argument of ‘retCounts’, namely ‘newState’
In the first argument of ‘runState'’, namely ‘(retCounts newState)’
If I could get any help on how I could solve this type error and some hints to go from here, it would be highly appreciated.
PS: I realize it might be a good idea to rename calcCounts to something like calcFunctions
[EDIT: I'm also getting a different error when I work around this one by supplying a dummy value:
Assignment4.hs:233:5:
No instance for (Monad ((,) a)) arising from a do statement
In a stmt of a 'do' block: initState <- return ns
In the expression:
do { initState <- return ns;
initCounts <- return (Counts 0 0 0 0);
newState <- return (runState' s (initState, initCounts));
newCounts <- return (runState' retCounts (newState, initCounts));
.... }
In an equation for ‘run’:
run s ns
= do { initState <- return ns;
initCounts <- return (Counts 0 0 0 0);
newState <- return (runState' s (initState, initCounts));
.... }
]
There are a few problems here.
There was also an mempty and <*> defined...
Do you mean <> = mappend? <*> is the application operator for applicative functors.
run :: State' s a -> s -> (a, Counts)
run s ns = do
initState <- return ns
initCounts <- return (Counts 0 0 0 0)
newState <- return (runState' s (initState, initCounts))
newCounts <- return (runState' (retCounts newState) (newState, initCounts))
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return (count)
Firstly, think about what the type of your do block is. It has the same type as run s ns, which according to your type signature for run is (a, Counts). As you know, do notation only works with monads. (a, Counts) (or more accurately ((,) a)) is not a monad, which is one of the reasons GHC is getting confused.
Next, you should note that in a do block:
initState <- return ns
is identical to
let initState = ns
If we rewrite run to reflect this, we get the following:
run s ns = do
let initState = ns
initCounts = Counts 0 0 0 0
newState = runState' s (initState, initCounts)
newCounts = runState' (retCounts newState) (newState, initCounts)
let st = let (a,_,_) = newState
in a
let count = let (c,_,_) = newCounts
in c
return count
Now we can see the next big problem: you aren't actually binding any monadic variables in your do block! In fact, by manually using newState etc you are circumventing the entire point of a state monad -- to keep track of state for us.
The fact is that all this is not so complicated as you might believe; we don't actually even need to use do notation. I advise that you think about this a little more before looking at the text below, to see if you can find the solution. As a hint: the function can be written simply in one line.
Here's how I might write run:
run :: State' s a -> s -> (a, Counts)
run s ns = let (a, _, counts) = runState' s (ns, Counts 0 0 0 0) in (a, counts)
To study the details of the State monad, I'm trying to create myself a complete desugared version of a simple state monad function, completing the thought started in How does 'get' actually /get/ the initial state in Haskell?, in the answer by J Cooper.
The example state monad function simply swaps the state and the input value, so that (conceptually) if the input is (v, s) then the output is (s, v). I show three translations, first from do notation to desugared >>= and >>, then placing those operators in function position, and finally attempting to replace them and get/put with their definitions.
The 'do' version and the first two translations work, but the final translation does not. Problems:
Upon loading the module, GHCi reports that z1 is not in scope.
I've not figured out exactly how to represent omitting the argument passing in the >> translation.
How should these be fixed?
FWIW, current Haskell platform (GHC 7.4.2).
Thanks!
-- simpleswap
import Control.Monad.State
-- =============================================
-- 'Do' version
simpleswap1 :: String -> State String String
simpleswap1 inp = do
z1 <- get
put inp
return z1
-- =============================================
-- Desugared to >>= and >>
simpleswap2 :: String -> State String String
simpleswap2 inp =
get >>=
\z1 -> put inp >>
return z1
-- =============================================
-- >>= and >> changed to function position
simpleswap3 :: String -> State String String
simpleswap3 inp =
(>>=) get
(\z1 -> (>>) (put inp) (return z1) )
-- =============================================
-- Attempt to translate >>=, >>, get and put
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (a2, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 a2) s2
where
rhs1 a2 = \z1 ->
-- (>>)
state $ \s3 ->
let (a4, s4) = runState ( {- put inp -} state $ \_ -> (inp, ()) ) s3
in runState (rhs2 a4) s4
where
rhs2 a4 = return z1
-- =============================================
main = do
putStrLn "version 1004"
let v = "vvv"
let s = "sss"
putStrLn ("Before val: " ++ v ++ " state: " ++ s)
let (v2, s2) = runState (simpleswap4 v) s
putStrLn ("After val: " ++ v2 ++ " state: " ++ s2)
-- =============================================
There are a few minor mistakes in simpleswap4. Here is a corrected version:
simpleswap4 :: String -> State String String
simpleswap4 inp =
state $ \s1 ->
-- (>>=)
let (z1, s2) = runState ( {- get -} state $ \sg -> (sg,sg) ) s1
in runState (rhs1 z1) s2
where
rhs1 z1 =
-- (>>)
state $ \s3 ->
let (_, s4) = runState ( {- put inp -} state $ \_ -> ((), inp) ) s3
in runState rhs2 s4
where
rhs2 = return z1
I've renamed a2 to z1 (in lines 5 and 6). This doesn't change the semantics, but emphasized that the first component of the pair returned by the desugared get call is actually the result that gets bound to z1 in the previous versions of simpleswap.
The type of rhs1 should be String -> State String String. In your version, it gets an additional lambda-bound variable. It's unclear what the difference between a2 and z1 should be in your version. Removing the lambda (in line 8) also has the advantage of fixing your scoping problem. You are using z1 in the nested where-clause, but the where can only see variables bound on the left hand side of the declaration it is attached to.
In line 11, I've replaced a4 with _. This is to emphasize that (>>) does discard the result of the first action. As a consequence, rhs2 is not parameterized over this result either.
I have the following function:
loopMyQ s q m = forever $ do
q' <- atomically $ readTVar q
let Just b = PSQ.findMin q' --irrefutable pattern here in case the queue has just been created
duetime = (PSQ.prio b) + 2.000
now <- getPOSIXTime
when (now > duetime) (transMit2 s now q m)
The problem is that when the PSQ has "just" been created as empty PSQ the Just cannot match and gives me an irrefutable pattern error at runtime. This occurs exactly once since apparently the queue later is filled and Just b always matches.
I have tried to test whether the queue is empty or not and then act on it in my function BUT this made the whole thing run twice as slow.
Since this apparently does not hurt can this error somehow be suppressed with e.g. a compiler option or would I need to catch the exception and then ignore it (that also might cost extra time).
You are probably better off by using retry
if the queue is empty: the STM action will not be retried until the queue in the TVar has been updated!
loopMyQ s q m = forever $ do
b <- atomically $ do q' <- readTVar q
case PSQ.findMin q' of
Just b -> return b
Nothing -> retry
let duetime = (PSQ.prio b) + 2.000
now <- getPOSIXTime
when (now > duetime) (transMit2 s now q m)
Assuming that once your queue is non-empty, it will never be empty again, one thing you could do is do the expensive version (check for non-empty) only until it becomes non-empty, then switch to the cheap version.
loopMyQ s q m = do
q' <- atomically $ readTVar q
case PSQ.findMin q' of
Nothing -> loopMyQ s q m
Just b -> do
body b
forever $ do
q' <- atomically $ readTVar q
let Just b <- PSQ.findMin q'
body b
where body b = do
let duetime = 2 + PSQ.prio b
now <- getPOSIXTime
when (now > duetime) (transMit2 s now q m)
I am using enumerator-0.4.10, and I need to distribute processing of
different parts of the incoming stream to different iteratees (I am
parsing a huge XML file, and different sub-trees have different
processing logic). Only a single iteratee will be active at a time
since the sub-trees don't intersect.
I wrote a simple example that filters the stream and passes the result
to one iteratee; please see below. However, with multiple nested
iteratees it seems to me that I can no longer use an enumeratee. Do I
need to write my own multi-enumeratee that holds multiple inner
iteratees? Any better ideas?
Here is my (beginner's) code for a single nested iteratee:
module Main ( main ) where
import qualified Data.Enumerator as E ( Enumeratee, Step(..), Stream(..),
checkDone, checkDoneEx, continue, enumList, joinI, run_, yield )
import Data.Enumerator ( ($$), (>>==) )
import qualified Data.Enumerator.List as EL ( consume )
-- cribbed from EL.concatMap
concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s ->
E.Enumeratee ao ai m b
concatMapAccum f s0 = E.checkDone (E.continue . step s0)
where
step _ k E.EOF = E.yield (E.Continue k) E.EOF
step s k (E.Chunks xs) = loop s k xs
loop s k [] = E.continue (step s k)
loop s k (x:xs) = case f s x of
(s', ais) -> k (E.Chunks $ ais) >>==
E.checkDoneEx (E.Chunks xs) (\k' -> loop s' k' xs)
passFromTo :: Monad m => ((a -> Bool), (a -> Bool)) -> Bool -> E.Enumeratee a a m b
passFromTo (from, to) pass0 =
concatMapAccum updatePass pass0
where
updatePass pass el = case (pass, from el, to el) of
(True, _, to_el) -> (not to_el, [el])
(False, True, _) -> (True, [el])
(False, False, _) -> (False, [])
main :: IO()
main = do
E.run_ (E.enumList 3 [1..20] $$
E.joinI $ passFromTo ((\e -> e == 3 || e == 13), (\e -> e == 7 || e == 17)) False $$
EL.consume) >>= print
$ ./dist/build/StatefulEnumeratee/StatefulEnumeratee
[3,4,5,6,7,13,14,15,16,17]
Yes, you need an enumeratee that passes the stream to multiple iteratees, like Data.Iteratee.sequence_ and Data.Iteratee.Parallel.psequence_ from iteratee-0.8.6. sequence_ takes a list of iteratees to run simultaneously, and handles each input chunk by mapM across that list. psequence_ takes similar arguments, but runs each input iteratee in a separate forkIO thread.
There has been some discussion on haskell-cafe and the iteratee mailing lists about these over the past year, eg: http://www.haskell.org/pipermail/haskell-cafe/2011-January/088319.html The main thing to be careful about is handling errors from the inner iteratees: in your application, if one inner iteratee fails do you want to terminate all iteratees or just that one, and [how] do you want to propagate those errors.