{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- Note: If the first line of the file has wrong indentation, some of the
-- code might be left outside of the blocks
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 -- block opened because of indentation; parameter is the column of it.
                 | Paren t      -- block opened because of parentheses
                 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
$cshowsPrec :: forall t. Show t => Int -> BlockOpen t -> ShowS
showsPrec :: Int -> BlockOpen t -> ShowS
$cshow :: forall t. Show t => BlockOpen t -> String
show :: BlockOpen t -> String
$cshowList :: forall t. Show t => [BlockOpen t] -> ShowS
showList :: [BlockOpen t] -> ShowS
Show

isParen :: BlockOpen t -> Bool
isParen :: forall t. BlockOpen t -> Bool
isParen (Paren t
_) = Bool
True
isParen BlockOpen t
_ = Bool
False

data IState t = IState [BlockOpen t]  -- current block nesting
                     Bool   -- should we open a compound now ?
                     Int    -- last line number
  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
$cshowsPrec :: forall t. Show t => Int -> IState t -> ShowS
showsPrec :: Int -> IState t -> ShowS
$cshow :: forall t. Show t => IState t -> String
show :: IState t -> String
$cshowList :: forall t. Show t => [IState t] -> ShowS
showList :: [IState t] -> ShowS
Show
type State t lexState = (IState t, AlexState lexState)


-- | Transform a scanner into a scanner that also adds opening,
-- closing and "next" tokens to indicate layout.

-- @isSpecial@ predicate indicates a token that starts a compound,
-- like "where", "do", ...

-- @isIgnore@ predicate indicates a token that is to be ignored for
-- layout. (eg. pre-processor directive...)

-- @parens@ is a list of couple of matching parenthesis-like tokens
-- "()[]{}...".


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 :: 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
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
  {
   scanLooked :: (IState t, AlexState 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)
-> ((IState t, AlexState lexState) -> AlexState lexState)
-> (IState t, AlexState lexState)
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IState t, AlexState 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 :: (IState t, AlexState 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 :: (IState t, AlexState lexState)
-> [((IState t, AlexState lexState), Tok t)]
scanRun  = \(IState t, AlexState lexState)
st -> let result :: [((IState t, AlexState lexState), Tok t)]
result = IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
parse ((IState t, AlexState lexState) -> IState t
forall a b. (a, b) -> a
fst (IState t, AlexState 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 ((IState t, AlexState lexState) -> AlexState lexState
forall a b. (a, b) -> b
snd (IState t, AlexState lexState)
st))
                     in --trace ("toks = " ++ show (fmap snd result)) $
                        [((IState t, AlexState lexState), Tok t)]
result
  }
    where dummyAlexState :: AlexState lexerState
dummyAlexState = 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, -- setting this to maxBound ensures nobody ever uses it.
               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) -> b) -> b -> Maybe (t, t)
findParen (t, t) -> b
f b
t = ((t, t) -> Bool) -> [(t, t)] -> Maybe (t, t)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
t) (b -> Bool) -> ((t, t) -> b) -> (t, t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t, t) -> b
f) [(t, t)]
parens

          parse :: IState t -> [(AlexState lexState, Tok t)] -> [(State t lexState, Tok t)]
          parse :: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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)

            -- ignore this token
            | Tok t -> Bool
isIgnored Tok t
tok
              = ((IState t, AlexState lexState)
st, Tok t
tok) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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

            -- start a compound if the rest of the line is empty then skip to it!
            | Bool
doOpen
              = if Tok t -> Bool
isGroupOpen Tok t
tok -- check so that the do is not followed by a {
                  then IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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 ((IState t, AlexState lexState)
st', t -> Tok t
forall {t}. t -> Tok t
tt t
openT) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
                  -- if it's a block opening, we ignore the layout, and just let the "normal" rule
                  -- handle the creation of another level.

            -- close, or prepare to close, a paren block
            | Just (t
openTok,t
_) <- ((t, t) -> t) -> t -> Maybe (t, t)
forall {b}. Eq b => ((t, t) -> b) -> b -> 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 -> ((IState t, AlexState lexState)
st',t -> Tok t
forall {t}. t -> Tok t
tt t
closeT) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
                      -- close an indent level inside the paren block
                      Paren t
openTok' :[BlockOpen t]
levs
                          | t
openTok t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
openTok' -> ((IState t, AlexState lexState)
st', Tok t
tok) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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)]
-> [((IState t, AlexState 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
                      -- close one level of nesting.
                      [] -> String -> [((IState t, AlexState lexState), Tok t)]
forall a. HasCallStack => String -> a
error (String -> [((IState t, AlexState lexState), Tok t)])
-> String -> [((IState t, AlexState 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

            -- pop an indent block
            | 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 ((IState t, AlexState lexState)
st', t -> Tok t
forall {t}. t -> Tok t
tt t
closeT) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
                  -- drop all paren levels inside the indent

            -- next item
            | 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
                = ((IState t, AlexState lexState)
st', t -> Tok t
forall {t}. t -> Tok t
tt t
nextT) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
                  -- drop all paren levels inside the indent

            -- open a paren block
            | 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 {b}. Eq b => ((t, t) -> b) -> b -> 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
              = ((IState t, AlexState lexState)
st', Tok t
tok) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
              -- important note: the the token can be both special and an opening. This is the case of the
              -- haskell 'let' (which is closed by 'in'). In that case the inner block is that of the indentation.

            -- prepare to open a compound
            | t -> Bool
isSpecial (Tok t -> t
forall t. Tok t -> t
tokT Tok t
tok)
                = ((IState t, AlexState lexState)
st', Tok t
tok) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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
                = ((IState t, AlexState lexState)
st', Tok t
tok) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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 :: (IState t, AlexState lexState)
st = (IState t
iSt, AlexState lexState
aSt)
                        st' :: (IState t, AlexState lexState)
st' = (IState t
iSt, AlexState lexState
aSt {lookedOffset = max peeked (lookedOffset 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
                        -- This function checked the position and kind of the
                        -- next token.  We peeked further, and so must
                        -- update the lookedOffset accordingly.

          -- finish by closing all the indent states.
          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) ((IState t, AlexState lexState), Tok t)
-> [((IState t, AlexState lexState), Tok t)]
-> [((IState t, AlexState lexState), Tok t)]
forall a. a -> [a] -> [a]
: IState t
-> [(AlexState lexState, Tok t)]
-> [((IState t, AlexState 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)]
-> [((IState t, AlexState 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
-- HACK! here we have collusion between using (-1) here and the parsing of
-- OnlineTrees, which relies on the position of the last token to stop
-- the parsing.