Skip to content

Instantly share code, notes, and snippets.

@dtchepak
Last active December 17, 2015 23:58
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dtchepak/5693190 to your computer and use it in GitHub Desktop.
Save dtchepak/5693190 to your computer and use it in GitHub Desktop.
My attempt at first 4 or so steps of string calc kata, using hand-rolled parser combinators. Not strictly following the kata requirements, just experimenting.
import Data.Char
import Data.Maybe
newline = is '\n'
comma = is ','
defaultDelim = newline ||| comma
customDelim = do
is '/'
is '/'
delim <- char
newline
return $ is delim
stringCalcP :: Parser [Int]
stringCalcP = do
delim <- customDelim ||| return defaultDelim
empty ||| sepBy delim positive
stringCalc :: String -> Maybe Int
stringCalc =
fmap sum . parseAll stringCalcP
----------------------
-- Parser stuff
-- Should use one of the parsing libraries instead.
----------------------
data Parser a = P { parse :: String -> Maybe (String, a) }
instance Functor Parser where
fmap f (P p) = P $ \i -> (fmap . fmap) f (p i)
instance Monad Parser where
return = constP
(P p) >>= f = P $ \i -> case p i of
Just (i', a) -> parse (f a) i'
_ -> Nothing
constP :: a -> Parser a
constP a = P $ \i -> Just (i, a)
failP :: Parser a
failP = P $ const Nothing
(|||) :: Parser a -> Parser a -> Parser a
(P p) ||| (P q) = P $ \i -> case p i of
Nothing -> q i
result -> result
char :: Parser Char
char = P $ \i -> case i of
[] -> Nothing
(c:cs) -> Just (cs, c)
match :: (Char -> Bool) -> Parser Char
match pred = char >>= \a -> if pred a then constP a else failP
is :: Char -> Parser Char
is = match . (==)
atLeast1 :: Parser a -> Parser [a]
atLeast1 p = p >>= \a -> fmap (a:) (many p)
many :: Parser a -> Parser [a]
many p = atLeast1 p ||| constP []
positive:: Parser Int
positive = fmap read (atLeast1 (match isDigit))
empty :: Parser [a]
empty = P $ \i -> case i of
[] -> Just (i, [])
_ -> Nothing
sepBy :: Parser s -> Parser a -> Parser [a]
sepBy s p =
let sepAndOne = s >> p
in do
first <- p
rest <- many sepAndOne
return $ first:rest
sepByChar :: Char -> Parser a -> Parser [a]
sepByChar = sepBy . is
parseAll :: Parser a -> String -> Maybe a
parseAll p s = case parse p s of
Just ([], a) -> Just a
_ -> Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment