module Compiler.AST.Parser.Common where import Compiler.Lexer import Parser import Common type AstParser a = ParserM IO AstParserState a data AstParserState = AstParserState { astInput :: [Token] , astIndent :: Int } deriving Show instance HaveLocation AstParserState where getLocation (astInput -> (t:_)) = tkLocation t getLocation _ = error "No location for empty input" instance HasEmpty AstParserState where isEmpty s = astInput s == [] mkAstParserState :: [Token] -> AstParserState mkAstParserState ts = AstParserState ts 0 liftModifier :: Monad m => ([Token] -> m (Either ParseError a, [Token])) -> (AstParserState -> m (Either ParseError a, AstParserState)) liftModifier fn = \s -> do (fn $ astInput s) >>= \case (r, rst) -> pure (r, s { astInput = rst }) instance {-# OVERLAPS #-} HasLogIndent AstParserState where incIndent a = a { astIndent = astIndent a + 1 } decIndent a = a { astIndent = astIndent a - 1 } logInfo _ _ = pure () -- logInfo name ps = liftIO $ do -- T.putStr $ T.replicate (astIndent ps) " " -- T.putStrLn $ T.pack $ show (name, Prelude.take 2 $ astInput ps) instance ToSource AstParserState where toSource s = toSource $ astInput s class HasAstParser a where astParser :: AstParser a