Additional pattern matching inside case - haskell

Hopefully, the code is commented well enough.
-- I have 2 data types:
data Person = Person { firstName :: String, lastName :: String, age :: Int }
deriving (Show)
data Error = IncompleteDataError | IncorrectDataError String
deriving (Show)
-- This function should take a list a pairs like:
-- fillPerson [("firstName","John"), ("lastName","Smith"), ("dbdf", "dff"), ("age","30"), ("age", "40")]
-- And fill the record with values of the fields with corresponding names.
-- It ignores the redundant fields.
-- If there are less then 3 meaningful fields, it should throw an error IncompleteDataError
-- If the field age doesn't have a number, if should return IncorrectDataError str, where str — is the value of age.
fillPerson :: [(String, String)] -> Either Error Person
fillPerson [] = Left IncompleteDataError
fillPerson (x:xs) = let
-- Int stores number of fields
helper :: [(String, String)] -> Person -> Int -> Either Error Person
helper _ p 3 = Right p
helper [] _ _ = Left IncompleteDataError
helper ((key, value):xs) p n = case key of
"firstName" -> helper xs p{firstName=value} (n + 1)
"lastName" -> helper xs p{lastName=value} (n + 1)
-- how to return IncorrectDataError str here?
-- I need to store reads value :: [(Int, String)]
-- if the String is not empty, return Left IncorrectDataError value
-- but how to write this?
"age" -> helper xs p{age=read value::Int} (n + 1)
_ -> helper xs p n
in
helper (x:xs) Person{} 0

You have an association list; use lookup to get each name, or produce an IncompleteDataError if the lookup fails. maybe converts each Nothing to a Left value and each Just value to Right value.
-- lookup :: Eq a => a -> [(a,b)] -> Maybe b
-- maybe :: b -> (a -> b) -> Maybe a -> b
verifyInt :: String -> Either Error Int
verifyInt x = ... -- E.g. verify "3" == Right 3
-- verify "foo" == Left IncorrectDataError
fillPerson kv = Person
<$> (get "firstName" kv)
<*> (get "lastName" kv)
<*> (get "age" kv >>= verifyInt)
where get key kv = maybe (Left IncompleteDataError) Right $ lookup key kv
Since get :: String -> [(String, String)] -> Either Error String, the Applicative instance for functions ensures that fillPerson :: [(String, String)] -> Either Error Person. If any call to get returns Left IncompleteDataError, the result of Person <$> ... will do so as well; otherwise, you'll get a Right (Person ...) value.

