module Yi.Syntax.Layout (layoutHandler, State) where
import Yi.Syntax
import Yi.Lexer.Alex
import Yi.Prelude
import Prelude ()
import Data.Maybe (isJust)
import Data.List (dropWhile)
data BlockOpen t = Indent Int
| Paren t
deriving Show
isParen :: BlockOpen t -> Bool
isParen (Paren _) = True
isParen _ = False
data IState t = IState [BlockOpen t]
Bool
Int
deriving Show
type State t lexState = (IState t, AlexState lexState)
layoutHandler :: forall t lexState. (Show t, Eq t) => (t -> Bool) -> [(t,t)] ->
(Tok t -> Bool) ->
(t,t,t) -> (Tok t -> Bool) ->
Scanner (AlexState lexState) (Tok t) -> Scanner (State t lexState) (Tok t)
layoutHandler isSpecial parens isIgnored (openT, closeT, nextT) isGroupOpen lexSource = Scanner
{
scanLooked = scanLooked lexSource . snd,
scanEmpty = error "layoutHandler: scanEmpty",
scanInit = (IState [] True (1), scanInit lexSource),
scanRun = \st -> let result = parse (fst st) (scanRun lexSource (snd st))
in
result
}
where dummyAlexState = AlexState
{
stLexer = error "dummyAlexState: should not be reused for restart!",
lookedOffset = maxBound,
stPosn = startPosn
}
deepestIndent [] = (1)
deepestIndent (Indent i:_) = i
deepestIndent (_:levs) = deepestIndent levs
deepestParen _ [] = False
deepestParen p (Paren t:levs) = p == t || deepestParen p levs
deepestParen p (_:levs) = deepestParen p levs
findParen f t = find ((== t) . f) parens
parse :: IState t -> [(AlexState lexState, Tok t)] -> [(State t lexState, Tok t)]
parse iSt@(IState levels doOpen lastLine)
toks@((aSt, tok @ Tok {tokPosn = Posn _nextOfs line col}) : tokss)
| isIgnored tok
= (st, tok) : parse (IState levels doOpen line) tokss
| doOpen
= case isGroupOpen tok of
False -> (st', tt openT) : parse (IState (Indent col:levels) False line) toks
True -> parse (IState levels False lastLine) toks
| Just (openTok,_) <- findParen snd $ tokT tok,
deepestParen openTok levels
= case levels of
Indent _:levs -> (st',tt closeT) : parse (IState levs False lastLine) toks
Paren openTok' :levs
| openTok == openTok' -> (st', tok) : parse (IState levs False line) tokss
| otherwise -> parse (IState levs False line) toks
[] -> error $ "Parse: " ++ show iSt
| col < deepestIndent levels
= let (_lev:levs) = dropWhile isParen levels
in (st', tt closeT) : parse (IState levs doOpen lastLine) toks
| line > lastLine &&
col == deepestIndent levels
= (st', tt nextT) : parse (IState (dropWhile isParen levels) doOpen line) toks
| isJust $ findParen fst $ (tokT tok)
= (st', tok) : parse (IState (Paren (tokT tok):levels) (isSpecial (tokT tok)) line) tokss
| isSpecial (tokT tok)
= (st', tok) : parse (IState levels True line) tokss
| otherwise
= (st', tok) : parse (IState levels doOpen line) tokss
where st = (iSt, aSt)
st' = (iSt, aSt {lookedOffset = max peeked (lookedOffset aSt)})
tt t = Tok t 0 (tokPosn tok)
peeked = case tokss of
[] -> maxBound
(AlexState {lookedOffset = p},_):_ -> p
parse iSt@(IState (Indent _:levs) doOpen posn) []
= ((iSt,dummyAlexState), Tok closeT 0 maxPosn) : parse (IState levs doOpen posn) []
parse (IState (Paren _:levs) doOpen posn) []
= parse (IState levs doOpen posn) []
parse (IState [] _ _) [] = []
maxPosn :: Posn
maxPosn = Posn (1) (1) 0