cga/Parser/Core.hs

146 lines
3.7 KiB
Haskell
Raw Normal View History

{-# OPTIONS_HADDOCK ignore-exports #-}
module Parser.Core (Parser(MkParser),
runParser,
satisfy,
char,
string,
posInt,
2014-09-30 22:05:29 +00:00
posDouble,
negDouble,
allDouble,
oneOrMore,
zeroOrMore,
spaces) where
import Control.Applicative
import Data.Char
import Data.List
import Data.Maybe
import MyPrelude
2014-10-09 22:19:05 +00:00
-- |The parser type. It allows us to create specific parsers,
-- combine them and run them via 'runParser' to get a result.
newtype Parser a = MkParser { runParser :: String -> Maybe (a, String) }
2014-10-09 22:19:05 +00:00
-- |Functor instance.
instance Functor Parser where
2014-10-05 13:57:18 +00:00
fmap = inParser . fmap . fmap . first
2014-10-09 22:19:05 +00:00
-- |Applicative functor instance.
instance Applicative Parser where
2014-10-09 22:19:05 +00:00
pure a = MkParser (\s -> Just (a, s))
(MkParser fp) <*> xp = MkParser $ \s ->
case fp s of
Nothing -> Nothing
Just (f,x) -> runParser (f <$> xp) x
2014-10-09 22:19:05 +00:00
-- |Alternative functor instance.
instance Alternative Parser where
2014-10-09 22:19:05 +00:00
empty = MkParser (const Nothing)
MkParser p1 <|> MkParser p2 = MkParser $ liftA2 (<|>) p1 p2
2014-10-09 22:19:05 +00:00
inParser :: ((String -> Maybe (a1, String))
-> String
-> Maybe (a, String))
-> Parser a1
-> Parser a
inParser f p = MkParser . f . runParser $ p
2014-10-09 22:19:05 +00:00
-- |Creates a Parser that parses a Char depending on a given condition.
satisfy :: (Char -> Bool) -- ^ condition
-> Parser Char -- ^ created Parser
satisfy p = MkParser f
where
f [] = Nothing
f (x:xs)
| p x = Just (x, xs)
| otherwise = Nothing
2014-10-09 22:19:05 +00:00
-- |Creates a Parser that accepts a given Char.
char :: Char -> Parser Char
char c = satisfy (== c)
2014-10-09 22:19:05 +00:00
-- |Creates a Parser that accepts a given String.
string :: String -> Parser String
string str = MkParser f
where
f [] = Nothing
f allstr
| str `isPrefixOf` allstr =
Just(str, fromJust . stripPrefix str $ allstr)
| otherwise = Nothing
-- |Creates a Parser that accepts positive integers.
posInt :: Parser Integer
posInt = MkParser f
where
f xs
| null ns = Nothing
| otherwise = Just (read ns, rest)
where (ns, rest) = span isDigit xs
2014-10-09 22:19:05 +00:00
2014-10-09 15:00:03 +00:00
-- |Creates a Parser that accepts positive doubles.
-- Both 131.31 and 132 are valid.
2014-09-30 22:05:29 +00:00
posDouble :: Parser Double
2014-10-09 22:19:05 +00:00
posDouble =
(read <$>) $
(\x y z -> x ++ [y] ++ z) <$>
MkParser f <*>
char '.' <*>
MkParser f <|>
MkParser f
where
f xs
| null ns = Nothing
| otherwise = Just (ns, rest)
where (ns, rest) = span isDigit xs
2014-10-09 22:19:05 +00:00
-- |Creates a Parser that accepts negative doubles.
-- Both -131.31 and -132 are valid.
negDouble :: Parser Double
negDouble =
(negate <$>) $
(read <$>) $
(\x y z -> x ++ [y] ++ z) <$>
(char '-' *> MkParser f) <*>
char '.' <*>
MkParser f <|>
(char '-' *> MkParser f)
where
f xs
| null ns = Nothing
| otherwise = Just (ns, rest)
where (ns, rest) = span isDigit xs
-- |Creates a Parser that accepts both positive and negative doubles.
allDouble :: Parser Double
allDouble = negDouble <|> posDouble
-- |Convert a given Parser to a Parser that accepts zero or more occurences.
zeroOrMore :: Parser a -> Parser [a]
zeroOrMore p = oneOrMore p <|> pure []
2014-10-09 22:19:05 +00:00
-- |Convert a given Parser to a Parser that accepts one or more occurences.
oneOrMore :: Parser a -> Parser [a]
oneOrMore p = (:) <$> p <*> zeroOrMore p
2014-10-09 22:19:05 +00:00
-- |Creates a Parser that accepts spaces.
spaces :: Parser String
spaces = zeroOrMore (satisfy isSpace)