The problem that you have is trying to do all the things at once in a single recursive function, interleaving several different concerns. It’s possible to write that way, but better to follow the format of #chepner’s answer and break things down into pieces. This is a supplement to their answer re. the verification of age. With the addition of an import:
-- readMaybe :: Read a => String -> Maybe a
import Text.Read (readMaybe)
And a helper function to turn Maybe “failures” (Nothing) into the corresponding Either (Left):
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither x = maybe (Left x) Right
Here is a solution that does all the verification you describe:
fillPerson store = do -- Either monad
-- May fail with ‘IncompleteDataError’
f <- string "firstName"
l <- string "lastName"
-- May fail with ‘IncompleteDataError’ *or* ‘IncorrectDataError’
a <- int "age"
pure Person
{ firstName = f
, lastName = l
, age = a
}
where
string :: String -> Either Error String
string key = maybeToEither IncompleteDataError (lookup key store)
int :: String -> Either Error Int
int key = do
value <- string key -- Reuse error handling from ‘string’
maybeToEither (IncorrectDataError value) (readMaybe value)
You can make this more compact using RecordWildCards, although this is less advisable because it’s not explicit, so it’s sensitive to renaming of fields in Person.
fillPerson store = do
firstName <- string "firstName"
lastName <- string "lastName"
age <- int "age"
pure Person{..} -- Implicitly, ‘firstName = firstName’ &c.
where
…
Applicative operators are more common for this type of thing, and preferable in most cases as they avoid unnecessary intermediate names. However, one caveat of using positional arguments rather than named fields is that it’s possible to mix up the order of fields that have the same type (here, firstName and lastName).
fillPerson store = Person
<$> string "firstName"
<*> string "lastName"
<*> int "age"
where
…
It’s also possible to make this definition point-free, omitting store from the parameters of fillPerson and making it instead a parameter of string and int, using liftA3 Person <$> string "firstName" <*> … (the (r ->) applicative); in this particular case I wouldn’t choose that style, but it may be a worthy exercise to try to rewrite it yourself.
As to your question:
-- I need to store reads value :: [(Int, String)]
-- if the String is not empty, return Left IncorrectDataError value
-- but how to write this?
You can write:
"age" -> case reads value of
[(value', "")] -> helper xs p{age=value'} (n + 1)
_ -> Left (IncorrectValueError value)
However there are a number of problems with your code:
It starts with a Person whose fields are undefined, and will raise exceptions if accessed, which would be fine if you guaranteed that they were all filled in, but…
It tracks the number of fields set but not which fields, so you can set firstName three times and end up returning an invalid Person.
So if you want to do this in a single definition, here’s how I would restructure it—keep the recursive helper, but make each equation handle one condition, using an accumulator with Maybes for each of the fields, updating them from Nothing to Just as you find each field.
fillPerson' :: [(String, String)] -> Either Error Person
fillPerson' = fillFields (Nothing, Nothing, Nothing)
where
fillFields
-- Accumulator of firstName, lastName, and age.
:: (Maybe String, Maybe String, Maybe Int)
-- Remaining input keys to check.
-> [(String, String)]
-- Final result.
-> Either Error Person
-- Set firstName if not set.
fillFields (Nothing, ml, ma) (("firstName", f) : kvs)
= fillFields (Just f, ml, ma) kvs
-- Set lastName if not set.
fillFields (mf, Nothing, ma) (("lastName", l) : kvs)
= fillFields (mf, Just l, ma) kvs
-- Set age if not set, failing immediately if not a valid number.
fillFields (mf, ml, Nothing) (("age", a) : kvs)
| all (`elem` ['0'..'9']) a
= fillFields (mf, ml, Just (read a)) kvs
| otherwise
= Left (IncorrectDataError a)
-- Ignore redundant firstName.
fillFields acc#(Just{}, ml, ma) (("firstName", _) : kvs)
= fillFields acc kvs
-- Ignore redundant lastName.
fillFields acc#(mf, Just{}, ma) (("lastName", _) : kvs)
= fillFields acc kvs
-- Ignore redundant age.
fillFields acc#(mf, ml, Just{}) (("age", _) : kvs)
= fillFields acc kvs
-- Ignore extra fields.
fillFields acc (_ : kvs)
= fillFields acc kvs
-- If all fields are present anywhere in the input,
-- we can finish early and successfully.
fillFields (Just f, Just l, Just a) _
= Right Person
{ firstName = f
, lastName = l
, age = a
}
-- If any field is missing at the end, fail.
fillFields __ []
= Left IncompleteDataError
Note how the structure of the code is very brittle: if we change Person at all, many lines of this definition will have to change. That’s why it’s better to break the problem down into smaller composable parts and put them together.
This does, however, serve as an example of how to translate an “imperative” loop into Haskell: write a recursive function with an accumulator for your “mutable” state, make a recursive call (possibly updating the accumulator) to loop, and stop the recursion to exit the loop. (In fact, if you squint, this is essentially a translation of an imperative program into an explicit control graph.)

Related

Types and Typeclasses in Haskell: Missing field in record construction

I have three datatypes:
data Person = Person { firstName :: String
, lastName :: String
, age :: Int
, height :: Float
, phoneNumber :: String
, flavor :: String
} deriving (Eq,Show, Read)
data Car = Car {company :: String, model :: String, year :: Int} deriving (Eq,Show,Read)
data Things = C Car | P Person deriving (Eq,Show,Read)
And I want to find the Car's coordinates in a [[Things]].
I tried:
enumerate = zip [0..]
findCar :: [[Things]] -> [(Int, Int)]
findCar things = do
[(x, y)
| (y, row) <- enumerate things
, (x, thing) <- enumerate row
, thing == C (Car { })]
But I got an Exception: 'Missing field in record construction company'.
How can I find coordinates of Car in a [[Things]] in a proper way?
Rather than checking whether your thing is equal to a specific Car, which is what (==) is for, you seem to want to check whether it's any kind of Car. So:
isCar (C Car{}) = True
isCar _ = False
findCar things =
[ (x, y)
| (y, row) <- enumerate things
, (x, thing) <- enumerate row
, isCar thing
]
(I've removed the unnecessary and potentially confusing do from findCar.)
Alternately, you could use the behavior of failed pattern matches in list comprehensions:
findCar things =
[ (x, y)
| (y, row) <- enumerate things
, (x, C Car{}) <- enumerate row
]
This is a well-known trick, but a bit subtle and possibly confusing in a quick read of the code (since the match looks partial, but isn't), so it may be worth avoiding in a codebase shared between many programmers.

Writing an assembler in Haskell - mapM with state?

I'm writing a very simple two-pass assembler in Haskell and I've come across a scenario that I don't yet have the experience to solve. I think the solution is likely to involve monad transformers, which I don't really understand.
The assembler parses the assembly code into a list of Statements, which are either instructions or labels. Some Statements may refer to labels. The assembler needs to convert the Statements into Instructions, which involves eliminating the labels and substituting the label references with an appropriate value.
I have written the first pass of the assembler, which produces a [(String, Int)] representing a map from labels to addresses. I have also written the following function for translating a Statement into an Instruction:
stmtToInstruction :: Int -> [(String, Int)] -> Statement -> Either String [I.Instruction]
stmtToInstruction addr labels stmt = case stmt of
ADD d s1 s2 -> Right [I.ADD d s1 s2]
BEQL s1 s2 l -> case do label <- find (\e -> fst e == l) labels
let labelAddr = snd label
let relativeAddr = I.ImmS $ fromIntegral (labelAddr - addr)
return (I.BEQ s1 s2 relativeAddr) of
Just i -> Right [i]
Nothing -> Left $ "Label " ++ l ++ " not defined"
LABEL _ -> Right []
I've omitted several cases for brevity, but you can see all the possible results here:
ADD always succeeds and produces an instruction
BEQL can either succeed or fail, depending on whether a label is found
LABEL always succeeds, even though it produces no actual instructions
This works as expected. The problem I now have is writing this function:
replaceLabels :: [Statement] -> Either String [I.Instruction]
replaceLabels takes a list of statements, and runs stmtToInstruction on each one. The addr argument to stmtToInstruction must be the length of the [Instruction] accumulated so far. The output may either be a Left String, if one of the label references was invalid, or a Right [I.Instruction], if there were no errors.
mapM :: Monad m => (a -> m b) -> [a] -> m [b] gets us some of the way there, but provides no way to inject the current address into the (a -> m b) function. How do I make this work?
You're right: the StateT monad transformer will do the trick:
imapM :: (Traversable t, Monad m)
=> (Int -> a -> m b) -> t a -> m (t b)
imapM f = flip runStateT 0 .
mapM (\a ->
do
count <- get
put $! count + 1
f count a)
But writing the specialized version for lists might be better:
itraverse :: Applicative f
=> (Int -> a -> f b) -> [a] -> f [b]
itraverse f = go 0 where
go !_ [] = pure []
go !count (x:xs) = (:) <$> f count x <*> go (count + 1) xs
I've implemented a recursive solution that I'm sure is very inefficient. I'd still be interested to see the 'proper' way of doing this.
replaceLabels :: [Statement] -> Either String [I.Instruction]
replaceLabels [] = Right []
replaceLabels stmts#(s:ss) = replaceLabels' labels stmts 0
where labels = process stmts
replaceLabels' :: [(String, Int)] -> [Statement] -> Int -> Either String [I.Instruction]
replaceLabels' _ [] _ = Right []
replaceLabels' labels (s:ss) addr = do
instructions <- stmtToInstruction addr labels s
restInstructions <- replaceLabels' labels ss (addr + length instructions)
return (instructions ++ restInstructions)
I would start by changing
stmtToInstruction :: Int -> [(String, Int)] -> Statement -> Either String [I.Instruction]
into
stmtToInstruction :: [(String, Int)] -> Statement -> Either String (Int -> [I.Instruction])
That is, moving the function that takes the address into the Right branch of the Either. The reason is that label reference errors seem to be independent of addresses, so it's better to handle reference errors first and then worry about the address stuff in isolation.
This function resolves the references:
resolveRefs :: [(String,Int)] -> [Statement] -> Either String [Int -> [Instruction]]
resolveRefs environment = traverse (stmtToInstruction environment)
(traverse is equivalent to mapM but it only requires an Applicative constraint. They are different functions merely for historical reasons.)
Ok, after having handled the errors, lets now focus on the [Int -> [Instruction]] list. It seems that we have to map over it from the left while carrying an accumulated address that we must supply to each function. The mapAccumL function is perfect for this:
resolveAddrs :: [Int -> [Instruction]] -> [Instruction]
resolveAddrs funcs = mconcat . snd $ accumulate funcs
where
accumulate :: [Int -> [Instruction]] -> (Int,[[Instruction]])
accumulate = mapAccumL step 0
step address func = let is = func address in (address + length is,is)

Extracting values from list based on their type?

Im trying to iterate over a list of custom data types, and exact the value of a specific type. In this case, I want the ages from the list:
data MyData = Age Int | DOB Int | Name String | Address String
myList = [Age 89, DOB 13, Age 33, Name "Barbra", Address "103 Lane"]
myFunction :: [MyData] -> MyData
myFunction (x : xs) = if x == Age then x : myFunction xs else myFunction xs
Error:
"Age is applied to too few arguments"
Whats the best solution for this?
You can't really have x == Age ... that doesn't make sense. You can only compare x to other values of type MyData, like Age 10, or DOB 40, or Name "John". Age doesn't have type MyData ... it has type Int -> MyData.
You can check what constructor a value has by using case statements:
myFunction :: [MyData] -> MyData
myFunction (x:xs) = case x of
Age _ -> ...
DOB _ -> ...
Name _ -> ...
Address _ -> ...
Or if you only care about the Age constructor, you can wildcard everything else:
myFunction :: [MyData] -> MyData
myFunction (x:xs) = case x of
Age _ -> ...
_ -> ...
Also note that you might actually be wanting to return a [MyData], not a MyData.
For what it's worth, a nicer way to write this function might be
myFunction :: [MyData] -> [MyData]
myFunction xs = [ x | x#(Age _) <- xs ]
Or you can use a higher order function instead of explicit recursion, which tends to be more prone to bugs:
myFunction :: [MyData] -> [MyData]
myFunction = mapMaybe (\x -> case x of Age _ -> Just x; _ -> Nothing)
EDIT: Be careful of the language you're using here in the question -- all values of x have the same type, here -- MyData. Age 10 has the same type as DOB 40. They are all values of the same type, just created using different constructors. So this isn't filtering a list for values of a certain type -- it's filtering it for values created by a certain constructor.

Monadic excerise Haskell. I can't deal with that

I am trying to write my function which extract numbers from string, for example:
"321 43 123 213" -> [321, 43, 123, 3212]
"dsa" -> Error
"123 da" -> Error
And I would like to do it using readEither and in monadic way ( I try to understand monads). My attemption:
import Text.Read
unit :: Either String [Int]
unit = Right []
extractInt :: String -> Either String [Int]
extractInt s = helper (words s) where
helper (h:t) = (bind readEither h) . (helper t)
helper [] = Right []
bind :: (String -> Either String Int) -> String -> (Either String [Int] -> Either String [Int])
bind f x z = bind' (f x) z where
bind' (Left s) _ = Left s
bind' (Right i) (Right l) = Right (l ++ [i])
bind' (Left s) _ = Left s
Please help me solve my problem.
Please say something my solution.
Please say my how to do it correctly. ;)
Error:
Couldn't match expected type `a0 -> Either String [Int]'
with actual type `Either a1 [t0]'
In the return type of a call of `Right'
Probable cause: `Right' is applied to too many arguments
In the expression: Right [1]
In an equation for `helper': helper [] = Right [1]
Failed, modules loaded: none.
If you want "something with >>=" your helper function should look like:
helper [] = Right []
helper (w:ws) = readEither w >>= \i -> fmap (i:) (helper ws)
Explanation: Clearly, for an empty list of words, we want an empty list of integers. For a nonempty list, we do readEither on the first word, which gives us an Either String Int. The bind (>>=) will pass the resulting integer to the function on the right hand side, but only if the result was Right If it was Left this is the overall result of the helper.
Now, the function on the right hand side of (>>=) applies the helper to the remaining words. As we know, this will result in Either String [Int]. Then it prepends the integer that resulted from conversion of the first word to the list in the Right result, if there is one. If, however, helper returned a Left value, the fmap won't change anything, and so this will be the overall result.
So the 2nd line with the (>>=) expands approxiamtely to the following code:
case readEither w of
Left err -> Left err
Right int -> case helper ws of
Left err -> Left err
Right ints -> Right (int:ints)
You could use the mapM function to monadically map over the words:
extractInt :: String -> Either String [Int]
extractInt s = mapM readEither (words s)
If any one call to readEither happens to return Left, then the function will do so too. Is that what you are looking for?

Haskell: put in State monad seems to be elided

I'm writing a program to allocate pizzas to people; each person will get one pizza, ideally of their favorite type, unless stock has run out, in which case they are given their next favorite type recursively.
My approach is to compute a ((User, Pizza), Int) for the amount a person would like said pizza, sort those, and recurse through using a state monad to keep inventory counts.
The program is written and type checks:
allocatePizzasImpl :: [((User, Pizza), Int)]
-> State [(Pizza, Int)] [(User, Pizza)]
allocatePizzasImpl [] = return []
allocatePizzasImpl ((user, (flavor, _)):ranks) =
do inventory <- get
-- this line is never hit
put $ updateWith inventory (\i -> if i <= 0
then Nothing
else Just $ i - 1) flavor
next <- allocatePizzasImpl $ filter ((/= user) . fst) ranks
return $ (user, flavor) : next
and I have a helper function to extract the result:
allocatePizzas :: [Pizza]
-> [((User, Pizza), Int)]
-> [(User, Pizza)]
allocatePizzas pizzas rank = fst
. runState (allocatePizzasImpl rank)
$ buildQuotas pizzas
but the line indicated by -- this line is never hit is... never hit by any GHCI breakpoints; furthermore, if I break on the return call, GHCI says inventory isn't in scope.
When run, the result is assigning the same pizza (with one inventory count) to all users. Something is going wrong, but I have absolutely no idea how to proceed. I'm new to Haskell, so any comments on style would be appreciated as well =)
Thanks!
PS: For completeness, updateWith is defined as:
updateWith :: (Eq a, Eq b)
=> [(a, b)] -- inventory
-> (b -> Maybe b) -- update function; Nothing removes it
-> a -- key to update
-> [(a, b)]
updateWith set update key =
case lookup key set of
Just b -> replace set
(unwrapPair (key, update b))
(fromMaybe 0 $ elemIndex (key, b) set)
Nothing -> set
where replace :: [a] -> Maybe a -> Int -> [a]
replace [] _ _ = []
replace (_:xs) (Just val) 0 = val:xs
replace (_:xs) Nothing 0 = xs
replace (x:xs) val i = x : (replace xs val $ i - 1)
unwrapPair :: Monad m => (a, m b) -> m (a, b)
unwrapPair (a, mb) = do b <- mb
return (a, b)
I think your function replace is broken:
replace (_:xs) (Just val) 0 = val:xs
This doesn't pay any attention to the value it's replacing. Wasn't your intention to replace just the pair corresponding to key?
I think you want
updateWith [] e k = []
updateWith ((k', v):kvs) e k
| k' == k = case e v of
Just v' -> (k, v'):kvs
Nothing -> kvs
| otherwise = (k', v) : updateWith kvs e k
The issue (ignoring other conceptual things mentioned by the commenters) turned out to be using fst to extract the result from the State would for some reason not cause the State to actually be computed. Running the result through seq fixed it.
I'd be interested in knowing why this is the case, though!
Edit: As Daniel Wagner pointed out in the comments, I wasn't actually using inventory, which turned out to be the real bug. Marking this as accepted.

Resources