{-# OPTIONS -Wall #-}
module Language.Haskell.HBB.Internal.InternalTTree (
    applyIndentation,
    applyInsertionInfo, {- only exported for the unit-tests -}
    InternalTTree,
    InsertionInfo(..)) where

import Language.Haskell.HBB.Internal.SrcSpan
import Language.Haskell.HBB.Internal.TTree
import Debug.Trace (trace)
import SrcLoc

-- [Internal TTree]
-- ================
--
-- Motivation
-- ----------
--
-- The internal TTree (the name has been chosen because this structure is used
-- by HBB internally) is an instance of TTree which is first produced by HBB.
-- The main goal of using an internal representation is because it is hard to
-- calculate the indentation of different elements in the transformation-tree.
-- By using a more adequate (than the one reported to the client)
-- representation the task of calculating the indentation (especially for
-- Displays where the client should be reported an according hint) is
-- considered to be easier.
type InternalTTree = TTree LineBuf RealSrcSpan InsertionInfo

-- We introduce a data type called InsertionInfo. Each element in the internal
-- TTree is attached such a InsertionInfo. When recursing in the TTree the
-- (parental) InsertionInfos make up a stack which (in combination with some
-- other factors) describes the current indentation.
--
-- An information that belongs to the insertion is whether a new section in the
-- source code should be started or not. All NewSection elements that are on
-- the same tree-level will have the same indentation.
data InsertionInfo = IncInline BufSpan -- Child should be inserted into the current parent
                                       -- BufSpan: The position the text should be inlined at
                   | NewSection Int    -- Child should open a new section. Int:
                                       -- The index (smallest first) of the new section
                                       -- Indices start from 1...
                   deriving (Show)


type RecElementOffset = Indentation
type AccLevelOffset   = Indentation -- The sum of the recusive element indentation of all
                                    -- previously applied elements plus the element offset of
                                    -- the parent element.

-- This function converts an InternalTTree into the one that is reported to the
-- client. It is a thin wrapper around applyInsertionInfo which is the
-- (complex) heart of this module.
applyIndentation 
    :: (InsertionInfo,InternalTTree)
    -> (BufSpan      ,ClientTTree)
applyIndentation tree = 
    let shouldTrace = False
        tree'  = if shouldTrace then trace ("/*" ++  (show tree) ++ "*/") tree else tree
        ((bs,_),tree3) = head $ foldl (applyInsertionInfo 0 0 [] [] [] 0 1 0) [] [attachRecusiveElementOffsets tree']
    in  (bs,tree3)

-- The ClientTTree is constructed in two phases. In the first phase
-- (represented by this function) each node is attached the recursive element
-- offset. This is the offset of an element after having applied all IncInline
-- child elements (and their IncInline childs as well...)
attachRecusiveElementOffsets
    :: ( InsertionInfo             ,InternalTTree             )
    -> ((InsertionInfo,Indentation),TTree LineBuf RealSrcSpan (InsertionInfo,Indentation))
attachRecusiveElementOffsets (insInfo,TTree content childs) =
    let newChilds         = map attachRecusiveElementOffsets childs 
        totalChildOffset  = sum [ i | ((IncInline _,i),_) <- newChilds ]
        offsetFromContent = elementOffset content
    in  ((insInfo,totalChildOffset+offsetFromContent),TTree content newChilds)
                                    
-- | This function turns the (internal) transformation-tree (with the recursive
-- elements offsets attached) into a transformation-tree the client
-- understands. This is mostly a task of making the indentation (which first is
-- attached implicitely) explicit which means that each addition begins with
-- enough spaces for example.
--
-- The (indentation-)calculations in applyInsertionInfo are kind of complex and
-- therefore 'indentation.markdown' is a concept-paper which describes some
-- details with the help of some examples.
applyInsertionInfo
    :: Indentation        -- ^ Element offset of the parent element
    -> Indentation        -- ^ The recursive element offset of the parent element
                          -- if it is of type IncInline or 0 if it is of type
                          -- NewSection
    -> [RecElementOffset] -- ^ 'Recursive element offset' of all parents
                          -- between the the current element and the root node
    -> [AccLevelOffset]   -- ^ The accumulated level offset stack
    -> [Int]              -- ^ Parent elemen trailing chars stack
    -> Indentation        -- ^ 'Effective indentation' of the parent element
    -> Int                -- ^ Number of lines in the parent element   (for NewSection insertion position)
    -> Int                -- ^ Number of NewSection childs the parent element has (for NewSection insertion position)
    -> [((BufSpan      ,RecElementOffset),ClientTTree                         )]
    ->  ((InsertionInfo,RecElementOffset),TTree LineBuf  RealSrcSpan      (InsertionInfo,RecElementOffset))
    -> [((BufSpan      ,RecElementOffset),ClientTTree                         )]
applyInsertionInfo
    parent_elemOffset
    parent_recElemOffset
    parent_recElemOffsetStack
    parent_accLevelOffsetStack
    parent_parentElemTrailingCharsStack
    parent_EffectiveIndentation
    nrOfLinesInParentElement
    nrOfNewSectionChildsInParent
    appliedNodesOnSameLvl
    ((currentElementsInsertionInfo,curElemRecElemOffs),(TTree _content childs)) =

    let samLvl_recElemOffsetStack = [ reo | ((_,reo),_) <- appliedNodesOnSameLvl ]

        currentAccLevelOffset   = (sum samLvl_recElemOffsetStack) + parent_elemOffset

        recElemOffsetOfThisElement = case currentElementsInsertionInfo of
            (NewSection _) -> 0  {- NewSection mustn't have any influence on
                                    the indentation of the following nodes on
                                    the same level -}
            (IncInline  _) -> curElemRecElemOffs

        currentElemParentElemTrailingchars = case currentElementsInsertionInfo of
                  (NewSection _)                        -> 0
                  (IncInline (BufSpan (BufLoc _ c1) _)) -> parent_elemOffset - c1 + 1

        -- The 'effective indentation' is the indentation that should be
        -- applied for non-first lines. The calculation of it is described
        -- in 'indentation.markdown'...
        currentEffInd = case currentElementsInsertionInfo of
                        (NewSection _)  -> (sum $ currentAccLevelOffset:parent_accLevelOffsetStack) -
                                           (sum $ currentElemParentElemTrailingchars:parent_parentElemTrailingCharsStack)
                        (IncInline  bs) -> 
                            let (BufSpan (BufLoc _ c1) (BufLoc _ _)) = bs
                            in  (c1-1) + (sum samLvl_recElemOffsetStack) + parent_EffectiveIndentation


        newSectionChildsIndentation = (sum $ currentAccLevelOffset:parent_accLevelOffsetStack) -
                                      (sum $ currentElemParentElemTrailingchars:parent_parentElemTrailingCharsStack) +
                                      curElemRecElemOffs
                                      --(elementOffset content)
                                      
        -------------------------------------------------------------------
        -- TRACING
        -------------------------------------------------------------------

        shouldTrace          = case _content of (Addition ["in  "]) -> False
                                                _                   -> False

        txt = case currentElementsInsertionInfo of
            (NewSection  n) -> "NewSection " ++ (show n) ++ " -> " ++ msgContentTxt ++ "\n" ++
                               restMsg
            (IncInline (BufSpan (BufLoc l1 c1) (BufLoc l2 c2))) -> 
                               "IncInline (" ++ ((show l1) ++ "," ++ (show c1)) ++ 
                                       ") (" ++ ((show l2) ++ "," ++ (show c2)) ++ 
                               ") -> " ++ msgContentTxt ++ "\n" ++
                               restMsg
            where
                msgContentTxt = case _content of
                    (Addition []) -> "Addition \"\""
                    (Addition ls) -> "Addition \"" ++ (head ls) ++ "\"..."
                    (Display   _) -> "Display"
                restMsg = unlines
                    ["   current elements recursive offset: " ++ (show curElemRecElemOffs)
                    ,"   parent recursive element offset stack: " ++ (show parent_recElemOffsetStack)
                    ,"   samlvl recursive element offset stack: " ++ (show samLvl_recElemOffsetStack)
                    ,"   #lines in parent element: " ++ (show nrOfLinesInParentElement)
                    ,"   parent eff. indentation:  " ++ (show parent_EffectiveIndentation)
                    ,"   calced eff. indentation:  " ++ (show currentEffInd)
                    ,"   parent accumulat. level offset stack:  " ++ (show parent_accLevelOffsetStack)
                    ,"   current level accum. level offset:     " ++ (show currentAccLevelOffset)
                    ,"   parent element trailing chars: " ++ (show parent_parentElemTrailingCharsStack)
                    ,"   indentation of NewSection childs: " ++ (show newSectionChildsIndentation)]

        content = if not shouldTrace then _content
                  else trace ("/* applyInsertionInfo with " ++ txt ++ " */") _content

        -------------------------------------------------------------------
        -- END OF TRACING
        -------------------------------------------------------------------

        effectiveIndStr = replicate currentEffInd ' '

        newSecChilds    = [ c | c@((NewSection _,_),_) <- childs ]
        otherChilds     = [ c | c@((IncInline  _,_),_) <- childs ]
        
        newSecChildsAdditionalLines = 
            -- As described in 'indentation.markdown' a NewSections indentation
            -- is the sum of all accumulative level offsets between the current
            -- element and the root node (minus the trailing chars up to the
            -- root node). If we calculate the indentation string for our child
            -- NewSection elements, we have to consider our part as well...
            let childNewSecindStr = replicate newSectionChildsIndentation ' '
            in case length newSecChilds of
                      -- The first NewSection is on the same line with the previous content
                      0 -> []
                      1 -> [] 
                      n -> replicate (n-1) childNewSecindStr

        nrOfLinesWithoutNewSections = case content of
                                      (Addition ad) -> length ad
                                      (Display spn) -> srcSpanEndLine spn - srcSpanStartLine spn + 1

        -- This is the insertion position within the parent element. For
        -- elements of type IncInline the BufSpan is adapted by the parent. For
        -- NewSection elements the parent prepared the indentation and the
        -- insertion position is at the end of this indentation.
        insertionPosWithinParent = 
            case currentElementsInsertionInfo of
                 (NewSection idx) -> pointBufSpan 
                        (nrOfLinesInParentElement - (nrOfNewSectionChildsInParent - idx)) 
                        (currentEffInd + 1)
                 (IncInline  bs)  -> bs

        -- Recursion function
        -- ------------------
        -- This function should only be used to apply all IncInline childs
        -- elements at once because it sets the 'Recursive element offset'
        -- stack for the previous childs to [].
        recurseWith 
            :: Int    -- Number of lines in the parent element
            -> [((BufSpan      ,RecElementOffset),ClientTTree                         )]
            -> [((InsertionInfo,RecElementOffset),TTree LineBuf  RealSrcSpan      (InsertionInfo,RecElementOffset))]
            -> [((BufSpan      ,RecElementOffset),ClientTTree                         )]
        recurseWith nrOfLinesInParent acc ch = 
            foldl
                (applyInsertionInfo 
                    (elementOffset content)
                    (case currentElementsInsertionInfo of
                          (NewSection _) -> 0
                          (IncInline  _) -> curElemRecElemOffs)
                    (case currentElementsInsertionInfo of 
                          (NewSection _) ->                    parent_recElemOffsetStack
                          (IncInline  _) -> curElemRecElemOffs:parent_recElemOffsetStack)
                    (currentAccLevelOffset:parent_accLevelOffsetStack)
                    (currentElemParentElemTrailingchars:parent_parentElemTrailingCharsStack)
                    currentEffInd
                    nrOfLinesInParent
                    (length newSecChilds))
                acc
                ch

    in  case content of
        (Addition ad) -> 
            let additionAdapted = 

                    let addIndentation :: LineBuf -> LineBuf
                        addIndentation xs = map (\x -> effectiveIndStr ++ x) xs

                        baseIndented = case ad of []     -> [] 
                                                  (x:xs) -> x:(addIndentation xs)

                    in  baseIndented ++ newSecChildsAdditionalLines

                moveBufSpanByEffInd :: BufSpan -> BufSpan
                moveBufSpanByEffInd bs =
                    -- 
                    -- One non-first lines are prepended with spaces so we do not
                    -- need to move things on the first line.
                    --
                    let (BufSpan (BufLoc l1 c1) (BufLoc l2 c2)) = bs
                        newC1 = case l1 of 1 -> c1
                                           _ -> c1 + currentEffInd
                        newC2 = case l2 of 1 -> c2
                                           _ -> c2 + currentEffInd
                    in  (BufSpan (BufLoc l1 newC1) (BufLoc l2 newC2))

                -- The childs need to be adapted because we have added spaces
                -- to our content and the BufSpans that are contained are
                -- referring to wrong positions...

                otherChildsMoved = [ (((IncInline (moveBufSpanByEffInd bs)),recInd),tree) | ((IncInline bs,recInd),tree ) <- otherChilds ]

                -- --------------------------------------
                -- RECURSIVE CALLS
                -- --------------------------------------
                newChilds = 
                    recurseWith
                        (nrOfLinesWithoutNewSections + (length newSecChildsAdditionalLines))
                        []
                        (otherChildsMoved ++ newSecChilds)
                -- --------------------------------------
                -- END RECURSIVE CALLS
                -- --------------------------------------

                childWithoutRecElemOffs = map (\((bs,_),ch) -> (bs,ch)) newChilds
                    
            in  ((insertionPosWithinParent,recElemOffsetOfThisElement)
                ,TTree (Addition additionAdapted) childWithoutRecElemOffs):appliedNodesOnSameLvl

        (Display spn) -> 
            let -- --------------------------------------
                -- RECURSIVE CALLS
                -- --------------------------------------
                newDisplayChilds =
                    recurseWith
                    (srcSpanEndLine spn - srcSpanStartLine spn + 1)
                    []
                    (if length newSecChilds /= 0 
                     then error "NewSections within displays aren't supported"
                     else childs)
                -- --------------------------------------
                -- END RECURSIVE CALLS
                -- --------------------------------------
                
                newDisplayChildsWithoutRecElemOffs = map (\((bs,_),ch) -> (bs,ch)) newDisplayChilds

                clientDispOffsetHint = currentEffInd - (srcSpanStartCol spn) + 1

            in  ((insertionPosWithinParent,recElemOffsetOfThisElement)
                ,TTree (Display (spn,clientDispOffsetHint)) newDisplayChildsWithoutRecElemOffs):appliedNodesOnSameLvl

-- Returns the number of characters the indentation will be higher after having
-- applied the passed tree-node 
elementOffset :: TTreeNode LineBuf RealSrcSpan -> Indentation
elementOffset (Addition  []) = 0
elementOffset (Addition  ad) = length $ last ad
elementOffset (Display  spn) = endCol - startCol
    where startCol = srcLocCol $ realSrcSpanStart spn
          endCol   = srcLocCol $ realSrcSpanEnd   spn