I want to extract the value of v from the following code into m2.
It is a little difficult to understand these chains. I am trying to understand the flow for a long, couldn't find any specific solution.
m1 <- newEmptyMVar
m2 <- newEmptyMVar
forkIO $ 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
Helping functions
runUpdate :: (MonadState x m, Has Campaign x) => ((SolTest, TestState) -> m (SolTest, TestState)) -> m ()
runUpdate f = use (hasLens . tests) >>= mapM f >>= (hasLens . tests .=)
updateTest :: ( MonadCatch m, MonadRandom m, MonadReader x m, Has TestConf x, Has CampaignConf x)
=> VM -> Maybe (VM, [Tx]) -> (SolTest, TestState) -> m (SolTest, TestState)
I tried to include putMVar m1 v as the following in the step line
step = runUpdate (updateTest v Nothing) >> lift u >> putMVar m1 v >> runCampaign
I thought these are just sequencing, putting putMVar m1 v in between produces following error.
parse error (possibly incorrect indentation or mismatched brackets)
|
192 | runCampaign = use (hasLens . tests . to (fmap snd)) >>= update
| ^
Some extra information
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
This is the code I'm trying to work on.
Here, I want to declare one variable m1 <- newEmptyMVar and m2.
Then I want to run the code from 2nd line(through the end) on two threads concurrently using forkIO .
I want v to get stored in m1 & m2 from both the threads. So that I can manually check if both threads have the same v
Hope it helps!
Related
I have the following code
newtype State s a = State { runState :: s -> (s,a) }
evalState :: State s a -> s -> a
evalState sa s = snd $ runState sa s
instance Functor (State s) where
fmap f sa = State $ \s ->
let (s',a) = runState sa s in
(s',f a)
instance Applicative (State s) where
pure a = State $ \s -> (s,a)
sf <*> sa = State $ \s ->
let (s',f) = runState sf s
(s'',a) = runState sa s' in
(s'', f a)
instance Monad (State s) where
sa >>= k = State $ \s ->
let (s',a) = runState sa s in
runState (k a) s'
get :: State s s
get = State $ \s -> (s,s)
set :: s -> State s ()
set s = State $ \_ -> (s,())
bar (acc,n) = if n <= 0
then return ()
else
set (n*acc,n-1)
f x = factLoop
factLoop = get >>= bar >>= f
And
runState factLoop (1,7)
gives ((5040,0),())
I'm trying to write the function
factLoop = get >>= bar >>= f
using the do notation
I tried
factLoop' = do
(x,y) <- get
h <- bar (x,y)
return ( f h)
But that does not give the correct type which should be State (Int, Int) ()
Any idea ?
Thanks!
Just remove the return on the final line :
factLoop' = do
(x,y) <- get
h <- bar (x,y)
f h
There is no return in your original code, so there should be none in the do notation version either. do notation simply "translates" uses of >>=, as you've already done.
>>= is infixl 1 (left-associating binary operator), so what you really have is
f x = factLoop
factLoop = get >>= bar >>= f
= (get >>= bar) >>= f
= (get >>= bar) >>= (\x -> f x)
= do { x <- (get >>= bar)
; f x }
= do { _ <- (get >>= bar)
; factLoop }
= do { _ <- (get >>= (\x -> bar x))
; factLoop }
= do { _ <- do { x <- get
; bar x }
; factLoop }
= do { x <- get
; _ <- bar x
; factLoop }
the last one is because of the monad associativity law ("Kleisli composition forms a category").
Doing this in the principled way you don't need to guess. After a little while you get a feeling for it of course, but until you do, being formal helps.
I'm in a situation where I have a data type like
data X = X {foo :: SInteger, bar :: SInteger}
and I want to prove e.g.
forAll_ $ \x -> foo x + bar x .== bar x + foo x
using haskell's sbv.
This doesn't compile because X -> SBool is not an instance of Provable. I can make it an instance with e.g.
instance (Provable p) => Provable (X -> p) where
forAll_ k = forAll_ $ \foo bar -> forAll_ $ k $ X foo bar
forAll (s : ss) k =
forAll ["foo " ++ s, "bar " ++ s] $ \foo bar -> forAll ss $ k $ X foo bar
forAll [] k = forAll_ k
-- and similarly `forSome_` and `forSome`
but this is tedious and error prone (e.g. using forSome when forAll should've been used). Is there a way to automatically derive Provable for my type?
It can at least be made less error-prone:
onX :: (((SInteger, SInteger) -> a) -> b) -> ((X -> a) -> b)
onX f g = f (g . uncurry X)
instance Provable p => Provable (X -> p) where
forAll_ = onX forAll_
forSome_ = onX forSome_
forAll = onX . forAll
forSome = onX . forSome
There's also a generalizable pattern, in case SBV's existing instances for up to 7-tuples are not sufficient.
data Y = Y {a, b, c, d, e, f, g, h, i, j :: SInteger}
-- don't try to write the types of these, you will wear out your keyboard
fmap10 = fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap
onY f g = f (fmap10 g Y)
instance Provable p => Provable (Y -> p) where
forAll_ = onY forAll_
forSome_ = onY forSome_
forAll = onY . forAll
forSome = onY . forSome
Still tedious, though.
Daniel's answer is "as good as it gets" if you really want to use quantifiers directly with your lambda-expressions. However, instead of creating a Provable instance, I'd strongly recommend defining a variant of free for your type:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
Now you can use it like this:
test = prove $ do x <- freeX
return $ foo x + bar x .== bar x + foo x
This is much easier to use, and composes well with constraints. For instance, if your data type has the extra constraint that both components are positive, and the first one is larger than the second, then you can write freeX thusly:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
constrain $ f .> b
constrain $ b .> 0
return $ X f b
Note that this will work correctly in both prove and sat contexts, since free knows how to behave correctly in each case.
I think this is much more readable and easier to use, even though it forces you to use the do-notation. You can also create a version that accepts names, like this:
freeX :: String -> Symbolic X
freeX nm = do f <- free $ nm ++ "_foo"
b <- free $ nm ++ "_bar"
constrain $ f .> b
constrain $ b .> 0
return $ X f b
test = prove $ do x <- freeX "x"
return $ foo x + bar x .== bar x * foo x
Now we get:
*Main> test
Falsifiable. Counter-example:
x_foo = 3 :: Integer
x_bar = 1 :: Integer
You can also make X "parseable" by SBV. In this case the full code looks like this:
data X = X {foo :: SInteger, bar :: SInteger} deriving Show
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
instance SatModel X where
parseCWs xs = do (x, ys) <- parseCWs xs
(y, zs) <- parseCWs ys
return $ (X (literal x) (literal y), zs)
The following test demonstrates:
test :: IO (Maybe X)
test = extractModel `fmap` (prove $ do
x <- freeX
return $ foo x + bar x .== bar x * foo x)
We have:
*Main> test >>= print
Just (X {foo = -4 :: SInteger, bar = -5 :: SInteger})
Now you can take your counter-examples and post-process them as you wish.
I'm trying to pause a computation and later resume it on demand (upon a prompt from the user). It should resemble something like the following, only using the continuation monad.
import Control.Monad.IO.Class (liftIO,MonadIO(..))
import Data.Void
f :: MonadIO m => Int -> Int -> m Void
f x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f (x+1) y)
else (f' y x)
f' :: MonadIO m => Int -> Int -> m Void
f' x y = do
liftIO (print x)
input <- liftIO getLine
if input /= "pause"
then (f' (x-1) y)
else (f y x)
Example output:
λ> f 5 5
5
6
7
8
pause
5
4
3
2
pause
8
9
10
Interrupted.
Original version of the question:
-- Helpers
cond = fmap (not . (== "pause")) getLine
ch b x y = if b then x else y
ch' :: a -> a -> Bool -> a
ch' = flip . (flip ch)
-- Main code
f i i' = liftIO (print i) >> liftIO cond >>= ch' (f (i+1) i') (f' i' i)
f' i i' = liftIO (print i) >> liftIO cond >>= ch' (f' (i-1) i') (f i' i)
In my application, I'm trying to implement an animation system. In this system, animations are represented as a cyclic list of frames:
data CyclicList a = CL a [a]
We can (inefficiently) advance the animation as follows:
advance :: CyclicList a -> CyclicList a
advance (CL x []) = CL x []
advance (CL x (z:zs)) = CL z (zs ++ [x])
Now, I'm pretty sure that this data type is a comonad:
instance Functor CyclicList where
fmap f (CL x xs) = CL (f x) (map f xs)
cyclicFromList :: [a] -> CyclicList a
cyclicFromList [] = error "Cyclic list must have one element!"
cyclicFromList (x:xs) = CL x xs
cyclicLength :: CyclicList a -> Int
cyclicLength (CL _ xs) = length xs + 1
listCycles :: CyclicList a -> [CyclicList a]
listCycles cl = let
helper 0 _ = []
helper n cl' = cl' : (helper (n-1) $ advance cl')
in helper (cyclicLength cl) cl
instance Comonad CyclicList where
extract (CL x _) = x
duplicate = cyclicFromList . listCycles
The question I have is: what kind of benefits do I get (if any) from using the comonad instance?
The advantage of providing a type class or implementing an interface is that code, written to use that typeclass or interface, can use your code without any modifications.
What programs can be written in terms of Comonad? A Comonad provides a way to both inspect the value at the current location (without observing its neighbors) using extract and a way to observe the neighborhood of every location with duplicate or extend. Without any additional functions, this isn't terribly useful. However, if we also require other functions along with the Comonad instance, we can write programs that depend on both local data and data from elsewhere. For example, if we require functions that allow us to change location, such as your advance, we can write programs that depend only on the local structure of the data, not on the data structure itself.
For a concrete example, consider a cellular automata program written in terms of Comonad and the following Bidirectional class:
class Bidirectional c where
forward :: c a -> Maybe (c a)
backward :: c a -> Maybe (c a)
The program could use this, together with Comonad, to extract data stored in a cell and explore the cells forward and backward of the current cell. It can use duplicate to capture the neighborhood of each cell and fmap to inspect that neighborhood. This combination of fmap f . duplicate is extract f.
Here is such a program. rule' is only interesting to the example; it implements cellular automata rules on neighborhood with just the left and right values. rule extracts data from the neighborhood, given the class, and runs the rule on each neighborhood. slice pulls out even larger neighborhoods so that we can display them easily. simulate runs the simulation, displaying these larger neighborhoods for each generation.
rule' :: Word8 -> Bool -> Bool -> Bool -> Bool
rule' x l m r = testBit x ((if l then 4 else 0) .|. (if m then 2 else 0) .|. (if r then 1 else 0))
rule :: (Comonad w, Bidirectional w) => Word8 -> w Bool -> w Bool
rule x = extend go
where
go w = rule' x (maybe False extract . backward $ w) (extract w) (maybe False extract . forward $ w)
slice :: (Comonad w, Bidirectional w) => Int -> Int -> a -> w a -> [a]
slice l r a w = sliceL l w (extract w : sliceR r w)
where
sliceR r w | r > 0 = case (forward w) of
Nothing -> take r (repeat a)
Just w' -> extract w' : sliceR (r-1) w'
sliceR _ _ = []
sliceL l w r | l > 0 = case (backward w) of
Nothing -> take l (repeat a) ++ r
Just w' -> sliceL (l-1) w' (extract w':r)
sliceL _ _ r = r
simulate :: (Comonad w, Bidirectional w) => (w Bool -> w Bool) -> Int -> Int -> Int -> w Bool -> IO ()
simulate f l r x w = mapM_ putStrLn . map (map (\x -> if x then '1' else '0') . slice l r False) . take x . iterate f $ w
This program might have been intended to work with the following Bidirectional Comonad, a Zipper on a list.
data Zipper a = Zipper {
heads :: [a],
here :: a,
tail :: [a]
} deriving Functor
instance Bidirectional Zipper where
forward (Zipper _ _ [] ) = Nothing
forward (Zipper l h (r:rs)) = Just $ Zipper (h:l) r rs
backward (Zipper [] _ _) = Nothing
backward (Zipper (l:ls) h r) = Just $ Zipper ls l (h:r)
instance Comonad Zipper where
extract = here
duplicate (Zipper l h r) = Zipper (goL (h:r) l) (Zipper l h r) (goR (h:l) r)
where
goL r [] = []
goL r (h:l) = Zipper l h r : goL (h:r) l
goR l [] = []
goR l (h:r) = Zipper l h r : goR (h:l) r
But will also work with a CyclicList Bidirectional Comonad.
data CyclicList a = CL a (Seq a)
deriving (Show, Eq, Functor)
instance Bidirectional CyclicList where
forward (CL x xs) = Just $ case viewl xs of
EmptyL -> CL x xs
x' :< xs' -> CL x' (xs' |> x)
backward (CL x xs) = Just $ case viewr xs of
EmptyR -> CL x xs
xs' :> x' -> CL x' (x <| xs')
instance Comonad CyclicList where
extract (CL x _) = x
duplicate (CL x xs) = CL (CL x xs) (go (singleton x) xs)
where
go old new = case viewl new of
EmptyL -> empty
x' :< xs' -> CL x' (xs' >< old) <| go (old |> x') xs'
We can reuse simulate with either data structure. The CyclicList has a more interesting output, because, instead of bumping into a wall, it wraps back around to interact with itself.
{-# LANGUAGE DeriveFunctor #-}
import Control.Comonad
import Data.Sequence hiding (take)
import Data.Bits
import Data.Word
main = do
putStrLn "10 + 1 + 10 Zipper"
simulate (rule 110) 10 10 30 $ Zipper (take 10 . repeat $ False) True (take 10 . repeat $ False)
putStrLn "10 + 1 + 10 Cyclic"
simulate (rule 110) 10 10 30 $ CL True (fromList (take 20 . repeat $ False))
Are there a possibility to stop a recursive algorithm when it throws some exception provided by us, save it's state, ask user something and then continue the recursion from the saved place?
I changed the question.
I read a file system recursively and keep data in a tree. Suddenly I face with a hidden directory. Can I stop calculations and ask now user should I place information about the directory in my tree and then continue calculations?
About working with IO:
obtainTree :: ByteString -> Tree
...
main = print $ obtainTree partition
as I understand to work with IO inside the algorithm we have to use function like this:
obtainTree :: ByteString -> IO Tree
but can we avoid it?
Sure you can do it. You can always set things up so that you capture the remaining computation as a continuation, which can be resumed externally.
Here's one way to do something like this:
-- intended to be put in a module that only exports the following list:
-- (Resumable, Prompted, prompt, runResumable, extract, resume)
import Control.Applicative
newtype Resumable e r a = R { runResumable :: Either (Prompted e r a) a }
data Prompted e r a = P e (r -> Resumable e r a)
suspend :: e -> (r -> Resumable e r a) -> Resumable e r a
suspend e = R . Left . P e
instance Functor (Resumable e r) where
fmap f (R (Right x)) = pure $ f x
fmap f (R (Left (P e g))) = suspend e $ \x -> f <$> g x
instance Applicative (Resumable e r) where
pure = R . Right
(R (Right f)) <*> (R (Right x)) = pure $ f x
(R (Left (P e f))) <*> x = suspend e $ \y -> f y <*> x
f <*> (R (Left (P e g))) = suspend e $ \y -> f <*> g y
instance Monad (Resumable e r) where
return = pure
(R (Right x)) >>= f = f x
(R (Left (P e f))) >>= g = suspend e $ \x -> f x >>= g
prompt :: e -> Resumable e r r
prompt e = suspend e pure
extract :: Prompted e r a -> e
extract (P e _) = e
resume :: Prompted e r a -> r -> Either (Prompted e r a) a
resume (P _ f) e = runResumable $ f e
This lets you divide up your logic into an internal piece that runs inside Resumable and an external piece that handles the results of the internal part's prompting using whatever method it likes.
Here's a simple example of using this:
askAboutNegatives :: [Int] -> Resumable Int Bool [Int]
askAboutNegatives [] = return []
askAboutNegatives (x:xs) = do
keep <- if x < 0 then prompt x else return True
rest <- askAboutNegatives xs
return $ if keep then x:rest else rest
main :: IO ()
main = do
let ls = [1, -4, 2, -7, 3]
loopIfNeeded (Right r) = return r
loopIfNeeded (Left p) = do
putStrLn $ "Would you like to keep " ++ show (extract p)
i <- getLine
loopIfNeeded $ resume p (i == "y")
asked <- loopIfNeeded $ runResumable (askAboutNegatives ls)
print asked
As a way of making this use case simpler, the module containing Resumable can be augmented to also export this function:
runResumableWithM :: Monad m => (e -> m r) -> Resumable e r a -> m a
runResumableWithM f x = case runResumable x of
Right y -> return y
Left (P e g) -> do
r <- f e
runResumableWithM f $ g r
Which would allow rewriting main from that example as the somewhat simpler:
main :: IO ()
main = do
let ls = [1, -4, 2, -7, 3]
ask x = do
putStrLn $ "Would you like to keep " ++ show x
i <- getLine
return $ i == "y"
asked <- runResumableWithM ask (askAboutNegatives ls)
print asked
The one real issue with this approach is that every prompt must have the same type. Otherwise, it handles the problem nicely, using continuations to capture the rest of the computation implicitly when needed.
First thing first, a pure code cannot go to IO or we can say a pure function needs to become impure if it tries to use some impure function (i.e trying to use IO). In case you are wondering why this so, think about this: If the pure function ask the impure function about some data to complete its own processing then it looses "Referential transparency" because now the pure function can return different result for same input due to the involved impure (IO) call, hence it is no more pure.
Based on the above information, your solution will be as simple as making use of higher order function to ask the user about the information. Something like:
parseFileSystem :: FileSystem -> (Directory -> IO Tree) -> IO Tree
Here the (Directory -> IO Tree) is the function that will ask user about the required information and return a Tree data based on it.