module GardGround.Utils.SteParser.Comments (
  lexeComments,
) where
import qualified Data.HashMap.Strict as H
import GardGround.Utils.SteParser.Lex (HandleTree(..), Parser', eats, skipWhiteSpace, tryOne)
data LevelDelta = LevelIncr | LevelDecr
lvladj :: LevelDelta -> Integer -> Integer
lvladj LevelDecr lvl = lvl - 1
lvladj LevelIncr lvl = lvl + 1
lexeCommentsTreeInit :: HandleTree LevelDelta
lexeCommentsTreeInit = HandleTree (H.fromList l1) Nothing
  where
    l1 = [('(' {- ) -}, HandleTree (H.fromList l2) Nothing)]
    l2 = [('*',         Htleaf LevelIncr)]
lexeCommentsTree :: HandleTree LevelDelta
lexeCommentsTree = HandleTree (H.fromList l1) Nothing
  where
    -- (* ... comment start; *) ... comment end
    l1 = [('(' {- ) -}, HandleTree (H.fromList l2) Nothing)
         ,('*',         HandleTree (H.fromList l3) Nothing)]
    l2 = [('*',         Htleaf LevelIncr)]
    l3 = [({- ( -} ')', Htleaf LevelDecr)]
lexeComments :: Integer -> Parser' e ()
lexeComments (-1) = error "lexeComments invalid index"
lexeComments lvl = do
  (if lvl <= 0 then skipWhiteSpace else pure ())
  fi <- eats (if lvl <= 0 then lexeCommentsTreeInit else lexeCommentsTree)
  case fi of
    Just ld -> lexeComments $ lvladj ld lvl
    -- we either can abort searching for comment contents (lvl == 0)
    -- or we skip over a single character and continue
    Nothing -> if lvl <= 0 then pure () else tryOne (\_ -> Just ()) >> lexeComments lvl

    -- concrete parsers
    skipComments,

-- | usually called as `skipComments 0`, skips over comments delimited by `(*` and `*)`
skipComments :: Integer -> Parser' e ()
skipComments (-1) = error "lexeComments invalid index"
skipComments lvl = do
  (if lvl <= 0 then skipWhiteSpace else pure ())
  fi <- eats (if lvl <= 0 then lexeCommentsTreeInit else lexeCommentsTree)
  case fi of
    Just ld -> skipComments $ lvl + ld
    -- we either can abort searching for comment contents (lvl == 0)
    -- or we skip over a single character and continue
    Nothing -> if lvl <= 0 then pure () else tryOne (\_ -> Just ()) >> skipComments lvl
  where
    lexeCommentsTreeInit :: HandleTree Integer
    lexeCommentsTreeInit = HandleTree (H.fromList l1) Nothing
      where
        l1 = [('(' {- ) -}, HandleTree (H.fromList l2) Nothing)]
        l2 = [('*',         Htleaf 1)]
    lexeCommentsTree :: HandleTree Integer
    lexeCommentsTree = HandleTree (H.fromList l1) Nothing
      where
        -- (* ... comment start; *) ... comment end
        l1 = [('(' {- ) -}, HandleTree (H.fromList l2) Nothing)
             ,('*',         HandleTree (H.fromList l3) Nothing)]
        l2 = [('*',         Htleaf 1)]
        l3 = [({- ( -} ')', Htleaf (-1))]

        GardGround.Utils.SteParser.Comments