diff --git a/2016-04-19/parser.hs b/2016-04-19/parser.hs new file mode 100644 index 0000000..d9a756e --- /dev/null +++ b/2016-04-19/parser.hs @@ -0,0 +1,79 @@ +module Parser where + +import qualified Data.Char as Char +import Control.Applicative + +newtype Parser i o = Parser { runParser :: i -> Maybe (o, i) } + +evalParser :: Parser a b -> a -> Maybe b +evalParser p i = fst <$> runParser p i + +instance Functor (Parser i) where + fmap f (Parser p) = Parser $ \i -> fmap (\(o, i') -> (f o, i')) $ p i + +instance Applicative (Parser i) where + pure x = Parser $ \i -> Just (x, i) + + Parser ff <*> Parser fv = Parser $ \i -> case ff i of + Just (f, i') -> case fv i' of + Just (v, i'') -> Just (f v, i'') + Nothing -> Nothing + Nothing -> Nothing + +instance Alternative (Parser i) where + empty = Parser $ const Nothing + + p1 <|> p2 = Parser $ \i -> case runParser p1 i of + Nothing -> runParser p2 i + success -> success + +predParser :: Show a => (a -> Bool) -> Parser [a] a +predParser p = Parser $ \l -> case l of + (x:xs) | p x -> Just (x, xs) + _ -> Nothing + +charParser :: Char -> Parser String Char +charParser c = predParser (== c) + +newtype Digit = Digit { getIntOfDigit :: Int } deriving (Show, Eq, Ord) + +charToDigit :: Char -> Maybe Digit +charToDigit c = + if Char.isDigit c then Just $ Digit (Char.digitToInt c) else Nothing + +digitParser :: Parser String Digit +digitParser = Parser $ \i -> case i of + (c : cs) -> fmap (\d -> (d, cs)) . charToDigit $ c + _ -> Nothing + +digitsParser :: Parser String [Digit] +digitsParser = Parser $ \i -> case runParser digitParser i of + Nothing -> Nothing + Just (d, i') -> case runParser digitsParser i' of + Nothing -> Just ([d], i') + Just (ds, i'') -> Just (d:ds, i'') + +-- numberParser :: Parser String Int +-- numberParser = foldl (\acc -> (acc * 10 +) . getIntOfDigit) 0 <$> digitsParser + +numberParser :: Parser String Int +numberParser = foldl (\acc -> (acc * 10 +) . getIntOfDigit) 0 <$> some digitParser + +wordParser :: Parser String String +wordParser = some (predParser Char.isAlphaNum) + +whitespaceParser :: Parser String String +whitespaceParser = many (predParser Char.isSpace) + +data Person = Person String Int deriving (Show) + +whitespacedParser :: Parser String a -> Parser String a +whitespacedParser p = whitespaceParser *> p <* whitespaceParser + +personParser :: Parser String Person +personParser = + whitespacedParser (charParser '(') *> rawPersonParser <* whitespacedParser (charParser ')') + where + nameParser = unwords <$> some (whitespacedParser wordParser) + ageParser = whitespacedParser numberParser + rawPersonParser = pure Person <*> (nameParser <* charParser ',') <*> ageParser