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