{-# 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
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]  -- 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
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)


-- | 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 :: (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 --trace ("toks = " ++ show (fmap snd result)) $
                        [(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, -- 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) -> 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)

            -- ignore this token
            | 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

            -- 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)] -> [(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
                  -- 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 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
                      -- 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' -> (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
                      -- close one level of nesting.
                      [] -> 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

            -- 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 (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
                  -- 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
                = (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
                  -- 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 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
              -- 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)
                = (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
                        -- 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) (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
-- 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.