Let's say, I have the following types:
type LinkID = Int
data Link = Link {
lid :: LinkID,
llength :: Int
}
data Snap = Snap {
slid :: LinkID,
slength :: Int
}
Now, I want to write a pipes based function which does this:
getSnaps :: LinkID -> [Link] -> [Snap] -> [(LinkID, [Snap])]
getSnaps l lks snp = map (\x -> (lid x, filter (\y -> lid x == slid y) snp)) a
where a = filter (\x -> lid x > l) lks
Assumming that I already have Producers of Link and Snap, how can I implement the above getSnaps function in the Pipes world from these two Producers:
psnap :: Producer Snap IO ()
psnap = undefined
plink :: Producer Link IO ()
plink = undefined
The actual types of psnap and plink are more involved (created out by using attoparsec-pipes), but I would like to know how to implement the functionality of getSnaps from psnap and plink. Is there a proper way to solve this type of problem ?
The solution I came up with is pretty similar to your code. I just replaced map with Pipes.Prelude.map and one of the filters with Pipes.Prelude.filter:
import Pipes
import qualified Pipes.Prelude as Pipes
type LinkID = Int
data Link = Link
{ lid :: LinkID
, llength :: Int
}
data Snap = Snap
{ slid :: LinkID
, slength :: Int
}
getSnaps
:: Monad m
=> LinkID
-> Producer Link m ()
-> Producer Snap m ()
-> Producer (LinkID, [Snap]) m ()
getSnaps l lks snp = do
snp' <- lift (Pipes.toListM snp) -- Cache `snp` into the list `snp'`
lks >-> Pipes.filter (\x -> lid x > l)
>-> Pipes.map (\x -> (lid x, filter (\y -> lid x == slid y) snp'))
Note that there is one non-trivial part, which is that the above solution strictly loads the snp Producer's contents into the list snp'. The reason for this is that we have to use the contents of the list repeatedly, so we need to cache the entire list in memory for repeated usage.
Related
I have a state where it contains different values and I want to use the same function to update different values in the state. But I am unable to do so because of the following error.
Error Received:
warning: [-Woverlapping-patterns]
Pattern match is redundant
In a case alternative: currentRegister -> ...
|
559 | currentRegister -> modify $ \st->st{ currentRegister = nextAddr}
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data St = St
{ cotxt :: [Cxt]
, currentLabel :: Int
, currentLogicLabel :: Int
, currentIfLabel :: Int
, currentWhileLabel :: Int
, currentRegister :: Int
}
getcurrStateValue :: (St -> Int) -> Compile Int
getcurrStateValue x = do
current <- gets x
let nextAddr = current + 1
case x of
currentLabel -> modify $ \st->st{ currentLabel = nextAddr}
currentRegister -> modify $ \st->st{ currentRegister = nextAddr}
currentLogicLabel -> modify $ \st->st{ currentLogicLabel = nextAddr}
currentIfLabel -> modify $ \st->st{ currentIfLabel = nextAddr}
currentWhileLabel -> modify $ \st->st{ currentWhileLabel = nextAddr}
return current
func1::
..
current <- getcurrStateValue currentRegister
..
func2::
anothercurrent <- getcurrStateValue currentLogicLabel ```
As commenters have pointed out, in this case expression, you’re trying to compare the parameter x with the getter functions from the St type.
case x of
currentLabel -> modify $ \ st -> st { currentLabel = nextAddr }
currentRegister -> modify $ \ st -> st { currentRegister = nextAddr }
-- …
Unfortunately, functions cannot be compared; only data constructors and numeric literals (Num + Eq) can appear in basic patterns. What your code actually does is match x against anything, and bind it to a new local variable currentLabel, and then all the subsequent case branches (currentRegister and so on) are redundant, as the warning tells you.
It’s just as if you had written this, with distinct variable names:
case x of
a -> modify $ \ st -> st { currentLabel = nextAddr }
b -> modify $ \ st -> st { currentRegister = nextAddr }
-- …
A simple solution here is to add a new enumeration type indicating which field you want to modify, and pattern-match on that:
data Field
= CurrentLabel
| CurrentLogicLabel
| CurrentIfLabel
| CurrentWhileLabel
| CurrentRegister
getCurrStateValue :: Field -> Compile Int
getCurrStateValue field = case field of
CurrentLabel -> do
current <- gets currentLabel
modify $ \ st -> st { currentLabel = current + 1 }
pure current
CurrentRegister -> do
current <- gets currentRegister
modify $ \ st -> st { currentRegister = current + 1 }
pure current
CurrentLogicLabel -> do
current <- gets currentLogicLabel
modify $ \ st -> st { currentLogicLabel = current + 1 }
pure current
CurrentIfLabel -> do
current <- gets currentIfLabel
modify $ \ st -> st { currentIfLabel = current + 1 }
pure current
CurrentWhileLabel -> do
current <- gets currentWhileLabel
modify $ \ st -> st { currentWhileLabel = current + 1 }
pure current
As you can see, though, this is quite repetitive! A better solution is to pass both a getter and a setter function (whereas currently you’re only passing the getter):
getCurrStateValue
:: (St -> Int)
-> (St -> Int -> St)
-> Compile Int
getCurrStateValue getField setField = do
current <- gets getField
modify $ \ st -> setField st $ current + 1
pure current
Of course, now this has moved the repetitiveness to the call site, since you must pass both functions, and they must refer to the same field:
current <- getCurrStateValue
currentRegister
(\ st x -> st { currentRegister = x })
So an improvement would be to package up these invocations into helper functions for each field:
getCurrRegister = getCurrStateValue
currentRegister
(\ st x -> st { currentRegister = x })
getCurrLogicLabel = getCurrStateValue
currentLogicLabel
(\ st x -> st { currentLogicLabel = x })
I think this is a good place to stop: the repetition is abstracted away without too much heavy machinery.
However, this can be abstracted further. The combination of a getter and setter for the same field is very useful, and it would be nice to reuse it with other functions besides getCurrStateValue.
A getter+setter pair can be packaged up into a lens (or more generally an “optic”), which is a first-class accessor that can be composed with other lenses. While there are many lens libraries like lens (big and complete) and microlens (small and simple) containing functions for working with lenses, you don’t actually need any dependencies to define a lens; it’s just a function with a type like this:
(Functor f) => (a -> f b) -> s -> f t
Or, slightly simplified:
(Functor f) => (a -> f a) -> s -> f s
How this works is beyond the scope of this answer, but what it means is an accessor for a field of type a within a structure of type s. In your case, a is always Int and s is St. Here’s a helper function for defining a lens from a getter and setter:
lens
:: Functor f
=> (s -> a) -- get ‘a’ out of ‘s’
-> (s -> a -> s) -- put ‘a’ into ‘s’
-> (a -> f a) -> s -> f s -- lens
lens getter setter
= \ f s -> fmap (setter s) (f (getter s))
Using this, you can define lenses for your fields:
currentRegisterL, currentLogicLabelL -- …
:: (Functor f) => (Int -> f Int) -> St -> f St
currentRegisterL = lens
currentRegister
(\ st x -> st { currentRegister = x })
currentLogicLabelL = lens
currentLogicLabel
(\ st x -> st { currentLogicLabel = x })
-- …
And then use them with functions and types from lens, such as view to use the getter part and set to use the setter. To take a lens as a function parameter, you need the RankNTypes extension, which allows passing polymorphic functions like lenses as arguments to other functions.
{-# LANGUAGE RankNTypes #-}
import Control.Lens (Lens', set, view)
getCurrStateValue :: Lens' St Int -> Compile Int
getCurrStateValue field = do
current <- gets $ view field
modify $ set field $ current + 1
pure current
Most of the time, when using lenses, people don’t write their own by hand, unless they specifically want to avoid a dependency on a lens package. Instead, it’s common to automate this by deriving lenses for a data type with Template Haskell:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens.TH (makeLenses)
data St = St
{ _cotxt :: [Cxt]
, _currentLabel :: Int
, _currentLogicLabel :: Int
, _currentIfLabel :: Int
, _currentWhileLabel :: Int
, _currentRegister :: Int
}
makeLenses ''St
The convention is that the getters and record accessors are prefixed with an underscore, like _currentLabel, and the lenses derived from them have no prefix, like currentLabel. You can still use the accessor functions directly, but when you need to abstract over field access, you can use view, set, over, and other such functions.
Pattern matching only works with data constructors; it can't check for equality of values. (Patterns like x:xs, [x,y], and (x,y) are treated constructor matches.) In particular, there is no other general way to handle coproduct types like data Foo = Bar | Baz. (Aside from using Eq, Ord, etc.)
What you probably need here is a lens.
Somewhat similar to this question, I'm trying to figure out
how to move around a Haskell Monad state.
Each Employee in a team is replaced with a corresponding Employee'
while maintaining some simple state. Here is the code:
module Main( main ) where
import Control.Monad.State
data Employee = EmployeeSW Int Int | EmployeeHW Int String deriving ( Show )
data Employee' = EmployeeSW' Int | EmployeeHW' String deriving ( Show )
scanTeam :: [Employee] -> State (Int,Int) [Employee']
scanTeam [ ] = return []
scanTeam (p:ps) = scanEmployee p -- : scanTeam ps ???
scanEmployee :: Employee -> State (Int,Int) Employee'
scanEmployee (EmployeeSW id s) = do
(num,raise) <- get
put (num+1,raise)
return (EmployeeSW' (s+raise))
scanEmployee (EmployeeHW id s) = do
(num,raise) <- get
put (num+1,raise)
return (EmployeeHW' (s++(show raise)))
startState = (0,3000)
t = [(EmployeeHW 77 "Hundred"),(EmployeeSW 66 500),(EmployeeSW 32 200)]
main = print $ evalState (scanTeam t) startState
I want to eventually concatenate scanEmployee p with scanTeam ps,
so I tried to extract the pieces of scanEmployee p and somehow glue
them together with scanTeam ps. So far I failed miserably.
Actually, I'm not even sure the state can be moved around between them (?).
Since State is a monad, you can use do notation to define State computations.
(State's instance of Monad plumbs the state through, so the ending state of one statement in the do block becomes the starting state of the next.)
So, in a do block, I'm going to:
Process the first Employee in the list to get a new Employee
Process the rest of the list recursively
Put the two results back together and use them as the return value for the Stateful computation.
scanTeam :: [Employee] -> State (Int,Int) [Employee']
scanTeam [ ] = return []
scanTeam (p:ps) = do
newP <- scanEmployee p
newPs <- scanTeam ps
return (newP:newPs)
It turns out that "map in a monadic context" is pretty useful in general, so it's present in the standard prelude as mapM :: Monad m => (a -> m b) -> [a] -> m [b] (aka traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b), if you're ready to go down the rabbit hole).
scanTeam = mapM scanEmployee
An idiom I use for composing a couple of procedures (with memory) is as follows:
p1 :: State (Int, String) ()
p1 = do
(a, b) <- get
... do something ...
put (a', b)
p2 :: State (Int, String) ()
p2 = do
(a, b) <- get
... do something else ...
put (a, b')
main = do
... initializing a0 b0 ...
print . flip evalState (a0, b0)
. sequence $ replicate 10 p1 ++ repeat p2
However, as the number of state variable grows, this quickly gets way more verbose than necessary:
p1 :: State (Int, String, Bool, Int, String, Bool) ()
p1 = do
(a, b, c, d, e, f) <- get
... do something ...
put (a, b, c', d, e, f')
p2 :: State (Int, String, Bool, Int, String, Bool) ()
p2 = do
(a, b, c, d, e, f) <- get
... do something ...
put (a', b', c, d, e, f)
main = do
print . flip evalState (a0, b0, c0, d0, e0, f0)
. sequence $ replicate 10 p1 ++ repeat p2
As I was wondering, is there a way of updating only a few state variables without having to refer to all the unused ones? I was thinking something like IORef but for State (in fact there is a package stateref), but I'm not sure if there are already some common idioms that other people have been using.
This seems like a job for lenses. Especially the Control.Lens.Tuple module together with .= and use:
p1 = do
a <- use _1
-- do something --
_1 .= a'
However, it's usually better if you give the things in your state proper names, e.g.
{-# LANGUAGE TemplateHaskell #-
data Record = MkRecord { _age :: Int
, _name :: String
, _programmer :: Bool
} deriving (Show, Eq)
makeLenses ''Record
That way, you have better names for your field:
p1 = do
a <- use age
-- do something --
age .= a'
Note that this still helps you if you don't want to use lenses, since you can use record syntax to update your data:
p1 = do
r <- get
let a = _age r
--- do something
put $ r{_age = a'}
This is a good situation to use records, with the gets and modify functions to manipulate subparts of the state:
data Env = Env
{ envNumber :: Int
, envText :: String
}
p1 :: State Env ()
p1 = do
a <- gets envNumber
-- ...
modify $ \r -> r { envNumber = a' }
p2 :: State Env ()
p2 = do
b <- gets envText
-- ...
modify $ \r -> r { envText = b' }
gets turns a pure getter function into a state action:
gets :: (s -> a) -> State s a
envNumber :: Env -> Int
gets envNumber :: State Env Int
And modify turns a pure update function into a state action:
modify :: (s -> s) -> State s ()
(\r -> r { envText = b' }) :: Env -> Env
modify (\r -> ...) :: State Env ()
lens's zoom combinator lifts a computation in a State monad into a computation that runs in a "larger" State monad.
zoom :: Lens' s t -> State t a -> State s a
So, given a "big" state:
data Big = Big {
_big1 :: Medium,
_big2 :: Medium
}
data Medium = Medium {
_medium1 :: Small,
_medium2 :: Small
}
data Small = Small { _small :: Int }
makeLenses ''Big
makeLenses ''Medium
makeLenses ''Small
you can "zoom in" on a part of the state:
incr :: State Int ()
incr = id += 1
incrSmall :: State Big ()
incrSmall = zoom (big2.medium1.small) incr
Of course, this'll work on big tuples as well as records, using lens's built-in tuple field accessors.
zoom's real type signature is more general than the simple one I quoted above. It uses MonadState constraints to work under a monad transformer stack, rather than in State specifically.
Given the data structure:
data CustomError = FooError | BarError deriving Show
And then two functions that perform IO:
foo :: IO (Either CustomError Int)
foo = return $ Right 100
bar :: IO (Either CustomError Int)
bar = return $ Left BarError
And a method that adds two Either's.
add :: Either CustomError Int -> Either CustomError Int -> Either CustomError Int
add e1 e2 = (+) <$> e1 <*> e2
Lastly, a function that performs two IO actions, and then tries to apply add to their extracted Right values:
f :: IO (Either CustomError Int)
f = do
x <- foo
y <- bar
return $ add x y
Running it shows:
λ: f
Left BarError
But, let's say that calling foo persists data to a database. If foo succeeds, but bar fails, then there will be irregular state. In other words, I want f to operate like a transaction - everything succeeds or nothing does.
I thought of doing something like:
fWithRecovery:: IO (Either CustomError Int)
fWithRecovery = do
x <- foo
y <- bar
case y of (Right _) -> return $ add x y
(Left FooError) -> fmap Right recoverFoo
(Left BarError) -> fmap Right recoverBar
recoverFoo :: IO Int
recoverFoo = do
_ <- undefined -- clean up DB
return 666 -- using an 'evil' value
-- Note - I know using this value is horrible, but
-- I'm using for this simple example
recoverBar :: IO Int
recoverBar = do
_ <- undefined -- clean up DB
return 42 -- Note - I know using this value is horrible, but
-- I'm using for this simple example
But, I'm curious if there's an idiomatic way to handle roll-back for my do notation case.
Given the below program, I am having issues dealing with monads.
module Main
where
import System.Environment
import System.Directory
import System.IO
import Text.CSV
--------------------------------------------------
exister :: String -> IO Bool
exister path = do
fileexist <- doesFileExist path
direxist <- doesDirectoryExist path
return (fileexist || direxist )
--------------------------------------------------
slurp :: String -> IO String
slurp path = do
withFile path ReadMode (\handle -> do
contents <- hGetContents handle
last contents `seq` return contents )
--------------------------------------------------
main :: IO ()
main = do
[csv_filename] <- getArgs
putStrLn (show csv_filename)
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
printCSV csv_data -- unable to compile.
csv_data is an Either (parseerror) CSV type, and printCSV takes only CSV data.
Here's the ediff between the working version and the broken version.
***************
*** 27,30 ****
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
! printCSV csv_data -- unable to compile.
\ No newline at end of file
--- 27,35 ----
csv_raw <- slurp csv_filename
let csv_data = parseCSV csv_filename csv_raw
! case csv_data of
! Left error -> putStrLn $ show error
! Right csv_data -> putStrLn $ printCSV csv_data
!
! putStrLn "done"
!
reference: http://hackage.haskell.org/packages/archive/csv/0.1.2/doc/html/Text-CSV.html
Regarding monads:
Yes, Either a is a monad. So simplifying the problem, you are basically asking for this:
main = print $ magicMonadUnwrap v
v :: Either String Int
v = Right 3
magicMonadUnwrap :: (Monad m) => m a -> a
magicMonadUnwrap = undefined
How do you define magicMonadUnwrap? Well, you see, it's different for each monad. Each one needs its own unwrapper. Many of these have the word "run" in them, for example, runST, runCont, or runEval. However, for some monads, it might not be safe to unwrap them (hence the need for differing unwrappers).
One implementation for lists would be head. But what if the list is empty? An unwrapper for Maybe is fromJust, but what if it's Nothing?
Similarly, the unwrapper for the Either monad would be something like:
fromRight :: Either a b -> b
fromRight (Right x) = x
But this unwrapper isn't safe: what if you had a Left value instead? (Left usually represents an error state, in your case, a parse error). So the best way to act upon an Either value it is to use the either function, or else use a case statement matching Right and Left, as Daniel Wagner illustrated.
tl;dr: there is no magicMonadUnwrap. If you're inside that same monad, you can use <-, but to truly extract the value from a monad...well...how you do it depends on which monad you're dealing with.
Use case.
main = do
...
case csv_data of
Left err -> {- whatever you're going to do with an error -- print it, throw it as an exception, etc. -}
Right csv -> printCSV csv
The either function is shorter (syntax-wise), but boils down to the same thing.
main = do
...
either ({- error condition function -}) printCSV csv_data
You must unlearn what you have learned.
Master Yoda.
Instead of thinking about, or searching for ways to "free", "liberate", "release", "unwrap" or "extract" normal Haskell values from effect-centric (usually monadic) contexts, learn how to use one of Haskell's more distinctive features - functions are first-class values:
you can use functions like values of other types e.g. like Bool, Char, Int, Integer etc:
arithOps :: [(String, Int -> Int -> Int)]
arithOps = zip ["PLUS","MINUS", "MULT", "QUOT", "REM"]
[(+), (-), (*), quot, rem]
For your purposes, what's more important is that functions can also be used as arguments e.g:
map :: (a -> b) -> [a] -> [b]
map f xs = [ f x | x <- xs ]
filter :: (a -> Bool) -> [a] -> [a]
filter p xs = [ x | x <- xs, p x ]
These higher-order functions are even available for use in effect-bearing contexts e.g:
import Control.Monad
liftM :: Monad m => (a -> b) -> (m a -> m b)
liftM2 :: Monad m => (a -> b -> c) -> (m a -> m b -> m c)
liftM3 :: Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)
...etc, which you can use to lift your regular Haskell functions:
do .
.
.
val <- liftM3 calculate this_M that_M other_M
.
.
.
Of course, the direct approach also works:
do .
.
.
x <- this_M
y <- that_M
z <- other_M
let val = calculate x y z
.
.
.
As your skills develop, you'll find yourself delegating more and more code to ordinary functions and leaving the effects to a vanishingly-small set of entities defined in terms of functors, applicatives, monads, arrows, etc as you progress towards Haskell mastery.
You're not convinced? Well, here's a brief note of how effects used to be handled in Haskell - there's also a longer description of how Haskell arrived at the monadic interface. Alternately, you could look at Standard ML, OCaml, and other similar languages - who knows, maybe you'll be happier with using them...