module Language.Haskell.Lexer.Layout (layoutPre,PosToken) where

import Language.Haskell.Lexer.Tokens
import Language.Haskell.Lexer.Position

type PosToken = (Token,(Pos,String))

-- | This is an implementation of Haskell layout, as specified in
-- section 9.3 of the revised Haskell 98 report.
-- This preprocessor inserts the extra \<n\> and {n} tokens.
layoutPre :: [PosToken] -> [PosToken]
layoutPre :: [PosToken] -> [PosToken]
layoutPre = [PosToken] -> [PosToken]
indent ([PosToken] -> [PosToken])
-> ([PosToken] -> [PosToken]) -> [PosToken] -> [PosToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PosToken] -> [PosToken]
open

open :: [PosToken] -> [PosToken]
open :: [PosToken] -> [PosToken]
open = [PosToken] -> [PosToken]
open1

{-+
If the first lexeme of a module is not { or module, then it is preceded
by {n} where n is the indentation of the lexeme.
-}
open1 :: [PosToken] -> [PosToken]
open1 :: [PosToken] -> [PosToken]
open1 (t1 :: PosToken
t1@(Token
Reservedid,(Pos
_,String
"module")):[PosToken]
ts) = PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts
open1 (t1 :: PosToken
t1@(Token
Special,(Pos
_,String
"{")):[PosToken]
ts)         = PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts
open1 ts :: [PosToken]
ts@((Token
_,(Pos
p,String
_)):[PosToken]
_)                  = (Int -> Token
Open (Pos -> Int
column Pos
p),(Pos
p,String
""))PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts
open1 []                                = []

{-+
If a let, where, do, or of keyword is not followed by the lexeme {,
the token {n} is inserted after the keyword, where n is the indentation of
the next lexeme if there is one, or 0 if the end of file has been reached.
-}
open2 :: [PosToken] -> [PosToken]
open2 :: [PosToken] -> [PosToken]
open2 (PosToken
t1:[PosToken]
ts1) | PosToken -> Bool
forall {a}. (Token, (a, String)) -> Bool
isLtoken PosToken
t1 =
    case [PosToken]
ts1 of
      t2 :: PosToken
t2@(Token
_,(Pos
p,String
_)):[PosToken]
ts2 ->
        if PosToken -> Bool
forall {a}. (Token, (a, String)) -> Bool
notLBrace PosToken
t2
        then PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:(Int -> Token
Open (Pos -> Int
column Pos
p),(Pos
p,String
""))PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts1
        else PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:PosToken
t2PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts2
      [] -> PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:(Int -> Token
Open Int
0,((Pos, String) -> Pos
forall a b. (a, b) -> a
fst (PosToken -> (Pos, String)
forall a b. (a, b) -> b
snd PosToken
t1),String
""))PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[]
  where
    isLtoken :: (Token, (a, String)) -> Bool
isLtoken (Token
Reservedid,(a
_,String
s)) = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"let",String
"where",String
"do",String
"of"]
    isLtoken (Token, (a, String))
_ = Bool
False

    notLBrace :: (Token, (a, String)) -> Bool
notLBrace (Token
Special,(a
_,String
"{")) = Bool
False
    notLBrace (Token, (a, String))
_ = Bool
True
open2 (PosToken
t:[PosToken]
ts) = PosToken
tPosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:[PosToken] -> [PosToken]
open2 [PosToken]
ts
open2 [] = []

{-+
(This is from the original Haskell 98 report.)
The first token on each line (not including tokens already annotated) is
preceeded by &lt;n&gt;, where n is the indentation of the token.
-}
indent :: [PosToken] -> [PosToken]
indent :: [PosToken] -> [PosToken]
indent (t1 :: PosToken
t1@(Open Int
_,(Pos
p,String
_)):[PosToken]
ts) = PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:Int -> [PosToken] -> [PosToken]
indent2 (Pos -> Int
line Pos
p) [PosToken]
ts
indent (t1 :: PosToken
t1@(Token
_,(Pos
p,String
_)):[PosToken]
ts)    = (Int -> Token
Indent (Pos -> Int
column Pos
p),(Pos
p,String
""))PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:Int -> [PosToken] -> [PosToken]
indent2 (Pos -> Int
line Pos
p) [PosToken]
ts
indent [] = []

indent2 :: Int -> [PosToken] -> [PosToken]
indent2 :: Int -> [PosToken] -> [PosToken]
indent2 Int
r (t1 :: PosToken
t1@(Token
_,(Pos
p,String
_)):[PosToken]
ts) | Pos -> Int
line Pos
pInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
r = PosToken
t1PosToken -> [PosToken] -> [PosToken]
forall a. a -> [a] -> [a]
:Int -> [PosToken] -> [PosToken]
indent2 Int
r [PosToken]
ts
indent2 Int
_ [PosToken]
ts = [PosToken] -> [PosToken]
indent [PosToken]
ts