haskell-token-utils 0.0.0.1 → 0.0.0.2

raw patch · 7 files changed

+1996/−271 lines, 7 filesdep −kuredep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: kure

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• haskell-token-utils.cabal +3/−3
• src-ghc/Language/Haskell/TokenUtils/GHC/Layout.hs +50/−0
• src-hse/Language/Haskell/TokenUtils/HSE/Layout.hs +2/−0
• src/Language/Haskell/TokenUtils/Pretty.hs +9/−1
• src/Language/Haskell/TokenUtils/TokenUtils.hs +1854/−266
• src/Language/Haskell/TokenUtils/Types.hs +10/−1
• src/Language/Haskell/TokenUtils/Utils.hs +68/−0

@@ -1,5 +1,5 @@ name:                haskell-token-utils-version:             0.0.0.1+version:             0.0.0.2 synopsis:            Utilities to tie up tokens to an AST description:         This library is currently experimental.                      .@@ -42,7 +42,7 @@                      , Language.Haskell.TokenUtils.HSE.Layout   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.6 && <4.7+  build-depends:       base >=4.5 && <4.7                      , containers                      , dual-tree                      , semigroups@@ -89,7 +89,7 @@     , mtl     , pretty     -- experimentation-    , kure+    -- , kure     , syb      -- For testing the GHC version

