Monadic excerise Haskell. I can't deal with that - haskell

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?

Related

Additional pattern matching inside case

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.)

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)

Haskell: Exception <<loop>> on recursive data entry

So I'm trying to make a little program that can take in data captured during an experiment, and for the most part I think I've figured out how to recursively take in data until the user signals there is no more, however upon termination of data taking haskell throws Exception: <<loop>> and I can't really figure out why. Here's the code:
readData :: (Num a, Read a) => [Point a] -> IO [Point a]
readData l = do putStr "Enter Point (x,y,<e>) or (d)one: "
entered <- getLine
if (entered == "d" || entered == "done")
then return l
else do let l = addPoint l entered
nl <- readData l
return nl
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point (dataList !! 0) (dataList !! 1) (dataList !! 2)]
where dataList = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
checkInputData :: [String] -> [String]
checkInputData xs
| length xs < 2 = ["0","0","0"]
| length xs < 3 = (xs ++ ["0"])
| length xs == 3 = xs
| length xs > 3 = ["0","0","0"]
As far as I can tell, the exception is indication that there is an infinite loop somewhere, but I can't figure out why this is occurring. As far as I can tell when "done" is entered the current level should simply return l, the list it's given, which should then cascade up the previous iterations of the function.
Thanks for any help. (And yes, checkInputData will have proper error handling once I figure out how to do that.)
<<loop>> basically means GHC has detected an infinite loop caused by a value which depends immediately on itself (cf. this question, or this one for further technical details if you are curious). In this case, that is triggered by:
else do let l = addPoint l entered
This definition, which shadows the l you passed as an argument, defines l in terms of itself. You meant to write something like...
else do let l' = addPoint l entered
... which defines a new value, l', in terms of the original l.
As Carl points out, turning on -Wall (e.g. by passing it to GHC at the command line, or with :set -Wall in GHCi) would make GHC warn you about the shadowing:
<interactive>:171:33: warning: [-Wname-shadowing]
This binding for ‘l’ shadows the existing binding
bound at <interactive>:167:10
Also, as hightlighted by dfeuer, the whole do-block in the else branch can be replaced by:
readData (addPoint l entered)
As an unrelated suggestion, in this case it is a good idea to replace your uses of length and (!!) with pattern matching. For instance, checkInputData can be written as:
checkInputData :: [String] -> [String]
checkInputData xs = case xs of
[_,_] -> xs ++ ["0"]
[_,_,_] -> xs
_ -> ["0","0","0"]
addPoint, in its turn, might become:
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point x y z]
where [x,y,z] = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
That becomes even neater if you change checkInputData so that it returns a (String, String, String) triple, which would better express the invariant that you are reading exactly three values.

State transformer: need a Nothing in a (Maybe Bool)

This is from the nicta course (hence List = [], Optional = Maybe, ...), so I'm not looking for a full solution, but I am stuck on a State Transformer question. The aim is to filter duplicates from a List and completely fail if passed any number > 100.
-- filtering :: Applicative f => (a -> f Bool) -> List a -> f (List a)
distinctF :: (Ord a, Num a) => List a -> Optional (List a)
distinctF lst = case runStateT (filtering go lst) S.empty of
Full (val, _) -> Full val
Empty -> Empty
where
--go :: a -> StateT (S.Set a) Optional Bool
go x = do
s <- getT
if x > 100 then do
return *?*Empty / False*?*
This typechecks while go = undefined, but I'm struggling to put Empty into as return wraps e.g. False in a Full/Just. fail gets me someway forward but I don't think that is the solution.
In practice I am probably missing a more important issue and would welcome enlightenment.
If the goal is to write function making both: unique filtering and failing on large input at the same time, you got the skeleton quite right:
distinctF :: (Ord a, Num a) => List a -> Optional (List a)
distinctF lst = evalStateT (go lst) S.empty -- evalStateT is your case runStateT part
where -- on empty input we just return empty list
go [] = return []
-- otherwise
go (x:xs)
-- we check whether we should 'fail'
-- for that we *lift* the value from underlying monad (Optional) into our StateT Optional
| x > 100 = lift $ Empty
| otherwise = do
-- the stuff to do
-- get the state, do nothing if x is in there
-- otherwise add x to the state and recurse
So for your question, you need to lift Empty, not return it.
OK, so I finally found a way, by realising that I could construct the precisely correct return type, rather than trying to rely on return
go x = do
if x > 100 then
StateT (\_ -> Empty) -- `return` a fail
else do
st <- getT
However, I am still not quite sure how <- unwraps both the StateT and the inner monadic container

