+ 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