I want to lazily read user input and do something with it line by line. But if user ends a line with , (comma) followed by any number of spaces (including zero), I want give him opportunity to finish his input on the next line.
And here is what I've got:
import System.IO
import Data.Char
chop :: String -> [String]
chop = f . map (++ "\n") . lines
where f [] = []
f [x] = [x]
f (x : y : xs) = if (p . tr) x
then f ((x ++ y) : xs)
else x : f (y : xs)
p x = (not . null) x && ((== ',') . last) x
tr xs | all isSpace xs = ""
tr (x : xs) = x :tr xs
main :: IO ()
main =
do putStrLn "Welcome to hell, version 0.1.3!"
putPrompt
mapM_ process . takeWhile (/= "quit\n") . chop =<< getContents
where process str = putStr str >> putPrompt
putPrompt = putStr ">>> " >> hFlush stdout
Sorry, it doesn't work at all. Bloody mess.
P.S. I want to preserve \n characters on end of every chunk. Currently I add them manually with map (++ "\n") after lines.
How about changing the type of chop a little:
readMultiLine :: IO [String]
readMultiLine = do
ln <- getLine
if (endswith (rstrip ln) ",") then
liftM (ln:) readMultiLine
else
return [ln]
Now you know that if the last list is not empty, then the user didn't finish typing (the last input ended with ',').
Of course, either import Data.String.Utils, or write your own. Could be as simple as:
endswith xs ys = (length xs >= length ys)
&& (and $ zipWith (==) (reverse xs) (reverse ys))
rstrip = reverse . dropWhile isSpace . reverse
But I missed the point at first. Here's the actual thing.
unfoldM :: (Monad m) => (a -> Maybe (m b, m a)) -> a -> m [b]
unfoldM f z = case f z of
Nothing -> return []
Just (x, y) -> liftM2 (:) x $ y >>= unfoldM f
main = unfoldM (\x -> if (x == ["quit"]) then Nothing
else Just (print x, readMultiLine)) =<< readMultiLine
The reason is, you need to be able to insert the "action" to be done on input between reading one multi-line input and the next. Here print x is the action inserted between two readMultiLine
Since you have questions about getContents, let me add. Even though getContents provides a lazy String, its effectful changes to the world are ordered with the subsequent effects of processing the list. But the processing of the list attempts to insert effects between effects of reading particular list items. To do that, you need a function that exposes the chain of effects, so you can insert your own effects between them.
You can do this using pipes, preserving the laziness of the user's input
import Data.Char (isSpace)
import Pipes
import qualified Pipes.Prelude as Pipes
endsWithComma :: String -> Bool
endsWithComma str =
case (dropWhile isSpace $ reverse str) of
',':_ -> True
_ -> False
finish :: Monad m => Pipe String String m ()
finish = do
str <- await
yield str
if endsWithComma str
then do
str' <- await
yield str'
else finish
user :: Producer String IO ()
user = Pipes.stdinLn >-> finish
You can then hook up the user Producer to any downstream Consumer. For example, to echo the stream back out you can write:
main = runEffect (user >-> Pipes.stdoutLn)
To learn more about pipes you can read the tutorial.
Sorry, I wrote something wrong in a comment and I thought that now that I understood what you were trying to do, I'd give an answer with a little more substance. The core idea is that you're going to need a state buffer while you loop through the string, as far as I can tell. You have f :: [String] -> [String] but you'll need an extra string of buffer before you can solve this puzzle.
So let me assume an answer which looks like:
chop = joinCommas "" . map (++ "\n") . lines
Then the structure of joinCommas is going to look like:
import Data.List (isSuffixOf)
-- override with however you want to handle the ",\n" between lines.
joinLines = (++)
incomplete = isSuffixOf ",\n"
joinCommas :: String -> [String] -> [String]
joinCommas prefix (line : rest)
| incomplete prefix = joinCommas (joinLines prefix line) rest
| otherwise = prefix : joinCommas line rest
joinCommas prefix []
| incomplete prefix = error "Incomplete input"
| otherwise = [prefix]
The prefix stores up lines until it doesn't end with ",\n" at which point it emits the prefix and continues with the rest of the lines. On EOF we process the last line unless that line is incomplete.
Related
I have the following function:
main = do xs <- getContents
edLines <- ed $ lines xs
putStr $ unlines edLines
Firstly I used the working version main = interact (unlines . ed . lines) but changed the signature of ed since. Now it returns IO [String] instead of just [String] so I can't use this convenient definition any more.
The problem is that now my function ed is still getting evaluated partly but nothing is displayed till I close the stdin via CTRL + D.
Definition of ed:
ed :: Bool -> [EdCmdLine] -> IO EdLines
ed xs = concatM $ map toLinesExt $ scanl (flip $ edLine defHs) (return [Leaf ""]) xs where
toLinesExt :: IO [EdState] -> IO EdLines
toLinesExt rsIO = do
rs#(r:_) <- rsIO -- todo add fallback pattern with (error)
return $ fromEd r ++ [" "]
The scanl is definitely evaluated lazy because edLine is getting evaluated for sure (observable by the side effects).
I think it could have to do with concatM:
concatM :: (Foldable t, Monad m) => t (m [a]) -> m [a]
concatM xsIO = foldr (\accIO xIO -> do {x <- xIO; acc <- accIO; return $ acc ++ x}) (return []) xsIO
All I/O in Haskell is explicitly ordered. The last two lines of your main function desugar into something like
ed (lines xs) >>= (\edLines -> putStr $ unlines edLines)
>>= sequences all of the I/O effects on the left before all of those on the right. You're constructing an I/O action of the form generate line 1 >> ... >> generate line n >> output line 1 >> ... >> output line n.
This isn't really an evaluation order issue, it's a correctness issue. An implementation is free to evaluate in any order it wants, but it can't change the ordering of I/O actions that you specified, any more than it can reorder the elements of a list.
Here's a toy example showing what you need to do:
lineProducingActions :: [IO String]
lineProducingActions = replicate 10 getLine
wrongOrder, correctOrder :: IO ()
wrongOrder = do
xs <- sequence lineProducingActions
mapM_ putStrLn xs
correctOrder = do
let xs = [x >>= putStrLn | x <- lineProducingActions]
sequence_ xs
Note that you can decouple the producer and consumer while getting the ordering you want. You just need to avoid combining the I/O actions in the producer. I/O actions are pure values that can be manipulated just like any other values. They aren't side-effectful expressions that happen immediately as they're written. They happen, rather, in whatever order you glue them together in.
You would need to use unsafeInterleaveIO to schedule some of your IO actions for later. Beware that the IO actions may then be executed in a different order than you might first expect!
However, I strongly recommend not doing that. Change your IO [String] action to print each line as it's produced instead.
Alternately, if you really want to maintain the computation-as-pipeline view, check out one of the many streaming libraries available on Hackage (streamly, pipes, iteratees, conduit, machines, and probably half a dozen others).
Thanks to #benrg answer I was able to solve the issue with the following code:
ed :: [EdCmdLine] -> [IO EdLines]
ed cmds = map (>>= return . toLines . head) $ edHistIO where
toLines :: EdState -> EdLines
toLines r = fromEd r ++ [" "]
edHistIO = edRec defHs cmds (return [initState])
edRec :: [HandleHandler] -> [EdCmdLine] -> IO EdHistory -> [IO EdHistory]
edRec _ [] hist = [hist] -- if CTRL + D
edRec defHs (cmd:cmds) hist = let next = edLine defHs cmd hist in next : edRec defHs cmds next
main = getContents >>= mapM_ (>>= (putStr . unlines)) . ed . lines
I'm trying to cut chunks from a list, with a given predicate. I would have preferred to use a double character, e.g. ~/, but have resolved to just using $. What I essentially want to do is this...
A: "Hello, my $name is$ Danny and I $like$ Haskell"
What I want to turn this into is this:
B: "Hello, my Danny and I Haskell"
So I want to strip everything in between the given symbol, $, or my first preference was ~/, if I can figure it out. What I tried was this:
s1 :: String -> String
s1 xs = takeWhile (/= '$') xs
s2 :: String -> String
s2 xs = dropWhile (/= '$') xs
s3 :: String -> String
s3 xs = s3 $ s2 $ s1 xs
This solution seems to just bug my IDE out (possibly infinite looping).
Solution:
s3 :: String -> String
s3 xs
|'$' `notElem` xs = xs
|otherwise = takeWhile (/= '$') xs ++ (s3 $ s1 xs)
s1 :: String -> String
s1 xs = drop 1 $ dropWhile (/= '$') $ tail $ snd $ break ('$'==) xs
This seems like a nice application for parsers. A solution using trifecta:
import Control.Applicative
import Data.Foldable
import Data.Functor
import Text.Trifecta
input :: String
input = "Hello, my $name is$ Danny and I $like$ Haskell"
cutChunk :: CharParsing f => f String
cutChunk = "" <$ (char '$' *> many (notChar '$') <* char '$')
cutChunk matches $, followed by 0 or more (many) non-$ characters, then another $. Then we use ("" <$) to make this parser's value always be the empty string, thus discarding all the characters that this parser matches.
includeChunk :: CharParsing f => f String
includeChunk = some (notChar '$')
includeChunk matches the text that we want to include in the result, which is anything that's not the $ character. It's important that we use some (matching one or more characters) and not many (matching zero or more characters) because we're going to include this parser within another many expression next; if this parser matched on the empty string, then that could loop infinitely.
chunks :: CharParsing f => f String
chunks = fold <$> many (cutChunk <|> includeChunk)
chunks is the parser for everything. Read <|> as "or", as in "parse either a cutChunk or an includeChunk". many (cutChunk <|> includeChunk) is a parser that produces a list of chunks e.g. Success ["Hello, my ",""," Danny and I ",""," Haskell"], so we fold the output to concatenate those chunks together into a single string.
result :: Result String
result = parseString chunks mempty input
The result:
Success "Hello, my Danny and I Haskell"
Your infinite loop comes from calling s3 recursively with no base case:
s3 :: String -> String
s3 xs = s3 $ s2 $ s1 xs
Adding a base case corrects the infinite loop:
s3 xs
| '$' `notElem` xs = xs
| otherwise = ...
This is not the whole answer. Think about what s1 actually does and where you use its return value:
s1 "hello $my name is$ ThreeFx" == "hello "
For further reference, see the break function:
break :: (a -> Bool) -> [a] -> ([a], [a])
I think your logic is wrong, perhaps easier to write it in an elementary way
Prelude> let pr xs = go xs True
Prelude| where go [] _ = []
Prelude| go (x:xs) f | x=='$' = go xs (not f)
Prelude| | f = x : go xs f
Prelude| | otherwise = go xs f
Prelude|
Prelude> pr "Hello, my $name is$ Danny and I $like$ Haskell"
"Hello, my Danny and I Haskell"
Explanation The flag f keeps track of the state (either pass mode or not). If the current char is a token skip and switch state.
I have a list of lists of strings e.g;
[["h","e","l","l","o"], ["g","o","o","d"], ["w","o","o","r","l","d"]]
And I want to rename repeated values outside a sublist so that all the repetitions are set to new randomly generated values throughout a sublist that are not pre-existing in the list but the same inside the same sublist so that a possible result might be:
[["h","e","l","l","o"], ["g","t","t","d"], ["w","s","s","r","z","f"]]
I already have a function that can randomly generate a string of size one called randomStr:
randomStr :: String
randomStr = take 1 $ randomRs ('a','z') $ unsafePerformIO newStdGen
Presuming you want to do what I've outlined in my comment below, it's best to break this problem up into several smaller parts to tackle one at a time. I would also recommend leveraging common modules in base and containers, since it will make the code much simpler and faster. In particular, the modules Data.Map and Data.Sequence are very useful in this case. Data.Map I would say is the most useful here, as it has some very useful functions that would otherwise be difficult to write by hand. Data.Sequence is used for efficiency purposes at the end, as you'll see.
First, imports:
import Data.List (nub)
import Data.Map (Map)
import Data.Sequence (Seq, (|>), (<|))
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import Data.Foldable (toList)
import System.Random (randomRIO)
import Control.Monad (forM, foldM)
import Control.Applicative ((<$>))
Data.Foldable.toList is needed since Data.Sequence does not have a toList function, but Foldable provides one that will work. On to the code. We first want to be able to take a list of Strings and find all the unique elements in it. For this, we can use nub:
lettersIn :: [String] -> [String]
lettersIn = nub
I like providing my own names for functions like this, it can make the code more readable.
Now that we can get all the unique characters, we want to be able to assign each a random character:
makeRandomLetterMap :: [String] -> IO (Map String String)
makeRandomLetterMap letters
= fmap Map.fromList
$ forM (lettersIn letters) $ \l -> do
newL <- randomRIO ('a', 'z')
return (l, [newL])
Here we get a new random character and essentially zip it up with our list of letters, then we fmap (<$>) Map.fromList over that result. Next, we need to be able to use this map to replace letters in a list. If a letter isn't found in the Map, we just want the letter back. Luckily, Data.Map has the findWithDefault function which is perfect for this situation:
replaceLetter :: Map String String -> String -> String
replaceLetter m letter = Map.findWithDefault letter letter m
replaceAllLetters :: Map String String -> [String] -> [String]
replaceAllLetters m letters = map (replaceLetter m) letters
Since we want to be able to update this map with new letters that have been encountered in each sublist, overwriting previously encountered letters as needed, we can use Data.Map.union. Since union favors its first argument, we need to flip it:
updateLetterMap :: Map String String -> [String] -> IO (Map String String)
updateLetterMap m letters = flip Map.union m <$> makeRandomLetterMap letters
Now we have all the tools needed to tackle the problem at hand:
replaceDuplicatesRandomly :: [[String]] -> IO [[String]]
replaceDuplicatesRandomly [] = return []
For the base case, just return an empty list.
replaceDuplicatesRandomly (first:rest) = do
m <- makeRandomLetterMap first
For a non-empty list, make the initial map off the first sublist
(_, seqTail) <- foldM go (m, Seq.empty) rest
Fold over the rest, starting with an empty sequence and the first map, and extract the resulting sequence
return $ toList $ first <| seqTail
Then convert the sequence to a list after prepending the first sublist (it doesn't get changed by this function). The go function is pretty simple too:
where
go (m, acc) letters = do
let newLetters = replaceAllLetters m letters
newM <- updateLetterMap m letters
return (newM, acc |> newLetters)
It takes the current map m and an accumulation of all the sublists processed so far acc along with the current sublist letters, replaces the letters in said sublist, builds a new map for the next iteration (newM), and then returns the new map along with the accumulation of everything processed, i.e. acc |> newLetters. All together, the function is
replaceDuplicatesRandomly :: [[String]] -> IO [[String]]
replaceDuplicatesRandomly [] = return []
replaceDuplicatesRandomly (first:rest) = do
m <- makeRandomLetterMap first
(_, seqTail) <- foldM go (m, Seq.empty) rest
return $ toList $ first <| seqTail
where
go (m, acc) letters = do
let newLetters = replaceAllLetters m letters
newM <- updateLetterMap m letters
return (newM, acc |> newLetters)
It's always better to keep impure and pure computations separated.
You cannot replace by letters, which are already in a list, so you need to get a string of fresh letters:
fresh :: [String] -> String
fresh xss = ['a'..'z'] \\ foldr union [] xss
This function replaces one letter with another in a string:
replaceOne :: Char -> Char -> String -> String
replaceOne y y' = map (\x -> if x == y then y' else x)
This function replaces one letter each time with a new letter for every string in a list of strings:
replaceOnes :: Char -> String -> [String] -> (String, [String])
replaceOnes y = mapAccumL (\(y':ys') xs ->
if y `elem` xs
then (ys', replaceOne y y' xs)
else (y':ys', xs))
For example
replaceOnes 'o' "ijklmn" ["hello", "good", "world"]
returns
("lmn",["helli","gjjd","wkrld"])
A bit tricky one:
replaceMany :: String -> String -> [String] -> (String, [String])
replaceMany ys' ys xss = runState (foldM (\ys' y -> state $ replaceOnes y ys') ys' ys) xss
This function replaces each letter from ys each time with a new letter from ys' for every string in xss.
For example
replaceMany "mnpqstuvxyz" "lod" ["hello", "good", "world"]
returns
("vxyz",["hemmp","gqqt","wsrnu"])
i.e.
'l's in "hello" are replaced by the first letter in "mnpqstuvxyz"
'l' in "world" is replaced by the second letter in "mnpqstuvxyz"
'o' in "hello" is replaced by the third letter in "mnpqstuvxyz"
'o's in "good" are replaced by the fourth letter in "mnpqstuvxyz"
...
'd' in "world" is replaced by the seventh letter in "mnpqstuvxyz"
This function goes through a list of strings and replaces all letters from the head by fresh letters, that ys' contains, for each string in the rest of the list.
replaceDuplicatesBy :: String -> [String] -> [String]
replaceDuplicatesBy ys' [] = []
replaceDuplicatesBy ys' (ys:xss) = ys : uncurry replaceDuplicatesBy (replaceMany ys' ys xss)
I.e. it does what you want, but without any randomness — just picks fresh letters from a list.
All described functions are pure. Here is an impure one:
replaceDuplicates :: [String] -> IO [String]
replaceDuplicates xss = flip replaceDuplicatesBy xss <$> shuffle (fresh xss)
I.e. generate a random permutation of a string, that contains fresh letters, and pass it to replaceDuplicatesBy.
You can take the shuffle function from https://www.haskell.org/haskellwiki/Random_shuffle
And the final test:
main = replicateM_ 3 $ replaceDuplicates ["hello", "good", "world"] >>= print
prints
["hello","gxxd","wcrzy"]
["hello","gyyd","wnrmf"]
["hello","gmmd","wvrtx"]
The whole code (without shuffle): http://lpaste.net/115763
I think this is bound to raise more questions than it answers.
import Control.Monad.State
import Data.List
import System.Random
mapAccumLM _ s [] = return (s, [])
mapAccumLM f s (x:xs) = do
(s', y) <- f s x
(s'', ys) <- mapAccumLM f s' xs
return (s'', y:ys)
pick excluded for w = do
a <- pick' excluded
putStrLn $ "replacement for " ++ show for ++ " in " ++ show w ++ " excluded: " ++ show excluded ++ " = " ++ show a
return a
-- | XXX -- can loop indefinitely
pick' excluded = do
a <- randomRIO ('a','z')
if elem a excluded
then pick' excluded
else return a
transform w = do
globallySeen <- get
let go locallySeen ch =
case lookup ch locallySeen of
Nothing -> if elem ch globallySeen
then do let excluded = globallySeen ++ (map snd locallySeen)
a <- lift $ pick excluded ch w
return ( (ch, a):locallySeen, a)
else return ( (ch,ch):locallySeen, ch )
Just ch' -> return (locallySeen, ch')
(locallySeen, w') <- mapAccumLM go [] w
let globallySeen' = w' ++ globallySeen
put globallySeen'
return w'
doit ws = runStateT (mapM transform ws) []
main = do
ws' <- doit [ "hello", "good", "world" ]
print ws'
So the problem I'm working on matching a pattern to a list, such like this:
match "abba" "redbluebluered" -> True or
match "abba" "redblueblue" -> False, etc. I wrote up an algorithm that works, and I think it's reasonable understandable, but I'm not sure if there's a better way to do this without explicit recursion.
import Data.HashMap.Strict as M
match :: (Eq a, Eq k, Hashable k) => [k] -> [a] -> HashMap k [a] -> Bool
match [] [] _ = True
match [] _ _ = False
match _ [] _ = False
match (p:ps) s m =
case M.lookup p m of
Just v ->
case stripPrefix v s of
Just post -> match ps post m
Nothing -> False
Nothing -> any f . tail . splits $ s
where f (pre, post) = match ps post $ M.insert p pre m
splits xs = zip (inits xs) (tails xs)
I would call this like match "abba" "redbluebluered" empty. The actual algorithm is simple. The map contains the patterns already matched. At the end it is [a - > "red", b -> "blue"]. If the next pattern is one we've seen before, just try matching it and recurse down if we can. Otherwise fail and return false.
If the next pattern is new, just try mapping the new pattern to every single prefix in the string and recursing down.
This is very similar to a parsing problem, so let's take a hint from the parser monad:
match should return a list of all of the possible continuations of the parse
if matching fails it should return the empty list
the current set of assignments will be state that has to carried through the computation
To see where we are headed, let's suppose we have this magic monad. Attempting to match "abba" against a string will look like:
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
return () -- or whatever you want to return
test = runMatch matchAbba "redbluebluered"
It turns out this monad is the State monad over the List monad. The List monad provides for backtracking and the State monad carries the current assignments and input around.
Here's the code:
import Data.List
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Data.Maybe
import qualified Data.Map as M
import Data.Monoid
type Assigns = M.Map Char String
splits xs = tail $ zip (inits xs) (tails xs)
var p = do
(assigns,input) <- get
guard $ (not . null) input
case M.lookup p assigns of
Nothing -> do (a,b) <- lift $ splits input
let assigns' = M.insert p a assigns
put (assigns', b)
return a
Just t -> do guard $ isPrefixOf t input
let inp' = drop (length t) input
put (assigns, inp')
return t
matchAbba :: StateT (Assigns, String) [] Assigns
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
(assigns,_) <- get
return assigns
test1 = evalStateT matchAbba (M.empty, "xyyx")
test2 = evalStateT matchAbba (M.empty, "xyy")
test3 = evalStateT matchAbba (M.empty, "redbluebluered")
matches :: String -> String -> [Assigns]
matches pattern input = evalStateT monad (M.empty,input)
where monad :: StateT (Assigns, String) [] Assigns
monad = do sequence $ map var pattern
(assigns,_) <- get
return assigns
Try, for instance:
matches "ab" "xyz"
-- [fromList [('a',"x"),('b',"y")],fromList [('a',"x"),('b',"yz")],fromList [('a',"xy"),('b',"z")]]
Another thing to point out is that code which transforms a string like "abba" to the monadic value do var'a'; var'b'; var 'b'; var 'a' is simply:
sequence $ map var "abba"
Update: As #Sassa NF points out, to match the end of input you'll want to define:
matchEnd :: StateT (Assigns,String) [] ()
matchEnd = do
(assigns,input) <- get
guard $ null input
and then insert it into the monad:
monad = do sequence $ map var pattern
matchEnd
(assigns,_) <- get
return assigns
I would like to modify your signature and return more than Bool. Your solution then becomes:
match :: (Eq a, Ord k) => [k] -> [a] -> Maybe (M.Map k [a])
match = m M.empty where
m kvs (k:ks) vs#(v:_) = let splits xs = zip (inits xs) (tails xs)
f (pre, post) t =
case m (M.insert k pre kvs) ks post of
Nothing -> t
x -> x
in case M.lookup k kvs of
Nothing -> foldr f Nothing . tail . splits $ vs
Just p -> stripPrefix p vs >>= m kvs ks
m kvs [] [] = Just kvs
m _ _ _ = Nothing
Using the known trick of folding to produce a function we can obtain:
match ks vs = foldr f end ks M.empty vs where
end m [] = Just m
end _ _ = Nothing
splits xs = zip (inits xs) (tails xs)
f k g kvs vs = let h (pre, post) = (g (M.insert k pre kvs) post <|>)
in case M.lookup k kvs of
Nothing -> foldr h Nothing $ tail $ splits vs
Just p -> stripPrefix p vs >>= g kvs
Here match is the function folding all keys to produce a function taking a Map and a string of a, which returns a Map of matches of the keys to substrings. The condition for matching the string of a in its entirety is tracked by the last function applied by foldr - end. If end is supplied with a map and an empty string of a, then the match is successful.
The list of keys is folded using function f, which is given four arguments: the current key, the function g matching the remainder of the list of keys (i.e. either f folded, or end), the map of keys already matched, and the remainder of the string of a. If the key is already found in the map, then just strip the prefix and feed the map and the remainder to g. Otherwise, try to feed the modified map and remainder of as for different split combinations. The combinations are tried lazily as long as g produces Nothing in h.
Here is another solution, more readable, I think, and as inefficient as other solutions:
import Data.Either
import Data.List
import Data.Maybe
import Data.Functor
splits xs = zip (inits xs) (tails xs)
subst :: Char -> String -> Either Char String -> Either Char String
subst p xs (Left q) | p == q = Right xs
subst p xs q = q
match' :: [Either Char String] -> String -> Bool
match' [] [] = True
match' (Left p : ps) xs = or [ match' (map (subst p ixs) ps) txs
| (ixs, txs) <- tail $ splits xs]
match' (Right s : ps) xs = fromMaybe False $ match' ps <$> stripPrefix s xs
match' _ _ = False
match = match' . map Left
main = mapM_ (print . uncurry match)
[ ("abba" , "redbluebluered" ) -- True
, ("abba" , "redblueblue" ) -- False
, ("abb" , "redblueblue" ) -- True
, ("aab" , "redblueblue" ) -- False
, ("cbccadbd", "greenredgreengreenwhiteblueredblue") -- True
]
The idea is simple: instead of having a Map, store both patterns and matched substrings in a list. So when we encounter a pattern (Left p), then we substitute all occurrences of this pattern with a substring and call match' recursively with this substring being striped, and repeat this for each substring, that belongs to inits of a processed string. If we encounter already matched substring (Right s), then we just try to strip this substring, and call match' recursively on a successive attempt or return False otherwise.
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