Non-exhaustive patterns in lambda

I am getting Non-exhaustive patterns in lambda. I am not sure of the cause yet. Please anyone how to fix it. The code is below:
import Control.Monad
import Data.List
time_spent h1 h2 = max (abs (fst h1 - fst h2)) (abs (snd h1 - snd h2))
meeting_point xs = foldl' (find_min_time) maxBound xs
where
time_to_point p = foldl' (\tacc p' -> tacc + (time_spent p p')) 0 xs
find_min_time min_time p = let x = time_to_point p in if x < min_time then x else min_time
main = do
n <- readLn :: IO Int
points <- fmap (map (\[x,y] -> (x,y)) . map (map (read :: String->Int)) . map words . lines) getContents
putStrLn $ show $ meeting_point points
This is the lambda with the non-exhaustive patterns: \[x,y] -> (x,y).
The non-exhaustive pattern is because the argument you've specified, [x,y] doesn't match any possible list - it only matches lists with precisely two elements.
I would suggest replacing it with a separate function with an error case to print out the unexpected data in an error message so you can debug further, e.g.:
f [x,y] = (x, y)
f l = error $ "Unexpected list: " ++ show l
...
points <- fmap (map f . map ...)
As an addition to #GaneshSittampalam's answer, you could also do this with more graceful error handling using the Maybe monad, the mapM function from Control.Monad, and readMaybe from Text.Read. I would also recommend refactoring your code so that the parsing is its own function, it makes your main function much cleaner and easier to debug.
import Control.Monad (mapM)
import Text.Read (readMaybe)
toPoint :: [a] -> Maybe (a, a)
toPoint [x, y] = Just (x, y)
toPoint _ = Nothing
This is just a simple pattern matching function that returns Nothing if it gets a list with length not 2. Otherwise it turns it into a 2-tuple and wraps it in Just.
parseData :: String -> Maybe [(Int, Int)]
parseData text = do
-- returns Nothing if a non-Int is encountered
values <- mapM (mapM readMaybe . words) . lines $ text
-- returns Nothing if a line doesn't have exactly 2 values
mapM toPoint values
Your parsing can actually be simplified significantly by using mapM and readMaybe. The type of readMaybe is Read a => String -> Maybe a, and in this case since we've specified the type of parseData to return Maybe [(Int, Int)], the compiler can infer that readMaybe should have the local type of String -> Maybe Int. We still use lines and words in the same way, but now since we use mapM the type of the right hand side of the <- is Maybe [[Int]], so the type of values is [[Int]]. What mapM also does for us is if any of those actions fails, the overall computation exits early with Nothing. Then we simply use mapM toPoint to convert values into a list of points, but also with the failure mechanism built in. We actually could use the more general signature of parseData :: Read a => String -> Maybe [(a, a)], but it isn't necessary.
main = do
n <- readLn :: IO Int
points <- fmap parseData getContents
case points of
Just ps -> print $ meeting_point ps
Nothing -> putStrLn "Invalid data!"
Now we just use fmap parseData on getContents, making points have the type Maybe [(Int, Int)]. Finally, we pattern match on points to print out the result of the meeting_point computation or print a helpful message if something went wrong.
If you wanted even better error handling, you could leverage the Either monad in a similar fashion:
toPoint :: [a] -> Either String (a, a)
toPoint [x, y] = Right (x, y)
toPoint _ = Left "Invalid number of points"
readEither :: Read a => String -> Either String a
readEither text = maybe (Left $ "Invalid parse: " ++ text) Right $ readMaybe text
-- default value ^ Wraps output on success ^
-- Same definition with different type signature and `readEither`
parseData :: String -> Either String [(Int, Int)]
parseData text = do
values <- mapM (mapM readEither . words) . lines $ text
mapM toPoint values
main = do
points <- fmap parseData getContents
case points of
Right ps -> print $ meeting_point ps
Left err -> putStrLn $ "Error: " ++ err

Resources