Haskell: get list of strings from file - haskell

Question

My input is:
Plaster ["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
What I'm trying to get:
["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
My code for now:
go = do --print "Enter file name"
--path <- getLine
file <- (readFile "1.txt")
print file
let list = consume file
print list
let content = (wordsWhen (=='"') list)
print content
print (content !! 0)
print (content !! 1)
print (content !! 2)
wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s = case dropWhile p s of
"" -> []
", " -> []
s' -> w : wordsWhen p s''
where (w, s'') = break p s'
consume [] = []
consume ('[':xs) = consume' xs
consume (_ :xs) = consume xs
consume' [] = []
consume' (']':xs) = []
consume' (x :xs) = x : consume' xs
So what I'm doing is
Read file from destination (now hardcoded for testing)
Get rid of the word "Plaster" with consume
Get all strings from file with wordsWhen
I tried different separators for wordsWhen, but I can't get what I need. In current form the output is:
"Plaster [\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\"]"
"\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\""
["BD..",", ",".GA.D",", ",".FEG",", ","ABDCF",", ","E..."]
"BD.."
", "
".GA.D"
Which is quite accurate, but I want to get rid of this words that contains only commas. I can change the separator to comma (which it's supposed to be, I think), but then output is given with all this slashes and quotation marks, like this:
"Plaster [\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\"]"
"\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\""
["\"BD..\""," \".GA.D\""," \".FEG\""," \"ABDCF\""," \"E...\""]
"\"BD..\""
" \".GA.D\""
" \".FEG\""
Is there a way to fix my code? Or should I do it in a different way?
EDIT: As it is my exercise, I can only use standard types and functions.

Answer 1

Well, you could cheat by defining a datatype with a Read instance that matches your existing input:
{-# OPTIONS_GHC -Wall -Werror -Wno-name-shadowing #-}
module Main where
data Input = Plaster [String] deriving (Read, Show)
main :: IO ()
main = do
Plaster xs <- readIO =<< readFile "1.txt"
_ <- traverse print (zip [0 :: Int ..] xs)
return ()
This works perfectly for me with ghc-8.0.2:
$ cat "1.txt"
Plaster ["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
$ ghc --make SO44269043.hs && ./SO44269043
(0,"BD..")
(1,".GA.D")
(2,".FEG")
(3,"ABDCF")
(4,"E...")
Alternately, you could define your own read instance:
data Input = Plaster [String]
instance Read Input where
readsPrec p = readParen (p >= 10) . runR $ do
Plaster <$> (string "Plaster" *> many1 whitespace *> R readList)
If you're unfamiliar with <$> and *>, it may be a little easier to read this as
readsPrec p = readParen (p >= 10) . runR $ do
_ <- string "Plaster"
_ <- many1 whitespace
xs <- R readList
return (Plaster xs)
Even without imports, it's not a lot of code to define a parser type R, basically just a wrapper that lets you define a monad instance for String -> [(a, String)]:
newtype R a = R { runR :: ReadS a }
instance Functor R where
fmap f = R . fmap (map (\(a, s) -> (f a, s))) . runR
instance Applicative R where
pure a = R $ \s -> [(a, s)]
mf <*> ma = R $ \s -> do
(f, s) <- runR mf s
(a, s) <- runR ma s
return (f a, s)
instance Monad R where
m >>= f = R $ \s -> do
(a, s) <- runR m s
runR (f a) s
The >>= (or bind) operator just means "parse some of the string
with the parser on the left, then parse the rest of the string
with the after passing the resulting value to the function on the right."
We get R readList :: R [String] for free now, so all we need to do
is skip the initial "Plaster" and any whitespace between that and the
list of strings:
string :: String -> R String
string = traverse char
many1 :: R a -> R [a]
many1 r = loop where
loop = (:) <$> r <*> (loop <|> return [])
whitespace :: R Char
whitespace = char ' ' <|> char '\t' <|> char '\n' <|> char '\r'
Normally we'd use <|> from GHC.Base, but it's not hard to define a one-off here. Basically
r <|> r' means "try to parse with r, and if it fails, try to parse with r' instead"
(<|>) :: R a -> R a -> R a
r <|> r' = R $ \s -> runR r s ++ runR r' s
And now all we need is the ability to match a single character:
char :: Char -> R Char
char c = R $ \s -> case s of
(c' : s) | c == c' -> [(c, s)]
_ -> []
If even using Prelude.readList is too easy, we can define our own parsers for lists and quoted strings:
readsPrec p = readParen (p >= 10) . runR $ do
Plaster <$> (string "Plaster" *> many1 whitespace *> listOf quotedString)
Where lists just have a leading '[', a trailing ']', and some number of delimited terms:
listOf :: R a -> R [a]
listOf term = char '[' *> (term `sepBy` string ", ") <* char ']'
sepBy :: R a -> R b -> R [a]
sepBy term delim = sepBy1 term delim <|> return []
sepBy1 :: R a -> R b -> R [a]
sepBy1 term delim = loop where
loop = (:) <$> term <*> ((delim *> loop) <|> return [])
Similarly, a quoted string just has a leading '"', a trailing '"', and some number of escaped characters:
quotedString :: R String
quotedString = char '"' *> many escapedChar <* char '"'
many :: R a -> R [a]
many r = many1 r <|> return []
escapedChar :: R Char
escapedChar = R $ \s -> case s of
'\\' : '\\' : s -> [('\\', s)]
'\\' : '"' : s -> [('"', s)]
c : s | c /= '\\' && c /= '"' -> [(c, s)]
_ -> []
It's worth noting the similarity between many/many1 and sepBy/sepBy1 - if we were really
lazy, we could define one in terms of the other:
many1 r = r `sepBy1` return ()
term `sepBy1` delim = (:) <$> term <*> many (delim *> term)

Answer 2

This is how it could be done:
import System.Environment
import System.IO
import Data.Maybe
import Text.Read
readStringList :: String -> Maybe [String]
readStringList = readMaybe
main = do --print "Enter file name"
handle <- openFile "1.txt" ReadMode
hSeek handle AbsoluteSeek 8
file <- hGetContents handle
let list = fromJust (readStringList file )
print list
let filterThis = "," :: String
let filtered = filter (/=filterThis) list
print filtered
To get first command line argument, use getArgs.

Answer 3

Here is a quick and dirty parser.
Be careful, it only works for well formed input, is not performant and code is not factorised. But there is no cheating ;)
Maybe it could give you some inspiration to solve your exercise.
plaster :: String -> String
plaster ('P':'l':'a':'s':'t':'e':'r':' ':xs) = xs
plaster s = undefined
brackets :: String -> String
brackets ('[':xs) = brackets xs
brackets (x:']':_) = [x]
brackets (x:xs) = x:brackets xs
quotes :: String -> String
quotes ('"':xs) = quotes xs
quotes (x:'"':_) = [x]
quotes (x:xs) = x:quotes xs
sepByComma :: String -> [String]
sepByComma s = go s ""
where
go [] acc = [acc]
go (',':' ':xs) acc = [acc] ++ go xs ""
go (x:xs) acc = go xs (acc ++ [x])
parse :: String -> [String]
parse s = map quotes . sepByComma . brackets . plaster $ s

Answer 4

Here is an alternative using only the very basics, no Monads, Functors or Applicative operators.
main :: IO()
main = do
input <- getLine
let output = parse input
print output
parse :: String -> [String]
parse = map stripQuotes . parse' . tokenize []
where
parse' :: [String] -> [String]
-- If the input matches the pattern, call parseList on the inner tokens.
-- Does not nest brackets! This is a simple regex match.
parse' ("Plaster":"[":tokens) | last tokens == "]" =
parseList [] (removeLast tokens)
parse' _ = error "The input does not have the form \"Plaster [...]\"."
parseList :: [String] -> [String] -> [String]
-- Empty list.
parseList tokens [] = tokens
-- Unexpected tokens.
parseList _ (",":_) = error "Unexpected comma."
parseList _ ("[":_) = error "No support for nested brackets."
parseList _ ("]":_) = error "Unexpected input after \"]\"."
-- One-element list.
parseList tokens [x] = tokens ++ [x]
-- Comma-separated list with at least two elements.
parseList tokens (x:",":y:ys) = parseList (tokens ++ [x]) (y:ys)
-- Comma at end of list, so we don’t want to give the "expected comma" error!
parseList _ [_,","] = error "Extra comma at end of list."
-- More than one element not separated by commas.
parseList _ (x:_) = error $ "Expected comma after \"" ++ x ++ "\"."
stripQuotes :: String -> String
stripQuotes ('"':xs) | last xs == '"' = removeLast xs
stripQuotes xs = error $ "Expected string literal instead of " ++ xs ++ "."
removeLast :: [a] -> [a]
removeLast xs = take ((length xs) - 1) xs
whitespace :: [Char]
whitespace = [' ', '\n', '\t'] -- Incomplete, but sufficient.
isWhitespace :: Char -> Bool
isWhitespace c = elem c whitespace
tokenize :: [String] -> String -> [String]
-- If we’ve consumed all the input, we’re done.
tokenize tokens [] = tokens
-- We’d need something a little more complicated for longer operators:
tokenize tokens ('[':xs) = tokenize (tokens ++ ["["]) xs
tokenize tokens (']':xs) = tokenize (tokens ++ ["]"]) xs
tokenize tokens (',':xs) = tokenize (tokens ++ [","]) xs
-- Not currently processing a token, so skip whitespace.
-- Otherwise, start a new token.
tokenize tokens (x:xs) | isWhitespace x = tokenize tokens xs
| otherwise = tokenize' tokens [x] xs
where
tokenize' :: [String] -> String -> String -> [String]
-- If we’ve consumed all the input, the current token is the last.
tokenize' ts t [] = ts ++ [t]
-- If we encounter an operator, it is the token after the current one.
tokenize' ts t ('[':ys) = tokenize (ts ++ [t] ++ ["["]) ys
tokenize' ts t (']':ys) = tokenize (ts ++ [t] ++ ["]"]) ys
tokenize' ts t (',':ys) = tokenize (ts ++ [t] ++ [","]) ys
-- Whitespace means the current token is complete.
-- Otherwise, append y to the current token and continue.
tokenize' ts t (y:ys) | isWhitespace y = tokenize (ts ++ [t]) ys
| otherwise = tokenize' ts (t ++ [y]) ys
You wouldn’t do this in production code; this is simple enough to do with a regex, and parsing is (more or less) a solved problem. Parser combinators are the trendy way to go.