separate into files, parser error messages

Logic/Parse.hs

@@ -0,0 +1,77 @@
+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