@@ -16,6 +16,7 @@   , retrieveTokens   , getLoc   , nullSrcSpan+  , mkToken    -- * For testing   , addEndOffsets@@ -2060,6 +2061,18 @@  -- --------------------------------------------------------------------- +-- |Compose a new token using the given arguments.+mkToken::GHC.Token -> SimpPos -> String -> GhcPosToken+mkToken t (row,col) c = ((GHC.L l t),c)+  where+    filename = (GHC.mkFastString "f")+    l = GHC.mkSrcSpan (GHC.mkSrcLoc filename row col) (GHC.mkSrcLoc filename row (col + (length c) ))++ghcZeroToken :: GhcPosToken+ghcZeroToken = mkToken GHC.ITsemi (0,0) ""++-- ---------------------------------------------------------------------+ nullSrcSpan :: GHC.SrcSpan nullSrcSpan = GHC.UnhelpfulSpan $ GHC.mkFastString "HaRe nullSrcSpan" @@ -2091,6 +2104,7 @@    isComment = ghcIsComment   isEmpty = ghcIsEmpty+  mkZeroToken = ghcZeroToken   isDo = ghcIsDo   isElse = ghcIsElse   isIn = ghcIsIn@@ -2102,6 +2116,9 @@   tokenToString (_,s) = s   showTokenStream = GHC.showRichTokenStream +  markToken = ghcMarkToken+  isMarked  = ghcIsMarked+ instance (HasLoc (GHC.Located a)) where   getLoc    (GHC.L l _) = start where Span start end = g2s l   getLocEnd (GHC.L l _) = end   where Span start end = g2s l@@ -2113,9 +2130,41 @@  instance Show (GHC.GenLocated GHC.SrcSpan GHC.Token) where   show t@(GHC.L _l tok) = show ((getLocatedStart t, getLocatedEnd t),tok)+  -- show t@(GHC.L _l tok) = show ((getLocatedStart t),tok)  -- --------------------------------------------------------------------- +-- |Used as a marker in the filename part of the SrcSpan on modified+-- tokens, to trigger re-alignment when retrieving the tokens.+tokenFileMark :: GHC.FastString+tokenFileMark = GHC.mkFastString "HaRe"++-- |Mark a token so that it can be use to trigger layout checking+-- later when the toks are retrieved+ghcMarkToken :: GhcPosToken -> GhcPosToken+ghcMarkToken tok = tok'+  where+      (GHC.L l t,s) = tok+      tok' = (GHC.L (GHC.RealSrcSpan l') t,s)++      l' = case l of+            GHC.RealSrcSpan ss ->+                 GHC.mkRealSrcSpan+                      (GHC.mkRealSrcLoc tokenFileMark (GHC.srcSpanStartLine ss)  (GHC.srcSpanStartCol ss))+                      (GHC.mkRealSrcLoc tokenFileMark (GHC.srcSpanEndLine ss)  (GHC.srcSpanEndCol ss))++            _ -> error $ "markToken: expecting a real SrcSpan, got" -- ++ (showGhc l)+++-- |Does a token have the file mark in it+ghcIsMarked :: GhcPosToken -> Bool+ghcIsMarked (GHC.L l _,_) =+  case l of+    GHC.RealSrcSpan ss -> GHC.srcSpanFile ss == tokenFileMark+    _                  -> False++-- ---------------------------------------------------------------------+ ghcGetSpan :: GhcPosToken -> Span ghcGetSpan (GHC.L l _,_) = g2s l @@ -2196,6 +2245,7 @@ -}  +ghcTokenLen :: (t, [a]) -> Int ghcTokenLen (_,s) = length s  

@@ -88,6 +88,8 @@   -- No empty tokens in HSE   isEmpty _ = False +  mkZeroToken = (Loc (s2ss nullSpan) (T (VarId "")))+   isDo (Loc _ (T KW_Do))  = True   isDo (Loc _ (T KW_MDo)) = True   isDo _                  = False

@@ -95,9 +95,17 @@   ppr (Line r c o s f str) = parens $ text "Line" <+> ppr r                          <+> ppr c <+> ppr o                          <+> ppr s <+> ppr f-                         <+> text ("\"" ++ (init $ showTokenStream str) ++ "\"")+                         <+> text ("\"" ++ (safeShowTokenStream str) ++ "\"")+                         -- <+> text ("\"" ++ (init $ showTokenStream str) ++ "\"")                          -- <+> text ("\"" ++ (init $ showFriendlyToks str) ++ "\"")                          -- <+> text (show str) -- ++AZ++ debug++safeShowTokenStream :: IsToken a => [a] -> String+safeShowTokenStream str =+  let+    s = showTokenStream str+  in+    if s == "" then s else init s  instance Outputable Source where   ppr SOriginal = text "SOriginal"

@@ -1,268 +1,1856 @@ module Language.Haskell.TokenUtils.TokenUtils   (-    replaceTokenInCache-  , replaceTokenForSrcSpan-  , invariant-  ) where--import Control.Exception-import Data.List-import Data.Tree--import Language.Haskell.TokenUtils.Types-import Language.Haskell.TokenUtils.Utils--import qualified Data.Map as Map-import qualified Data.Tree.Zipper as Z---- -----------------------------------------------------------------------invariant :: a-invariant = assert False undefined---- -----------------------------------------------------------------------replaceTokenInCache :: (IsToken a) => TokenCache a -> Span -> a -> TokenCache a-replaceTokenInCache tk sspan tok = tk'-  where-   forest = getTreeFromCache sspan tk-   forest' = replaceTokenForSrcSpan forest sspan tok-   tk' = replaceTreeInCache sspan forest' tk---- -----------------------------------------------------------------------getTreeFromCache :: (IsToken a) => Span -> TokenCache a -> Tree (Entry a)-getTreeFromCache sspan tk = (tkCache tk) Map.! tid-  where-    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan---- -----------------------------------------------------------------------replaceTreeInCache :: (IsToken a) => Span -> Tree (Entry a) -> TokenCache a -> TokenCache a-replaceTreeInCache sspan tree tk = tk'-  where-    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan-    -- tree' = treeIdIntoTree tid tree-    tree' = putTidInTree tid tree-    tk' = tk {tkCache = Map.insert tid tree' (tkCache tk) }--putTidInTree :: (IsToken a) => TreeId -> Tree (Entry a) -> Tree (Entry a)-putTidInTree tid (Node (Deleted fspan pg eg) subs) = (Node (Deleted fs' pg eg) subs)-  where fs' = treeIdIntoForestSpan tid fspan-putTidInTree tid (Node (Entry fspan lay toks) subs) = tree'-  where-    subs' = map (putTidInTree tid) subs-    fs' = treeIdIntoForestSpan tid fspan-    tree' = Node (Entry fs' lay toks) subs'---- ------------------------------------------------------------------------- |Replace a single token in a token tree, without changing the--- structure of the tree--- NOTE: the GHC.SrcSpan may have been used to select the appropriate--- forest in the first place, and is required to select the correct--- span in the tree, due to the ForestLine annotations that may be present---- TODO: work at the token level, not the sspan level--- TODO: Use start of token span only, with length 1.-replaceTokenForSrcSpan :: (IsToken a) => Tree (Entry a) -> Span -> a -> Tree (Entry a)-replaceTokenForSrcSpan forest sspan tok = forest'-  where-    -- (GHC.L tl _,_) = tok-    tl = getSpan tok-    -- First open to the sspan, making use of any Forestline annotations-    z = openZipperToSpanDeep (srcSpanToForestSpan sspan) $ Z.fromTree forest--    -- Then drill down to the specific subtree containing the token-    -- z' = openZipperToSpan (srcSpanToForestSpan tl) z-    z' = z -- No, pass in original token span as sspan.--    -- Note: with LayoutTree, the full tree matching the AST has been-    -- built, still need to drill down to the nearest enclosing span-    (tspan,lay,toks) = case Z.tree z' of-       (Node (Entry ss ly tks) []) -> (ss,ly,tks)-       (Node (Entry _ _ _nullToks) _sub) -> error $ "replaceTokenForSrcSpan:tok pos" ++ (showForestSpan $ sf sspan) ++ " expecting tokens, found: " ++ (show $ Z.tree z')-       (Node (Deleted _ _ _) _sub)       -> error $ "replaceTokenForSrcSpan:tok pos" ++ (showForestSpan $ sf sspan) ++ " expecting Entry, found: " ++ (show $ Z.tree z')--    ((row,col),_) = forestSpanToSimpPos $ srcSpanToForestSpan tl-    toks' = replaceTokNoReAlign toks (row,col) tok--    zf = Z.setTree (Node (Entry tspan lay toks') []) z'-    forest' = Z.toTree zf----- ------------------------------------------------------------------------- |Open a zipper so that its focus has the given SrcSpan in its--- subtree, or the location where the SrcSpan should go, if it is not--- in the tree.--- In the case of an 'Above' layout with the same SrcSpan below,--- return that instead-openZipperToSpanDeep-  :: (IsToken a)-  => ForestSpan-     -> Z.TreePos Z.Full (Entry a)-     -> Z.TreePos Z.Full (Entry a)-openZipperToSpanDeep sspan z = zf-  where-    z' = openZipperToSpan sspan z--    zf = case Z.tree z' of-           (Node (Entry _ (Above _ _ _ _) _) _) ->-                case getChildrenAsZ z' of-                  []  -> z'-                  [x] -> if (treeStartEnd (Z.tree x) == sspan) then x else z'-                  _   -> z'-           _ -> z'----- ------------------------------------------------------------------------- |Open a zipper so that its focus has the given SrcSpan in its--- subtree, or the location where the SrcSpan should go, if it is not--- in the tree-openZipperToSpan ::-  (IsToken a)-  => ForestSpan-     -> Z.TreePos Z.Full (Entry a)-     -> Z.TreePos Z.Full (Entry a)-openZipperToSpan sspan z-  | hasVersions = openZipperToSpanAdded sspan z-  | otherwise   = openZipperToSpanOrig sspan z-  where-    (vs,_ve) = forestSpanVersions sspan-    hasVersions = vs /= 0----- ------------------------------------------------------------------------- |Open a zipper so that its focus has the given SrcSpan in its--- subtree, or the location where the SrcSpan should go, if it is not--- in the tree-openZipperToSpanOrig ::-  (IsToken a)-  => ForestSpan-     -> Z.TreePos Z.Full (Entry a)-     -> Z.TreePos Z.Full (Entry a)-openZipperToSpanOrig sspan z-  = if (treeStartEnd (Z.tree z) == sspan) || (Z.isLeaf z)-      then z-      else z'-        where-          -- go through all of the children to find the one that-          -- either is what we are looking for, or contains it--          -- childrenAsZ = go [] (Z.firstChild z)-          childrenAsZ = getChildrenAsZ z-          z' = case (filter contains childrenAsZ) of-            [] -> z -- Not directly in a subtree, this is as good as-                    -- it gets-            [x] -> -- exactly one, drill down-                   openZipperToSpan sspan x--            xx  -> case (filter (\zt -> (treeStartEnd $ Z.tree zt) == sspan) xx) of -                    [] -> -- more than one matches, see if we can get-                          -- rid of the ones that have been lengthened-                          case (filter (not .forestSpanLenChanged . treeStartEnd . Z.tree) xx) of-                            [] -> z -- we tried...-                            [w] -> openZipperToSpan sspan w-                            -- ww -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,ww))-                            ww -> -- more than one candidate, break-                                  -- the tie on version match-                                  case (filter (\zt -> matchVersions sspan zt) ww) of-                                     [v] -> openZipperToSpan sspan v-                                     _   -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,map (\zt -> treeStartEnd $ Z.tree zt) ww))-                    [y] -> openZipperToSpan sspan y-                    yy -> -- Multiple, check if we can separate out by-                          -- version-                          case (filter (\zt -> (fst $ forestSpanVersions $ treeStartEnd $ Z.tree zt) == (fst $ forestSpanVersions sspan)) xx) of-                           -- [] -> z-                           [] -> error $ "openZipperToSpan:no version match:(sspan,yy)=" ++ (show (sspan,yy)) -- ++AZ++-                           [w] -> openZipperToSpan sspan w-                           _ww -> error $ "openZipperToSpan:multiple version match:" ++ (show (sspan,yy)) -- ++AZ++--          contains zn = spanContains (treeStartEnd $ Z.tree zn) sspan--          matchVersions span1 z2 = isMatch-            where-              span2 = treeStartEnd $ Z.tree z2-              isMatch = forestSpanVersions span1 == forestSpanVersions span2---- ------------------------------------------------------------------------- |Open a zipper to a SrcSpan that has been added in the tree, and--- thus does not necessarily fall in the logical hierarchy of the tree-openZipperToSpanAdded ::-  (IsToken a)-  => ForestSpan-     -> Z.TreePos Z.Full (Entry a)-     -> Z.TreePos Z.Full (Entry a)-openZipperToSpanAdded sspan z = zf-  where-    treeAsList = getTreeSpansAsList $ Z.tree z--    -- True if first span contains the second-    myMatch (((ForestLine _ _ vs1 rs1),cs1),((ForestLine _ _ ve1 re1),ce1))-            (((ForestLine _ _ vs2 rs2),cs2),((ForestLine _ _ ve2 re2),ce2))-      = vs1 == vs2 && ve1 == ve2 && ((rs1,cs1) <= (rs2,cs2)) && ((re1,ce1) >= (re2,ce2))-    tl2 = dropWhile (\(_,s) -> not (myMatch s sspan)) $ reverse treeAsList--    fff [] _ = []-    fff acc@((cd,_cs):_) (v,sspan') = if v < cd then (v,sspan'):acc-                                               else acc--    tl3 = foldl' fff [(head tl2)] tl2-    -- tl3 now contains the chain of ForestSpans to open in order in the zipper--    zf = foldl' (flip openZipperToSpanOrig) z $ map snd tl3---- -----------------------------------------------------------------------getTreeSpansAsList :: (IsToken a) => Tree (Entry a) -> [(Int,ForestSpan)]-getTreeSpansAsList = getTreeSpansAsList' 0--getTreeSpansAsList' :: (IsToken a) => Int -> Tree (Entry a) -> [(Int,ForestSpan)]-getTreeSpansAsList' level (Node (Deleted sspan  _pg _eg )  _  )   = [(level,sspan)]-getTreeSpansAsList' level (Node (Entry sspan _lay _toks) ts0) = (level,sspan)-                       : (concatMap (getTreeSpansAsList' (level + 1)) ts0)----- -----------------------------------------------------------------------getChildrenAsZ :: Z.TreePos Z.Full a -> [Z.TreePos Z.Full a]-getChildrenAsZ z = go [] (Z.firstChild z)-  where-    go acc Nothing = acc-    go acc (Just zz) = go (acc ++ [zz]) (Z.next zz)---- ------------------------------------------------------------------------- |Replace a single token in the token stream by a new token, without--- adjusting the layout.--- Note1: does not re-align, else other later replacements may fail.--- Note2: must keep original end col, to know what the inter-token gap---        was when re-aligning-replaceTokNoReAlign:: (IsToken a) => [a] -> SimpPos -> a -> [a]-replaceTokNoReAlign toks pos newTok =-    toks1 ++ [newTok'] ++ toksRest-   where-      (toks1,toks2) = break (\t -> tokenPos t >= pos && tokenLen t > 0) toks-      toksRest = if (null toks2) then [] else (gtail "replaceTokNoReAlign" toks2)-      oldTok  =  if (null toks2) then newTok else (ghead "replaceTokNoReAlign" toks2)-      -- newTok' = markToken $ matchTokenPos oldTok newTok-      newTok' = matchTokenPos oldTok newTok---- ------------------------------------------------------------------------- |Transfer the location information from the first param to the second-matchTokenPos :: (IsToken a) => a -> a -> a-matchTokenPos t1 t2 = putSpan t2 (getSpan t1)--{---- |Transfer the location information from the first param to the second-matchTokenPos :: PosToken -> PosToken -> PosToken-matchTokenPos (GHC.L l _,_) (GHC.L _ t,s) = (GHC.L l t,s)--}---- ----------------------------------------------------------------------+  -- * Creating+    initTokenCache+  , initTokenCacheLayout+  , mkTreeFromTokens+  , mkTreeFromSpanTokens++  -- * Operations at 'TokenCache' level+  , Positioning (..)+  , ReversedToks(..)+  , reverseToks+  , unReverseToks+  , reversedToks+  , putToksInCache+  , replaceTokenInCache+  , removeToksFromCache+  , replaceTokenForSrcSpan+  , invariant+  , getSrcSpanFor+  , indentDeclToks++  , addToksAfterSrcSpan+  , addOffsetToSpan+  , reIndentToks++  -- *+  , retrieveTokensInterim+  , getTokensForNoIntros+  , getTokensFor+  , getTokensBefore+  -- , retrieveTokensFinal+  , reAlignMarked++  -- *+  , splitOnNewLn+  , getIndentOffset+  , newLnToken+  , startEndLocIncComments'+  , forestSpanToGhcPos++  -- *+  , nullForestSpan+  , nullForestPos+++  -- * should be in utils+  , simpPosToForestSpan++  -- *+  , showTree+  , showToks++  -- * Exposed for testing only+  , addNewSrcSpanAndToksAfter+  , openZipperToSpan+  , openZipperToSpanAdded+  , retrievePrevLineToks+  , limitPrevToks+  , insertSrcSpan+  , insertLenChangedInSrcSpan+  , insertVersionsInSrcSpan+  , updateTokensForSrcSpan+  , removeSrcSpan+  , containsStart+  , containsMiddle+  , containsEnd+  , splitSubtree+  -- , splitForestOnSpan+  , insertNodeAfter+  , splitSubToks+  , placeToksForSpan+  , reAlignOneLine+  , calcEndGap+  , getTreeSpansAsList+  , openZipperToSpanOrig+  ) where++import Control.Exception+import Data.Bits+import Data.List+import Data.Tree++import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.Utils++import qualified Data.Foldable as F+import qualified Data.Map as Map+import qualified Data.Tree.Zipper as Z++-- ---------------------------------------------------------------------++-- |Keep track of when tokens are reversed, to avoid confusion+data ReversedToks a = RT [a]+                    deriving (Show)++reverseToks :: (IsToken a) => [a] -> ReversedToks a+reverseToks toks = RT $ reverse toks++unReverseToks :: (IsToken a) => ReversedToks a -> [a]+unReverseToks (RT toks) = reverse toks++reversedToks :: (IsToken a) => ReversedToks a -> [a]+reversedToks (RT toks) = toks+++-- |How new SrcSpans should be inserted in the Token tree, relative to+-- the prior span+data Positioning = PlaceAdjacent -- ^Only a single space between the+                   -- end of the prior span and the new one+                 | PlaceAbsolute !Int !Int -- ^Start at the specified+                   -- line and col+                 | PlaceAbsCol !Int !Int !Int -- ^Line offset and+                                              -- absolute Col. Mainly+                                              -- for forcing start at+                                              -- left margin, number+                                              -- of lines to add at+                                              -- the end+                 | PlaceOffset !Int !Int !Int -- ^Line and Col offset for+                   -- start, num lines to add at the end+                   -- relative to the indent level of the prior span+                 | PlaceIndent !Int !Int !Int -- ^Line and Col offset for+                   -- start, num lines to add at the end+                   -- relative to the indent level of the prior line+                 deriving (Show)++-- ---------------------------------------------------------------------++initTokenCache :: (IsToken a) => [a] -> TokenCache a+initTokenCache toks = TK (Map.fromList [((TId 0),(mkTreeFromTokens toks))]) (TId 0)++initTokenCacheLayout :: (IsToken a) => Tree (Entry a) -> TokenCache a+initTokenCacheLayout tree = TK (Map.fromList [((TId 0),tree)]) (TId 0)++-- ---------------------------------------------------------------------++-- |Make a tree representing a particular set of tokens+mkTreeFromTokens :: (IsToken a) => [a] -> Tree (Entry a)+mkTreeFromTokens []   = Node (Entry nullForestSpan NoChange []) []+mkTreeFromTokens toks = Node (Entry sspan NoChange toks) []+  where+   (startLoc',endLoc') = nonCommentSpan toks+   sspan    = if (startLoc',endLoc') == ((0,0),(0,0))+     then error $ "mkTreeFromTokens:null span for:" ++ (show toks)+     else simpPosToForestSpan (startLoc',endLoc')++-- ---------------------------------------------------------------------++-- |Make a tree representing a particular set of tokens+mkTreeFromSpanTokens :: (IsToken a) => ForestSpan -> [a] -> Tree (Entry a)+mkTreeFromSpanTokens sspan toks = Node (Entry sspan NoChange toks) []++-- ---------------------------------------------------------------------++forestSpanStart :: ForestSpan -> ForestPos+forestSpanStart (start,_) = start++forestSpanEnd :: ForestSpan -> ForestPos+forestSpanEnd (_,end) = end++nullForestSpan :: ForestSpan+nullForestSpan = (nullForestPos,nullForestPos)++nullForestPos :: ForestPos+nullForestPos = (ForestLine False 0 0 0,0)++-- ---------------------------------------------------------------------++simpPosToForestSpan :: (SimpPos,SimpPos) -> ForestSpan+simpPosToForestSpan ((sr,sc),(er,ec))+    = ((ghcLineToForestLine sr,sc),(ghcLineToForestLine er,ec))++-- ---------------------------------------------------------------------++-- |Utility function to either return True or throw an error to report the problem+invariantOk :: (IsToken a) => Tree (Entry a) -> Bool+invariantOk forest = ok+  where+    inv = invariant forest+    ok = case inv of+           [] -> True+           _  -> error $ "Token Tree invariant fails:" ++ (intercalate "\n" inv)++-- ---------------------------------------------------------------------+-- |Check the invariant for the token cache. Returns list of any errors found.+-- Invariants:+--   1. For each tree, either the rootLabel has a SrcSpan only, or the subForest /= [].+--   2a. The trees making up the subForest of a given node fully include the parent SrcSpan.+--        i.e. the leaves contain all the tokens for a given SrcSpan.+--   2b. The subForest is in SrcSpan order+--   3. A given SrcSpan can only appear (or be included) in a single tree of the forest.+--   4. The parent link for all sub-trees does exist, and actually points to the parent. +--   5. There are no nullForestSpan entries in the tree+-- NOTE: the tokens may extend before or after the SrcSpan, due to comments only+-- NOTE2: this will have to be revisited when edits to the tokens are made+invariant :: (IsToken a) => Tree (Entry a) -> [String]+invariant forest = rsub+  where+    rsub = F.foldl checkOneTree [] [forest]++    checkOneTree :: (IsToken a) => [String] -> Tree (Entry a) -> [String]+    checkOneTree acc tree = acc ++ r+      where+        r = checkNode [] tree++    checkNode :: (IsToken a) => [String] -> Tree (Entry a) -> [String]+    checkNode _acc (Node (Deleted _sspan _ _) []) = []+    checkNode _acc node@(Node (Deleted _sspan _ _) _sub)+         = ["FAIL: deleted node with subtree: " ++ (prettyshow node)]+    checkNode acc node@(Node (Entry sspan _lay toks) sub) = acc ++ r ++ rinc ++ rsubs ++ rnull+      where+        r = if (     null toks  && not (null sub)) ||+               (not (null toks) &&      null sub)+              then []+              else ["FAIL: exactly one of toks or subforest must be empty: " ++ (prettyshow node)]+        rsubs = foldl' checkNode [] sub++        rinc = checkInclusion node++        rnull = if (sspan == nullForestSpan)+                 then ["FAIL: null SrcSpan in tree: " ++ (prettyshow node)]+                 else []++    -- |Check invariant 2, assuming 1 ok+    --  NOTE: check that the subtree spans do not go outside the node+    --  span, they do not need to completely fill it, because some may+    --  have been removed during manipulation+    checkInclusion      (Node _                    []) = []+    checkInclusion      (Node (Deleted _ _ _)       _) = []+    checkInclusion node@(Node (Entry _sspan _lay _toks)  sub) = rs ++ rseq+      where+        (start,end) = treeStartEnd node+        subs = map treeStartEnd sub+        (sstart, _) = ghead "invariant" subs+        (_, send) = last subs+        -- Do not count any custom added srcspans at the end for this+        -- test+        -- TODO: is this a reasonable approach?++        rs = if ((start <= sstart) &&+                ((end >= send) || (forestPosVersionSet send) || (forestPosAstVersionSet send)))+                || (forestPosLenChanged start)+                || (forestPosLenChanged sstart)+                || (forestPosLenChanged send)++               then []+               else ["FAIL: subForest start and end does not match entry: " ++ (prettyshow node)]+               -- else ["FAIL: subForest start and end does not match entry: " ++ (show node)]++        rseq = checkSequence node subs++        checkSequence :: (IsToken a) => Tree (Entry a) -> [ForestSpan] -> [String]+        checkSequence _ [] = []+        checkSequence _ [_x] = []+        checkSequence node' ((_s1,e1):s@(s2,_e2):ss)+          = r ++ checkSequence node' (s:ss)+          where+            -- r = if e1 <= s2+            r = if (before e1 s2) || (sizeChanged e1) {- ++AZ++ -} || (sizeChanged s2)+                 then []+                 else ["FAIL: subForest not in order: " +++                        show e1 ++ " not < " ++ show s2 +++                        ":" ++ prettyshow node']++            -- |Compare end of one span with beginning of another+            before (ForestLine _chs _trs ve er,ec) (ForestLine _che _tre vs sr,sc)+              = case (ve /= 0, vs /= 0) of+                 (False, False) -> (er,ec) <= (sr,sc) -- e.g. (10,3) <= (11,5)+                 (False, True)  -> True               -- e.g. (10,3) <= (100011,5)+                 (True, False)  -> True               -- e.g. (100010,3) <= (11,5)+                 (True, True)   -> if vs < ve         -- both have version, lowest wins +                                    then False+                                    else True++            sizeChanged (ForestLine ch _ _ _,_) = ch++{-+     cs    ce+     True  _ -> True+     False _ -> before++-}++-- ---------------------------------------------------------------------++showTree :: (IsToken a) => Tree (Entry a) -> String+showTree = prettyshow++-- |Represent a tree in a more concise/pretty way+prettyshow :: (IsToken a) => Tree (Entry a) -> String+prettyshow (Node (Deleted sspan _pg eg) _nullSubs)+  = "Node (Deleted " ++ (showForestSpan sspan) ++ " " ++ (show eg) ++ ")"+prettyshow (Node (Entry sspan _lay toks) sub)+  = "Node (Entry " ++ (showForestSpan sspan) ++ " "+     ++ (prettyToks toks) ++ ") "+     -- ++ show (map prettyshow sub)+     ++ "[" ++ intercalate "," (map prettyshow sub) ++ "]"++prettyToks :: (IsToken a) => [a] -> String+prettyToks [] = "[]"+prettyToks toks@[_x] = showToks toks+prettyToks toks@[_t1,_t2] = showToks toks+prettyToks toks = showToks [ghead "prettyToks" toks] ++ ".." ++ showToks [last toks]++showToks :: (IsToken a) => [a] -> String+showToks toks = show $ map doOne toks+  where+    doOne tok = (s,e,tok)+      where (Span s e) = getSpan tok++-- ---------------------------------------------------------------------++getTreeFromCache :: (IsToken a) => Span -> TokenCache a -> Tree (Entry a)+getTreeFromCache sspan tk = (tkCache tk) Map.! tid+  where+    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan++-- ---------------------------------------------------------------------++replaceTreeInCache :: (IsToken a) => Span -> Tree (Entry a) -> TokenCache a -> TokenCache a+replaceTreeInCache sspan tree tk = tk'+  where+    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan+    -- tree' = treeIdIntoTree tid tree+    tree' = putTidInTree tid tree+    tk' = tk {tkCache = Map.insert tid tree' (tkCache tk) }++-- ---------------------------------------------------------------------++-- TODO: get rid of one of the following 2, it is a duplicate+putTidInTree :: (IsToken a) => TreeId -> Tree (Entry a) -> Tree (Entry a)+putTidInTree tid (Node (Deleted fspan pg eg) subs) = (Node (Deleted fs' pg eg) subs)+  where fs' = treeIdIntoForestSpan tid fspan+putTidInTree tid (Node (Entry fspan lay toks) subs) = tree'+  where+    subs' = map (putTidInTree tid) subs+    fs' = treeIdIntoForestSpan tid fspan+    tree' = Node (Entry fs' lay toks) subs'++treeIdIntoTree :: (IsToken a) => TreeId -> Tree (Entry a) -> Tree (Entry a)+treeIdIntoTree tid (Node (Entry fspan lay toks) subTree) = tree'+  where+    fs' = treeIdIntoForestSpan tid fspan+    tree' = Node (Entry fs' lay toks) subTree+treeIdIntoTree tid (Node (Deleted fspan pg eg) subTree) = tree'+  where+    fs' = treeIdIntoForestSpan tid fspan+    tree' = Node (Deleted fs' pg eg) subTree++-- ---------------------------------------------------------------------++stash :: (IsToken a) => TokenCache a -> Tree (Entry a) -> TokenCache a+stash tk oldTree = tk'+  where+    (TId lastTreeId) = tkLastTreeId tk+    lastTreeId' = TId (lastTreeId + 1)+    oldTree' = treeIdIntoTree lastTreeId' oldTree+    cache' = Map.insert lastTreeId' oldTree' (tkCache tk)+    tk' = tk {tkLastTreeId = lastTreeId', tkCache = cache' }++-- ---------------------------------------------------------------------++-- |Replace a single token in a token tree, without changing the+-- structure of the tree+-- NOTE: the GHC.SrcSpan may have been used to select the appropriate+-- forest in the first place, and is required to select the correct+-- span in the tree, due to the ForestLine annotations that may be present++-- TODO: work at the token level, not the sspan level+-- TODO: Use start of token span only, with length 1.+replaceTokenForSrcSpan :: (IsToken a) => Tree (Entry a) -> Span -> a -> Tree (Entry a)+replaceTokenForSrcSpan forest sspan tok = forest'+  where+    -- (GHC.L tl _,_) = tok+    tl = getSpan tok+    -- First open to the sspan, making use of any Forestline annotations+    z = openZipperToSpanDeep (srcSpanToForestSpan sspan) $ Z.fromTree forest++    -- Then drill down to the specific subtree containing the token+    -- z' = openZipperToSpan (srcSpanToForestSpan tl) z+    z' = z -- No, pass in original token span as sspan.++    -- Note: with LayoutTree, the full tree matching the AST has been+    -- built, still need to drill down to the nearest enclosing span+    (tspan,lay,toks) = case Z.tree z' of+       (Node (Entry ss ly tks) []) -> (ss,ly,tks)+       (Node (Entry _ _ _nullToks) _sub) -> error $ "replaceTokenForSrcSpan:tok pos" ++ (showForestSpan $ sf sspan) ++ " expecting tokens, found: " ++ (show $ Z.tree z')+       (Node (Deleted _ _ _) _sub)       -> error $ "replaceTokenForSrcSpan:tok pos" ++ (showForestSpan $ sf sspan) ++ " expecting Entry, found: " ++ (show $ Z.tree z')++    ((row,col),_) = forestSpanToSimpPos $ srcSpanToForestSpan tl+    toks' = replaceTokNoReAlign toks (row,col) tok++    zf = Z.setTree (Node (Entry tspan lay toks') []) z'+    forest' = Z.toTree zf++-- ---------------------------------------------------------------------++replaceTokenInCache :: (IsToken a) => TokenCache a -> Span -> a -> TokenCache a+replaceTokenInCache tk sspan tok = tk'+  where+   forest = getTreeFromCache sspan tk+   forest' = replaceTokenForSrcSpan forest sspan tok+   tk' = replaceTreeInCache sspan forest' tk++-- ---------------------------------------------------------------------++putToksInCache :: (IsToken a) => TokenCache a -> Span -> [a] -> (TokenCache a,Span)+putToksInCache tk sspan toks = (tk'',newSpan)+  where+   forest = getTreeFromCache sspan tk+   (forest',newSpan,oldTree) = updateTokensForSrcSpan forest sspan toks+   tk' = replaceTreeInCache sspan forest' tk+   tk'' = stash tk' oldTree++-- ---------------------------------------------------------------------++removeToksFromCache :: (IsToken a) => TokenCache a -> Span -> TokenCache a+removeToksFromCache tk sspan = tk''+  where+    forest = getTreeFromCache sspan tk+    (forest',oldTree) = removeSrcSpan forest (srcSpanToForestSpan sspan)+    tk' = replaceTreeInCache sspan forest' tk+    tk'' = stash tk' oldTree++-- ---------------------------------------------------------------------++-- | Removes a ForestSpan and its tokens from the forest.+removeSrcSpan :: (IsToken a) => Tree (Entry a) -> ForestSpan+  -> (Tree (Entry a),Tree (Entry a)) -- ^Updated forest, removed span+removeSrcSpan forest sspan = (forest'', delTree)+  where+    forest' = insertSrcSpan forest sspan -- Make sure span is actually+                                         -- in the tree+    z = openZipperToSpan sspan $ Z.fromTree forest'+    zp = gfromJust "removeSrcSpan" $ Z.parent z++    ((pg,_),eg) = calcPriorAndEndGap forest' sspan++    pt = Z.tree zp++    subTree = map (\t -> if (treeStartEnd t == sspan) then (Node (Deleted sspan pg eg) []) else t) $ subForest pt++    z' = Z.setTree (pt { subForest = subTree}) zp+    forest'' = Z.toTree z'++    delTree = Z.tree z+    -- forest'' = error $ "removeSrcSpan: forest'=" ++ drawTreeCompact forest'++-- ---------------------------------------------------------------------++-- |Add a new SrcSpan and Tokens after a given one in the token stream+-- and forest. This will be given a unique SrcSpan in return, which+-- specifically indexes into the forest.+addNewSrcSpanAndToksAfter :: (IsToken a)+  => Tree (Entry a) -- ^The forest to update+  -> Span -- ^The new span comes after this one+  -> Span -- ^Existing span for the tokens+  -> Positioning+  -> [a]  -- ^The new tokens belonging to the new SrcSpan+  -> (Tree (Entry a) -- Updated forest with the new span+     , Span) -- ^Unique SrcSpan allocated in the forest to+                    -- identify this span in its position+addNewSrcSpanAndToksAfter forest oldSpan newSpan pos toks = (forest'',newSpan')+  where+    (forest',tree) = getSrcSpanForDeep forest (srcSpanToForestSpan oldSpan)++    (ghcl,_c) = getStartLoc newSpan+    (ForestLine ch tr v l) = ghcLineToForestLine ghcl+    newSpan' = insertForestLineInSpan (ForestLine ch tr (v+1) l) newSpan++    toks' = placeToksForSpan forest' oldSpan tree pos toks++    newNode = Node (Entry (srcSpanToForestSpan newSpan') NoChange toks') []++    forest'' = insertNodeAfter tree newNode forest'++-- ---------------------------------------------------------------------++placeToksForSpan :: (IsToken a)+  => Tree (Entry a)+  -> Span+  -> Tree (Entry a)+  -> Positioning+  -> [a]+  -> [a]+placeToksForSpan forest oldSpan tree pos toks = toks'+  where+    z = openZipperToSpanDeep (srcSpanToForestSpan oldSpan) $ Z.fromTree forest+    prevToks = case (retrievePrevLineToks z) of+                 RT [] -> reverseToks $ retrieveTokensInterim tree+                 xs -> xs++    prevToks' = limitPrevToks prevToks oldSpan+    toks' = reIndentToks pos (unReverseToks prevToks') toks+    -- toks' = error $ "placeToksForSpan: prevToks'=" ++ (show prevToks')+    -- toks' = error $ "placeToksForSpan: prevToks=" ++ (show prevToks)++-- ---------------------------------------------------------------------++limitPrevToks :: (IsToken a) => ReversedToks a -> Span -> ReversedToks a+limitPrevToks prevToks sspan = reverseToks prevToks''+  where+    ((ForestLine _ _ _ startRow,_startCol),(ForestLine _ _ _ endRow,_)) = srcSpanToForestSpan sspan++    -- Make sure the toks do not extend past where we are+    prevToks' = dropWhile (\t -> tokenRow t > endRow) $ unReverseToks prevToks++    -- Only use the toks for the given oldspan+    -- prevToks'' = dropWhile (\t -> tokenPos t < (startRow,startCol)) prevToks'+    prevToks'' = dropWhile (\t -> tokenRow t < startRow) prevToks'++-- ---------------------------------------------------------------------++-- |Add new tokens after the given SrcSpan, constructing a new SrcSpan+-- in the process+addToksAfterSrcSpan :: (IsToken a)+  => Tree (Entry a)  -- ^TokenTree to be modified+  -> Span -- ^Preceding location for new tokens+  -> Positioning+  -> [a] -- ^New tokens to be added+  -> (Tree (Entry a), Span) -- ^ updated TokenTree and SrcSpan location for+                               -- the new tokens in the TokenTree+addToksAfterSrcSpan forest oldSpan pos toks = (forest',newSpan')+  where+    (fwithspan,tree) = getSrcSpanForDeep forest (srcSpanToForestSpan oldSpan)++    toks'' = placeToksForSpan fwithspan oldSpan tree pos toks++    (startPos,endPos) = nonCommentSpan toks''++    newSpan = posToSpan (startPos,endPos)++    (forest',newSpan') = addNewSrcSpanAndToksAfter forest oldSpan newSpan pos toks++-- ---------------------------------------------------------------------++-- |For a span about to be deleted, calculate the gap between the end+-- of the span being deleted and the start of the next one, at a token+-- level.+calcPriorAndEndGap :: (IsToken a) => Tree (Entry a) -> ForestSpan -> (SimpPos,SimpPos)+calcPriorAndEndGap tree sspan = (pg,eg)+  where+    ((spanStartRow,spanStartCol),(spanRow,spanCol)) = forestSpanToSimpPos sspan+    (spanStart,spanEnd) = sspan+    entries = retrieveTokens' tree+    -- NOTE: the entries are the fringe of the tree, the sspan in+       -- question may be represented by several entries+    (before,rest)    = span  (\e -> (forestSpanStart $ forestSpanFromEntry e) < spanStart) entries+    (rafter,rmiddle) = break (\e -> (forestSpanEnd $ forestSpanFromEntry e) <= spanEnd) $ reverse rest+    _middle = reverse rmiddle+    after = reverse rafter+    -- last element of before should be the sspan we care about, first+    -- of after is the one we are looking for.++    -- NOTE: `after` may contain zero or more Deleted segments in the+    -- front. These get merged later in mergeDeletes+    (tokRow,tokCol) = if null after+        then (spanRow + 2,spanCol)+        else (r,c)+            where+                (r,c) = case ghead ("calcEndGap:after="++(show after)) after of+                    (Entry _ _ toks) -> (tokenRow t,tokenCol t)+                        where t = ghead "calcEndGap" toks+                    (Deleted ss _ _) -> fst $ forestSpanToSimpPos ss++    eg = (tokRow - spanRow, tokCol - spanCol)+    -- eg = error $ "calcEndGap: (sspan,(before,middle,after))=" ++ (show (sspan,(_before,middle,after)))++    (tokRowPg,tokColPg) = if null before+        then (spanStartRow - 1,spanStartCol)+        else (r,c)+            where+                (r,c) = case glast ("calcEndGap:before="++(show before)) before of+                    (Entry _ _ toks) -> (tokenRow t,tokenCol t)+                        where t = glast "calcEndGap pg" toks+                    (Deleted ss _ _) -> snd $ forestSpanToSimpPos ss++    -- TODO: what about comments before the span? spanStartRow may be off+    pg = (spanStartRow - tokRowPg, spanStartCol - tokColPg)+++-- ---------------------------------------------------------------------++-- TODO: delete this, superseded by calcPriorAndEndGap+-- |For a span about to be deleted, calculate the gap between the end+-- of the span being deleted and the start of the next one, at a token+-- level.+calcEndGap :: (IsToken a) => Tree (Entry a) -> ForestSpan -> SimpPos+calcEndGap tree sspan = gap+  where+    (_sspanStart,(spanRow,spanCol)) = forestSpanToSimpPos sspan+    (spanStart,spanEnd) = sspan+    entries = retrieveTokens' tree+    -- NOTE: the entries are the fringe of the tree, the sspan in+       -- question may be represented by several entries+    (_before,rest)   = span  (\e -> (forestSpanStart $ forestSpanFromEntry e) < spanStart) entries+    (rafter,rmiddle) = break (\e -> (forestSpanEnd $ forestSpanFromEntry e) <= spanEnd) $ reverse rest+    _middle = reverse rmiddle+    after = reverse rafter+    -- last element of before should be the sspan we care about, first+    -- of after is the one we are looking for.++    -- NOTE: `after` may contain zero or more Deleted segments in the+    -- front. These get merged later in mergeDeletes+    (tokRow,tokCol) = if null after+        then (spanRow + 2,spanCol)+        else (r,c)+            where+                (r,c) = case ghead ("calcEndGap:after="++(show after)) after of+                    (Entry _ _ toks) -> (tokenRow t,tokenCol t)+                        where t = ghead "calcEndGap" toks+                    (Deleted ss _ _) -> fst $ forestSpanToSimpPos ss++    gap = (tokRow - spanRow, tokCol - spanCol)+    -- gap = error $ "calcEndGap: (sspan,(before,middle,after))=" ++ (show (sspan,(_before,middle,after)))++-- ---------------------------------------------------------------------++-- |Replace the tokens for a given SrcSpan with new ones. The SrcSpan+-- will be inserted into the tree if it is not already there.+-- If the SrcSpan changes size, replace the SrcSpan with a new one+-- (marked), and return it, as well as the old one+-- TODO: What about trailing comments? Preserve or replace?+updateTokensForSrcSpan :: (IsToken a)+  => Tree (Entry a) -> Span -> [a] -> (Tree (Entry a),Span,Tree (Entry a))+updateTokensForSrcSpan forest sspan toks = (forest'',newSpan,oldTree)+  where+    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (srcSpanToForestSpan sspan)+    prevToks = retrieveTokensInterim tree++    endComments   = reverse $ takeWhile isWhiteSpaceOrIgnored $ reverse toks+    startComments = takeWhile isWhiteSpaceOrIgnored $ toks++    newTokStart = if (null prevToks)+                   then mkZeroToken+                   else ghead "updateTokensForSrcSpan.1" prevToks++    toks'' = if (not (null startComments) || not (null endComments))+      then -- toks have comments, discard originals+           reIndentToks (PlaceAbsolute (tokenRow newTokStart) (tokenCol newTokStart)) prevToks toks+      else -- Must reuse any pre-existing start or end comments, and+           -- resync the tokens across all three.+        let+           origEndComments   = reverse $ takeWhile isWhiteSpaceOrIgnored $ reverse prevToks+           origStartComments = takeWhile isWhiteSpaceOrIgnored $ prevToks++           ((startRow,startCol),_) = forestSpanToGhcPos $ srcSpanToForestSpan sspan+           core = reIndentToks (PlaceAbsolute startRow startCol) prevToks toks+           trail = if (null origEndComments)+            then []+            else addOffsetToToks (lineOffset,colOffset) origEndComments+              where+                lineOffset = 0 -- tokenRow (head origEndComments) - tokenRow (head origEndComments)+                colOffset = 0 -- tokenCol (head origEndComments)++           toks' = origStartComments ++ core ++ trail+        in toks'++    (startPos,endPos) = nonCommentSpan toks''++    -- if the original sspan had a ForestLine version, preserve it+    (((ForestLine _chs _trs vs _),_),(ForestLine _che _tre ve _,_)) = srcSpanToForestSpan sspan+    -- Note: adding one to end version, so invariant won't fail+    -- newSpan = insertVersionsInSrcSpan vs ve $ posToSrcSpan forest (startPos,endPos) +    newSpan = insertLenChangedInSrcSpan True True+            $ insertVersionsInSrcSpan vs ve $ posToSpan (startPos,endPos)++    zf = openZipperToNode tree $ Z.fromTree forest'++    zf' = Z.setTree (Node (Entry (srcSpanToForestSpan newSpan) NoChange toks'') []) zf+    forest'' = Z.toTree zf'++    oldTree = tree++-- ---------------------------------------------------------------------++-- |Get the tokens preceding a given 'SrcSpan'+getTokensBefore :: (IsToken a) => Tree (Entry a) -> Span -> (Tree (Entry a),ReversedToks a)+getTokensBefore forest sspan = (forest', prevToks')+  where+    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (srcSpanToForestSpan sspan)++    z = openZipperToSpan (srcSpanToForestSpan sspan) $ Z.fromTree forest'++    prevToks = case (retrievePrevLineToks z) of+                 RT [] -> reverseToks $ retrieveTokensInterim tree+                 xs -> xs++    (_,rtoks) = break (\t->tokenPos t < (getStartLoc sspan)) $ reversedToks prevToks+    prevToks' = RT rtoks++getStartLoc :: Span -> SimpPos+getStartLoc (Span s _) = s++-- ---------------------------------------------------------------------++-- |Get the (possible cached) tokens for a given source span, and+-- cache their being fetched.+-- NOTE: The SrcSpan may be one introduced by HaRe, rather than GHC.+getTokensFor :: (IsToken a) => Bool -> Tree (Entry a) -> Span -> (Tree (Entry a),[a])+getTokensFor checkInvariant forest sspan = (forest'', tokens)+  where+     forest' = if (not checkInvariant) || invariantOk forest+                -- short circuit eval+               then forest+               else error $ "getTokensFor:invariant failed:" ++ (show $ invariant forest)+     (forest'',tree) = getSrcSpanFor forest' (srcSpanToForestSpan sspan)++     tokens = retrieveTokensInterim tree++-- ---------------------------------------------------------------------++-- |Get the (possible cached) tokens for a given source span, and+-- cache their being fetched.+-- NOTE: The SrcSpan may be one introduced by HaRe, rather than GHC.+getTokensForNoIntros :: (IsToken a) => Bool -> Tree (Entry a) -> Span -> (Tree (Entry a),[a])+getTokensForNoIntros checkInvariant forest sspan = (forest', tokens')+  where+    (forest',tokens) = getTokensFor checkInvariant forest sspan+    -- (lead,rest) = break (not . isWhiteSpaceOrIgnored) tokens+    (lead,rest) = break (not . isIgnoredNonComment) tokens+    tokens' = (filter (not . isIgnored) lead) ++ rest++-- ---------------------------------------------------------------------++-- |Starting from a point in the zipper, retrieve all tokens backwards+-- until the line changes for a non-comment/non-empty token or+-- beginning of file.+retrievePrevLineToks :: (IsToken a) => Z.TreePos Z.Full (Entry a) -> ReversedToks a+retrievePrevLineToks z = RT res' -- error $ "retrievePrevLineToks:done notWhite=" ++ (show (done notWhite)) -- ++AZ+++  where+    -- Assuming the zipper has been opened to the span we care about,+    -- we will start with the tokens in the current tree, and work+    -- back.+    -- prevToks = retrieveTokens $ Z.tree z+    prevToks = retrieveTokensInterim $ Z.tree z++    -- Next one is the usual one+    -- res' = reverse $ (concat (go z)) ++ prevToks+    res' =  reverse $ concat $ reverse (prevToks : (go z))++    -- TODO:  ++AZ++ what is this actually doing?+    go :: (IsToken a) => Z.TreePos Z.Full (Entry a) -> [[a]]+    go zz+      | not (Z.isRoot zz) = toks : (go $ gfromJust "retrievePrevLineToks" (Z.parent zz))+      | otherwise = [toks]+      where+        toks = concat $ reverse $ map retrieveTokensInterim $ Z.before zz+        -- toks = concat $ map retrieveTokensInterim $ Z.before zz+++-- ---------------------------------------------------------------------++posToSpan ::  (SimpPos,SimpPos) -> Span+posToSpan (s,e) = Span s e++-- ---------------------------------------------------------------------++reIndentToks :: (IsToken a) => Positioning -> [a] -> [a] -> [a]+reIndentToks _ _ [] = []+reIndentToks pos prevToks toks = toks''+  where+    newTokStart = ghead "reIndentToks.1"+                $ dropWhile (\tok -> isComment tok || isEmpty tok) $ toks++    firstTok = ghead "reIndentToks.2" toks+    lastTok  = glast "reIndentToks.1" prevToks++    lastNonCommentTok = ghead "reIndentToks.3"+                      $ dropWhile (\tok -> isComment tok || isEmpty tok) $ reverse prevToks++    prevOffset = getIndentOffset prevToks (tokenPos (glast "reIndentToks.2" prevToks))++    (lastTokEndLine,_) = tokenPosEnd lastTok+++    (lineOffset,colOffset,endNewlines) = case pos of+      PlaceAdjacent -> (lineOffset',colOffset',0)+        where+          colStart  = (tokenColEnd (lastTok)) + 1+          lineStart = (tokenRow    (lastTok))++          lineOffset' = lineStart - (tokenRow firstTok)+          colOffset'  = colStart  - (tokenCol newTokStart)++      PlaceAbsolute row col -> (lineOffset', colOffset', 0)+        where+          lineOffset' = row - (tokenRow firstTok)+          colOffset'  = col - (tokenCol firstTok)++      PlaceAbsCol rowIndent col numLines -> (lineOffset', colOffset', numLines)+        where+          colOffset'  = col - (tokenCol firstTok)+          lineStart = (tokenRow (lastTok)) -- + 1++          lineOffset' = rowIndent + lineStart - (tokenRow firstTok)++      PlaceOffset rowIndent colIndent numLines -> (lineOffset',colOffset',numLines)+        where+          -- TODO: Should this not be prevOffset?+          colStart  = tokenCol $ ghead "reIndentToks.4"+                    $ dropWhile isWhiteSpaceOrIgnored prevToks++          lineStart = (tokenRow (lastTok)) -- + 1++          lineOffset' = rowIndent + lineStart - (tokenRow firstTok)+          colOffset'  = colIndent + colStart  - (tokenCol newTokStart)+          -- colOffset'  = error $ "reIndentToks:placeOffset lineOffset=" ++ show lineOffset++      PlaceIndent rowIndent colIndent numLines -> (lineOffset',colOffset',numLines)+        where+          colStart = prevOffset+          lineStart = if ((isComment lastTok) && (tokenRow lastNonCommentTok /= lastTokEndLine))+              then (tokenRow (lastTok)) + 1+              else (tokenRow (lastTok))++          lineOffset' = rowIndent + lineStart - (tokenRow firstTok)+          colOffset'  = colIndent + colStart  - (tokenCol newTokStart) + 1 -- ++AZ++ Why +1?++    toks'  = addOffsetToToks (lineOffset,colOffset) toks+    toks'' = if endNewlines > 0+               then toks' ++ [(newLinesToken (endNewlines - 1) $ glast "reIndentToks.3" toks')]+               else toks'++-- ---------------------------------------------------------------------++-- | indent the tree and tokens by the given offset, and sync the AST+-- to the tree too.+indentDeclToks :: (IsToken a,HasLoc t) --(SYB.Data t)+  => (t -> ForestSpan -> t)+  -> t -- ^The AST (or fragment)+  -> Tree (Entry a)    -- ^Existing token tree+  -> Int           -- ^ (signed) number of columns to indent/dedent+  -> (t, Tree (Entry a)) -- ^Updated AST and tokens+indentDeclToks syncAST decl forest offset = (decl',forest'')+  where+    sspan = posToSpan (getLoc decl,getLocEnd decl)++    -- make sure the span is in the forest+    (forest',tree) = getSrcSpanFor forest (srcSpanToForestSpan sspan)++    z = openZipperToSpan (srcSpanToForestSpan sspan) $ Z.fromTree forest'++    tree' = go tree+    -- The invariant will fail if we do not propagate this change+    -- upward. But it needs to sync with the AST, which we do not have+    -- the upward version of.+    -- Instead, set the lengthChanged flag, in the parent.++    -- sss = forestSpanFromEntry entry+    -- sss' = insertLenChangedInForestSpan True sss+    -- tree'' = Node (putForestSpanInEntry entry sss') subs++    markLenChanged (Node entry subs) = (Node entry' subs)+      where+        sss = forestSpanFromEntry entry+        sss' = insertLenChangedInForestSpan True sss+        entry' = putForestSpanInEntry entry sss'++    z' = Z.setTree tree' z+    -- forest'' = Z.toTree (Z.setTree tree'' z)++    forest'' = case Z.parent z' of+                Nothing  -> Z.toTree (Z.setTree (markLenChanged $ Z.tree z' ) z' )+                Just z'' -> Z.toTree (Z.setTree (markLenChanged $ Z.tree z'') z'')+++    -- decl' = syncAST decl (addOffsetToSpan off sspan) tree+    decl' = syncAST decl (sf $ addOffsetToSpan off sspan)++    off = (0,offset)++    -- Pretty sure this could be a fold of some kind+    go (Node (Deleted ss pg eg) sub) = (Node (Deleted (addOffsetToForestSpan off ss) pg eg) sub)+    go (Node (Entry ss lay [])  sub) = (Node (Entry (addOffsetToForestSpan off ss) lay []) (map go sub))+    go (Node (Entry ss lay toks) []) = (Node (Entry (addOffsetToForestSpan off ss) lay (addOffsetToToks off toks)) [])+    go n = error $ "indentDeclToks:strange node:" ++ (show n)++-- ---------------------------------------------------------------------++addOffsetToSpan :: (Int,Int) -> Span -> Span+addOffsetToSpan (lineOffset,colOffset) sspan = sspan'+  where+   Span (sl,sc) (el,ec) = sspan+   sspan' = Span (sl+lineOffset,sc+colOffset) (el+lineOffset,ec+colOffset)++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree.+-- In the case of an 'Above' layout with the same SrcSpan below,+-- return that instead+openZipperToSpanDeep+  :: (IsToken a)+  => ForestSpan+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToSpanDeep sspan z = zf+  where+    z' = openZipperToSpan sspan z++    zf = case Z.tree z' of+           (Node (Entry _ (Above _ _ _ _) _) _) ->+                case getChildrenAsZ z' of+                  []  -> z'+                  [x] -> if (treeStartEnd (Z.tree x) == sspan) then x else z'+                  _   -> z'+           _ -> z'+++-- ---------------------------------------------------------------------+-- |Retrieve a path to the tree containing a ForestSpan from the forest,+-- inserting it if not already present+getSrcSpanFor :: (IsToken a) => Tree (Entry a) -> ForestSpan -> (Tree (Entry a), Tree (Entry a))+getSrcSpanFor forest sspan = (forest',tree)+  where+    forest' = insertSrcSpan forest sspan -- Will NO-OP if already+                                         -- there+    z = openZipperToSpan sspan $ Z.fromTree forest'+    tree = Z.tree z++-- ---------------------------------------------------------------------+-- |Retrieve a path to the tree containing a ForestSpan from the forest,+-- inserting it if not already present.+-- In the case where there is a nested series of spans as in an+-- 'Above' layout, return the deepest one+getSrcSpanForDeep :: (IsToken a)+ => Tree (Entry a) -> ForestSpan -> (Tree (Entry a), Tree (Entry a))+getSrcSpanForDeep forest sspan = (forest',tree)+  where+    forest' = insertSrcSpan forest sspan -- Will NO-OP if already+                                         -- there+    z = openZipperToSpanDeep sspan $ Z.fromTree forest'++    tree = Z.tree z++-- ---------------------------------------------------------------------+-- |Insert a ForestSpan into the forest, if it is not there already.+-- Assumes the forest was populated with the tokens containing the+-- ForestSpan already+insertSrcSpan :: (IsToken a) => Tree (Entry a) -> ForestSpan -> Tree (Entry a)+insertSrcSpan forest sspan = forest'+  where+    z = openZipperToSpan sspan $ Z.fromTree forest+    forest' = if treeStartEnd (Z.tree z) == sspan+      then forest -- Already in, exactly+      -- else error $ "insertSrcSpan:span not in tree " ++ show sspan++      else if (Z.isLeaf z)+        then  -- TODO: This should be in splitSubToks+          let+            -- If we are at a leaf, retrieve the toks+            (Entry _ _ toks) = Z.label z++            (tokStartPos,tokEndPos) = forestSpanToSimpPos sspan++            -- Tokens here, must introduce sub-spans with split, taking+            -- cognizance of start and end comments+            -- TODO: does startEndLocIncComments' give the same boundary+            --       if approached from one side as the other?+            (startLoc,endLoc) = startEndLocIncComments' toks (tokStartPos,tokEndPos)++            (startToks,middleToks,endToks) = splitToks (startLoc,endLoc) toks++            tree1 = if (nonCommentSpan startToks == ((0,0),(0,0)))+                       then []+                       else [mkTreeFromTokens startToks]+            tree2 = [mkTreeFromSpanTokens sspan middleToks]++            tree3 = if (nonCommentSpan endToks == ((0,0),(0,0)))+                       then []+                       else [mkTreeFromTokens endToks]++            subTree = tree1 ++ tree2 ++ tree3+            subTree' = filter (\t -> treeStartEnd t /= nullForestSpan) subTree+            -- (Entry sspan2 _ _) = Z.label z+            sspan2 = case Z.label z of+              (Entry ss _ _) -> ss+              (Deleted ss _ _) -> ss+++            -- z' = Z.setTree (Node (Entry sspan2 NoChange []) subTree') z+            z' = case Z.label z of+              (Entry _ _ _) -> Z.setTree (Node (Entry sspan2 NoChange []) subTree') z+              (Deleted _ _ _) -> Z.setTree (Node (Entry sspan2 NoChange []) subTreeD) z+                where+                  (tb,tm,te) = splitSubToks (Z.tree z) sspan+                  subTreeD = tb ++ tm ++ te++            forest'' = Z.toTree z'+          in forest''+        else+          let+            (before,middle,end) = doSplitTree (Z.tree z) sspan+            newTree = case middle of+                        [x] -> x+                        _xs -> (Node (Entry sspan NoChange []) middle)+            subTree' = before ++ [newTree] ++ end+            (Entry sspan2 _ _) = Z.label z++            z' = Z.setTree (Node (Entry sspan2 NoChange []) subTree') z+            forest'' = Z.toTree z'+          in+            forest''+++-- ---------------------------------------------------------------------++doSplitTree :: (IsToken a)+  => Tree (Entry a) -> ForestSpan+  -> ([Tree (Entry a)], [Tree (Entry a)], [Tree (Entry a)])+doSplitTree tree@(Node (Deleted _ss _ _)   []) sspan = splitSubToks tree sspan -- ++AZ+ What is correct?+doSplitTree tree@(Node (Entry _ss _ _toks) []) sspan = splitSubToks tree sspan+doSplitTree tree                               sspan = (b'',m'',e'')+ -- error $ "doSplitTree:(sspan,tree,(b1,m1,e1))=" ++ (show (sspan,tree,(b1,m1,e1)))+  where+    (b1,m1,e1) = splitSubtree tree sspan+    (b,m,e) = case m1 of+      [] -> -- NOTE: This may have happened through a span being+            --       deleted from the tree+            -- Hence, correct solution is to kick it up a level and+            -- rebuild using tokens etc+             error $ "doSplitTree:no middle:(tree,sspan,b1,m1,e1)=" ++ (show (tree,sspan,b1,m1,e1))+      [x] -> -- only one tree+             doSplitTree x sspan++      xx  -> -- more than one tree+        (b',m',e')+          where+            (bb,mb,_eb) = case (doSplitTree (ghead "doSplitTree.2" xx) sspan) of+                           (x,y,[]) -> (x,y,[])+                           xxx -> error $ "doSplitTree:eb populated:" ++ (show (sspan,tree,xxx))+++            ( [],me,ee) = doSplitTree (glast "doSplitTree.2" xx) sspan++            mm = tail $ init xx -- xx = (head xx) ++ mm ++ (last xx)++            b' = bb+            m' = mb ++ mm ++ me+            e' = ee+    (b'',m'',e'') = (b1++b,m,e++e1)+++-- ---------------------------------------------------------------------++-- TODO: The Bool is horrible+mkTreeListFromTokens :: (IsToken a) => [a] -> ForestSpan -> Bool -> [Tree (Entry a)]+mkTreeListFromTokens  [] _sspan _ = []+mkTreeListFromTokens toks sspan useOriginalSpan = res+  where+   (Node (Entry tspan NoChange treeToks) sub) = mkTreeFromTokens toks++   ((ForestLine chs ts vs  _, _),(ForestLine che te ve  _, _)) = sspan+   ((ForestLine   _  _  _ ls,cs),(ForestLine   _  _  _ le,ce)) = tspan++   span' = ((ForestLine chs ts vs ls, cs),(ForestLine che te ve le, ce))++   res = if nonCommentSpan toks == ((0,0),(0,0))+     then []+     else if useOriginalSpan+            then [(Node (Entry sspan NoChange treeToks) sub)]+            else [(Node (Entry span' NoChange treeToks) sub)]++-- ---------------------------------------------------------------------++splitSubToks :: (IsToken a)+  => Tree (Entry a)+  -> (ForestPos, ForestPos)+  -> ([Tree (Entry a)], [Tree (Entry a)], [Tree (Entry a)])+splitSubToks n@(Node (Deleted (treeStart,treeEnd) _pg _eg) []) (sspanStart,sspanEnd) = (b',m',e')+  where+    egs = (0,0) -- TODO: calculate this+    ege = (0,0) -- TODO: calculate this+    pg = 0      -- TODO: calculate this+    b' = if sspanStart > treeStart+           then [Node (Deleted (treeStart,treeStart) pg egs) []]+           else []+    m' = [n]+    e' = if treeEnd > sspanEnd+           then [Node (Deleted (sspanEnd,treeEnd) pg ege) []]+           else []++splitSubToks tree sspan = (b',m',e')+                          -- error $ "splitSubToks:(sspan,tree)=" ++ (show (sspan,tree))+  where+    (Node (Entry ss@(treeStart,treeEnd) _lay toks)  []) = tree+    (sspanStart,sspanEnd) = sspan+    -- TODO: ignoring comment boundaries to start++    -- There are three possibilities+    --  1. The span starts only in these tokens+    --  2. The span starts and ends in these tokens+    --  3. The span ends only in these tokens+    (b',m',e') = case (containsStart ss sspan,containsEnd ss sspan) of+      (True, False) -> (b'',m'',e'') -- Start only+                       -- error $ "splitSubToks:StartOnly:(sspan,tree,(b'',m''))=" ++ (show (sspan,tree,(b'',m'')))+        where+         (_,toksb,toksm) = splitToks (forestSpanToSimpPos (nullForestPos,sspanStart)) toks+--         b'' = if (emptyList toksb) then [] else [Node (Entry (treeStart, sspanEnd) toksb) []]+         b'' = if (null toksb || nonCommentSpan toksb == ((0,0),(0,0)))+                 then []+                 else [mkTreeFromTokens toksb] -- Need to get end from actual toks+         m'' = let+                (ForestLine _ch _ts _v le,ce) = sspanEnd+                tl =+                  if (treeStart == sspanStart) -- Eq does not compare all flags+                    then mkTreeListFromTokens toksm (treeStart, treeEnd) False+                    else mkTreeListFromTokens toksm (sspanStart,treeEnd) False+                _tl' = if null tl+                 then []+                 else [Node (Entry (st,(ForestLine ch ts v le,ce)) lay tk) []]+                   where [Node (Entry (st,(ForestLine ch ts v _l,_c)) lay tk) []] = tl+               in+                -- tl'+                tl+         e'' = []++      (True, True) -> (b'',m'',e'') -- Start and End+        where+         (toksb,toksm,tokse) = splitToks (forestSpanToSimpPos (sspanStart,sspanEnd)) toks+         b'' = mkTreeListFromTokens toksb (treeStart,  sspanStart) False+         m'' = mkTreeListFromTokens toksm (sspanStart, sspanEnd)   True+         e'' = mkTreeListFromTokens tokse (sspanEnd,   treeEnd)    False++      (False,True) -> (b'',m'',e'') -- End only+        where+         (_,toksm,tokse) = splitToks (forestSpanToSimpPos (nullForestPos,sspanEnd)) toks+         b'' = []+         m'' = let -- If the last span is changed, make sure it stays+                   -- as it was+                tl = mkTreeListFromTokens toksm (treeStart,sspanEnd) False+                tl' = if null tl+                 then []+                 else [Node (Entry (st,sspanEnd) lay tk) []]+                   where [Node (Entry (st,_en) lay tk) []] = mkTreeListFromTokens toksm (treeStart,sspanEnd) False+                in+                 tl'+         e'' = mkTreeListFromTokens tokse (sspanEnd,treeEnd) False++      (False,False) -> if (containsMiddle ss sspan)+                        then ([],[tree],[])+                        else error $ "splitSubToks: error (ss,sspan)=" ++ (show (ss,sspan))++-- ---------------------------------------------------------------------++-- |True if the start of the second param lies in the span of the first+containsStart :: ForestSpan -> ForestSpan -> Bool+containsStart (nodeStart,nodeEnd) (startPos,_endPos)+  = (startPos >= nodeStart && startPos <= nodeEnd)++-- |True if the start of the second param lies before the first, and+-- ends after or on the second+containsMiddle :: ForestSpan -> ForestSpan -> Bool+containsMiddle   (nodeStart,nodeEnd) (startPos,endPos)+  = (startPos <= nodeStart) && (endPos >= nodeEnd)++-- |True if the end of the second param lies in the span of the first+containsEnd :: ForestSpan -> ForestSpan -> Bool+containsEnd   (nodeStart,nodeEnd) (_startPos,endPos)+  = (endPos >= nodeStart && endPos <= nodeEnd)++-- ---------------------------------------------------------------------++-- |Split a given tree into a possibly empty part that lies before the+-- srcspan, the part that is wholly included in the srcspan and the+-- part the lies outside of it at the end.+splitSubtree :: (IsToken a)+  => Tree (Entry a) -> ForestSpan+  -> ([Tree (Entry a)], [Tree (Entry a)], [Tree (Entry a)])+splitSubtree tree sspan = (before,middle,end)+                          -- error $ "splitSubtree:(sspan,tree,middle',end')=" ++ (show (sspan,tree,middle',end'))+  where+    containsStart'  t = containsStart  (treeStartEnd t) sspan+    containsMiddle' t = containsMiddle (treeStartEnd t) sspan+    containsEnd'    t = containsEnd    (treeStartEnd t) sspan++    cond t = containsStart' t || containsMiddle' t || containsEnd' t++    (Node _entry children) = tree+    (before,rest)   = break (\x -> cond x) children+    (endr,middler)  = break (\x -> cond x) $ reverse rest++    (middle,end) = (reverse middler,reverse endr)++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree+openZipperToSpan ::+  (IsToken a)+  => ForestSpan+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToSpan sspan z+  | hasVersions = openZipperToSpanAdded sspan z+  | otherwise   = openZipperToSpanOrig sspan z+  where+    (vs,_ve) = forestSpanVersions sspan+    hasVersions = vs /= 0+++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree+openZipperToSpanOrig ::+  (IsToken a)+  => ForestSpan+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToSpanOrig sspan z+  = if (treeStartEnd (Z.tree z) == sspan) || (Z.isLeaf z)+      then z+      else z'+        where+          -- go through all of the children to find the one that+          -- either is what we are looking for, or contains it++          -- childrenAsZ = go [] (Z.firstChild z)+          childrenAsZ = getChildrenAsZ z+          z' = case (filter contains childrenAsZ) of+            [] -> z -- Not directly in a subtree, this is as good as+                    -- it gets+            [x] -> -- exactly one, drill down+                   openZipperToSpan sspan x++            xx  -> case (filter (\zt -> (treeStartEnd $ Z.tree zt) == sspan) xx) of +                    [] -> -- more than one matches, see if we can get+                          -- rid of the ones that have been lengthened+                          case (filter (not .forestSpanLenChanged . treeStartEnd . Z.tree) xx) of+                            [] -> z -- we tried...+                            [w] -> openZipperToSpan sspan w+                            -- ww -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,ww))+                            ww -> -- more than one candidate, break+                                  -- the tie on version match+                                  case (filter (\zt -> matchVersions sspan zt) ww) of+                                     [v] -> openZipperToSpan sspan v+                                     _   -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,map (\zt -> treeStartEnd $ Z.tree zt) ww))+                    [y] -> openZipperToSpan sspan y+                    yy -> -- Multiple, check if we can separate out by+                          -- version+                          case (filter (\zt -> (fst $ forestSpanVersions $ treeStartEnd $ Z.tree zt) == (fst $ forestSpanVersions sspan)) xx) of+                           -- [] -> z+                           [] -> error $ "openZipperToSpan:no version match:(sspan,yy)=" ++ (show (sspan,yy)) -- ++AZ+++                           [w] -> openZipperToSpan sspan w+                           _ww -> error $ "openZipperToSpan:multiple version match:" ++ (show (sspan,yy)) -- ++AZ++++          contains zn = spanContains (treeStartEnd $ Z.tree zn) sspan++          matchVersions span1 z2 = isMatch+            where+              span2 = treeStartEnd $ Z.tree z2+              isMatch = forestSpanVersions span1 == forestSpanVersions span2++-- ---------------------------------------------------------------------++-- |Open a zipper to a SrcSpan that has been added in the tree, and+-- thus does not necessarily fall in the logical hierarchy of the tree+openZipperToSpanAdded ::+  (IsToken a)+  => ForestSpan+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToSpanAdded sspan z = zf+  where+    treeAsList = getTreeSpansAsList $ Z.tree z++    -- True if first span contains the second+    myMatch (((ForestLine _ _ vs1 rs1),cs1),((ForestLine _ _ ve1 re1),ce1))+            (((ForestLine _ _ vs2 rs2),cs2),((ForestLine _ _ ve2 re2),ce2))+      = vs1 == vs2 && ve1 == ve2 && ((rs1,cs1) <= (rs2,cs2)) && ((re1,ce1) >= (re2,ce2))+    tl2 = dropWhile (\(_,s) -> not (myMatch s sspan)) $ reverse treeAsList++    fff [] _ = []+    fff acc@((cd,_cs):_) (v,sspan') = if v < cd then (v,sspan'):acc+                                               else acc++    tl3 = foldl' fff [(head tl2)] tl2+    -- tl3 now contains the chain of ForestSpans to open in order in the zipper++    zf = foldl' (flip openZipperToSpanOrig) z $ map snd tl3++-- ---------------------------------------------------------------------++getTreeSpansAsList :: (IsToken a) => Tree (Entry a) -> [(Int,ForestSpan)]+getTreeSpansAsList = getTreeSpansAsList' 0++getTreeSpansAsList' :: (IsToken a) => Int -> Tree (Entry a) -> [(Int,ForestSpan)]+getTreeSpansAsList' level (Node (Deleted sspan  _pg _eg )  _  )   = [(level,sspan)]+getTreeSpansAsList' level (Node (Entry sspan _lay _toks) ts0) = (level,sspan)+                       : (concatMap (getTreeSpansAsList' (level + 1)) ts0)+++-- ---------------------------------------------------------------------++-- |Insert a new node after the designated one in the tree+insertNodeAfter :: (IsToken a)+  => Tree (Entry a) -> Tree (Entry a) -> Tree (Entry a) -> Tree (Entry a)+insertNodeAfter oldNode newNode forest = forest'+  where+    zf = openZipperToNodeDeep oldNode $ Z.fromTree forest++    zp = gfromJust ("insertNodeAfter:" ++ (show (oldNode,newNode,forest))) $ Z.parent zf+    tp = Z.tree zp++    -- now go through the children of the parent tree, and find the+    -- right spot for the new node+    (f,s) = break (\t -> treeStartEnd t == treeStartEnd oldNode) $ subForest tp+    (f',s') = (f++[ghead "insertNodeAfter" s],tail s) -- break does not include the found point+    subForest' = f' ++ [newNode] ++ s'++    tp' = tp { subForest = subForest' }+    forest' = Z.toTree $ Z.setTree tp' zp++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus is the given node+--  NOTE: the node must already be in the tree+openZipperToNode :: (IsToken a)+  => Tree (Entry a)+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToNode (Node (Entry sspan _ _) _) z+  = openZipperToSpan sspan z+openZipperToNode (Node (Deleted sspan _ _) _) z+  = openZipperToSpan sspan z++-- |Open a zipper so that its focus is the given node+--  NOTE: the node must already be in the tree+openZipperToNodeDeep :: (IsToken a)+  => Tree (Entry a)+     -> Z.TreePos Z.Full (Entry a)+     -> Z.TreePos Z.Full (Entry a)+openZipperToNodeDeep (Node (Entry sspan _ _) _) z+  = openZipperToSpanDeep sspan z+openZipperToNodeDeep (Node (Deleted sspan _ _) _) z+  = openZipperToSpanDeep sspan z++-- ---------------------------------------------------------------------++getChildrenAsZ :: Z.TreePos Z.Full a -> [Z.TreePos Z.Full a]+getChildrenAsZ z = go [] (Z.firstChild z)+  where+    go acc Nothing = acc+    go acc (Just zz) = go (acc ++ [zz]) (Z.next zz)++-- ---------------------------------------------------------------------++-- |Replace a single token in the token stream by a new token, without+-- adjusting the layout.+-- Note1: does not re-align, else other later replacements may fail.+-- Note2: must keep original end col, to know what the inter-token gap+--        was when re-aligning+replaceTokNoReAlign:: (IsToken a) => [a] -> SimpPos -> a -> [a]+replaceTokNoReAlign toks pos newTok =+    toks1 ++ [newTok'] ++ toksRest+   where+      (toks1,toks2) = break (\t -> tokenPos t >= pos && tokenLen t > 0) toks+      toksRest = if (null toks2) then [] else (gtail "replaceTokNoReAlign" toks2)+      oldTok  =  if (null toks2) then newTok else (ghead "replaceTokNoReAlign" toks2)+      -- newTok' = markToken $ matchTokenPos oldTok newTok+      newTok' = matchTokenPos oldTok newTok++-- ---------------------------------------------------------------------++-- |Transfer the location information from the first param to the second+matchTokenPos :: (IsToken a) => a -> a -> a+matchTokenPos t1 t2 = putSpan t2 (getSpan t1)++{-+-- |Transfer the location information from the first param to the second+matchTokenPos :: PosToken -> PosToken -> PosToken+matchTokenPos (GHC.L l _,_) (GHC.L _ t,s) = (GHC.L l t,s)+-}++-- ---------------------------------------------------------------------++-- ---------------------------------------------------------------------++-- |Retrieve all the tokens at the leaves of the tree, in order. No+-- adjustments are made to address gaps or re-alignment of the tokens+retrieveTokensInterim :: (IsToken a) => Tree (Entry a) -> [a]+retrieveTokensInterim forest = monotonicLineToks $ stripForestLines {-  reAlignMarked -}+                             $ concat $ map (\t -> F.foldl accum [] t) [forest]+  where+    accum :: [a] -> (Entry a) -> [a]+    accum acc (Entry _ _ [])   = acc+    accum acc (Entry _ _ toks) = acc ++ toks+    accum acc (Deleted _ _ _)  = acc+++retrieveTokens' :: (IsToken a) => Tree (Entry a) -> [Entry a]+retrieveTokens' forest = mergeDeletes $ concat $ map (\t -> F.foldl accum [] t) [forest]+  where+    accum :: [Entry a] -> Entry a -> [Entry a]+    accum acc   (Entry _ _ [])    = acc+    accum acc e@(Entry _ _ _toks) = acc ++ [e]+    accum acc e@(Deleted _ _ _)   = acc ++ [e]++-- |Merge adjacent Deleted entries+mergeDeletes :: (IsToken a) => [Entry a] -> [Entry a]+mergeDeletes [] = []+mergeDeletes [x] = [x]+mergeDeletes ((Deleted ss1 pg1 (r1,_)):(Deleted ss2 _ (r2,c2)):xs) = (Deleted ss pg1 o):xs+  where+    (start,_) = ss1+    (_, end) = ss2+    ss = (start,end)+    o = (r1+r2,c2)+mergeDeletes (x:xs) = x:mergeDeletes xs++-- ---------------------------------------------------------------------++-- | sort out line numbering so that they are always monotonically+-- increasing.+monotonicLineToks :: (IsToken a) => [a] -> [a]+monotonicLineToks toks = goMonotonicLineToks (0,0) toks++goMonotonicLineToks :: (IsToken a) => SimpPos -> [a] -> [a]+goMonotonicLineToks _ [] = []+goMonotonicLineToks _ [t] = [t]+goMonotonicLineToks (orow,ocol) (t1:t2:ts)+  = t1:goMonotonicLineToks offset' (t2':ts)+  where+    offset' = if (tokenRow t1 - orow) > (tokenRow t2)+               then (orow + (tokenRow t1) - tokenRow t2 + 1, ocol)+               else (orow,ocol)++    -- t1' = increaseSrcSpan (orow,ocol) t1+    t2' = increaseSrcSpan offset'     t2++-- ---------------------------------------------------------------------+{- No longer used+-- |Retrieve all the tokens at the leaves of the tree, in order.+-- Marked tokens are re-aligned, and gaps are closed.+retrieveTokensFinal :: (IsToken a) => Tree (Entry a) -> [a]+retrieveTokensFinal forest = monotonicLineToks $ stripForestLines $ reAlignMarked+                      $ deleteGapsToks $ retrieveTokens' forest+-}+-- ---------------------------------------------------------------------++reAlignMarked :: (IsToken a) => [a] -> [a]+reAlignMarked toks = concatMap alignOne $ groupTokensByLine toks+  where+    -- alignOne toksl = unmarked ++ (reAlignToks marked)+    alignOne toksl = unmarked ++ (reAlignOneLine marked)+     where+       (unmarked,marked) = break isMarked toksl++-- ---------------------------------------------------------------------++-- | Some tokens are marked if they belong to identifiers which have+-- been renamed. When the renaming takes place, no layout adjustment+-- is done. This function adjusts the spacing for the rest of the line+-- to match as far as possible the original spacing, except for the+-- name change.+reAlignOneLine :: (IsToken a) => [a] -> [a]+reAlignOneLine toks = go (0,0) toks+  where+    go _ [] = []+    go (l,c) (t:ts) = (increaseSrcSpan (l,c) t') : (go (l,c') ts)+      where+        (t',dc) = adjustToken t+        c' = c + dc++    adjustToken tt+      | tokenLen tt == 0 = (tt,0)+      | otherwise = (tt',deltac)+      where+        Span (sl,sc) (el,ec) = getSpan tt+        deltac = (tokenLen tt) - (ec - sc)+        newPos = Span (sl,sc) (el,ec+deltac)+        tt' = putSpan tt newPos+{-+    adjustToken tt@(_,"") = (tt,0)+    adjustToken tt@(lt@(GHC.L _ t),s) = ((GHC.L newL t,s),deltac)+      where+        (sl,sc) = getLocatedStart lt+        (el,ec) = getLocatedEnd   lt+        deltac = (length s) - (ec - sc)++        filename = fileNameFromTok tt+        newL = GHC.mkSrcSpan (GHC.mkSrcLoc filename sl sc)+                             (GHC.mkSrcLoc filename el (ec + deltac))+-}++++{-+reAlignToks :: (IsToken a) => [a] -> [a]+reAlignToks [] = []+reAlignToks [t] = [t]+reAlignToks (tok1@(_,""):ts) = tok1 : reAlignToks ts+reAlignToks (tok1@((GHC.L l1 _t1),_s1):tok2@((GHC.L l2 t2),s2):ts)+  = tok1:reAlignToks (tok2':ts)+   where+     ((_sr1,_sc1),(er1,ec1)) = (getGhcLoc l1,getGhcLocEnd l1)+     (( sr2, sc2),(er2,ec2)) = (getGhcLoc l2,getGhcLocEnd l2)++     ((sr,sc),(er,ec)) = if (er1 == sr2 && ec1 >= sc2)+              then ((sr2,ec1+1),(er2,ec1+1 + tokenLen tok2))+              else ((sr2,sc2),(er2,ec2))++     fname = case l2 of+               GHC.RealSrcSpan ss -> GHC.srcSpanFile ss+               _ -> GHC.mkFastString "foo"+     l2' = GHC.mkRealSrcSpan (GHC.mkRealSrcLoc fname sr sc)+                             (GHC.mkRealSrcLoc fname er ec)+     tok2' = ((GHC.L (GHC.RealSrcSpan l2') t2),s2)+-}+-- ---------------------------------------------------------------------+{-+-- TODO: deprecated, doing this at the Ppr level now+adjustLinesForDeleted :: (IsToken a) => Tree (Entry a) -> Tree (Entry a)+adjustLinesForDeleted forest = forest'+  where+    (_,forest') = go (0,0) forest++    go :: (IsToken a) => (Int,Int) -> Tree (Entry a) -> ((Int,Int),Tree (Entry a))+    go (ro,co) (n@(Node (Entry _ss _lay _toks) [])) = ((ro,co),applyOffsetToTreeShallow (ro,co) n)+    go (ro,co) (n@(Node (Deleted _ _ (gr,_gc)) _nullSubs))   = ((ro-gr,co),n)+    go (ro,co) (n@(Node (Entry _ss _lay []) _subs)) = ((ro',co'),Node (Entry ss lay []) subs')+      where+        (Node (Entry ss lay []) subs) = applyOffsetToTreeShallow (ro,co) n+        ((ro',co'),subs') = foldl' go' ((ro,co),[]) subs++    go (_ro,_co) (n@(Node (Entry _ss _lay _toks) _subs))+      = error $ "adjustLinesForDeleted: Entry with toks and subs:" ++ (show n)++    go' ((ro,co),acc) tree = ((ro',co'),acc++[tree'])+      where+        ((ro',co'),tree') = go (ro,co) tree+-}+-- ---------------------------------------------------------------------++applyOffsetToTreeShallow :: (IsToken a) => (Int,Int) -> Tree (Entry a) -> Tree (Entry a)+applyOffsetToTreeShallow (ro,co) (Node (Entry sspan lay toks) subs)+  = (Node (Entry sspan' lay toks') subs')+  where+    sspan' = addOffsetToForestSpan (ro,co) sspan+    toks' = addOffsetToToks (ro,co) toks+    subs' = subs+applyOffsetToTreeShallow _ n@(Node (Deleted _ _ _) _) = n++-- ---------------------------------------------------------------------++addOffsetToForestSpan :: (Int,Int) -> ForestSpan -> ForestSpan+addOffsetToForestSpan (lineOffset,colOffset) fspan = fspan'+  where+    ((ForestLine sch str sv sl,sc),(ForestLine ech etr ev el,ec)) = fspan+    fspan' = ((ForestLine sch str sv (sl+lineOffset),sc+colOffset),+              (ForestLine ech etr ev (el+lineOffset),ec+colOffset))++-- ---------------------------------------------------------------------++stripForestLines :: (IsToken a) => [a] -> [a]+stripForestLines toks = map doOne toks+  where+    doOne tok = tok'+      where+       l = getSpan tok+       tok' = putSpan tok l'+       ((ForestLine _ _ _ ls,_),(_,_)) = srcSpanToForestSpan l+       l' = insertForestLineInSpan (ForestLine False 0 0 ls) l++-- ---------------------------------------------------------------------++insertVersionsInSrcSpan :: Int -> Int -> Span -> Span+insertVersionsInSrcSpan vs ve ss = ss'+  where+    Span (sl,sc) (el,ec) = ss+    (chs,che) = forestSpanLenChangedFlags $ srcSpanToForestSpan ss+    (trs,tre) = forestSpanAstVersions $ srcSpanToForestSpan ss+    lineStart = forestLineToGhcLine (ForestLine chs trs vs sl)+    lineEnd   = forestLineToGhcLine (ForestLine che tre ve el)+    ss' = Span (lineStart,sc) (lineEnd,ec)++-- ---------------------------------------------------------------------++insertLenChangedInSrcSpan :: Bool -> Bool -> Span -> Span+insertLenChangedInSrcSpan chs che ss = ss'+  where+    Span (sl,sc) (el,ec) = ss+    sl' = if chs then sl .|. forestLenChangedMask+                 else sl .&. (complement forestLenChangedMask)++    el' = if che then el .|. forestLenChangedMask+                 else el .&. (complement forestLenChangedMask)++    ss' = Span (sl',sc) (el',ec)+++-- ---------------------------------------------------------------------++-- | Replace any ForestLine flags already in a SrcSpan with the given ones+insertForestLineInSpan :: ForestLine -> Span -> Span+insertForestLineInSpan fl@(ForestLine ch tr v _l) ss = ss'+  where+    lineStart = forestLineToGhcLine fl+    ((_,cs),(ForestLine _ _ _ le,ce)) = srcSpanToForestSpan ss+    lineEnd   = forestLineToGhcLine (ForestLine ch tr v le)+    ss' = Span (lineStart,cs) (lineEnd,ce)++-- ---------------------------------------------------------------------+++-- |Strip out the version markers+forestSpanToGhcPos :: ForestSpan -> (SimpPos,SimpPos)+forestSpanToGhcPos ((fls,sc),(fle,ec))+  = ((forestLineToGhcLine fls,sc),(forestLineToGhcLine fle,ec))++-- ---------------------------------------------------------------------++-- | Get the indent of the line before, taking into account in-line+-- 'where', 'let', 'in' and 'do' tokens+getIndentOffset :: (IsToken a) => [a] -> SimpPos -> Int+getIndentOffset [] _pos     = 1+getIndentOffset _toks (0,0) = 1+getIndentOffset toks pos+  = let (ts1, ts2) = break (\t->tokenPos t >= pos) toks+    in if (null ts2)+         then error "haskell-token-utils error: position does not exist in the token stream!"+         else let (sl,_) = splitOnNewLn $ reverse ts1+                -- sl is the reversed tokens of the previous line+                  (sls,_) = break isWhereOrLet $ filter (\t -> tokenLen t > 0) sl+                  firstTok = (glast "getIndentOffset" sls)+              in if startLayout firstTok+                  then if (length sls > 1)+                          then tokenOffset (last $ init sls)+                          else 4 + tokenOffset firstTok+                  else tokenOffset firstTok++      where+        tokenOffset t = (tokenCol t) - 1++        startLayout tok = isDo tok || isIn tok || isLet tok || isWhere tok+        {-+        startLayout ((GHC.L _ (GHC.ITdo)),_)    = True+        startLayout ((GHC.L _ (GHC.ITin)),_)    = True+        startLayout ((GHC.L _ (GHC.ITlet)),_)   = True+        startLayout ((GHC.L _ (GHC.ITwhere)),_) = True+        startLayout _  = False+        -}++-- ---------------------------------------------------------------------++splitOnNewLn :: (IsToken a) => [a] -> ([a],[a])+splitOnNewLn toks = go [] toks+  -- ++AZ++ : TODO: is this simpler? : (toks1,toks2)=break (\x' -> tokenRow x /= tokenRow x') rtoks++  where+    go [] [] = ([],[])+    go ss [] = (ss,[])+    go [] xs = go [head xs] (tail xs)+    go ss xs+      | onSameLn (glast "splitOnNewLn" ss) (head xs) = go (ss ++ [head xs]) (tail xs)+      | otherwise = (ss,xs)++-- ---------------------------------------------------------------------++onSameLn :: (IsToken a) => a -> a -> Bool+onSameLn t1 t2 = r1 == r2+  where+    Span (r1,_) _ = getSpan t1+    Span (r2,_) _ = getSpan t2+-- ---------------------------------------------------------------------++newLnToken :: (IsToken a) => a -> a+newLnToken tok = newLinesToken 1 tok++-- ---------------------------------------------------------------------+++newLinesToken :: (IsToken a) => Int -> a -> a+newLinesToken jump tok = tok'+  where+   Span (sl,_) _ = getSpan tok+   nl = sl + jump+   tok' = putSpan mkZeroToken (Span (nl,1) (nl,1))+{-+   l' =  case l of+     GHC.RealSrcSpan ss ->+       let+         loc = GHC.mkSrcLoc (GHC.srcSpanFile ss) (jump + GHC.srcSpanEndLine ss) 1+       in+         GHC.mkSrcSpan loc loc+     _ -> l+-}++-- ---------------------------------------------------------------------++-- This stuff may be needed+{-+-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree+openZipperToSpan+  :: ForestSpan+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+openZipperToSpan sspan z+  | hasVersions = openZipperToSpanAdded sspan z+  | otherwise   = openZipperToSpanOrig sspan z+  where+    (vs,_ve) = forestSpanVersions sspan+    hasVersions = vs /= 0+++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree+openZipperToSpanOrig+  :: ForestSpan+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+openZipperToSpanOrig sspan z+  = if (treeStartEnd (Z.tree z) == sspan) || (Z.isLeaf z)+      then z+      else z'+        where+          -- go through all of the children to find the one that+          -- either is what we are looking for, or contains it++          -- childrenAsZ = go [] (Z.firstChild z)+          childrenAsZ = getChildrenAsZ z+          z' = case (filter contains childrenAsZ) of+            [] -> z -- Not directly in a subtree, this is as good as+                    -- it gets+            [x] -> -- exactly one, drill down+                   openZipperToSpan sspan x++            xx  -> case (filter (\zt -> (treeStartEnd $ Z.tree zt) == sspan) xx) of +                    [] -> -- more than one matches, see if we can get+                          -- rid of the ones that have been lengthened+                          case (filter (not .forestSpanLenChanged . treeStartEnd . Z.tree) xx) of+                            [] -> z -- we tried...+                            [w] -> openZipperToSpan sspan w+                            -- ww -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,ww))+                            ww -> -- more than one candidate, break+                                  -- the tie on version match+                                  case (filter (\zt -> matchVersions sspan zt) ww) of+                                     [v] -> openZipperToSpan sspan v+                                     _   -> error $ "openZipperToSpan:can't resolve:(sspan,ww)="++(show (sspan,map (\zt -> treeStartEnd $ Z.tree zt) ww))+                    [y] -> openZipperToSpan sspan y+                    yy -> -- Multiple, check if we can separate out by+                          -- version+                          case (filter (\zt -> (fst $ forestSpanVersions $ treeStartEnd $ Z.tree zt) == (fst $ forestSpanVersions sspan)) xx) of+                           -- [] -> z+                           [] -> error $ "openZipperToSpan:no version match:(sspan,yy)=" ++ (show (sspan,yy)) -- ++AZ+++                           [w] -> openZipperToSpan sspan w+                           _ww -> error $ "openZipperToSpan:multiple version match:" ++ (show (sspan,yy)) -- ++AZ++++          contains zn = spanContains (treeStartEnd $ Z.tree zn) sspan++          matchVersions span1 z2 = isMatch+            where+              span2 = treeStartEnd $ Z.tree z2+              isMatch = forestSpanVersions span1 == forestSpanVersions span2++-- ---------------------------------------------------------------------++-- |Open a zipper so that its focus has the given SrcSpan in its+-- subtree, or the location where the SrcSpan should go, if it is not+-- in the tree.+-- In the case of an 'Above' layout with the same SrcSpan below,+-- return that instead+openZipperToSpanDeep+  :: ForestSpan+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+openZipperToSpanDeep sspan z = zf+  where+    z' = openZipperToSpan sspan z++    zf = case Z.tree z' of+           (Node (Entry _ (Above _ _ _ _) _) _) ->+                case getChildrenAsZ z' of+                  []  -> z'+                  [x] -> if (treeStartEnd (Z.tree x) == sspan) then x else z'+                  _   -> z'+           _ -> z'+++-- ---------------------------------------------------------------------++-- |Open a zipper to a SrcSpan that has been added in the tree, and+-- thus does not necessarily fall in the logical hierarchy of the tree+openZipperToSpanAdded+  :: ForestSpan+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+openZipperToSpanAdded sspan z = zf+  where+    treeAsList = getTreeSpansAsList $ Z.tree z++    -- True if first span contains the second+    myMatch (((ForestLine _ _ vs1 rs1),cs1),((ForestLine _ _ ve1 re1),ce1))+            (((ForestLine _ _ vs2 rs2),cs2),((ForestLine _ _ ve2 re2),ce2))+      = vs1 == vs2 && ve1 == ve2 && ((rs1,cs1) <= (rs2,cs2)) && ((re1,ce1) >= (re2,ce2))+    tl2 = dropWhile (\(_,s) -> not (myMatch s sspan)) $ reverse treeAsList++    fff [] _ = []+    fff acc@((cd,_cs):_) (v,sspan') = if v < cd then (v,sspan'):acc+                                               else acc++    tl3 = foldl' fff [(head tl2)] tl2+    -- tl3 now contains the chain of ForestSpans to open in order in the zipper++    zf = foldl' (flip openZipperToSpanOrig) z $ map snd tl3++-- ---------------------------------------------------------------------++getTreeSpansAsList :: Tree (Entry PosToken) -> [(Int,ForestSpan)]+getTreeSpansAsList = getTreeSpansAsList' 0++getTreeSpansAsList' :: Int -> Tree (Entry PosToken) -> [(Int,ForestSpan)]+getTreeSpansAsList' level (Node (Deleted sspan  _pg _eg )  _  )   = [(level,sspan)]+getTreeSpansAsList' level (Node (Entry sspan _lay _toks) ts0) = (level,sspan)+                       : (concatMap (getTreeSpansAsList' (level + 1)) ts0)+++-- ---------------------------------------------------------------------++-- |Split a forest of trees into a (begin,middle,end) according to a+-- ForestSpan, such that no tokens are included in begin or end belonging+-- to the ForestSpan, and all of middle has some part of the ForestSpan+splitForestOnSpan :: Forest (Entry PosToken) -> ForestSpan+                  -> ([Tree (Entry PosToken)],[Tree (Entry PosToken)],[Tree (Entry PosToken)])+splitForestOnSpan forest sspan = (beginTrees,middleTrees,endTrees)+  where+    (spanStart,spanEnd) = sspan++    (beginTrees,rest)      = break (\t -> not $ inBeginTrees t) forest+    (middleTrees,endTrees) = break (\t ->       inEndTrees t) rest++    inBeginTrees tree = spanStart >= treeEnd+      where+        (_treeStart,treeEnd) = treeStartEnd tree++    inEndTrees tree = spanEnd <= treeStart+      where+        (treeStart,_treeEnd) = treeStartEnd tree++++++-}

@@ -38,6 +38,7 @@   , addOffsetToToks   , ghcLineToForestLine   , forestLineToGhcLine+  , forestLenChangedMask    , IsToken(..)   , notWhiteSpace@@ -207,7 +208,8 @@   isComment   :: a -> Bool    -- |Zero-length tokens, as appear in GHC as markers-  isEmpty     :: a -> Bool+  isEmpty      :: a -> Bool+  mkZeroToken  :: a    isDo         :: a -> Bool   isElse       :: a -> Bool@@ -220,6 +222,13 @@   tokenToString :: a -> String   -- TODO: may be able to get rid of next due to former   showTokenStream :: [a] -> String++  -- |Mark a token so that it can be use to trigger layout checking+  -- later when the toks are retrieved+  markToken :: a -> a+  isMarked  :: a -> Bool++  -- derived functions isWhiteSpace :: (IsToken a) => a -> Bool

@@ -22,6 +22,7 @@   , placeAbove   , allocList   , strip+  , startEndLocIncComments'    -- * SrcSpan to ForestSpan conversions   , sf@@ -42,12 +43,14 @@   , forestPosLenChanged   , treeIdIntoForestSpan   , spanContains+  -- , insertForestLineInSpan   , insertVersionsInForestSpan   , insertLenChangedInForestSpan    -- * Spans   , spanStartEnd   , combineSpans+  , nonCommentSpan    -- * drawing the various trees   , drawTreeEntry@@ -56,6 +59,9 @@   , drawTreeCompact   , drawTreeWithToks   , showForestSpan+  , drawTokenCache+  , drawTokenCacheDetailed+  , divideComments   ) where  import Control.Exception@@ -66,6 +72,7 @@ -- import Language.Haskell.TokenUtils.Layout -- import Language.Haskell.TokenUtils.TokenUtils import Language.Haskell.TokenUtils.Types+import qualified Data.Map as Map  -- --------------------------------------------------------------------- @@ -167,6 +174,16 @@  -- --------------------------------------------------------------------- +-- | Get the start&end location of t in the token stream, then extend+-- the start and end location to cover the preceding and following+-- comments.+--+{-+-- In this routine, 'then','else','do' and 'in' are treated as comments.+startEndLocIncComments::(SYB.Data t) => [PosToken] -> t -> (SimpPos,SimpPos)+startEndLocIncComments toks t = startEndLocIncComments' toks (getStartEndLoc t)+-}+ startEndLocIncComments' :: (IsToken a) => [a] -> (SimpPos,SimpPos) -> (SimpPos,SimpPos) startEndLocIncComments' toks (startLoc,endLoc) =   let@@ -371,6 +388,18 @@         (nodeStart,nodeEnd) = insertVersionsInForestSpan nvs nvs span2  -- ---------------------------------------------------------------------+{-+-- | Replace any ForestLine flags already in a Span with the given ones+insertForestLineInSpan :: ForestLine -> Span -> Span+insertForestLineInSpan fl@(ForestLine ch tr v _l) ss = ss'+  where+    Span (lineStart,sc) (_,ec) = ss+    -- lineStart = forestLineToGhcLine fl+    (_,(ForestLine _ _ _ le,_)) = srcSpanToForestSpan ss+    lineEnd   = forestLineToGhcLine (ForestLine ch tr v le)+    ss' = Span (lineStart,sc) (lineEnd,ec)+-}+-- ---------------------------------------------------------------------  insertVersionsInForestSpan :: Int -> Int -> ForestSpan -> ForestSpan insertVersionsInForestSpan vsNew veNew ((ForestLine chs trs _vs ls,cs),(ForestLine che tre _ve le,ce))@@ -414,6 +443,22 @@  -- --------------------------------------------------------------------- +-- |Extract the start and end position of a span, without any leading+-- or trailing comments+nonCommentSpan :: (IsToken a) => [a] -> (SimpPos,SimpPos)+nonCommentSpan [] = ((0,0),(0,0))+nonCommentSpan toks = (startPos,endPos)+  where+    stripped = dropWhile isIgnoredNonComment $ toks+    (startPos,endPos) = case stripped of+      [] -> ((0,0),(0,0))+      _ -> (tokenPos startTok,tokenPosEnd endTok)+       where+        startTok = ghead "nonCommentSpan.1" $ dropWhile isIgnoredNonComment $ toks+        endTok   = ghead "nonCommentSpan.2" $ dropWhile isIgnoredNonComment $ reverse toks++-- ---------------------------------------------------------------------+ -- | ForestSpan version of GHC combineSrcSpans combineSpans :: ForestSpan -> ForestSpan -> ForestSpan combineSpans fs1 fs2 = fs'@@ -536,5 +581,28 @@  showLevel :: Int -> String showLevel level = take level (repeat ' ')++-- ---------------------------------------------------------------------++-- |Call drawTreeEntry on the entire token cache+drawTokenCache :: (IsToken a) => TokenCache a -> String+drawTokenCache tk = Map.foldlWithKey' doOne "" (tkCache tk)+  where+    doOne :: String -> TreeId -> Tree (Entry a) -> String+    doOne s key val = s ++ "tree " ++ (show key) ++ ":\n"+                        ++ (drawTreeEntry val)++-- ---------------------------------------------------------------------++-- |Call drawTreeEntry on the entire token cache+drawTokenCacheDetailed :: (IsToken a) => TokenCache a -> String+drawTokenCacheDetailed tk = Map.foldlWithKey' doOne "" (tkCache tk)+  where+    doOne :: (IsToken a) => String -> TreeId -> Tree (Entry a) -> String+    doOne s key val = s ++ "tree " ++ (show key) ++ ":\n"+                        ++ (show val)++-- ---------------------------------------------------------------------+