Common.hs

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