77 lines
2.1 KiB
Haskell
77 lines
2.1 KiB
Haskell
module Logic.Parse where
|
|
|
|
import Control.Applicative (Applicative, Alternative(..))
|
|
import Data.Functor (Functor)
|
|
|
|
newtype Parser output = Parser
|
|
{ runParser :: Input -> Either ParseError (output, Input)
|
|
}
|
|
|
|
data Input = Input
|
|
{ inputPos :: Int
|
|
, inputSeq :: [Char]
|
|
} deriving (Eq, Show)
|
|
|
|
mkInput :: [Char] -> Input
|
|
mkInput = Input 0
|
|
|
|
data ParseError =
|
|
ParseError Int String
|
|
deriving (Show)
|
|
|
|
expected :: String -> Input -> ParseError
|
|
expected thing input = ParseError (inputPos input) $
|
|
"expected " <> thing <> ", found " <> show (take 20 $ inputSeq input)
|
|
|
|
eof :: Parser a -> Input -> Either ParseError a
|
|
eof p input = do
|
|
(result, rest) <- runParser p input
|
|
case inputSeq rest of
|
|
[] -> Right result
|
|
_ -> Left $ expected "end of input" rest
|
|
|
|
instance Functor Parser where
|
|
fmap :: (a -> b) -> Parser a -> Parser b
|
|
fmap f (Parser p) = Parser $ \input -> do
|
|
(result, rest) <- p input
|
|
return (f result, rest)
|
|
|
|
instance Applicative Parser where
|
|
pure :: a -> Parser a
|
|
pure result = Parser $ \input -> Right (result, input)
|
|
|
|
(Parser p1) <*> (Parser p2) =
|
|
Parser $ \input -> do
|
|
(f, rest) <- p1 input
|
|
(result, rest') <- p2 rest
|
|
return (f result, rest')
|
|
|
|
instance Alternative Parser where
|
|
empty :: Parser a
|
|
empty = Parser $ const empty
|
|
|
|
(Parser p1) <|> (Parser p2) =
|
|
Parser $ \input -> p1 input <|> p2 input
|
|
|
|
instance Alternative (Either ParseError) where
|
|
empty :: Either ParseError a
|
|
empty = Left $ ParseError 0 "this parser always fails"
|
|
|
|
(Right x) <|> _ = Right x
|
|
(Left _) <|> e = e
|
|
|
|
parseToken :: String -> Parser String
|
|
parseToken token = Parser parse
|
|
where
|
|
n = length token
|
|
parse input@(Input pos xs)
|
|
| token == take n xs = Right $ (token,) $ Input (pos + n) (drop n xs)
|
|
| otherwise = Left $ expected (show token) input
|
|
|
|
parseIf :: String -> (Char -> Bool) -> Parser Char
|
|
parseIf description check = Parser $ \input ->
|
|
case inputSeq input of
|
|
[] -> Left $ ParseError (inputPos input) "unexpected end of input"
|
|
(char:chars)
|
|
| check char -> Right $ (char,) $ Input (inputPos input + 1) chars
|
|
| otherwise -> Left $ expected description input
|