HaRe 0.7.2.3 → 0.7.2.4

raw patch · 17 files changed

+555/−3181 lines, 17 filesdep +haskell-token-utilsdep ~HUnitdep ~HaRedep ~ghc-pathsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: haskell-token-utils

Dependency ranges changed: HUnit, HaRe, ghc-paths

API changes (from Hackage documentation)

Files

• ChangeLog +3/−0
• HaRe.cabal +24/−8
• LICENSE +5/−5
• src/Language/Haskell/Refact/API.hs +11/−7
• src/Language/Haskell/Refact/HaRe.hs +2/−1
• src/Language/Haskell/Refact/Refactoring/MoveDef.hs +6/−6
• src/Language/Haskell/Refact/Utils/DualTree.hs +0/−575
• src/Language/Haskell/Refact/Utils/Layout.hs +0/−2053
• src/Language/Haskell/Refact/Utils/LayoutTypes.hs +0/−28
• src/Language/Haskell/Refact/Utils/LocUtils.hs +54/−96
• src/Language/Haskell/Refact/Utils/Monad.hs +5/−4
• src/Language/Haskell/Refact/Utils/MonadFunctions.hs +31/−28
• src/Language/Haskell/Refact/Utils/TokenUtils.hs +369/−345
• src/Language/Haskell/Refact/Utils/TokenUtilsTypes.hs +23/−14
• src/Language/Haskell/Refact/Utils/TypeSyn.hs +9/−3
• src/Language/Haskell/Refact/Utils/TypeUtils.hs +7/−4
• src/Language/Haskell/Refact/Utils/Utils.hs +6/−4

@@ -1,3 +1,6 @@+2014-07-03 v0.7.2.4+	Re-architect to split out haskell-token-utils as a separate+	package, usable with haskell-src-exts too 2014-05-02 v0.7.2.3 	* Update for ghc-mod 4.1.0 2014-04-03 v0.7.2.2

@@ -1,5 +1,5 @@ Name:                           HaRe-Version:                        0.7.2.3+Version:                        0.7.2.4 Author:                         Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer:                     Alan Zimmerman Stability:                      Alpha@@ -66,6 +66,8 @@                                 , Strafunski-StrategyLib                                 , syz +                                , haskell-token-utils+         GHC-Options:             -Wall          Hs-Source-Dirs:         src@@ -78,13 +80,10 @@            , Language.Haskell.Refact.Refactoring.MoveDef            , Language.Haskell.Refact.Refactoring.Renaming            , Language.Haskell.Refact.Refactoring.SwapArgs-           , Language.Haskell.Refact.Utils.DualTree            , Language.Haskell.Refact.Utils.GhcBugWorkArounds            , Language.Haskell.Refact.Utils.GhcModuleGraph            , Language.Haskell.Refact.Utils.GhcUtils            , Language.Haskell.Refact.Utils.GhcVersionSpecific-           , Language.Haskell.Refact.Utils.Layout-           , Language.Haskell.Refact.Utils.LayoutTypes            , Language.Haskell.Refact.Utils.LocUtils            , Language.Haskell.Refact.Utils.Monad            , Language.Haskell.Refact.Utils.MonadFunctions@@ -131,7 +130,8 @@                                 , hslogger                                 , Strafunski-StrategyLib                                 , syz-                                , HaRe >= 0.7.1.6+                                , haskell-token-utils+                                , HaRe >= 0.7.2.3         Extensions:      CPP  @@ -154,7 +154,8 @@   build-depends:       base        >= 4.0  && < 4.7     , Diff >= 0.3.0-    , HUnit       == 1.2.*+    -- , HUnit       == 1.2.*+    , HUnit     , QuickCheck  >= 2.5     , containers @@ -166,7 +167,8 @@     , directory     , filepath     , ghc         >= 7.0.1 && < 7.8-    , ghc-paths   == 0.1.*+    -- , ghc-paths   == 0.1.*+    , ghc-paths     , ghc-prim     , ghc-syb-utils     , ghc-mod >= 4.1.0@@ -183,8 +185,22 @@     , hslogger     , Strafunski-StrategyLib     , syz-    , HaRe >= 0.7.1.6+    , haskell-token-utils+    , HaRe >= 0.7.2.3   Extensions:      CPP+++-- test-suite doctests+--   type:          exitcode-stdio-1.0+--   ghc-options:   -threaded+--   main-is:       doctests.hs+--   build-depends: base        >= 4.0  && < 4.7+--                , doctest >= 0.8+--                , ghc-mod+--   Hs-Source-Dirs:+--     -- src+--     test+  source-repository head   type:     git

@@ -1,5 +1,5 @@-Copyright (c) 2003, OGI School of Science & Engineering, Oregon-Health & Science University, All rights reserved.+Copyright (c) 2014, University of Kent and contributors listed in+README.markdown, in this directory. All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following@@ -13,9 +13,9 @@   disclaimer in the documentation and/or other materials provided   with the distribution. -- Neither the name of OGI or OHSU nor the names of its-  contributors may be used to endorse or promote products derived-  from this software without specific prior written permission.+- Neither the name of the copyright holder nor the names of+  its contributors may be used to endorse or promote products+  derived from this software without specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,

@@ -53,7 +53,7 @@         -- ** Conveniences for state access -       , fetchToksFinal+       -- , fetchToksFinal        , fetchLinesFinal        , fetchOrigToks        , fetchToks -- Deprecated@@ -110,7 +110,7 @@                      , SimpPos,unmodified,modified                      , simpPos0                      , nullSrcSpan-                     , showToks+                     -- , showToks                      , whiteSpaceTokens                      , realSrcLocFromTok                      , isWhite@@ -175,7 +175,7 @@                      , fileNameFromTok                      , splitToks                      , emptyList, nonEmptyList-                     , divideComments+                     -- , divideComments                      , notWhiteSpace                      , isDoubleColon                      , isEmpty@@ -190,8 +190,8 @@                      , splitOnNewLn                      , tokenLen                      , newLnToken-                     , newLinesToken-                     , monotonicLineToks+                     -- , newLinesToken+                     -- , monotonicLineToks                      , reSequenceToks                      , mkToken                      , mkZeroToken@@ -203,7 +203,7 @@   -- * from `Language.Haskell.Refact.Utils.TypeSyn`     , InScopes-    , PosToken(..)+    , PosToken     , ghead     , glast     , gtail@@ -372,7 +372,7 @@  -- * from `Language.Haskell.Refact.Utils.TokenUtils`  , Positioning(..)  , reIndentToks- , srcSpanToForestSpan+ , ghcSrcSpanToForestSpan  ) where  import Language.Haskell.Refact.Utils.GhcUtils@@ -385,3 +385,7 @@ import Language.Haskell.Refact.Utils.TypeUtils import Language.Haskell.Refact.Utils.Utils +import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Utils+-- import Language.Haskell.TokenUtils.GHC.Layout

@@ -25,4 +25,5 @@ import Language.Haskell.Refact.Refactoring.Renaming import Language.Haskell.Refact.Refactoring.SwapArgs import Language.Haskell.Refact.Utils.Monad-import Language.Haskell.Refact.Utils.TypeSyn+import Language.Haskell.TokenUtils.Types+

@@ -335,7 +335,7 @@                          return sigToks    maybeToksSigMulti <- mapM getToksForMaybeSig-                       $ sortBy (\(GHC.L s1 _) (GHC.L s2 _) -> compare (srcSpanToForestSpan s1) (srcSpanToForestSpan s2))+                       $ sortBy (\(GHC.L s1 _) (GHC.L s2 _) -> compare (ghcSrcSpanToForestSpan s1) (ghcSrcSpanToForestSpan s2))                           sigsRemoved   let maybeToksSig = concat maybeToksSigMulti @@ -820,7 +820,7 @@   logm $ "addParamsToSigs:replaceSpan=" ++ showGhc replaceSpan   logm $ "addParamsToSigs:newStr=[" ++ newStr ++ "]"   newToks <- liftIO $ basicTokenise newStr-  putToksForSpan replaceSpan newToks+  void $ putToksForSpan replaceSpan newToks   let typ' = foldl addOneType ltyp ts   sigOk <- isNewSignatureOk ts   logm $ "addParamsToSigs:(sigOk,newStr)=" ++ show (sigOk,newStr)@@ -878,9 +878,9 @@ typeToHsType (GHC.FunTy t1 t2) = GHC.HsFunTy (GHC.noLoc $ typeToHsType t1)                                              (GHC.noLoc $ typeToHsType t2) #if __GLASGOW_HASKELL__ > 704-typeToHsType (GHC.ForAllTy v t) = GHC.HsForAllTy GHC.Explicit (GHC.HsQTvs [] []) (GHC.noLoc []) (GHC.noLoc $ typeToHsType t)+typeToHsType (GHC.ForAllTy _v t) = GHC.HsForAllTy GHC.Explicit (GHC.HsQTvs [] []) (GHC.noLoc []) (GHC.noLoc $ typeToHsType t) #else-typeToHsType (GHC.ForAllTy v t) = GHC.HsForAllTy GHC.Explicit [] (GHC.noLoc []) (GHC.noLoc $ typeToHsType t)+typeToHsType (GHC.ForAllTy _v t) = GHC.HsForAllTy GHC.Explicit [] (GHC.noLoc []) (GHC.noLoc $ typeToHsType t) #endif  #if __GLASGOW_HASKELL__ > 704@@ -932,7 +932,7 @@ -}  tyConAppToHsType :: GHC.Type -> GHC.HsType GHC.Name-tyConAppToHsType t@(GHC.TyConApp tc _ts)+tyConAppToHsType (GHC.TyConApp tc _ts)   | GHC.isFunTyCon tc = r "isFunTyCon"   | GHC.isAlgTyCon tc = r "isAlgTyCon"   | GHC.isTupleTyCon tc = r "isTupleTyCon"@@ -947,7 +947,7 @@ #if __GLASGOW_HASKELL__ > 704     r str = GHC.HsTyLit (GHC.HsStrTy $ GHC.mkFastString str) #else-    r str = error $ "tyConAppToHsType: " ++ str ++ " unexpected:" ++ (SYB.showData SYB.TypeChecker 0 t)+    r str = error $ "tyConAppToHsType: " ++ str ++ " unexpected:" ++ (SYB.showData SYB.TypeChecker 0 r) #endif  tyConAppToHsType t@(GHC.TyConApp _tc _ts)

@@ -1,575 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Language.Haskell.Refact.Utils.DualTree (-    layoutTreeToSourceTree-  , retrieveLinesFromLayoutTree-  , retrieveLines-  , renderLines-  , renderSourceTree-  , SourceTree-  , Line(..)-  , Source(..)-  , renderLinesFromLayoutTree-  ) where--import qualified GHC        as GHC-import qualified Outputable as GHC--import Control.Monad.State-import qualified Data.Tree as T--import Language.Haskell.Refact.Utils.LayoutTypes-import Language.Haskell.Refact.Utils.LocUtils-import Language.Haskell.Refact.Utils.TokenUtils-import Language.Haskell.Refact.Utils.TokenUtilsTypes-import Language.Haskell.Refact.Utils.TypeSyn---- -----------import Data.Tree.DUAL-import Data.Semigroup-import Data.Monoid.Action-import qualified Data.List.NonEmpty as NE-import qualified Data.Tree.DUAL.Internal as I---- -----------------------------------------------------------------------data DeletedSpan = DeletedSpan Span RowOffset SimpPos-              deriving (Show,Eq)---- TODO: We are not actually using any of these-data Transformation = TAbove ColOffset EndOffset (Row,Col) (Row,Col) EndOffset-                    deriving Show--{--transform :: Transformation -> Prim -> Prim-transform AsIs p = p-transform (T _n)                       (PToks s) = (PToks s)-transform (TAbove _co _bo _p1 _p2 _eo) (PToks s) = (PToks s)-transform (TDeleted _sspan _ro _p)     (PToks s) = (PToks s)-transform TAdded                       (PToks s) = (PToks s)--}---- | The value that bubbles up. This is the Span occupied by the--- subtree, together with a string representation of the subtree. The--- origin of the string is the start of the span.--data Up = Up Span Alignment (NE.NonEmpty Line) [DeletedSpan]-        | UDeleted [DeletedSpan]-        deriving Show--data Span = Span (Row,Col) (Row,Col)-          deriving (Show,Eq)--data Line = Line Row Col RowOffset Source LineOpt [PosToken]--data Alignment = ANone | AVertical-               deriving (Show,Eq)--instance Show Line where-  show (Line r c o f s toks) = "(" ++ show r ++ " " ++ show c ++ " " ++ show o-          ++ " " ++ show f-          ++ " " ++ show s ++ "\"" ++ GHC.showRichTokenStream toks ++ "\")"--data Source = SOriginal-            | SAdded-            | SWasAdded-            deriving (Show,Eq)--data LineOpt = ONone-             -- | This line needs to be grouped with the next in terms-             -- of layout, so any column offsets need to be propagated-             | OGroup-             deriving (Show,Eq)--data Annot = Ann String-           | ADeleted ForestSpan RowOffset SimpPos-           | ASubtree ForestSpan-           deriving Show--data Prim = PToks [PosToken]-          | PDeleted ForestSpan RowOffset SimpPos-          deriving Show---- | The main data structure for this module-type SourceTree = DUALTree Transformation Up Annot Prim---instance Semigroup Span where-  (Span p1 _p2) <> (Span _q1 q2) = (Span p1 q2)--instance Semigroup Up where-  u1 <> u2 = combineUps u1 u2---instance Semigroup Transformation where- (TAbove co1 bo1 p11 _p21 _eo1) <> (TAbove _co2 _bo2 _p12 p22 eo2)-    =  (TAbove co1 bo1 p11 p22 eo2)---instance (Action Transformation Up) where-  act (TAbove _co _bo _p1 _p2 _eo) (Up sspan _a s ds) = (Up sspan a' s' ds)-    where-      a' = AVertical-      s' = NE.map (\(Line r c o ss _f toks) -> (Line r c o ss OGroup toks)) s--  act (TAbove _co _bo _p1 _p2 _eo) (UDeleted ds) = UDeleted ds---- -----------------------------------------------------------------------instance GHC.Outputable SourceTree where-  ppr (I.DUALTree ot)-      = case getOption ot of-             Nothing -> GHC.text "Nothing"-             Just t  -> GHC.ppr t--instance GHC.Outputable (I.DUALTreeU Transformation Up Annot Prim) where-  ppr (I.DUALTreeU (u,t)) = GHC.parens $ GHC.ppr u GHC.<> GHC.comma GHC.$$ GHC.ppr t--instance GHC.Outputable (I.DUALTreeNE Transformation Up Annot Prim) where-  ppr (I.Leaf u l)   = GHC.parens $ GHC.hang (GHC.text "Leaf")   1 (GHC.ppr u GHC.$$ GHC.ppr l)-  ppr (I.LeafU u)    = GHC.parens $ GHC.hang (GHC.text "LeafU")  1 (GHC.ppr u)-  ppr (I.Concat dts) = GHC.parens $ GHC.hang (GHC.text "Concat") 1 (GHC.ppr dts)-  ppr (I.Act d t)    = GHC.parens $ GHC.hang (GHC.text "Act")    1 (GHC.ppr d GHC.$$ GHC.ppr t)-  ppr (I.Annot a t)  = GHC.parens $ GHC.hang (GHC.text "Annot")  1 (GHC.ppr a GHC.$$ GHC.ppr t)--instance GHC.Outputable Prim where-  ppr (PToks toks) = GHC.parens $ GHC.text "PToks" GHC.<+> GHC.text (show toks)-  ppr (PDeleted ss pg p) = GHC.parens $ GHC.text "PDeleted" GHC.<+> GHC.ppr ss-                               GHC.<+> GHC.ppr pg GHC.<+> GHC.ppr p--instance GHC.Outputable Transformation where-  ppr (TAbove co bo p1 p2 eo)  = GHC.parens $ GHC.text "TAbove" GHC.<+> GHC.ppr co-                              GHC.<+> GHC.ppr bo-                              GHC.<+> GHC.ppr p1  GHC.<+> GHC.ppr p2-                              GHC.<+> GHC.ppr eo--instance GHC.Outputable EndOffset where-  ppr None = GHC.text "None"-  ppr (SameLine co)     = GHC.parens $ GHC.text "SameLine" GHC.<+> GHC.ppr co-  ppr (FromAlignCol rc) = GHC.parens $ GHC.text "FromAlignCol" GHC.<+> GHC.ppr rc--instance GHC.Outputable Annot where-  ppr (Ann str) = GHC.parens $ GHC.text "Ann" GHC.<+> GHC.text str-  ppr (ADeleted ss pg p) = GHC.parens $ GHC.text "ADeleted" GHC.<+> GHC.ppr ss-                           GHC.<+> GHC.ppr pg GHC.<+> GHC.ppr p-  ppr (ASubtree ss)      = GHC.parens $ GHC.text "ASubtree" GHC.<+> GHC.ppr ss--instance GHC.Outputable Up where-  ppr (Up ss a ls ds) = GHC.parens $ GHC.hang (GHC.text "Up") 1-                                 ((GHC.ppr ss GHC.<+> GHC.ppr a) GHC.$$ GHC.ppr ls GHC.$$ GHC.ppr ds)-  ppr (UDeleted d)  = GHC.parens $ GHC.text "UDeleted" GHC.<+> GHC.ppr d--instance GHC.Outputable Alignment where-  ppr ANone     = GHC.text "ANone"-  ppr AVertical = GHC.text "AVertical"--instance GHC.Outputable DeletedSpan where-  ppr (DeletedSpan ss ro p) = GHC.parens $ (GHC.text "DeletedSpan")-                               GHC.<+> GHC.ppr ss GHC.<+> GHC.ppr ro-                               GHC.<+> GHC.ppr p---instance GHC.Outputable Span where-  ppr (Span sp ep) = GHC.parens $ GHC.text "Span" GHC.<+> GHC.ppr sp GHC.<+> GHC.ppr ep--instance (GHC.Outputable a) => GHC.Outputable (NE.NonEmpty a) where-  -- ppr (x NE.:| xs) = GHC.parens $ GHC.hang (GHC.text "NonEmpty") 1 (GHC.ppr (x:xs))-  ppr (x NE.:| xs) = (GHC.ppr (x:xs))--instance GHC.Outputable Line where-  ppr (Line r c o s f str) = GHC.parens $ GHC.text "Line" GHC.<+> GHC.ppr r-                         GHC.<+> GHC.ppr c GHC.<+> GHC.ppr o-                         GHC.<+> GHC.ppr s GHC.<+> GHC.ppr f-                         GHC.<+> GHC.text ("\"" ++ (GHC.showRichTokenStream str) ++ "\"")-                         -- GHC.<+> GHC.text (show str) -- ++AZ++ debug--instance GHC.Outputable Source where-  ppr SOriginal = GHC.text "SOriginal"-  ppr SAdded    = GHC.text "SAdded"-  ppr SWasAdded = GHC.text "SWasAdded"--instance GHC.Outputable LineOpt where-  ppr ONone  = GHC.text "ONone"-  ppr OGroup = GHC.text "OGroup"---- -----------------------------------------------------------------------renderLinesFromLayoutTree :: LayoutTree -> String-renderLinesFromLayoutTree = renderLines . retrieveLinesFromLayoutTree---- -----------------------------------------------------------------------retrieveLinesFromLayoutTree :: LayoutTree -> [Line]-retrieveLinesFromLayoutTree = retrieveLines . layoutTreeToSourceTree---- -----------------------------------------------------------------------retrieveLines :: SourceTree -> [Line]-retrieveLines srcTree-  = case getU srcTree of-         Nothing -> []-         Just (Up _ss _a str _ds) -> NE.toList str-         Just (UDeleted _) -> []---- -----------------------------------------------------------------------renderSourceTree :: SourceTree -> String-renderSourceTree srcTree = r-  where-    r = case getU srcTree of-         Nothing -> ""-         Just (Up _ss _a str _ds) -> renderLines $ NE.toList str-         Just (UDeleted _) -> ""---- -----------------------------------------------------------------------renderLines :: [Line] -> String-renderLines ls = res-  where-    (_,(_,res)) = runState (go 0 ls) ((1,1),"")--    go _ [] = do return ()-    go ci ((Line r c _o _f _s str):ls') = do-      newPos r (c+ci)-      addString (GHC.showRichTokenStream str)-      go ci ls'--    -- State operations ------------------    getRC = do-      (rc,_) <- get-      return rc--    putRC (r,c) = do-      (_,str) <- get-      put ((r,c),str)--    newPos newRow newCol = do-      (oldRow',oldCol) <- getRC--      -- Allow for out of order additions that result from additions-      -- to the tree. Will break the invariant.-      let oldRow = if oldRow' <= newRow then oldRow' else (newRow - 1)-      putRC (oldRow,oldCol)--      if oldRow == newRow-        then addString (take (newCol - oldCol) $ repeat ' ')-        else-          addString ( (take (newRow - oldRow) $ repeat '\n') ++-                      (take (newCol - 1) $ repeat ' ') )--    addString [] = return ()-    addString str = do-      ((r,c),curr) <- get-      let ll = (length $ filter (=='\n') str)-      let c'' = (length $ takeWhile (/='\n') $ reverse str)---      let (r',c') = case ll of-                     0 -> (r,c + c'')-                     _ -> (r + ll, c'' + 1)-      put ((r',c'),curr++str)--      -- checkInvariant $ "addString" ++ show str--    addDebugString str = do-      ((r,c),curr) <- get-      put ((r,c),curr++str)---- -----------------------------------------------------------------------layoutTreeToSourceTree :: LayoutTree -> SourceTree---- TODO: simplify by getting rid of PDeleted, and use leafU-layoutTreeToSourceTree (T.Node (Deleted sspan  pg eg) _)-  = leaf (UDeleted [(DeletedSpan (fs2s sspan) pg eg)]) (PDeleted sspan pg eg)--layoutTreeToSourceTree (T.Node (Entry sspan NoChange [])  ts0)-  = annot (ASubtree sspan) (mconcatl $ map layoutTreeToSourceTree ts0)----  TODO: only apply TAbove if the subs go on to the next line-layoutTreeToSourceTree (T.Node (Entry sspan (Above bo p1 p2 eo) [])  ts0)-  = case (numLines ts0) of-     0 -> annot (ASubtree sspan) (mconcatl $ map layoutTreeToSourceTree ts0)-     _ -> annot (ASubtree sspan)-           (applyD (TAbove co bo p1 p2 eo) subs)-  where-    subs = (mconcatl $ map layoutTreeToSourceTree ts0)-    co = 0-    numLines :: [T.Tree Entry] -> Int-    numLines [] = 0-    numLines sts = l - f-      where-        ((f,_),_    ) = forestSpanToSimpPos $ treeStartEnd $ head sts-        (_    ,(l,_)) = forestSpanToSimpPos $ treeStartEnd $ last sts--layoutTreeToSourceTree (T.Node (Entry sspan _lay toks) _ts) = leaf (mkUp sspan toks) (PToks toks)---- ----------------------------------------- We use the foldl version to get a more bushy tree, else the ppr of--- it is very hard to follow-mconcatl :: (Monoid a) => [a] -> a-mconcatl = foldl mappend mempty---- -----------------------------------------------------------------------fs2s :: ForestSpan -> Span-fs2s ss = Span sp ep-  where-    (sp,ep) = forestSpanToSimpPos ss---- -----------------------------------------------------------------------mkUp :: ForestSpan -> [PosToken] -> Up-mkUp sspan toks = Up ss a ls []-  where-    a = ANone-    s = if forestSpanVersionSet sspan then SAdded else SOriginal-    ss = mkSpan sspan-    -- toksByLine = groupTokensByLine $ reAlignMarked toks-    toksByLine = groupTokensByLine toks--    ls = NE.fromList $ concatMap (mkLinesFromToks s) toksByLine---- ------------------------------------------------------------------------- TODO: What if the toks comprise multiple lines, e.g. in a block comment?-mkLinesFromToks :: Source -> [PosToken] -> [Line]-mkLinesFromToks _ [] = []-mkLinesFromToks s toks = [Line ro co 0 s f toks']-  where-    f = ONone-    ro' = tokenRow $ head toks-    co' = tokenCol $ head toks-    (ro,co) = srcPosToSimpPos (tokenRow $ head toks, tokenCol $ head toks)-    toks' = addOffsetToToks (-ro',-co') toks---- ------------------------------------------------------------------------- | Combine the 'U' annotations as they propagate from the leafs to--- be cached at the root of the tree. This is the heart of the--- DualTree functionality-combineUps :: Up -> Up -> Up-combineUps (UDeleted d1) (UDeleted d2)  = UDeleted (d1 <> d2)--combineUps (UDeleted d1) (Up sp2 a2 l2 d2) = (Up sp2 a2 l (d1 <> d2))-  where-    l = adjustForDeleted d1 l2--combineUps (Up sp1 a1 l1 d1) (UDeleted d2) = (Up sp1 a1 l1 (d1 <> d2))--combineUps (Up sp1 _a1 l1 d1) (Up sp2 _a2 l2 d2) = (Up (sp1 <> sp2) a l (d1 <> d2))-  where-    a = ANone--    l2' = adjustForDeleted d1 l2--    (Line _ _ o2 _ _ _) = NE.head l2'-    --         1    0-    l2'' = if o1 == o2-            then l2'-            else NE.fromList $ map (\(Line r c f aa ff s) -> (Line (r + (o1-f)) c (o1-f) aa ff s)) (NE.toList l2')--    (Line r1 c1  o1 ss1 ff1 s1) = NE.last l1-    (Line r2 c2 _o2 ss2 ff2 s2) = NE.head l2''--    l = if r1 == r2-         then NE.fromList $ (NE.init l1) ++ m ++ ll-         else NE.fromList $ (NE.toList l1) ++ rest--    s2' = addOffsetToToks (0,c2 - c1) s2--    s1' = s1 ++ s2'-    ff' = if ff1 == OGroup || ff2 == OGroup then OGroup else ONone-    m' = [Line r1 c1 o1 ss1 ff' s1']--    -- 'o' takes account of any length change due to tokens being-    --     replaced by others of different length-    odiff = sum $ map (\t@(_,s) -> (length s) - (tokenColEnd t - tokenCol t)) $ filter (not.isComment) s1--    st1 = GHC.showRichTokenStream s1-    st2 = GHC.showRichTokenStream (s1 ++ s2')-    st3 = drop (length st1) st2-    st4 = takeWhile (==' ') st3-    oo = length (st1++st4)-    coo = c1 + oo-    o = coo - c2--    (m,ll) = if (ss1 /= ss2) && (length s1 == 1 && (tokenLen $ head s1) == 0)-          then ([NE.last l1],map (\(Line r c f aa ff s) -> (Line (r+1) (c + o) (f+1) aa ff s)) (NE.toList l2''))-          else if ff' == OGroup-                 then (m',addOffsetToGroup o (NE.tail l2''))-                 else (m',                   (NE.tail l2''))--    -- rest = if ff2 == OGroup-    rest = if ff2 == OGroup && ff1 == OGroup-            then addOffsetToGroup odiff (NE.toList l2'')-            else NE.toList l2''--    addOffsetToGroup _off [] = []-    addOffsetToGroup _off (ls@((Line _r _c _f _aa ONone _s):_)) = ls-    addOffsetToGroup  off ((Line r c f aa OGroup s):ls)-               = (Line r (c+off) f aa OGroup s) : addOffsetToGroup off ls--{----((((36,23),(41,25)),ITblockComment \" ++AZ++ : hsBinds does not re--(Up-   (Span (31, 23) (34,-                   72)) ANone-   [(Line 31 23 0 SOriginal ONone \"-- renamed <- getRefactRenamed\"),-    (Line 32 23 0 SOriginal OGroup \"let renamed = undefined\"),-    (Line 33 23 0 SOriginal OGroup \"let declsr = hsBinds renamed\"),-    (Line 34 23 0 SOriginal OGroup \"let (before,parent,after) = divideDecls declsr pn\"),-    (Line 35 23 0 SOriginal OGroup \"-- error (\"liftToMod:(before,parent,after)=\" ++ (showGhc (before,parent,after))) -- ++AZ++\"),-    (Line 36 23 0 SOriginal OGroup \"{- ++AZ++ : hsBinds does not return class or instance definitions-                      when (isClassDecl $ ghead \"liftToMod\" parent)-                            $ error \"Sorry, the refactorer cannot lift a definition from a class declaration!\"-                      when (isInstDecl $ ghead \"liftToMod\" parent)-                            $ error \"Sorry, the refactorer cannot lift a definition from an instance declaration!\"-                      -}\")]-    [])----------------------------(Up-    (Span (42, 23) (43,-                    79)) ANone-    [(Line 42 23 0 SOriginal OGroup \"let liftedDecls = definingDeclsNames [n] parent True True\"),-     (Line 43 27 0 SOriginal OGroup \"declaredPns = nub $ concatMap definedPNs liftedDecls\")]-    [])--}-{---(Line-r1 = 10-c1 = 3-o1 = 0-ss1 = SOriginal-ff1 = ONone-s1 = \"g2 <- getCurrentModuleGraph\")--(Line-r2 = 11-c2 = 3-o2 = 0-ss2 = SOriginal-ff2 = OGroup-s2 = \"let scc = topSortModuleGraph False g2 Nothing\")------(Up-   (Span (9, 3) (11, 47)) ANone-   [(Line 9 3 0 SOriginal ONone \"-- g <- GHC.getModuleGraph\"),-    (Line 10 3 0 SOriginal ONone \"g2 <- getCurrentModuleGraph\"),-    (Line 11 4 0 SOriginal OGroup \"let scc = topSortModuleGraph False g2 Nothing\")]-   [])-----------------------------Up1-(Up-  (Span (9, 3) (10, 29)) ANone-  [(Line 9 3 0 SOriginal ONone \"-- g <- GHC.getModuleGraph\"),-   (Line 10 3 0 SOriginal ONone \"g2 <- getCurrentModuleGraph\")]-  [])--Up2-(Up-  (Span (11, 3) (11, 47)) ANone-  [(Line 11 3 0 SOriginal OGroup \"let scc = topSortModuleGraph False g2 Nothing\")]-  [])---}--{---((o,st1,st3)=(0,"x y= sq x + sq y where"," sq x= x^pow"))--(Line-r1 = 7-c1 = 12-o1 = 0-ss1 = SOriginal-ff1 = ONone-s1 = \"x y= square x + square y where\")--(Line-r2 = 7-c2 = 35-o2 = 0-ss2 = SOriginal-ff2 = OGroup-s2 = \"square x= x^pow\")----------------------------(Up-  (Span (7, 12) (9, 40)) ANone-  [(Line 7 12 0 SOriginal OGroup \"x y= square x + square y where square x= x^pow\"),-   (Line 8 -5 0 SOriginal OGroup \"--There is a comment.\"),-   (Line 9 27 0 SOriginal OGroup \"pow=2\")]-  [])----------------Up1-(Up-  (Span (7, 12) (7, 34)) ANone-  [(Line 7 12 0 SOriginal ONone \"x y= square x + square y where\")]-  [])--Up2-(Up-  (Span (7, 35) (9, 40)) AVertical-  [(Line 7 35 0 SOriginal OGroup \"square x= x^pow\"),-   (Line 8 3 0 SOriginal OGroup \"--There is a comment.\"),-   (Line 9 35 0 SOriginal OGroup \"pow=2\")]-  [])----}------ ---------------------------------------adjustForDeleted :: [DeletedSpan] -> NE.NonEmpty Line -> NE.NonEmpty Line-adjustForDeleted d1 l2 = l-  where-    deltaL = calcDelta d1-    l = NE.map go l2--    go (Line r c o SOriginal f str) =  Line (r - deltaL) c  o SOriginal f str-    go (Line r c o SWasAdded f str) =  Line (r - deltaL) c  o SWasAdded f str-    go (Line r c o SAdded    f str) =  Line  r           c  o SWasAdded f str---- ---------------------------------------calcDelta :: [DeletedSpan] -> RowOffset-calcDelta d1 = deltaL-  where-    deltaL = case d1 of-              [] -> 0-              _  -> (-1) + (sum $ map calcDelta' d1)--    calcDelta' :: DeletedSpan -> RowOffset-    calcDelta' (DeletedSpan (Span (rs,_cs) (re,_ce)) pg (rd,_cd)) = r + 1-      where-        ol = re - rs-        eg = rd-        r = (pg + ol + eg) - (max pg eg)----- -----------------------------------------------------------------------mkSpan :: ForestSpan -> Span-mkSpan ss = Span s e-  where-   (s,e) = forestSpanToSimpPos ss---- ---------------------------------------------------------------------

@@ -1,2053 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE StandaloneDeriving   #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- |-----module Language.Haskell.Refact.Utils.Layout (-    initTokenLayout-  , nullTokenLayout-  , allocTokens-  , retrieveTokens-  , getLoc--  -- * For testing-  , addEndOffsets-  ) where--import qualified Bag           as GHC-import qualified ForeignCall   as GHC-import qualified GHC           as GHC--import Outputable--import qualified GHC.SYB.Utils as SYB--import Data.List-import Data.Tree-import Language.Haskell.Refact.Utils.GhcVersionSpecific-import Language.Haskell.Refact.Utils.LayoutTypes-import Language.Haskell.Refact.Utils.LocUtils-import Language.Haskell.Refact.Utils.TokenUtils-import Language.Haskell.Refact.Utils.TokenUtilsTypes-import Language.Haskell.Refact.Utils.TypeSyn---- import qualified Data.Tree.Zipper as Z---- ------------------------------------------------------------------------- | Extract the layout-sensitive parts of the GHC AST.---- The layout keywords are `let`, `where`, `of` and `do`. The--- expressions introduced by them need to be kept indented at the same--- level.--{---AST Items for layout keywords.--(gleaned from Parser.y.pp in the ghc sources)--`let`---@-  HsLet-    HsLet (HsLocalBinds id) (LHsExpr id) :: HsExpr id-              ^^keep aligned--  LetStmt-    LetStmt (HsLocalBindsLR idL idR) :: StmtLR idL idR-                ^^keep aligned-@--`where`--@-  HsModule-    -- not relevant to layout--  ClassDecl :: TyClDecl-    ClassDecl ....--  ClsInstD :: InstDecl-    ClsInstD typ binds sigs [fam_insts]-            ^^the binds, sigs, fam_insts should all align--  GRHSs-    GRHS [LStmt id] (LHsExpr id)-           ^^keep aligned--  TyDecl ::  TyClDecl-    TyDecl name vars defn fvs-                      ^^keep aligned-      [The `where` is in the defn]--  FamInstDecl-    FamInstDecl tycon pats defn fvs-                            ^^keep aligned-      [The `where` is in the defn]-@--`of`--@-  HsCase :: HsExpr-    HsCase (LHsExpr id) (MatchGroup id)-                           ^^keep aligned-@--`do`--@-  DoExpr :: HsExpr-    HsDo (HsStmtContext Name) [LStmt id] PostTcType-                                 ^^keep aligned-@--}---- Pretty print combinators of interest------ ($$) :: Doc -> Doc -> Doc------   Above, except that if the last line of the first argument stops at---   least one position before the first line of the second begins,---   these two lines are overlapped.--------- ($+$) :: Doc -> Doc -> Doc------   Above, with no overlapping.--------- nest :: Int -> Doc -> Doc------   Nest (or indent) a document by a given number of positions---   (which may also be negative)--------- hang :: Doc -> Int -> Doc -> Doc------   hang d1 n d2 = sep [d1, nest n d2]-------- -----------------------------------------------------------------------deriving instance Show Label--instance Outputable (Tree Entry) where-  ppr (Node label subs) = hang (text "Node") 2 (vcat [ppr label,ppr subs])--instance Outputable Entry where-  ppr (Entry sspan lay toks) = text "Entry" <+> ppr sspan <+> ppr lay <+> text (show toks)-  ppr (Deleted sspan pg eg)     = text "Deleted" <+> ppr sspan <+> ppr pg <+> ppr eg--instance Outputable Layout where-  ppr (Above so p1 p2 oe)   = text "Above" <+> ppr so <+> ppr p1 <+> ppr p2 <+> ppr oe-  -- ppr (Offset r c)    = text "Offset" <+> ppr r <+> ppr c-  ppr (NoChange)      = text "NoChange"-  -- ppr (EndOffset r c) = text "EndOffset" <+> ppr r <+> ppr c--instance Outputable PprOrigin where-  ppr Original = text "Original"-  ppr Added    = text "Added"--instance Outputable Ppr where-  ppr (PprText r c o str) = text "PprText" <+> ppr r <+> ppr c <+> ppr o-                        <+> text "\"" <> text str <> text "\""-  ppr (PprAbove so rc erc pps) = hang (text "PprAbove" <+> ppr so <+> ppr rc <+> ppr erc)-                                           2 (ppr pps)-  -- ppr (PprOffset ro co pps)       = hang (text "PprOffset" <+> ppr ro <+> ppr co)-  --                                          2 (ppr pps)-  ppr (PprDeleted ro co lb l la)     = text "PprDeleted" <+> ppr ro <+> ppr co-                                           <+> ppr lb <+> ppr l <+> ppr la-                                         --  <+> ppr n--instance Outputable EndOffset where-  ppr None               = text "None"-  ppr (SameLine co)      = text "SameLine" <+> ppr co-  ppr (FromAlignCol off) = text "FromAlignCol" <+> ppr off---- -----------------------------------------------------------------------initTokenLayout :: GHC.ParsedSource -> [PosToken] -> LayoutTree-initTokenLayout parsed toks = (allocTokens parsed toks)--nullTokenLayout :: TokenLayout--- nullTokenLayout = TL (Leaf nullSrcSpan NoChange [])-nullTokenLayout = TL (Node (Entry (sf nullSrcSpan) NoChange []) [])---- ------------------------------------------------------------------------- TODO: bring in startEndLocIncComments'-allocTokens :: GHC.ParsedSource -> [PosToken] -> LayoutTree-allocTokens (GHC.L _l (GHC.HsModule maybeName maybeExports imports decls _warns _haddocks)) toks = r-  where-    (nameLayout,toks1) =-      case maybeName of-        Nothing -> ([],toks)-        Just (GHC.L ln _modName) -> ((makeLeafFromToks s1) ++ [makeLeaf ln NoChange modNameToks],toks')-          where-            (s1,modNameToks,toks') = splitToksIncComments (ghcSpanStartEnd ln) toks--    (exportLayout,toks2) =-      case maybeExports of-        Nothing -> ([],toks1)-        Just exps -> ((makeLeafFromToks s2) ++ (makeLeafFromToks expToks),toks2')-          where-            (s2,expToks,toks2') = splitToksForList exps toks1--    (importLayout,toks3) =-      case imports of-        [] -> ([],toks2)-        is -> ((makeLeafFromToks s3) ++ (makeLeafFromToks impToks),toks3')-          where-            (s3,impToks,toks3') = splitToksForList is toks2--    (declLayout,toks4) =-      case decls of-        [] -> ([],toks3)-        is -> ((makeLeafFromToks s4) ++ allocDecls is declToks ++ (makeLeafFromToks toks4'),[])-          where-            (s4,declToks,toks4') = splitToksForList is toks3--    r' = makeGroup (strip $ nameLayout ++ exportLayout ++ importLayout ++ declLayout ++ (makeLeafFromToks toks4))-    r = addEndOffsets r' toks---- ------------------------------------------------------------------------addEndOffsets :: LayoutTree -> [PosToken] -> LayoutTree-addEndOffsets tree toks = go tree-  where-    go (t@(Node (Entry _ _ _toks) [])) = t-    go (  (Node (Entry s (Above so p1 (r,c) _eo) []) subs))-        = (Node (Entry s (Above so p1 (r,c) eo') []) (map go subs))-      where-        -- (_,m,_) = splitToksIncComments ((r,c),(99999,1)) toks-        (_,m,_) = splitToks ((r,c),(99999,1)) toks-        eo' = case m of-                []  -> None-                [_] -> None-                xs  -> if ro' /= 0 then FromAlignCol off-                                   else SameLine co'-                  where-                   -- off@(ro',co') = case (dropWhile isWhiteSpace $ tail xs) of-                   -- off@(ro',co') = case (dropWhile isWhiteSpace xs) of-                   off@(ro',co') = case (dropWhile isEmpty xs) of-                     []    -> (tokenRow y - r, tokenCol y - c) where y = head $ tail xs-                     (y:_) -> (tokenRow y - r, tokenCol y - c)-    go (  (Node (Entry s l []) subs)) = (Node (Entry s l []) (map go subs))-    go n = error $ "addEndOffsets:strange node:" ++ (show n)---- -----------------------------------------------------------------------allocDecls :: [GHC.LHsDecl GHC.RdrName] -> [PosToken] -> [LayoutTree]-allocDecls decls toks = r-  where-    (declLayout,tailToks) = foldl' doOne ([],toks) decls--    r = strip $ declLayout ++ (makeLeafFromToks tailToks)--    doOne :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-    doOne acc d@(GHC.L _ (GHC.TyClD       _)) = allocTyClD       acc d-    doOne acc d@(GHC.L _ (GHC.InstD       _)) = allocInstD       acc d-    doOne acc d@(GHC.L _ (GHC.DerivD      _)) = allocDerivD      acc d-    doOne acc d@(GHC.L _ (GHC.ValD        _)) = allocValD        acc d-    doOne acc d@(GHC.L _ (GHC.SigD        _)) = allocSigD        acc d-    doOne acc d@(GHC.L _ (GHC.DefD        _)) = allocDefD        acc d-    doOne acc d@(GHC.L _ (GHC.ForD        _)) = allocForD        acc d-    doOne acc d@(GHC.L _ (GHC.WarningD    _)) = allocWarningD    acc d-    doOne acc d@(GHC.L _ (GHC.AnnD        _)) = allocAnnD        acc d-    doOne acc d@(GHC.L _ (GHC.RuleD       _)) = allocRuleD       acc d-    doOne acc d@(GHC.L _ (GHC.VectD       _)) = allocVectD       acc d-    doOne acc d@(GHC.L _ (GHC.SpliceD     _)) = allocSpliceD     acc d-    doOne acc d@(GHC.L _ (GHC.DocD        _)) = allocDocD        acc d-    doOne acc d@(GHC.L _ (GHC.QuasiQuoteD _)) = allocQuasiQuoteD acc d---- -----------------------------------------------------------------------allocTyClD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocTyClD (acc,toks) (GHC.L l (GHC.TyClD d)) = (r,toks')-  where-    (s1,clToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    declLayout = allocLTyClDecl (GHC.L l d) clToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1) ++ declLayout)]-allocTyClD _ x = error $ "allocTyClD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocInstD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocInstD (acc,toks) (GHC.L l (GHC.InstD inst)) = (r,toks')-  where-    (s1,instToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    instLayout = allocInstDecl (GHC.L l inst) instToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1) ++ [makeGroup instLayout] )]-allocInstD _ x = error $ "allocInstD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocDerivD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocDerivD (acc,toks) (GHC.L l (GHC.DerivD (GHC.DerivDecl typ))) = (r,toks')-  where-    (s1,bindToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    typLayout = allocType typ bindToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1) ++ [makeGroup typLayout] )]-allocDerivD _ x = error $ "allocDerivD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocValD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocValD (acc,toks) (GHC.L l (GHC.ValD bind)) = (r,toks')-  where-    (s1,bindToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    bindLayout = allocBind (GHC.L l bind) bindToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1) ++ [makeGroup bindLayout] )]-allocValD _ x = error $ "allocValD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocSigD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocSigD (acc,toks) (GHC.L l (GHC.SigD sig)) = (r,toks')-  where-    (s1,sigToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    sigLayout = allocSig (GHC.L l sig) sigToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ sigLayout)]-allocSigD _ x = error $ "allocSigD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocDefD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocDefD (acc,toks) (GHC.L l (GHC.DefD (GHC.DefaultDecl typs))) = (r,toks')-  where-    (s1,typsToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    typsLayout = allocList typs typsToks allocType-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ typsLayout)]-allocDefD _ x = error $ "allocDefD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocForD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocForD (acc,toks) (GHC.L l (GHC.ForD (GHC.ForeignImport (GHC.L ln _) typ@(GHC.L lt _) _coer _imp))) = (r,toks')-  where-    (s1,declToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nameToks,toks1) = splitToksIncComments (ghcSpanStartEnd ln) declToks-    (s3,typToks,toks2)  = splitToksIncComments (ghcSpanStartEnd lt) toks1-    nameLayout = [makeLeaf ln NoChange nameToks]-    typLayout = allocType typ typToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                      ++ (makeLeafFromToks s2) ++ nameLayout-                      ++ (makeLeafFromToks s3) ++ typLayout-                      ++ (makeLeafFromToks toks2))]-allocForD (acc,toks) (GHC.L l (GHC.ForD (GHC.ForeignExport (GHC.L ln _) typ@(GHC.L lt _) _coer _imp))) = (r,toks')-  where-    (s1,declToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nameToks,toks1) = splitToksIncComments (ghcSpanStartEnd ln) declToks-    (s3,typToks,toks2)  = splitToksIncComments (ghcSpanStartEnd lt) toks1-    nameLayout = [makeLeaf ln NoChange nameToks]-    typLayout = allocType typ typToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                      ++ (makeLeafFromToks s2) ++ nameLayout-                      ++ (makeLeafFromToks s3) ++ typLayout-                      ++ (makeLeafFromToks toks2))]-allocForD _ x = error $ "allocForD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocWarningD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocWarningD (acc,toks) (GHC.L _l (GHC.WarningD _)) = (acc,toks)-allocWarningD _ x = error $ "allocWarningD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocAnnD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocAnnD (acc,toks) (GHC.L _l (GHC.AnnD _)) = (acc,toks)-allocAnnD _ x = error $ "allocAnnD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocRuleD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocRuleD (acc,toks) (GHC.L _l (GHC.RuleD _)) = (acc,toks)-allocRuleD _ x = error $ "allocRuleD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocVectD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocVectD (acc,toks) (GHC.L _l (GHC.VectD       _)) = (acc,toks)-allocVectD _ x = error $ "allocVectD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocSpliceD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocSpliceD (acc,toks) (GHC.L l (GHC.SpliceD (GHC.SpliceDecl ex _))) = (r,toks')-  where-    (s1,exprToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = allocExpr ex exprToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ exprLayout)]-allocSpliceD _ x = error $ "allocSpliceD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocDocD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])--- allocDocD (acc,toks) d@(GHC.L l (GHC.DocD        _))---   = error "allocDocD undefined"-allocDocD _ x = error $ "allocDocD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocQuasiQuoteD :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])-allocQuasiQuoteD (acc,toks) (GHC.L l (GHC.QuasiQuoteD (GHC.HsQuasiQuote _n _ss _))) = (r,toks')-  where-    (s1,qqToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    qqLayout = makeLeafFromToks qqToks-    r = acc ++ [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ qqLayout)]-allocQuasiQuoteD _ x = error $ "allocQuasiQuoteD:unexpected value:" ++ showGhc x---- -----------------------------------------------------------------------allocLTyClDecl :: GHC.LTyClDecl GHC.RdrName -> [PosToken] -> [LayoutTree]-allocLTyClDecl (GHC.L l (GHC.ForeignType ln _)) toks = r-  where-    (s1,clToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    lnToks = allocLocated ln clToks-    r = [makeGroup (strip $ (makeLeafFromToks s1) ++ lnToks ++ (makeLeafFromToks toks'))]-allocLTyClDecl (GHC.L l (GHC.TyFamily _f n@(GHC.L ln _) vars _mk)) toks = r-  where-    (s1,clToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,varsToks) = splitToksIncComments (ghcSpanStartEnd ln) toks'-    nLayout = allocLocated n nToks-#if __GLASGOW_HASKELL__ > 704-    (varsLayout,s3) = allocTyVarBndrs vars varsToks-#else-    varsLayout = allocList vars varsToks allocTyVarBndr-    s3 = []-#endif-    r = [makeGroup (strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks clToks)-                     ++ (makeLeafFromToks s2) ++ nLayout ++ varsLayout-                     ++ (makeLeafFromToks s3)-                     ++ (makeLeafFromToks toks'))-        ]-#if __GLASGOW_HASKELL__ > 704-allocLTyClDecl (GHC.L l (GHC.TyDecl (GHC.L ln _) vars def _fvs)) toks = r-  where-    (s1,clToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,toks'') = splitToksIncComments (ghcSpanStartEnd ln) clToks-    (varsLayout,toks3) = allocTyVarBndrs vars toks''-    (typeLayout,toks4) = allocHsTyDefn def toks3-    r = [makeGroup (strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-                     ++ (makeLeafFromToks nToks) ++ varsLayout ++ typeLayout-                     ++ (makeLeafFromToks toks4)-             ++ (makeLeafFromToks toks'))]-#else-allocLTyClDecl (GHC.L l (GHC.TyData _ (GHC.L lc ctx) (GHC.L ln _) vars mpats mkind cons mderivs)) toks = r-  where-    (s1,clToks,toks')    = splitToksIncComments (ghcSpanStartEnd l) toks-    (s15,ctxToks,toks'a) = splitToksIncComments (ghcSpanStartEnd lc) clToks-    (s2,nToks,toks'')    = splitToksIncComments (ghcSpanStartEnd ln) toks'a-    (s21,vToks,toks3)    = splitToksForList vars toks''-    ctxLayout = allocHsContext ctx ctxToks-    varsLayout = allocList vars vToks allocTyVarBndr-    (patsLayout,toks4) = case mpats of-       Nothing -> ([],toks3)-       Just pats -> ([makeGroup (strip $ (makeLeafFromToks s3) ++ (allocList pats patsToks allocType))],toks4')-          where (s3,patsToks,toks4') = splitToksForList pats toks3-    (kindLayout,toks5) = case mkind of-       Nothing -> ([],toks4)-       Just k@(GHC.L lk _k) -> (kLayout,toks5')-         where-           (s4,kToks,toks5') = splitToksIncComments (ghcSpanStartEnd lk) toks4-           kLayout = [makeGroup (strip $ (makeLeafFromToks s4) ++ allocHsKind k kToks)]-    (s5,consToks,toks6) = splitToksForList cons toks5-    consLayout = [makeGroup (strip $ (makeLeafFromToks s5) ++ (allocList cons consToks allocConDecl))]-    (derivsLayout,toks7) = case mderivs of-      Nothing -> ([],toks6)-      Just derivs -> (dLayout,toks7')-        where-          (s6,dToks,toks7') = splitToksForList derivs toks6-          dLayout = [makeGroup (strip $ (makeLeafFromToks s6) ++ (allocList derivs dToks allocType))]--    r = [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ (makeLeafFromToks s15)-                     ++ ctxLayout-                     ++ (makeLeafFromToks s2)-                     ++ (makeLeafFromToks nToks)-                     ++ (makeLeafFromToks s21)-                     ++ varsLayout ++ patsLayout-                     ++ kindLayout-                     ++ consLayout ++ derivsLayout-                     ++ (makeLeafFromToks toks7)-                     ++ (makeLeafFromToks toks')-         )]-{--tcdND :: NewOrData-tcdCtxt :: LHsContext name--    Context...--    Context -tcdLName :: Located name--    Name of the class--    type constructor--    Type constructor -tcdTyVars :: [LHsTyVarBndr name]--    Class type variables--    type variables--    Type variables -tcdTyPats :: Maybe [LHsType name]--    Type patterns See Note [tcdTyVars and tcdTyPats]--    Type patterns. See Note [tcdTyVars and tcdTyPats] -tcdKindSig :: Maybe (LHsKind name)--    Optional kind signature.--    (Just k) for a GADT-style data, or data instance decl with explicit kind sig -tcdCons :: [LConDecl name]--    Data constructors--    For data T a = T1 | T2 a the LConDecls all have ResTyH98. For data T a where { T1 :: T a } the LConDecls all have ResTyGADT. -tcdDerivs :: Maybe [LHsType name]--    Derivings; Nothing => not specified, Just [] => derive exactly what is asked--    These types must be of form forall ab. C ty1 ty2 Typically the foralls and ty args are empty, but they are non-empty for the newtype-deriving case --}-#endif-#if __GLASGOW_HASKELL__ > 704-allocLTyClDecl (GHC.L l (GHC.ClassDecl (GHC.L lc ctx) n@(GHC.L ln _) vars fds sigs meths ats atdefs docs _fvs)) toks = r-#else-allocLTyClDecl (GHC.L l (GHC.ClassDecl (GHC.L lc ctx) n@(GHC.L ln _) vars fds sigs meths ats atdefs docs     )) toks = r-#endif-  where-    (s1,clToks,  toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,ctxToks, toks1) = splitToksIncComments (ghcSpanStartEnd lc) clToks-    (s3,nToks,   toks2) = splitToksIncComments (ghcSpanStartEnd ln) toks1-#if __GLASGOW_HASKELL__ > 704-    (varsLayout, toks3) = allocTyVarBndrs vars toks2-#else-    varsLayout = allocList vars toks2 allocTyVarBndr-    toks3 = [] -- hmm-#endif-    (s5,fdToks,  toks4) = splitToksForList fds toks3--    ctxLayout = allocHsContext ctx ctxToks-    nLayout   = allocLocated n nToks-    -- fdsLayout = allocList fds fdToks allocFunDep-    fdsLayout = makeLeafFromToks fdToks--    bindList = GHC.bagToList meths-    sigMix     = makeMixedListEntry sigs     (shim allocSig)-    methsMix   = makeMixedListEntry bindList (shim allocBind)-    atsMix     = makeMixedListEntry ats      (shim allocLTyClDecl)-#if __GLASGOW_HASKELL__ > 704-    atsdefsMix = makeMixedListEntry atdefs   (shim allocLFamInstDecl)-#else-    atsdefsMix = makeMixedListEntry atdefs   (shim allocLTyClDecl)-#endif-    docsMix    = makeMixedListEntry docs     (shim allocLocated)--    bindsLayout = allocMixedList (sigMix++methsMix++atsMix++atsdefsMix++docsMix) toks4--    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ ctxLayout ++ (makeLeafFromToks s3)-             ++ nLayout ++ varsLayout ++ (makeLeafFromToks s5)-             ++ fdsLayout ++ bindsLayout-             ++ (makeLeafFromToks toks')-        ]--#if __GLASGOW_HASKELL__ > 704-#else-allocLTyClDecl (GHC.L l (GHC.TySynonym n@(GHC.L ln _) vars mpats synrhs@(GHC.L lr _))) toks = r-  where-    (s1,clToks,toks')   = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,toks2)    = splitToksIncComments (ghcSpanStartEnd ln) clToks-    (s25,vToks,toks3)    = splitToksForList vars toks2-    (patsLayout,toks4) = case mpats of-       Nothing -> ([],toks3)-       Just pats -> ([makeGroup (strip $ (makeLeafFromToks s3) ++ (allocList pats patsToks allocType))],toks4')-          where (s3,patsToks,toks4') = splitToksForList pats toks3-    (s4,rToks,toks5)    = splitToksIncComments (ghcSpanStartEnd lr) toks4-    varsLayout = allocList vars vToks allocTyVarBndr-    synrhsLayout = allocType synrhs rToks--    r = [makeGroup (strip $ (makeLeafFromToks s1)-                     ++ (makeLeafFromToks s2)-                     ++ (makeLeafFromToks nToks)-                     ++ (makeLeafFromToks s25)-                     ++ varsLayout ++ patsLayout-                     ++ (makeLeafFromToks s4)-                     ++ synrhsLayout-                     ++ (makeLeafFromToks toks5)-                     ++ (makeLeafFromToks toks')-         )]-#endif---- allocLTyClDecl x _ = error $ "allocLTyClDecl:unknown value:" ++ showGhc x---- -----------------------------------------------------------------------allocMatches :: [GHC.LMatch GHC.RdrName] -> [PosToken] -> [LayoutTree]-allocMatches matches toksIn = allocList matches toksIn doOne-  where-    doOne :: GHC.LMatch GHC.RdrName -> [PosToken] -> [LayoutTree]-    doOne (GHC.L lm (GHC.Match pats mtyp grhs@(GHC.GRHSs rhs _))) toks = r-      where-        (sb,matchToks,sa) = splitToksIncComments (ghcSpanStartEnd lm) toks-        (s2,patsToks,toks2) = splitToksForList pats matchToks-        (mtypLayout,toks') = case mtyp of-          Nothing -> ([],toks2)-          Just (typ@(GHC.L l _)) -> (typeLayout,toks'')-            where-              (t1,typToks,toks'') = splitToksIncComments (ghcSpanStartEnd l) toks2-              typeLayout = strip $ (makeLeafFromToks t1) ++ allocType typ typToks--        (s3,rhsToks,bindsToks) = splitToksForList rhs toks'-        -- patLayout = allocList pats patsToks allocPat--        -- Insert a SrcSpan over the parameters, if there are any-        patLayout = case (strip $ allocList pats patsToks allocPat) of-                     [] -> []-                     ps -> [makeGroup ps]--        grhsLayout = allocGRHSs grhs (rhsToks++bindsToks)-        matchLayout = [makeGroup $ strip $ (makeLeafFromToks s2)-                           ++ patLayout-                           ++ mtypLayout-                           ++ (makeLeafFromToks s3)-                           ++ grhsLayout-                      ]-        r = (strip $ (makeLeafFromToks sb)-                  ++ matchLayout-                  ++ (makeLeafFromToks sa))----- -----------------------------------------------------------------------allocGRHSs :: GHC.GRHSs GHC.RdrName -> [PosToken] -> [LayoutTree]-allocGRHSs (GHC.GRHSs rhs localBinds) toks = r-  where-    (s1,rhsToks,bindsToks) = splitToksForList rhs toks-    rhsLayout = allocList rhs rhsToks allocRhs-    localBindsLayout = allocLocalBinds localBinds bindsToks-    r = (strip $ (makeLeafFromToks s1) ++ rhsLayout ++ localBindsLayout)---- ------------------------------------------------------------------------- TODO: should this use the span from the LPat?-allocPat :: GHC.LPat GHC.RdrName -> [PosToken] -> [LayoutTree]-allocPat (GHC.L _ _) toks = makeLeafFromToks toks---- -----------------------------------------------------------------------allocRhs :: GHC.LGRHS GHC.RdrName -> [PosToken] -> [LayoutTree]-allocRhs (GHC.L l (GHC.GRHS stmts expr)) toksIn = r-  where-    (sb,toksRhs,sa) = splitToksIncComments (ghcSpanStartEnd l) toksIn-    (s1,stmtsToks,toks') = splitToksForList stmts toksRhs-    stmtsLayout = allocList stmts stmtsToks allocStmt-    exprLayout = allocExpr expr toks'-    exprMainLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ stmtsLayout ++ exprLayout]-    r = strip $ (makeLeafFromToks sb) ++ exprMainLayout ++ (makeLeafFromToks sa)---- -----------------------------------------------------------------------allocStmt :: GHC.LStmt GHC.RdrName -> [PosToken] -> [LayoutTree]-allocStmt (GHC.L _ (GHC.LastStmt expr _)) toks = allocExpr expr toks-allocStmt (GHC.L _ (GHC.BindStmt pat@(GHC.L lp _) expr _ _)) toks = r-  where-    (s1,patToks,toks') = splitToksIncComments (ghcSpanStartEnd lp) toks-    patLayout = allocPat pat patToks-    exprLayout = allocExpr expr toks'-    r = strip $ (makeLeafFromToks s1) ++ patLayout ++ exprLayout-allocStmt (GHC.L _ (GHC.ExprStmt expr _ _ _)) toks = allocExpr expr toks-allocStmt (GHC.L _ (GHC.LetStmt binds))       toks = allocLocalBinds binds toks-#if __GLASGOW_HASKELL__ > 704-allocStmt (GHC.L l (GHC.ParStmt blocks _ _))  toks = r-  where-    (s1,blocksToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (blocksLayout,toks2) = foldl' allocParStmtBlock ([],blocksToks) blocks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ blocksLayout-              ++ (makeLeafFromToks toks2)-              ++ (makeLeafFromToks toks')]-#else-allocStmt (GHC.L l (GHC.ParStmt blocks _ _ _)) toks = r-  where-    (s1,blocksToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (blocksLayout,toks2) = foldl' allocParStmtBlock ([],blocksToks) blocks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ blocksLayout-              ++ (makeLeafFromToks toks2)-              ++ (makeLeafFromToks toks')]--    allocParStmtBlock :: ([LayoutTree],[PosToken])-         -> ([GHC.LStmt GHC.RdrName],[GHC.RdrName]) -> ([LayoutTree],[PosToken])-    allocParStmtBlock (acc,toks) (stmts,ns) = (r1,toks')-      where-        (s1,stmtToks,toks') = splitToksForList stmts toks-        stmtLayout = allocList stmts stmtToks allocStmt-        r1 = [makeGroup $ strip $ (makeLeafFromToks s1)-                      ++ stmtLayout]--- ParStmt [([LStmt idL], [idR])] (SyntaxExpr idR) (SyntaxExpr idR) (SyntaxExpr idR)-#endif-allocStmt (GHC.L l (GHC.TransStmt _ stmts _ using@(GHC.L lu _) mby _ _ _ )) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,stmtsToks,toks1) = splitToksForList stmts toksExpr-    (s2,usingToks,toks2) = splitToksIncComments (ghcSpanStartEnd lu) toks1-    (byLayout,toks3) = case mby of-       Nothing -> ([],toks2)-       Just e -> (byL,toks3')-         where-           byL = allocExpr e toks2-           toks3' = []--    stmtsLayout = allocList stmts stmtsToks allocStmt-    usingLayout = allocExpr using usingToks-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                  ++ (makeLeafFromToks s1) ++ stmtsLayout-                  ++ (makeLeafFromToks s2) ++ usingLayout-                  ++ byLayout-                  ++ (makeLeafFromToks toks3)-                  ++ (makeLeafFromToks sa)-        ]--allocStmt (GHC.L l (GHC.RecStmt stmts _ _ _ _ _ _ _ _))  toks = r-  where-    -- Note: everything after the first field is filled in from the-    -- renamer onwards, can be ignored here-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,stmtsToks,toks1) = splitToksForList stmts toksExpr-    stmtsLayout = allocList stmts stmtsToks allocStmt--    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                  ++ (makeLeafFromToks s1) ++ stmtsLayout-                  ++ (makeLeafFromToks toks1)-                  ++ (makeLeafFromToks sa)-        ]-{--RecStmt-  recS_stmts :: [LStmtLR idL idR]-  recS_later_ids :: [idR]-  recS_rec_ids :: [idR]-  recS_bind_fn :: SyntaxExpr idR-  recS_ret_fn :: SyntaxExpr idR-  recS_mfix_fn :: SyntaxExpr idR-  recS_later_rets :: [PostTcExpr]-  recS_rec_rets :: [PostTcExpr]-  recS_ret_ty :: PostTcType--}--- -----------------------------------------------------------------------#if __GLASGOW_HASKELL__ > 704-allocParStmtBlock :: ([LayoutTree],[PosToken]) -> GHC.ParStmtBlock GHC.RdrName GHC.RdrName -> ([LayoutTree],[PosToken])-allocParStmtBlock (acc,toks) (GHC.ParStmtBlock stmts _ns _) = (acc ++ r,toks')-  where-    (s1,stmtToks,toks') = splitToksForList stmts toks-    stmtLayout = allocList stmts stmtToks allocStmt-    r = [makeGroup $ strip $ (makeLeafFromToks s1)-                      ++ stmtLayout]-#endif---- -----------------------------------------------------------------------allocExpr :: GHC.LHsExpr GHC.RdrName -> [PosToken] -> [LayoutTree]-allocExpr (GHC.L l (GHC.HsVar _)) toks = [makeLeaf l NoChange toks]-allocExpr (GHC.L l (GHC.HsLit _)) toks = [makeLeaf l NoChange toks]-allocExpr (GHC.L l (GHC.HsOverLit _)) toks = [makeLeaf l NoChange toks]-allocExpr (GHC.L _ (GHC.HsLam (GHC.MatchGroup matches _))) toks-  = allocMatches matches toks-#if __GLASGOW_HASKELL__ > 704-allocExpr (GHC.L _ (GHC.HsLamCase _ (GHC.MatchGroup matches _))) toks-  = allocMatches matches toks-#endif-allocExpr (GHC.L l (GHC.HsApp e1@(GHC.L l1 _) e2)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,e1Toks,e2Toks) = splitToksIncComments (ghcSpanStartEnd l1) toksExpr-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.OpApp e1@(GHC.L l1 _) e2@(GHC.L l2 _) _ e3)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,e1Toks,toks1) = splitToksIncComments (ghcSpanStartEnd l1) toksExpr-    (s2,e2Toks,e3Toks) = splitToksIncComments (ghcSpanStartEnd l2) toks1-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    e3Layout = allocExpr e3 e3Toks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1)-                      ++ e1Layout ++ (makeLeafFromToks s2)-                      ++ e2Layout ++ e3Layout]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.NegApp expr _)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocExpr expr toksExpr]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.HsPar expr))    toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocExpr expr toksExpr]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.SectionL e1@(GHC.L l1 _) e2)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,e1Toks,e2Toks) = splitToksIncComments (ghcSpanStartEnd l1) toksExpr-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.SectionR e1@(GHC.L l1 _) e2)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,e1Toks,e2Toks) = splitToksIncComments (ghcSpanStartEnd l1) toksExpr-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.ExplicitTuple tupArgs _)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,tupToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toksExpr-    tupLayout = allocTupArgList tupArgs tupToks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ tupLayout-             ++ (makeLeafFromToks toks')]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)--- ExplicitTuple [HsTupArg id] Boxity-allocExpr (GHC.L l (GHC.HsCase expr@(GHC.L le _) (GHC.MatchGroup matches _))) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,exprToks,toks1) = splitToksIncComments (ghcSpanStartEnd le) toksExpr-    (s2,matchToks,toks2) = splitToksForList matches toks1-    exprLayout = allocExpr expr exprToks--    firstMatchTok = ghead "allocLocalBinds" $ dropWhile isWhiteSpaceOrIgnored matchToks-    p1 = (tokenRow firstMatchTok,tokenCol firstMatchTok)-    (ro,co) = case (filter isOf s2) of-               [] -> (0,0)-               (x:_) -> (tokenRow firstMatchTok - tokenRow x,-                         tokenCol firstMatchTok - (tokenCol x + tokenLen x))--    (rt,ct) = calcLastTokenPos matchToks--    so = makeOffset ro (co - 1)-    matchesLayout = [placeAbove so p1 (rt,ct) (allocMatches matches matchToks)]--    exprMainLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ exprLayout-             ++ (makeLeafFromToks s2) ++ matchesLayout ++ (makeLeafFromToks toks2)]--    r = strip $ (makeLeafFromToks sb) ++ exprMainLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.HsIf _ e1@(GHC.L l1 _) e2@(GHC.L l2 _) e3)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,e1Toks,toks1) = splitToksIncComments (ghcSpanStartEnd l1) toksExpr-    (s2,e2Toks,e3Toks) = splitToksIncComments (ghcSpanStartEnd l2) toks1-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    e3Layout = allocExpr e3 e3Toks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1)-                         ++ e1Layout ++ (makeLeafFromToks s2)-                         ++ e2Layout ++ e3Layout]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-#if __GLASGOW_HASKELL__ > 704-allocExpr (GHC.L l (GHC.HsMultiIf _ rhs)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocList rhs toksExpr allocRhs]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-#endif-allocExpr (GHC.L l (GHC.HsLet localBinds expr@(GHC.L le _))) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (bindToks,exprToks,toks') = splitToksIncComments (ghcSpanStartEnd le) toksExpr-    bindLayout = allocLocalBinds localBinds bindToks-    exprLayout = allocExpr expr exprToks-    exprMainLayout = [makeGroup $ strip $ bindLayout ++ [makeGroup exprLayout] ++ (makeLeafFromToks toks')]-    r = strip $ (makeLeafFromToks sb) ++ exprMainLayout ++ (makeLeafFromToks sa)----- various kinds of list comprehension-allocExpr e@(GHC.L _ (GHC.HsDo GHC.ListComp  _ _)) toks = allocExprListComp e toks-allocExpr e@(GHC.L _ (GHC.HsDo GHC.MonadComp _ _)) toks = allocExprListComp e toks-allocExpr e@(GHC.L _ (GHC.HsDo GHC.PArrComp  _ _)) toks = allocExprListComp e toks----- various kinds of do-allocExpr e@(GHC.L _ (GHC.HsDo GHC.DoExpr   _ _)) toks = allocDoExpr e toks-allocExpr e@(GHC.L _ (GHC.HsDo GHC.GhciStmt _ _)) toks = allocDoExpr e toks-allocExpr e@(GHC.L _ (GHC.HsDo GHC.MDoExpr  _ _)) toks = allocDoExpr e toks---allocExpr e@(GHC.L _ (GHC.HsDo GHC.ArrowExpr _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)-allocExpr e@(GHC.L _ (GHC.HsDo (GHC.PatGuard _) _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)-allocExpr e@(GHC.L _ (GHC.HsDo (GHC.ParStmtCtxt _) _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)-allocExpr e@(GHC.L _ (GHC.HsDo (GHC.TransStmtCtxt _) _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)--allocExpr (GHC.L l (GHC.ExplicitList _ exprs)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocList exprs toksExpr allocExpr]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.ExplicitPArr _ exprs)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocList exprs toksExpr allocExpr]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)-allocExpr (GHC.L l (GHC.RecordCon (GHC.L ln _) _ binds)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,nameToks,fieldsToks) = splitToksIncComments (ghcSpanStartEnd ln) toksExpr-    nameLayout = [makeLeaf ln NoChange nameToks]-    (bindsLayout,toks3) = allocHsRecordBinds binds fieldsToks-    exprLayout = [makeGroup $ strip $ (makeLeafFromToks s1)-                 ++ nameLayout ++ bindsLayout-                 ++ (makeLeafFromToks toks3)]--    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)--allocExpr (GHC.L l (GHC.RecordUpd expr@(GHC.L le _) binds _cons _ptctypes1 _ptctypes2)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksE,toks2) = splitToksIncComments (ghcSpanStartEnd le) toksExpr-    (bindsLayout,toks3) = allocHsRecordBinds binds toks2-    exprLayout = allocExpr expr toksE-    recLayout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ exprLayout-                              ++ bindsLayout ++ (makeLeafFromToks toks3)]-    r = strip $ (makeLeafFromToks sb) ++ recLayout ++ (makeLeafFromToks sa)-{--RecordUpd (LHsExpr id) (HsRecordBinds id) [DataCon] [PostTcType] [PostTcType]--}-allocExpr (GHC.L l (GHC.ArithSeq _ info)) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    exprLayout = [makeGroup $ allocArithSeqInfo info toksExpr]-    r = strip $ (makeLeafFromToks sb) ++ exprLayout ++ (makeLeafFromToks sa)--allocExpr (GHC.L l (GHC.ExprWithTySig (GHC.L le expr) (GHC.L lt typ))) toks = r-  where-    (sb,toksExpr,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksE,toks2) = splitToksIncComments (ghcSpanStartEnd le) toksExpr-    (s2,toksType,toks3) = splitToksIncComments (ghcSpanStartEnd lt) toks2--    exprLayout = allocExpr (GHC.L le expr) toksE-    typeLayout = allocType (GHC.L lt typ) toksType-    layout = [makeGroup $ strip $ (makeLeafFromToks s1) ++ exprLayout-                              ++ (makeLeafFromToks s2) ++ typeLayout-                              ++ (makeLeafFromToks toks3)]-    r = strip $ (makeLeafFromToks sb) ++ layout ++ (makeLeafFromToks sa)--allocExpr (GHC.L _ (GHC.HsIPVar _)) toks = makeLeafFromToks toks-allocExpr e@(GHC.L _ (GHC.PArrSeq _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)-allocExpr (GHC.L _ (GHC.HsSCC _ ex)) toks = allocExpr ex toks-allocExpr (GHC.L _ (GHC.HsCoreAnn _ ex)) toks = allocExpr ex toks-allocExpr (GHC.L l (GHC.HsBracket bracket)) toks = r-  where-    (sb,toksBrack,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    layoutBrack = case bracket of-      GHC.ExpBr ex -> allocExpr ex toksBrack-      GHC.PatBr p -> allocPat p toksBrack-      GHC.DecBrL decs -> allocDecls decs toksBrack-      GHC.DecBrG g -> error $ "allocExpr.DecBrG undefined for " ++ (SYB.showData SYB.Parser 0 g)-      GHC.TypBr typ -> allocType typ toksBrack-      GHC.VarBr _ _ -> makeLeafFromToks toksBrack-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ layoutBrack-                   ++ (makeLeafFromToks sa)]---- Note: these are only present after the typechecker-allocExpr e@(GHC.L _ (GHC.ExprWithTySigOut _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)-allocExpr e@(GHC.L _ (GHC.HsBracketOut _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)---allocExpr (GHC.L _l (GHC.HsSpliceE (GHC.HsSplice _ expr))) toks = allocExpr expr toks--allocExpr e@(GHC.L _ (GHC.HsQuasiQuoteE _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0  e)--allocExpr (GHC.L l (GHC.HsProc p@(GHC.L lp _) cmd@(GHC.L lc _))) toks = r-  where-    (sb,toksBrack,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksPat,toks1) = splitToksIncComments (ghcSpanStartEnd lp) toksBrack-    (s2,toksCmd,toks2) = splitToksIncComments (ghcSpanStartEnd lc) toks1-    layoutPat = allocPat p toksPat-    layoutCmd = allocCmdTop cmd toksCmd-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks s1)-                   ++ layoutPat-                   ++ (makeLeafFromToks s2)-                   ++ layoutCmd-                   ++ (makeLeafFromToks toks2)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L l (GHC.HsArrApp e1@(GHC.L l1 _) e2@(GHC.L l2 _) _ _ _)) toks = r-  where-    (sb,toksApp,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksE1,toks1) = splitToksIncComments (ghcSpanStartEnd l1) toksApp-    (s2,toksE2,toks2) = splitToksIncComments (ghcSpanStartEnd l2) toks1-    layoutE1 = allocExpr e1 toksE1-    layoutE2 = allocExpr e2 toksE2-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks s1)-                   ++ layoutE1-                   ++ (makeLeafFromToks s2)-                   ++ layoutE2-                   ++ (makeLeafFromToks toks2)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L l (GHC.HsArrForm e@(GHC.L le _) _ cmds)) toks = r-  where-    (sb,toksApp,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksExpr,toks1) = splitToksIncComments (ghcSpanStartEnd le) toksApp-    (s2,toksCmd,toks2) = splitToksForList cmds toks1-    layoutExpr = allocExpr e toksExpr-    layoutCmds = allocList cmds toksCmd allocCmdTop-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks s1)-                   ++ layoutExpr-                   ++ (makeLeafFromToks s2)-                   ++ layoutCmds-                   ++ (makeLeafFromToks toks2)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L _ (GHC.HsTick _ e)) toks = allocExpr e toks-allocExpr (GHC.L _ (GHC.HsBinTick _ _ e)) toks = allocExpr e toks-allocExpr (GHC.L _ (GHC.HsTickPragma _ e)) toks = allocExpr e toks--allocExpr (GHC.L l (GHC.EWildPat)) toks = r-  where-    (sb,toksPat,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks toksPat)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L l (GHC.EAsPat (GHC.L ln _) e@(GHC.L le _))) toks = r-  where-    (sb,toksPat,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksN,toks1) = splitToksIncComments (ghcSpanStartEnd ln) toksPat-    (s2,toksE,toks2) = splitToksIncComments (ghcSpanStartEnd le) toks1-    layoutN = makeLeafFromToks toksN-    layoutExpr = allocExpr e toksE-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks s1)-                   ++ layoutN-                   ++ (makeLeafFromToks s2)-                   ++ layoutExpr-                   ++ (makeLeafFromToks toks2)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L l (GHC.EViewPat e1@(GHC.L l1 _) e2@(GHC.L l2 _))) toks = r-  where-    (sb,toksPat,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,toksE1,toks1) = splitToksIncComments (ghcSpanStartEnd l1) toksPat-    (s2,toksE2,toks2) = splitToksIncComments (ghcSpanStartEnd l2) toks1-    layoutE1 = allocExpr e1 toksE1-    layoutE2 = allocExpr e2 toksE2-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ (makeLeafFromToks s1)-                   ++ layoutE1-                   ++ (makeLeafFromToks s2)-                   ++ layoutE2-                   ++ (makeLeafFromToks toks2)-                   ++ (makeLeafFromToks sa)]--allocExpr (GHC.L _ (GHC.ELazyPat e)) toks = allocExpr e toks-allocExpr (GHC.L _ (GHC.HsType typ)) toks = allocType typ toks-allocExpr e@(GHC.L _ (GHC.HsWrap _ _)) toks = allocExpr e toks---- ---------------------------------------allocDoExpr :: GHC.LHsExpr GHC.RdrName -> [PosToken] -> [LayoutTree]-allocDoExpr _e@(GHC.L l (GHC.HsDo _ stmts _)) toks = r-  where-    (s1,toksBinds',toks1) = splitToksIncComments (ghcSpanStartEnd l) toks--    (before,including) = break isDo toksBinds'-    doToks = before ++ [ghead ("allocExpr:" ++ (show toksBinds') ++ (SYB.showData SYB.Renamer 0 _e)) including]-    toksBinds = gtail ("allocExpr.HsDo" ++ show (l,before,including,toks)) including--    bindsLayout' = allocList stmts toksBinds allocStmt--    firstBindTok = ghead "allocLocalBinds" $ dropWhile isWhiteSpaceOrIgnored toksBinds-    p1 = (tokenRow firstBindTok,tokenCol firstBindTok)-    (ro,co) = case (filter isDo doToks) of-               [] -> (0,0)-               (x:_) -> (tokenRow firstBindTok - tokenRow x,-                         tokenCol firstBindTok - (tokenCol x + tokenLen x))--    (rt,ct) = calcLastTokenPos toksBinds--    so = makeOffset ro (co -1)--    bindsLayout = case bindsLayout' of-      [] -> []-      bs -> [placeAbove so p1 (rt,ct) bs]--    r = strip $ (makeLeafFromToks (s1++doToks) ++ bindsLayout ++ makeLeafFromToks toks1)-allocDoExpr e _-  = error $ "Layout.allocDoExpr should not have been called with " ++ showGhc e---- ---------------------------------------allocExprListComp :: GHC.LHsExpr GHC.RdrName -> [PosToken] -> [LayoutTree]-allocExprListComp _e@(GHC.L l (GHC.HsDo _ stmts _)) toks = r-  where-    (s1,toksBinds,toks1) = splitToksIncComments (ghcSpanStartEnd l) toks-    bindsLayout = allocList stmts toksBinds allocStmt-    r = strip $ ((makeLeafFromToks s1) ++ bindsLayout ++ makeLeafFromToks toks1)-allocExprListComp e _-  = error $ "Layout.allocExprListComp should not have been called with " ++ showGhc e---- -----------------------------------------------------------------------allocCmdTop :: GHC.LHsCmdTop GHC.RdrName -> [PosToken] -> [LayoutTree]-allocCmdTop (GHC.L l (GHC.HsCmdTop cmd _ _ _)) toks = r-  where-    (sb,toksCmd,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    layoutExpr = allocExpr cmd toksCmd-    r = [makeGroup $ strip $ (makeLeafFromToks sb)-                   ++ layoutExpr-                   ++ (makeLeafFromToks sa)]---- -----------------------------------------------------------------------allocHsRecordBinds :: GHC.HsRecordBinds GHC.RdrName -> [PosToken] -> ([LayoutTree],[PosToken])-allocHsRecordBinds (GHC.HsRecFields flds _dot) toks = (r,toks')-  where-    (r,toks') = foldl doOne ([],toks) flds--    doOne (r1,toks1) fld = (r1',toks1')-      where-        (r2,toks1') = allocHsRecField fld toks1-        r1' = r1 ++ r2-{--type HsRecordBinds id = HsRecFields id (LHsExpr id)--data HsRecFields id arg--Constructors-  HsRecFields-    rec_flds :: [HsRecField id arg]-    rec_dotdot :: Maybe Int--data HsRecField id arg--Constructors-  HsRecField-    hsRecFieldId :: Located id-    hsRecFieldArg :: arg-    hsRecPun :: Bool---}--allocHsRecField ::- GHC.HsRecField GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> [PosToken]- -> ([LayoutTree],[PosToken])-allocHsRecField (GHC.HsRecField (GHC.L ln _) expr@(GHC.L le _) _) toks = (r,toks')-  where-    (s1,toksN,toks1) = splitToksIncComments (ghcSpanStartEnd ln) toks-    (s2,toksE,toks2) = splitToksIncComments (ghcSpanStartEnd le) toks1-    nLayout = makeLeafFromToks toksN-    exprLayout = allocExpr expr toksE-    toks' = toks2-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ nLayout-                    ++ (makeLeafFromToks s2) ++ exprLayout]---- -----------------------------------------------------------------------allocLocalBinds :: GHC.HsLocalBinds GHC.RdrName -> [PosToken] -> [LayoutTree]-allocLocalBinds GHC.EmptyLocalBinds toks = strip $ makeLeafFromToks toks-allocLocalBinds (GHC.HsValBinds (GHC.ValBindsIn binds sigs)) toks = r-  where-    bindList = GHC.bagToList binds--    startBind = startPosForList bindList-    startSig  = startPosForList sigs-    start = if startSig < startBind then startSig else startBind--    endBind = endPosForList bindList-    endSig  = endPosForList sigs-    end = if endSig > endBind then endSig else endBind--    (s1,toksBinds,toks1) = splitToksIncComments (start,end) toks--    -- s1 will contain the 'where' token, split into prior comments,-    -- the token, and post comments so that if the 'where' token must-    -- be removed the comments will stay-    (s1p,s1r) = break isWhereOrLet s1-    (w,s1a)   = break (not.isWhereOrLet) s1r-    whereLayout = makeLeafFromToks s1p ++ makeLeafFromToks w ++ makeLeafFromToks s1a--    firstBindTok = ghead "allocLocalBinds" $ dropWhile isWhiteSpaceOrIgnored toksBinds-    p1 = (tokenRow firstBindTok,tokenCol firstBindTok)-    (ro,co) = case (filter isWhereOrLet s1) of-               [] -> (0,0)-               (x:_) -> (tokenRow firstBindTok - tokenRow x,-                         tokenCol firstBindTok - (tokenCol x + tokenLen x))--    (rt,ct) = calcLastTokenPos toksBinds--    bindsLayout' = allocInterleavedLists bindList sigs (toksBinds) allocBind allocSig--    so = makeOffset ro (co -1)--    bindsLayout = case bindsLayout' of-      [] -> []-      bs -> [placeAbove so p1 (rt,ct) bs]--    -- r = strip $ (makeLeafFromToks s1) ++ bindsLayout ++ (makeLeafFromToks toks1)-    r = strip $ whereLayout ++ bindsLayout ++ (makeLeafFromToks toks1)-allocLocalBinds (GHC.HsValBinds (GHC.ValBindsOut _ _)) _-   = error "allocLocalBinds (GHC.HsValBinds (GHC.ValBindsOut..)) should not be required"--allocLocalBinds (GHC.HsIPBinds (GHC.IPBinds bs _))  toks = r-  where-    -- Note: only the Left x part is populated until after renaming, so no-    -- need to process deeper than this-    bindsLayout = allocList bs toks allocLocated-    r = strip $ bindsLayout---- -----------------------------------------------------------------------makeOffset :: RowOffset -> ColOffset -> EndOffset-makeOffset 0   0 = None-makeOffset 0  co = SameLine co-makeOffset ro co = FromAlignCol (ro,co)---- -----------------------------------------------------------------------startPosForList :: [GHC.Located a] -> SimpPos-startPosForList xs = start-  where-    (start,_) = case xs of-                 [] -> ((100000,0),(0,0))-                 ((GHC.L ls _):_) -> ghcSpanStartEnd ls--endPosForList :: [GHC.Located a] -> SimpPos-endPosForList xs = end-  where-    (_,end) = case xs of-                 [] -> ((0,0),(0,0))-                 ls -> ghcSpanStartEnd $ GHC.getLoc $ last ls---- -----------------------------------------------------------------------allocBind :: GHC.LHsBind GHC.RdrName -> [PosToken] -> [LayoutTree]-allocBind (GHC.L l (GHC.FunBind (GHC.L ln _) _ (GHC.MatchGroup matches _) _ _ _)) toks = r-  where-    (nameLayout,toks1) = ((makeLeafFromToks s1)++[makeLeaf ln NoChange nameToks],toks')-      where-        (s1,nameToks,toks') = splitToksIncComments (ghcSpanStartEnd ln) toks--    (matchesLayout,toks2) = ((makeLeafFromToks s2) ++ allocMatches matches matchToks,toks2')-          where-            (s2,matchToks,toks2') = splitToksForList matches toks1--    r = strip $ [mkGroup l NoChange (strip $ nameLayout ++ matchesLayout)] ++ (makeLeafFromToks toks2)--allocBind (GHC.L l (GHC.PatBind lhs@(GHC.L ll _) grhs@(GHC.GRHSs rhs _) _ _ _)) toks = r-  where-    (s1,bindToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,lhsToks,toks1) = splitToksIncComments (ghcSpanStartEnd ll) bindToks-    (s3,rhsToks,bindsToks) = splitToksForList rhs toks1--    lhsLayout = allocPat lhs lhsToks-    grhsLayout = allocGRHSs grhs (rhsToks ++ bindsToks)--    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-              ++ lhsLayout ++ (makeLeafFromToks s3) ++ grhsLayout-              ++ (makeLeafFromToks toks')) ]--allocBind (GHC.L l (GHC.VarBind _n rhs@(GHC.L lr _) _)) toks  = r-  where-    (sb,toksBind,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,exprToks,toks2) = splitToksIncComments (ghcSpanStartEnd lr) toksBind-    exprLayout = allocExpr rhs exprToks-    r = [makeGroup $ (strip $ (makeLeafFromToks sb)-              ++ (makeLeafFromToks s1)-              ++ exprLayout-              ++ (makeLeafFromToks toks2)-              ++ (makeLeafFromToks sa)-             )-         ]--allocBind (GHC.L l (GHC.AbsBinds _tvs _vars _exps _ev binds)) toks = r-  where-    bindsList = GHC.bagToList binds-    (sb,toksBind,sa) = splitToksIncComments (ghcSpanStartEnd l) toks-    (s1,bindsToks,toks2) = splitToksForList bindsList toksBind-    bindsLayout = allocList bindsList bindsToks allocBind-    r = [makeGroup $ (strip $ (makeLeafFromToks sb)-              ++ (makeLeafFromToks s1)-              ++ bindsLayout-              ++ (makeLeafFromToks toks2)-              ++ (makeLeafFromToks sa)-             )-         ]---- -----------------------------------------------------------------------allocSig :: GHC.LSig GHC.RdrName -> [PosToken] -> [LayoutTree]-allocSig (GHC.L l (GHC.TypeSig names t@(GHC.L lt _))) toks = r-  where-    -- TODO: make sure a grouped span completely covers the gap-    --       between the names and the type, so it can be replaced later-    (s1,bindToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nameToks,toks'') = splitToksForList names bindToks-    (s3,typeToks,s4)     = splitToksIncComments (ghcSpanStartEnd lt) toks''-    nameLayout = allocList names nameToks allocLocated-    typeLayout = allocType t typeToks-    -- The nameLayout cannot have leading and/or trailing comment Nodes, based on the way the tokens are split.-    nsub = ghead "allocSig.1" nameLayout-    tsub = ghead "allocSig.2" typeLayout-    (_,ne) = treeStartEnd nsub-    (tb,_) = treeStartEnd tsub-    gap = (ne,tb)-    gapLayout = [Node (Entry gap NoChange []) (makeLeafFromToks s3)]-    r = [makeGroup (strip $ (makeLeafFromToks s1)-               ++ (makeLeafFromToks s2)-               ++ nameLayout ++ gapLayout ++ typeLayout-               ++ (makeLeafFromToks s4) ++ (makeLeafFromToks toks'))]-allocSig (GHC.L l (GHC.GenericSig names t@(GHC.L lt _))) toks = r-  where-    (s1,bindToks,toks')  = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nameToks,toks'') = splitToksForList names bindToks-    (s3,typeToks,s4)     = splitToksIncComments (ghcSpanStartEnd lt) toks''-    nameLayout = allocList names nameToks allocLocated-    typeLayout = allocType t typeToks-    r = [makeGroup (strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-            ++ nameLayout ++ (makeLeafFromToks s3) ++typeLayout-            ++ (makeLeafFromToks s4) ++ (makeLeafFromToks toks') )]-allocSig (GHC.L l (GHC.IdSig _i)) toks = r-  where-    (s1,nameToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ [makeLeaf l NoChange nameToks])-              ++ (makeLeafFromToks toks') ]-allocSig (GHC.L l (GHC.FixSig (GHC.FixitySig n@(GHC.L ln _) _fix))) toks = r-  where-    (s1,fToks,toks')   = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,fixToks) = splitToksIncComments (ghcSpanStartEnd ln) fToks--    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ (allocLocated n nToks)-              ++ (makeLeafFromToks s2) ++ (makeLeafFromToks fixToks))-              ++ (makeLeafFromToks toks') ]-allocSig (GHC.L l (GHC.InlineSig n@(GHC.L ln _) _ip)) toks = r-  where-    (s1,sigToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,ipToks)  = splitToksIncComments (ghcSpanStartEnd ln) sigToks-    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ (allocLocated n nToks)-              ++ (makeLeafFromToks s2) ++ (makeLeafFromToks ipToks))-              ++ (makeLeafFromToks toks') ]-allocSig (GHC.L l (GHC.SpecSig n@(GHC.L ln _) t@(GHC.L lt _) _ip)) toks = r-  where-    (s1,sigToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,toks'')  = splitToksIncComments (ghcSpanStartEnd ln) sigToks-    (s3,tToks,ipToks)  = splitToksIncComments (ghcSpanStartEnd lt) toks''-    nameLayout = allocLocated n nToks-    typeLayout = allocType t tToks-    ipLayout = makeLeafFromToks ipToks-    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ nameLayout ++ (makeLeafFromToks s2)-              ++ typeLayout ++ (makeLeafFromToks s3) ++ ipLayout-              ++ (makeLeafFromToks toks')) ]-allocSig (GHC.L l (GHC.SpecInstSig t)) toks = r-  where-    (s1,sigToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    r = [makeGroup $ (strip $ (makeLeafFromToks s1) ++ allocType t sigToks-              ++ (makeLeafFromToks toks')) ]---- -----------------------------------------------------------------------allocArithSeqInfo :: GHC.ArithSeqInfo GHC.RdrName -> [PosToken] -> [LayoutTree]-allocArithSeqInfo (GHC.From e) toks = allocExpr e toks-allocArithSeqInfo (GHC.FromThen e1@(GHC.L l _) e2) toksIn = r-  where-    (s1,e1Toks,e2Toks) = splitToksIncComments (ghcSpanStartEnd l) toksIn-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    r = strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout--allocArithSeqInfo (GHC.FromTo e1@(GHC.L l _) e2) toksIn = r-  where-    (s1,e1Toks,e2Toks) = splitToksIncComments (ghcSpanStartEnd l) toksIn-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    r = strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout-allocArithSeqInfo (GHC.FromThenTo e1@(GHC.L l1 _) e2@(GHC.L l2 _) e3) toksIn = r-  where-    (s1,e1Toks,toks)   = splitToksIncComments (ghcSpanStartEnd l1) toksIn-    (s2,e2Toks,e3Toks) = splitToksIncComments (ghcSpanStartEnd l2) toks-    e1Layout = allocExpr e1 e1Toks-    e2Layout = allocExpr e2 e2Toks-    e3Layout = allocExpr e3 e3Toks-    r = strip $ (makeLeafFromToks s1) ++ e1Layout ++ e2Layout ++ (makeLeafFromToks s2) ++  e3Layout---- -----------------------------------------------------------------------allocType :: GHC.LHsType GHC.RdrName -> [PosToken] -> [LayoutTree]-allocType (GHC.L l (GHC.HsForAllTy _ef vars (GHC.L lc ctx) typ) ) toks = r-  where-    (s1,exprToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-#if __GLASGOW_HASKELL__ > 704-    (varsLayout,toks2) = allocTyVarBndrs vars exprToks-#else-    (s1',tp,toks2) = splitToksForList vars exprToks-    varsLayout = strip $ (makeLeafFromToks s1') ++ allocList vars tp allocTyVarBndr-#endif-    (s2,ctxToks,toks3) = splitToksIncComments (ghcSpanStartEnd lc) toks2--    ctxLayout = allocHsContext ctx ctxToks-    typLayout = allocType typ toks3--    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ varsLayout-             ++ (makeLeafFromToks s2) ++ ctxLayout-             ++ typLayout ++ (makeLeafFromToks toks')]-allocType n@(GHC.L _l (GHC.HsTyVar _) ) toks = allocLocated n toks-allocType (GHC.L l (GHC.HsAppTy t1@(GHC.L l1 _) t2@(GHC.L _ _)) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,t2Toks) = splitToksIncComments (ghcSpanStartEnd l1) typeToks-    t1Layout = allocType t1 t1Toks-    t2Layout = allocType t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ t2Layout ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsFunTy t1@(GHC.L l1 _) t2@(GHC.L _ _)) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,t2Toks) = splitToksIncComments (ghcSpanStartEnd l1) typeToks-    t1Layout = allocType t1 t1Toks-    t2Layout = allocType t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ t2Layout ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsListTy t1@(GHC.L l1 _)) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) typeToks-    t1Layout = allocType t1 t1Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks toks2) ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsPArrTy t1@(GHC.L l1 _)) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) typeToks-    t1Layout = allocType t1 t1Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks toks2) ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsTupleTy _sort types)) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    typesLayout = allocList types typeToks allocType-    r = [makeGroup $ strip $ (makeLeafFromToks s1)-             ++ typesLayout ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsOpTy t1@(GHC.L l1 _) _op t2@(GHC.L l2 _))) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) toks1-    (s4,t2Toks,toks4) = splitToksIncComments (ghcSpanStartEnd l2) toks2-    t1Layout = allocType t1 t1Toks-    -- opLayout = allocLocated op opToks-    t2Layout = allocType t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout -- ++ (makeLeafFromToks s3)-             {- ++ opLayout -} ++ (makeLeafFromToks s4)-             ++ t2Layout ++ (makeLeafFromToks toks4)-             ++ (makeLeafFromToks toks')]-allocType n@(GHC.L _l (GHC.HsParTy _) ) toks = allocLocated n toks-allocType (GHC.L l (GHC.HsIParamTy _ typ@(GHC.L lt _)) ) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,typToks,toks2) = splitToksIncComments (ghcSpanStartEnd lt) toks1-    typLayout = allocType typ typToks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ typLayout ++ (makeLeafFromToks toks2)-             ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsEqTy t1@(GHC.L l1 _) t2@(GHC.L l2 _))) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) toks1-    (s3,t2Toks,toks3) = splitToksIncComments (ghcSpanStartEnd l2) toks2-    t1Layout = allocType t1 t1Toks-    t2Layout = allocType t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks s3)-             ++ t2Layout ++ (makeLeafFromToks toks3)-             ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsKindSig t1@(GHC.L l1 _) t2@(GHC.L l2 _))) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) toks1-    (s3,t2Toks,toks3) = splitToksIncComments (ghcSpanStartEnd l2) toks2-    t1Layout = allocType t1 t1Toks-    t2Layout = allocType t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks s3)-             ++ t2Layout ++ (makeLeafFromToks toks3)-             ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsQuasiQuoteTy (GHC.HsQuasiQuote _n _lq _)) ) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    quoteLayout = makeLeafFromToks toks1-    r = [makeGroup $ strip $ (makeLeafFromToks s1)-             ++ quoteLayout-             ++ (makeLeafFromToks toks') ]-allocType (GHC.L l (GHC.HsSpliceTy (GHC.HsSplice _n e@(GHC.L le _)) _fv _k) ) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,eToks,toks2) = splitToksIncComments (ghcSpanStartEnd le) toks1-    eLayout = allocExpr e eToks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ eLayout ++ (makeLeafFromToks toks2)-             ++ (makeLeafFromToks toks') ]-allocType (GHC.L l (GHC.HsDocTy t1@(GHC.L l1 _) t2@(GHC.L l2 _))) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) toks1-    (s3,t2Toks,toks3) = splitToksIncComments (ghcSpanStartEnd l2) toks2-    t1Layout = allocType t1 t1Toks-    t2Layout = allocLocated t2 t2Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks s3)-             ++ t2Layout ++ (makeLeafFromToks toks3)-             ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsBangTy _ t1@(GHC.L l1 _)) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,t1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd l1) typeToks-    t1Layout = allocType t1 t1Toks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ t1Layout ++ (makeLeafFromToks toks2) ++ (makeLeafFromToks toks')]-allocType (GHC.L l (GHC.HsRecTy decls) ) toks = r-  where-    (s1,typeToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (declsLayout,toks1) = allocConDeclFieldList decls typeToks-    r = [makeGroup $ strip $ (makeLeafFromToks s1)-             ++ declsLayout-             ++ (makeLeafFromToks toks1)-             ++ (makeLeafFromToks toks') ]-allocType n@(GHC.L _l (GHC.HsCoreTy _) ) toks = allocLocated n toks-allocType (GHC.L _l (GHC.HsExplicitListTy  _ ts) ) toks = allocList ts toks allocType-allocType (GHC.L _l (GHC.HsExplicitTupleTy _ ts) ) toks = allocList ts toks allocType-#if __GLASGOW_HASKELL__ > 704-allocType n@(GHC.L _l (GHC.HsTyLit _) ) toks = allocLocated n toks-#endif-allocType (GHC.L l (GHC.HsWrapTy _ typ) ) toks = allocType (GHC.L l typ) toks---- -----------------------------------------------------------------------allocInstDecl :: GHC.LInstDecl GHC.RdrName -> [PosToken] -> [LayoutTree]-#if __GLASGOW_HASKELL__ > 704-allocInstDecl (GHC.L l (GHC.ClsInstD polyTy@(GHC.L lt _) binds sigs famInsts)) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,polytToks,toks2) = splitToksIncComments (ghcSpanStartEnd lt) toks1--    polytLayout = allocType polyTy polytToks--    -- TODO: will require 3-way merge of binds,sigs and famInsts-    bindList = GHC.bagToList binds-    bindMix = makeMixedListEntry bindList (shim allocBind)-    sigMix  = makeMixedListEntry sigs (shim allocSig)-    famMix  = makeMixedListEntry famInsts (shim allocLFamInstDecl)--    bindsLayout' = allocMixedList (bindMix++sigMix++famMix) toks2-    r = strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ polytLayout ++ bindsLayout'-             ++ (makeLeafFromToks toks')-allocInstDecl (GHC.L l (GHC.FamInstD decl)) toks = r-  where-    (s1,toks1,s2) = splitToksIncComments (ghcSpanStartEnd l) toks-    declLayout = allocLFamInstDecl (GHC.L l decl) toks1-    r = strip $(makeLeafFromToks s1) ++ declLayout ++ (makeLeafFromToks s2)-#else--- InstDecl (LHsType name) (LHsBinds name) [LSig name] [LTyClDecl name]-allocInstDecl (GHC.L l (GHC.InstDecl (GHC.L ln _) binds sigs tycldecls)) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks--    -- TODO: will require 3-way merge of binds,sigs and famInsts-    bindList = GHC.bagToList binds-    bindMix = makeMixedListEntry bindList (shim allocBind)-    sigMix  = makeMixedListEntry sigs (shim allocSig)-    famMix  = makeMixedListEntry tycldecls (shim allocLTyClDecl)--    bindsLayout' = allocMixedList (bindMix++sigMix++famMix) toks1-    r = strip $ (makeLeafFromToks s1)-             ++ bindsLayout'-             ++ (makeLeafFromToks toks')-#endif---- -----------------------------------------------------------------------#if __GLASGOW_HASKELL__ > 704-allocLFamInstDecl :: GHC.LFamInstDecl GHC.RdrName -> [PosToken] -> [LayoutTree]-allocLFamInstDecl (GHC.L l (GHC.FamInstDecl n@(GHC.L ln _) (GHC.HsWB typs _ _) defn _fvs)) toks = r-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nToks,toks2) = splitToksIncComments (ghcSpanStartEnd ln) toks1-    (s3,typsToks,defnToks) = splitToksForList typs toks2--    nLayout = allocLocated n nToks-    patsLayout = allocList typs typsToks allocType-    (defnLayout,s4) = allocHsTyDefn defn defnToks-    r = strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ nLayout ++ (makeLeafFromToks s3)-             ++ patsLayout ++ defnLayout-             ++ (makeLeafFromToks s4)-             ++ (makeLeafFromToks toks')-#endif---- -----------------------------------------------------------------------allocTupArgList :: [GHC.HsTupArg GHC.RdrName] -> [PosToken] -> [LayoutTree]-allocTupArgList tas toksIn = r-  where-    go :: ([LayoutTree],[PosToken]) -> [GHC.HsTupArg GHC.RdrName] -> ([LayoutTree],[PosToken])-    go (acc,toks) [] = (acc,toks)-    go (acc,toks) ((GHC.Missing _):ts')    = go (acc,toks) ts'-    go (acc,toks) ((GHC.Present expr@(GHC.L l _)):ts') = go (acc++exprLayout,toks') ts'-      where-        (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-        eLayout = allocExpr expr toks1-        exprLayout = strip $ (makeLeafFromToks s1) ++ eLayout-    (lay,toksOut) = go ([],toksIn) tas-    r = strip $ lay ++ (makeLeafFromToks toksOut)---- -----------------------------------------------------------------------allocLocated :: GHC.Located b -> [PosToken] -> [LayoutTree]-allocLocated (GHC.L l _) toks = r-  where-    (s1,toks1,s2) = splitToksIncComments (ghcSpanStartEnd l) toks-    r = strip $ (makeLeafFromToks s1) ++ [makeLeaf l NoChange toks1] ++ (makeLeafFromToks s2)---- -----------------------------------------------------------------------#if __GLASGOW_HASKELL__ > 704-allocTyVarBndrs :: GHC.LHsTyVarBndrs GHC.RdrName -> [PosToken] -> ([LayoutTree],[PosToken])-allocTyVarBndrs (GHC.HsQTvs _kvs tvs) toks = (r,s1)-  where-    (kvsToks,tyvarToks,s1) = splitToksForList tvs toks-    tyvarLayout = allocList tvs tyvarToks allocTyVarBndr-    r = (strip $ (makeLeafFromToks kvsToks) ++ tyvarLayout)-#else--#endif---- -----------------------------------------------------------------------allocTyVarBndr :: GHC.LHsTyVarBndr GHC.RdrName -> [PosToken] -> [LayoutTree]-#if __GLASGOW_HASKELL__ > 704-allocTyVarBndr n@(GHC.L l (GHC.UserTyVar _  )) toks = r-#else-allocTyVarBndr n@(GHC.L l (GHC.UserTyVar _ _)) toks = r-#endif-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    nLayout = allocLocated n toks1-    r = strip $ (makeLeafFromToks s1) ++ nLayout-             ++ (makeLeafFromToks toks')-#if __GLASGOW_HASKELL__ > 704-allocTyVarBndr (GHC.L l (GHC.KindedTyVar _n k@(GHC.L lk _)  )) toks = r-#else-allocTyVarBndr (GHC.L l (GHC.KindedTyVar _n k@(GHC.L lk _) _)) toks = r-#endif-  where-    (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (nToks,kToks,toks2) = splitToksIncComments (ghcSpanStartEnd lk) toks1-    nLayout = makeLeafFromToks nToks-    kindLayout = allocType k kToks-    r = strip $ (makeLeafFromToks s1) ++ nLayout-             ++ kindLayout ++ (makeLeafFromToks toks2)-             ++ (makeLeafFromToks toks')---- -----------------------------------------------------------------------#if __GLASGOW_HASKELL__ > 704-allocHsTyDefn :: GHC.HsTyDefn GHC.RdrName -> [PosToken] -> ([LayoutTree],[PosToken])-allocHsTyDefn (GHC.TySynonym typ@(GHC.L l _)) toks = (r,toks')-  where-    (s1,typToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    typeLayout = allocType typ typToks-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ typeLayout]-allocHsTyDefn (GHC.TyData _ (GHC.L lc ctx) mc mk cons mderivs) toks = (r,toks')-  where-    (s1,ctxToks,toks2) = splitToksIncComments (ghcSpanStartEnd lc) toks-    ctxLayout = allocHsContext ctx ctxToks--    -- TODO: correctly determine the token range for this-    (mcLayout,toks3) = case mc of-      Nothing -> ([],toks2)-      Just ct -> (rc,toks2')-        where-          ctLayout = allocCType ct toks2-          toks2' = toks2-          rc = strip $ ctLayout--    (mkLayout,toks4) = case mk of-      Nothing -> ([],toks3)-      Just k@(GHC.L lk _) -> (rk,toks3')-        where-          (sk,kToks,toks3') = splitToksIncComments (ghcSpanStartEnd lk) toks3-          kindLayout = allocHsKind k kToks-          rk = strip $ (makeLeafFromToks sk) ++ kindLayout--    (s2,consToks,toks5) = splitToksForList cons toks4-    consLayout = allocList cons consToks allocConDecl--    (mderivsLayout,toks6) = case mderivs of-      Nothing -> ([],toks5)-      Just ds -> (rd,toksd)-        where-          (sd,derivToks,toksd) = splitToksForList ds toks5-          derivLayout = allocList ds derivToks allocType-          rd = strip $ (makeLeafFromToks sd) ++ derivLayout-    toks' = toks6-    r = [makeGroup $ strip $ (makeLeafFromToks s1) ++ ctxLayout ++ mcLayout ++ mkLayout-             ++ (makeLeafFromToks s2) ++ consLayout ++ mderivsLayout]-#endif---- -----------------------------------------------------------------------allocConDecl :: GHC.LConDecl GHC.RdrName -> [PosToken] -> [LayoutTree]-allocConDecl (GHC.L l (GHC.ConDecl n@(GHC.L ln _) _expl qvars (GHC.L lc ctx) details res mdoc _)) toks = r-  where-    (s1,conDeclToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-    (s2,nameToks,toks2) = splitToksIncComments (ghcSpanStartEnd ln) conDeclToks-    nameLayout = allocLocated n nameToks-#if __GLASGOW_HASKELL__ > 704-    (qvarsLayout,toks3) = allocTyVarBndrs qvars toks2-#else-    qvarsLayout = allocList qvars toks2 allocTyVarBndr-    toks3 = []-#endif-    (s3,ctxToks,toks4) = splitToksIncComments (ghcSpanStartEnd lc) toks3-    ctxLayout = allocHsContext ctx ctxToks--    (detailsLayout,toks5) = allocHsConDeclDetails details toks4-    (resLayout,toks6) = case res of-      GHC.ResTyH98 -> ([],toks5)-      GHC.ResTyGADT (ty@(GHC.L lt _)) -> (rt,toks6')-        where-          (st,tyToks,toks6') = splitToksIncComments (ghcSpanStartEnd lt) toks5-          tyLayout = allocType ty tyToks-          rt = strip $ (makeLeafFromToks st) ++ tyLayout--    (docLayout,toks7) = case mdoc of-      Nothing -> ([],toks6)-      Just ds@(GHC.L ld _) -> (rd,toks7')-        where-          (sd,dsToks,toks7') = splitToksIncComments (ghcSpanStartEnd ld) toks6-          dsLayout = allocLocated ds dsToks-          rd = strip (makeLeafFromToks sd) ++ dsLayout--    r = strip $ (makeLeafFromToks s1) ++ (makeLeafFromToks s2)-             ++ nameLayout ++ qvarsLayout ++ (makeLeafFromToks s3)-             ++ ctxLayout ++ detailsLayout ++ resLayout-             ++ docLayout ++ (makeLeafFromToks toks7)-             ++ (makeLeafFromToks toks')---- -----------------------------------------------------------------------allocHsConDeclDetails :: GHC.HsConDeclDetails GHC.RdrName -> [PosToken] -> ([LayoutTree],[PosToken])-allocHsConDeclDetails (GHC.PrefixCon ds) toks = (r,toks')-  where-    (s1,dsToks,toks') = splitToksForList ds toks-    dsLayout = allocList ds dsToks allocLBangType-    r = strip $ (makeLeafFromToks s1) ++ dsLayout-allocHsConDeclDetails (GHC.RecCon conDecls) toks = allocConDeclFieldList conDecls toks-allocHsConDeclDetails (GHC.InfixCon bt1@(GHC.L lb1 _) bt2@(GHC.L lb2 _)) toks = (r,toks')-  where-    (s1,bt1Toks,toks2) = splitToksIncComments (ghcSpanStartEnd lb1) toks-    (s2,bt2Toks,toks') = splitToksIncComments (ghcSpanStartEnd lb2) toks2-    bt1Layout = allocType bt1 bt1Toks-    bt2Layout = allocType bt2 bt2Toks--    r = strip $ (makeLeafFromToks s1) ++ bt1Layout-             ++ (makeLeafFromToks s2) ++ bt2Layout---- -----------------------------------------------------------------------allocConDeclFieldList :: [GHC.ConDeclField GHC.RdrName] -> [PosToken] -> ([LayoutTree],[PosToken])-allocConDeclFieldList conDecls toks = (r,toks')-  where-    (r,toks') = foldl' doOne ([],toks) conDecls--    doOne (acc,toksOne) cdf = (r1,toks2)-      where-        (lay,toks2) = allocConDeclField cdf toksOne-        r1 = acc ++ lay--allocConDeclField :: GHC.ConDeclField GHC.RdrName -> [PosToken] -> ([LayoutTree],[PosToken])-allocConDeclField (GHC.ConDeclField n@(GHC.L ln _) typ@(GHC.L lb _) mdoc) toks = (r,toks')-  where-    (s1,nToks,toks1) = splitToksIncComments (ghcSpanStartEnd ln) toks-    nLayout = allocLocated n nToks-    (s2,btToks,toks2) = splitToksIncComments (ghcSpanStartEnd lb) toks1-    btLayout = allocLBangType typ btToks-    (mdocLayout,toks') = case mdoc of-      Nothing -> ([],toks2)-      Just ldoc@(GHC.L ld _) -> (rd,toks2')-        where-          (sd,docToks,toks2') = splitToksIncComments (ghcSpanStartEnd ld) toks2-          rdLayout = allocLocated ldoc docToks-          rd = strip $ (makeLeafFromToks sd) ++ rdLayout-    r = strip $ (makeLeafFromToks s1) ++ nLayout ++ (makeLeafFromToks s2)-             ++ btLayout ++ mdocLayout---- -----------------------------------------------------------------------allocLBangType :: GHC.LBangType GHC.RdrName -> [PosToken] -> [LayoutTree]-allocLBangType bt toks = allocType bt toks---- -----------------------------------------------------------------------allocHsKind :: GHC.LHsKind GHC.RdrName -> [PosToken] -> [LayoutTree]-allocHsKind = error "allocHsKind undefined"---- -----------------------------------------------------------------------#if __GLASGOW_HASKELL__ > 704-allocCType :: GHC.CType -> [PosToken] -> [LayoutTree]-#endif-allocCType = error "allocCType undefined"---- -----------------------------------------------------------------------allocHsContext :: GHC.HsContext GHC.RdrName -> [PosToken] -> [LayoutTree]-allocHsContext ts toks = r-  where-    r = allocList ts toks allocType---- -----------------------------------------------------------------------strip :: [LayoutTree] -> [LayoutTree]-strip ls = filter (not . emptyNode) ls-  where-    emptyNode (Node (Entry _ _ []) []) = True-    emptyNode _                        = False---- -----------------------------------------------------------------------allocList ::-      [GHC.Located b]-   -> [PosToken]-   -> (GHC.Located b -> [PosToken] -> [LayoutTree])-   -> [LayoutTree]-allocList xs toksIn allocFunc = r-  where-    (s2,listToks,toks2') = splitToksForList xs toksIn-    (layout,toks2) = (allocAll xs listToks,toks2')--    allocAll xs' toks = res-      where-        (declLayout,tailToks) = foldl' doOne ([],toks) xs'--        res = strip $ declLayout ++ (makeLeafFromToks tailToks)--        -- doOne :: ([LayoutTree],[PosToken]) -> GHC.Located a -> ([LayoutTree],[PosToken])-        doOne (acc,toksOne) x@(GHC.L l _) = r1-          where-            (s1,funcToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toksOne-            layout' = (makeLeafFromToks s1) ++ [makeGroup (strip $ allocFunc x funcToks)]-            r1 = (acc ++ (strip layout'),toks')--    -- r = strip $ (makeLeafFromToks s2) ++ layout ++ (makeLeafFromToks toks2)-    r = strip $ (makeLeafFromToks s2) ++ [makeGroup $ strip $ layout] ++ (makeLeafFromToks toks2)---- ------------------------------------------------------------------------- TODO: get rid of this in favour of mix stuf-allocInterleavedLists :: [GHC.Located a] -> [GHC.Located b] -> [PosToken]-   -> (GHC.Located a -> [PosToken] -> [LayoutTree])-   -> (GHC.Located b -> [PosToken] -> [LayoutTree])-   -> [LayoutTree]-allocInterleavedLists axs bxs toksIn allocFuncA allocFuncB = r-  where-    -- go :: ([LayoutTree],[PosToken]) -> [GHC.Located a] -> [GHC.Located b] -> ([LayoutTree],[PosToken])-    go (acc,ts) []     []     = (acc,ts)-    go (acc,ts) (a:as) []     = go (acc ++ aa,ts') as []-        where-          (aa,ts') = allocA a ts-    go (acc,ts) []     (b:bs) = go (acc ++ bb,ts') [] bs-        where-          (bb,ts') = allocB b ts-    go (acc,ts) (a:as) (b:bs) = if GHC.getLoc a < GHC.getLoc b-                             then go (acc ++ aa,tsa') as (b:bs)-                             else go (acc ++ bb,tsb') (a:as) bs-        where-          (aa,tsa') = allocA a ts-          (bb,tsb') = allocB b ts--    -- allocA :: GHC.Located a -> [PosToken] -> ([LayoutTree],[PosToken])-    allocA x@(GHC.L l _) toks = (r',toks')-      where-        (s1,funcToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-        funcLayout = allocFuncA x funcToks-        r' = strip $ (makeLeafFromToks s1) ++ [makeGroup (strip funcLayout)]--    -- allocB :: GHC.Located b -> [PosToken] -> ([LayoutTree],[PosToken])-    allocB x@(GHC.L l _) toks = (r',toks')-      where-        (s1,funcToks,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-        funcLayout = allocFuncB x funcToks-        r' = strip $ (makeLeafFromToks s1) ++ [makeGroup (strip funcLayout)]--    (layout,s2) = go ([],toksIn) axs bxs-    r = strip $ layout ++ (makeLeafFromToks s2)---- -----------------------------------------------------------------------shim ::-    (GHC.Located a -> [PosToken] -> [LayoutTree])- -> (GHC.Located a -> [PosToken] -> ([LayoutTree],[PosToken]))-shim f = f'-  where-    f' x@(GHC.L l _) toks = (r,toks')-      where-        (s1,toks1,toks') = splitToksIncComments (ghcSpanStartEnd l) toks-        r = strip $ (makeLeafFromToks s1) ++ f x toks1--makeMixedListEntry ::-      [GHC.Located a]-   -> (GHC.Located a -> [PosToken] -> ([LayoutTree],[PosToken]))-   -> [(SimpPos,([PosToken] -> ([LayoutTree],[PosToken])))]-makeMixedListEntry xs f = map (\x@(GHC.L l _) -> (fst $ ghcSpanStartEnd l,f x)) xs--allocMixedList ::-       [(SimpPos,([PosToken] -> ([LayoutTree],[PosToken])))]-   -> [PosToken] -> [LayoutTree]-allocMixedList xs toksIn = r-  where-    xs' = sortBy (\(p1,_) (p2,_) -> compare p1 p2) xs-    (layout,toksFin) = foldl' doOne ([],toksIn) xs'--    doOne :: ([LayoutTree],[PosToken]) -> (SimpPos,([PosToken] -> ([LayoutTree],[PosToken])))-              -> ([LayoutTree],[PosToken])-    doOne (acc,toks) (_,f) = (acc++lay,toks')-      where-        (lay,toks') = f toks--    r = strip $ layout ++ (makeLeafFromToks toksFin)---- ------------------------------------------------------------------------- | Split the given tokens into the ones that occur prior to the start--- of the list and ones that occur after-splitToksForList :: [GHC.Located a] -> [PosToken] -> ([PosToken],[PosToken],[PosToken])-splitToksForList [] toks = ([],[],toks)-splitToksForList xs toks = splitToksIncComments (getGhcLoc s, getGhcLocEnd e) toks-  where-    (GHC.L s _) = head xs-    (GHC.L e _) = last xs---- -----------------------------------------------------------------------calcLastTokenPos :: [PosToken] -> (Int,Int)-calcLastTokenPos toks = (rt,ct)-  where-    (rt,ct) = case (dropWhile isEmpty (reverse toks)) of-             []    -> (0,0)-             (x:_) -> (tokenRow x,tokenCol x + tokenLen x)---- -----------------------------------------------------------------------placeAbove :: EndOffset -> (Row,Col) -> (Row,Col) -> [LayoutTree] -> LayoutTree-placeAbove _ _ _ [] = error "placeAbove []"-placeAbove so p1 p2 ls = Node (Entry loc (Above so p1 p2 None) []) ls-  where-    loc = combineSpans (getLoc $ head ls) (getLoc $ last ls)---- -----------------------------------------------------------------------makeGroup :: [LayoutTree] -> LayoutTree-makeGroup [x] = x-makeGroup ls  = makeGroupLayout NoChange ls--makeGroupLayout :: Layout -> [LayoutTree] -> LayoutTree-makeGroupLayout lay ls = Node (Entry loc lay []) ls-  where-    loc = case ls of-           [] -> sf nullSrcSpan-           _  -> combineSpans (getLoc $ head ls) (getLoc $ last ls)--mkGroup :: GHC.SrcSpan -> Layout -> [LayoutTree] -> LayoutTree-mkGroup sspan lay subs = Node (Entry (sf sspan) lay []) subs---- -----------------------------------------------------------------------makeLeafFromToks :: [PosToken] -> [LayoutTree]-makeLeafFromToks [] = []-makeLeafFromToks toks = [Node (Entry loc NoChange toks) []]-  where-    loc = sspan--    (startLoc',endLoc') = nonCommentSpanLayout toks-    sspan    = if (startLoc',endLoc') == ((0,0),(0,0))-      then error $ "mkLeafFromToks:null span for:" ++ (show toks)-      else simpPosToForestSpan (startLoc',endLoc')---- ------------------------------------------------------------------------- |Extract the start and end position of a span, without any leading--- or trailing comments-nonCommentSpanLayout :: [PosToken] -> (SimpPos,SimpPos)-nonCommentSpanLayout [] = ((0,0),(0,0))-nonCommentSpanLayout toks = (startPos,endPos)-  where-    stripped = dropWhile isComment $ toks-    (startPos,endPos) = case stripped of-      -- [] -> ((0,0),(0,0))-      [] -> (tokenPos $ head toks,tokenPosEnd $ last toks)-      _ -> (tokenPos startTok,tokenPosEnd endTok)-       where-        startTok = ghead "nonCommentSpan.1" $ dropWhile isComment $ toks-        endTok   = ghead "nonCommentSpan.2" $ dropWhile isComment $ reverse toks---makeLeaf :: GHC.SrcSpan -> Layout -> [PosToken] -> LayoutTree-makeLeaf sspan lay toks = Node (Entry (sf sspan) lay toks) []---- -----------------------------------------------------------------------getLoc :: LayoutTree -> ForestSpan-getLoc (Node (Entry   l _ _) _) = l-getLoc (Node (Deleted l _ _) _) = l---- -----------------------------------------------------------------------retrieveTokens :: LayoutTree -> [PosToken]-retrieveTokens layout = go [] layout-  where-    -- go acc (Group _ _ xs)  = acc ++ (concat $ map (go []) xs)-    -- go acc (Leaf _ _ toks) = acc ++ toks-    go acc (Node (Entry _ _ []  ) xs) = acc ++ (concat $ map (go []) xs)-    go acc (Node (Entry _ _ toks)  _) = acc ++ toks-    go acc (Node (Deleted _ _ _)   _) = acc---- ------------------------------------------------------------------------- | Split the given tokens to include the comments belonging to the span.-splitToksIncComments ::-     (SimpPos, SimpPos)-  -> [PosToken]-  -> ([PosToken], [PosToken], [PosToken])-splitToksIncComments pos toks = splitToks pos' toks-  where-    pos' = startEndLocIncComments' toks pos---- ----------------------------------------------------------------------

@@ -1,28 +0,0 @@--- |-----module Language.Haskell.Refact.Utils.LayoutTypes (-    TokenLayout(..)-  , LayoutTree-  , Label(..)-  ) where--import GHC--import Data.Tree--import Language.Haskell.Refact.Utils.TypeSyn-import Language.Haskell.Refact.Utils.TokenUtilsTypes---- -----------------------------------------------------------------------data TokenLayout = TL (Tree Entry)--type LayoutTree = Tree Entry---- ------------------------------------------------------------------------data Label = Label GHC.SrcSpan Layout [PosToken]--

@@ -6,11 +6,11 @@                      module HsTokens,                      PosToken,simpPos,                      -}-                     SimpPos,unmodified,modified+                       unmodified,modified                      , simpPos0                      , nullSrcSpan                      -- , emptyList, nonEmptyList-                     , showToks+                     -- , showToks                      -- , tokenLen                      -- ,lengthOfToks                      -- , mkToken, mkZeroToken {-,defaultToken, -}@@ -22,9 +22,7 @@                      , isWhiteSpace                      , isWhiteSpaceOrIgnored                      , isIgnored-                     , isIgnoredNonComment                      {--                     ,isNewLn,isCommentStart -},isComment {-,                      isNestedComment-},isMultiLineComment {-,isOpenBracket,isCloseBracket, -}                      ,isOpenSquareBracket,isCloseSquareBracket {- ,isOpenBrace,isConid,                      isLit,isWhereOrLet,isWhere,isLet-},isIn {- ,isCase,isDo,isIf,isForall,@@ -65,11 +63,6 @@                      , insertComments,                      extractComments, insertTerms                      -}-                     , tokenCol-                     , tokenColEnd-                     , tokenRow-                     , tokenPos-                     , tokenPosEnd                      , tokenSrcSpan                      , tokenCon                      , increaseSrcSpan@@ -83,7 +76,7 @@                      , fileNameFromTok                      , splitToks                      , emptyList, nonEmptyList-                     , divideComments+                     -- , divideComments                      , notWhiteSpace                      , isDoubleColon                      , isEmpty@@ -98,14 +91,13 @@                      , splitOnNewLn                      , tokenLen                      , newLnToken-                     , newLinesToken-                     , monotonicLineToks+                     -- , newLinesToken+                     -- , monotonicLineToks                      , reSequenceToks                      , mkToken                      , mkZeroToken                      , markToken                      , isMarked-                     , addOffsetToToks                      , matchTokenPos                      , rmOffsetFromToks   ) where@@ -124,19 +116,25 @@ import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.TypeSyn +import Language.Haskell.TokenUtils.GHC.Layout+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.Utils+ import Data.Maybe import Data.List  -- --------------------------------------------------------------------- -+{- showToks :: [PosToken] -> String showToks toks = show $ map (\(t@(GHC.L _ tok),s) ->                  ((getLocatedStart t, getLocatedEnd t),tok,s)) toks-+-}+{- moved to haskell-token-utils instance Show (GHC.GenLocated GHC.SrcSpan GHC.Token) where   show t@(GHC.L _l tok) = show ((getLocatedStart t, getLocatedEnd t),tok)-+-}  --A flag used to indicate whether the token stream has been modified or not. unmodified, modified :: Bool@@ -147,8 +145,8 @@ simpPos0 :: (Int,Int) simpPos0 = (0,0) -nullSrcSpan :: GHC.SrcSpan-nullSrcSpan = GHC.UnhelpfulSpan $ GHC.mkFastString "HaRe nullSrcSpan"+-- nullSrcSpan :: GHC.SrcSpan+-- nullSrcSpan = GHC.UnhelpfulSpan $ GHC.mkFastString "HaRe nullSrcSpan"  ------------------------------------------------ @@ -204,12 +202,12 @@ isClass (t, (_,s)) = t == Reservedid && s=="class" isInstance (t, (_,s)) = t == Reservedid && s=="instance" isNewtype (t, (_,s)) = t == Reservedid && s=="newtype"--}+ isIn :: PosToken -> Bool isIn    ((GHC.L _ t),_s) = case t of                       GHC.ITin -> True                       _        -> False-{-+ isCase  (t,(_,s))  = t==Reservedid && s=="case" isDo    (t,(_,s))  = t==Reservedid && s=="do" isIf    (t,(_,s))  = t==Reservedid && s=="if"@@ -396,8 +394,8 @@       (toks1,toks2) = break (\t -> tokenPos t >= pos && tokenLen t > 0) toks       toksRest = if (emptyList toks2) then [] else (gtail "replaceTokNoReAlign" toks2)       oldTok  =  if (emptyList toks2) then newTok else (ghead "replaceTokNoReAlign" toks2)-      -- newTok' = markToken newTok-      newTok' = markToken $ matchTokenPos oldTok newTok+      -- newTok' = markToken $ matchTokenPos oldTok newTok+      newTok' = matchTokenPos oldTok newTok  -- --------------------------------------------------------------------- @@ -608,25 +606,8 @@   -- ------------------------------------------------------------------------ Returned from TokenUtils - --Some functions for fetching a specific field of a token-tokenCol :: PosToken -> Int-tokenCol (GHC.L l _,_) = c where (_,c) = getGhcLoc l--tokenColEnd :: PosToken -> Int-tokenColEnd (GHC.L l _,_) = c where (_,c) = getGhcLocEnd l--tokenRow :: PosToken -> Int-tokenRow (GHC.L l _,_) = r where (r,_) = getGhcLoc l--tokenPos :: (GHC.GenLocated GHC.SrcSpan t1, t) -> SimpPos-tokenPos (GHC.L l _,_)     = getGhcLoc l--tokenPosEnd :: (GHC.GenLocated GHC.SrcSpan t1, t) -> SimpPos-tokenPosEnd (GHC.L l _,_)     = getGhcLocEnd l- tokenSrcSpan :: (GHC.Located t1, t) -> GHC.SrcSpan tokenSrcSpan (GHC.L l _,_)     = l @@ -635,7 +616,7 @@ tokenCon (_,s)     = s  -- ----------------------------------------------------------------------+{- increaseSrcSpan :: SimpPos -> PosToken -> PosToken increaseSrcSpan (lineAmount,colAmount) posToken@(lt@(GHC.L _l t), s)     = (GHC.L newL t, s)@@ -649,7 +630,7 @@         add1 :: (Int, Int) -> (Int, Int)         add1 (r,c) = (r+lineAmount,c+colAmount) -+-} -- ---------------------------------------------------------------------  -- | gets the (row,col) of the start of the @GHC.SrcSpan@, or (-1,-1)@@ -707,7 +688,7 @@ fileNameFromTok (GHC.L _ _,_) = GHC.mkFastString "f"  -- ----------------------------------------------------------------------+{- -- | Split the token stream into three parts: the tokens before the -- startPos, the tokens between startPos and endPos, and the tokens -- after endPos.@@ -721,10 +702,11 @@   in     (toks1,toks21,toks22) -+-} -- ----------------------------------------------------------------------  -- |Get around lack of instance Eq when simply testing for empty list+-- TODO: get rid of this in favour of `null` built in fn emptyList :: [t] -> Bool emptyList [] = True emptyList _  = False@@ -741,7 +723,7 @@ startEndLocIncComments::(SYB.Data t) => [PosToken] -> t -> (SimpPos,SimpPos) startEndLocIncComments toks t = startEndLocIncComments' toks (getStartEndLoc t) -+{- startEndLocIncComments' :: [PosToken] -> (SimpPos,SimpPos) -> (SimpPos,SimpPos) startEndLocIncComments' toks (startLoc,endLoc) =   let@@ -812,62 +794,44 @@     go acc [_x] = acc     go acc (((_s1,e1),_t1):b@((s2,_e2),t2):xs) = go (acc ++ [((s2 - e1),t2)] ) (b:xs) -+-} -- ---------------------------------------------------------------------  isWhiteSpace :: PosToken -> Bool isWhiteSpace tok = isComment tok || isEmpty tok-+{- notWhiteSpace :: PosToken -> Bool notWhiteSpace tok = not (isWhiteSpace tok) -isWhiteSpaceOrIgnored :: PosToken -> Bool-isWhiteSpaceOrIgnored tok = isWhiteSpace tok || isIgnored tok- -- Tokens that are ignored when allocating tokens to a SrcSpan isIgnored :: PosToken -> Bool isIgnored tok = isThen tok || isElse tok || isIn tok || isDo tok---- | Tokens that are ignored when determining the first non-comment--- token in a span-isIgnoredNonComment :: PosToken -> Bool-isIgnoredNonComment tok = isThen tok || isElse tok || isWhiteSpace tok--+-} -- ---------------------------------------------------------------------  isDoubleColon :: PosToken -> Bool isDoubleColon ((GHC.L _ (GHC.ITdcolon)), "::") = True isDoubleColon _                                = False -isComment :: PosToken -> Bool-isComment ((GHC.L _ (GHC.ITdocCommentNext _)),_s)  = True-isComment ((GHC.L _ (GHC.ITdocCommentPrev _)),_s)  = True-isComment ((GHC.L _ (GHC.ITdocCommentNamed _)),_s) = True-isComment ((GHC.L _ (GHC.ITdocSection _ _)),_s)    = True-isComment ((GHC.L _ (GHC.ITdocOptions _)),_s)      = True-isComment ((GHC.L _ (GHC.ITdocOptionsOld _)),_s)   = True-isComment ((GHC.L _ (GHC.ITlineComment _)),_s)     = True-isComment ((GHC.L _ (GHC.ITblockComment _)),_s)    = True-isComment ((GHC.L _ _),_s)                         = False-+{- isEmpty :: PosToken -> Bool isEmpty ((GHC.L _ (GHC.ITsemi)),    "") = True isEmpty ((GHC.L _ (GHC.ITvocurly)), "") = True isEmpty ((GHC.L _ _),               "") = True isEmpty _                               = False--isWhereOrLet :: PosToken -> Bool-isWhereOrLet t = isWhere t || isLet t+-}+-- isWhereOrLet :: PosToken -> Bool+-- isWhereOrLet t = isWhere t || isLet t  -- --------------------------------------------------------------------- -- This section is horrible because there is no Eq instance for -- GHC.Token +{-                       _           -> False isWhere :: PosToken -> Bool isWhere ((GHC.L _ t),_s) =  case t of                        GHC.ITwhere -> True-                       _           -> False+ isLet :: PosToken -> Bool isLet   ((GHC.L _ t),_s) =  case t of                        GHC.ITlet -> True@@ -892,7 +856,7 @@ isDo   ((GHC.L _ t),_s) =  case t of                        GHC.ITdo -> True                        _        -> False-+-}  -- --------------------------------------------------------------------- @@ -933,7 +897,7 @@     importDecl (GHC.L l _) = Just l  -- ----------------------------------------------------------------------+{- -- | Get the indent of the line before, taking into account in-line -- 'where', 'let', 'in' and 'do' tokens getIndentOffset :: [PosToken] -> SimpPos -> Int@@ -976,14 +940,14 @@       | onSameLn (glast "splitOnNewLn" ss) (head xs) = go (ss ++ [head xs]) (tail xs)       | otherwise = (ss,xs) -+-} -- ----------------------------------------------------------------------+{- tokenLen :: PosToken -> Int tokenLen (_,s)     = length s   --check this again! need to handle the tab key.-+-} -- ----------------------------------------------------------------------+{- newLnToken :: PosToken -> PosToken newLnToken tok = newLinesToken 1 tok @@ -999,17 +963,17 @@        in          GHC.mkSrcSpan loc loc      _ -> l-+-} -- --------------------------------------------------------------------- -groupTokensByLine :: [PosToken] -> [[PosToken]]-groupTokensByLine xs = groupBy toksOnSameLine xs+-- groupTokensByLine :: [PosToken] -> [[PosToken]]+-- groupTokensByLine xs = groupBy toksOnSameLine xs  toksOnSameLine :: PosToken -> PosToken -> Bool toksOnSameLine t1 t2 = tokenRow t1 == tokenRow t2  -- ----------------------------------------------------------------------+{- -- | sort out line numbering so that they are always monotonically -- increasing. monotonicLineToks :: [PosToken] -> [PosToken]@@ -1027,7 +991,7 @@      -- t1' = increaseSrcSpan (orow,ocol) t1     t2' = increaseSrcSpan offset'     t2-+-} -- ---------------------------------------------------------------------  -- |Adjust token stream to cater for changes in token length due to@@ -1036,34 +1000,28 @@ reSequenceToks toks = toks  -- ----------------------------------------------------------------------+{- -- |Compose a new token using the given arguments. mkToken::GHC.Token -> SimpPos -> String -> PosToken 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) ))--+-}+{- mkZeroToken :: PosToken mkZeroToken = mkToken GHC.ITsemi (0,0) ""---- ------------------------------------------------------------------------- |Add a constant line and column offset to a span of tokens-addOffsetToToks :: SimpPos -> [PosToken] -> [PosToken]-addOffsetToToks (r,c) toks = map (\t -> increaseSrcSpan (r,c) t) toks-+-} -- ----------------------------------------------------------------------+{- onSameLn :: PosToken -> PosToken -> Bool onSameLn (GHC.L l1 _,_) (GHC.L l2 _,_) = r1 == r2   where     (r1,_) = getGhcLoc l1     (r2,_) = getGhcLoc l2-+-} -- ----------------------------------------------------------------------+{- -- |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@@ -1092,7 +1050,7 @@   case l of     GHC.RealSrcSpan ss -> GHC.srcSpanFile ss == tokenFileMark     _                  -> False-+-} -- ---------------------------------------------------------------------  rmOffsetFromToks :: [PosToken] -> [PosToken]

@@ -43,8 +43,9 @@ import Exception import Language.Haskell.GhcMod import Language.Haskell.GhcMod.Internal-import Language.Haskell.Refact.Utils.TokenUtilsTypes+import Language.Haskell.TokenUtils.Types import Language.Haskell.Refact.Utils.TypeSyn+import Language.Haskell.TokenUtils.Utils import System.Directory import System.FilePath.Posix import System.Log.Logger@@ -91,7 +92,7 @@ data RefactModule = RefMod         { rsTypecheckedMod  :: !GHC.TypecheckedModule         , rsOrigTokenStream :: ![PosToken]  -- ^Original Token stream for the current module-        , rsTokenCache      :: !TokenCache  -- ^Token stream for the current module, maybe modified, in SrcSpan tree form+        , rsTokenCache      :: !(TokenCache PosToken)  -- ^Token stream for the current module, maybe modified, in SrcSpan tree form         , rsStreamModified  :: !Bool        -- ^current module has updated the token stream         } @@ -244,14 +245,14 @@    (libs,exes,tests,benches) <- liftIO $ cabalAllTargets pkgDesc    setCurrentDirectory currentDir -   let -- libs'    = addCurrentDir libs+   let libs'    = filter (\l -> not (isPrefixOf "Paths_" l)) libs        exes'    = addCabalDir exes        tests'   = addCabalDir tests        benches' = addCabalDir benches         addCabalDir ts = map (\t -> combine cabalDir t) ts -   return (libs,exes',tests',benches')+   return (libs',exes',tests',benches')  -- --------------------------------------------------------------------- 

@@ -11,9 +11,9 @@        (        -- * Conveniences for state access -         fetchToksFinal+       --   fetchToksFinal        -- , fetchPprFinal-       , fetchLinesFinal+         fetchLinesFinal        , fetchOrigToks        , fetchToks -- Deprecated        -- , putToks -- ^Deprecated, destroys token tree@@ -79,20 +79,21 @@  import qualified Data.Data as SYB -import Language.Haskell.Refact.Utils.DualTree import Language.Haskell.Refact.Utils.GhcVersionSpecific-import Language.Haskell.Refact.Utils.Layout--- import Language.Haskell.Refact.Utils.LayoutTypes--- import Language.Haskell.Refact.Utils.LayoutUtils import Language.Haskell.Refact.Utils.LocUtils import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.TokenUtils-import Language.Haskell.Refact.Utils.TokenUtilsTypes import Language.Haskell.Refact.Utils.TypeSyn+import Language.Haskell.TokenUtils.DualTree+import Language.Haskell.TokenUtils.GHC.Layout+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.Utils -import Data.Time.Clock++-- import Data.Time.Clock import Data.Tree-import System.Log.Logger+-- import System.Log.Logger import qualified Data.Map as Map  -- ---------------------------------------------------------------------@@ -106,6 +107,7 @@   logm $ "fetchToks (not showing toks"   return toks +{- -- |fetch the final tokens fetchToksFinal :: RefactGhc [PosToken] fetchToksFinal = do@@ -114,9 +116,10 @@   -- logm $ "fetchToks" ++ (showToks toks)   logm $ "fetchToksFinal (not showing toks)"   return toks+-}  -- |fetch the final tokens in Ppr format-fetchLinesFinal :: RefactGhc [Line]+fetchLinesFinal :: RefactGhc [Line PosToken] fetchLinesFinal = do   Just tm <- gets rsModule   let linesVal = retrieveLinesFromLayoutTree $ (tkCache $ rsTokenCache tm) Map.! mainTid@@ -138,7 +141,7 @@   let Just tm = rsModule st   let forest = getTreeFromCache sspan (rsTokenCache tm)   -- let (forest',toks) = getTokensFor checkInv forest sspan-  let (forest',toks) = getTokensForNoIntros checkInv forest sspan+  let (forest',toks) = getTokensForNoIntros checkInv forest (ss2s sspan)   let tk' = replaceTreeInCache sspan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk'})   put $ st { rsModule = rsModule' }@@ -154,7 +157,7 @@   let checkInv = False   let Just tm = rsModule st   let forest = getTreeFromCache sspan (rsTokenCache tm)-  let (forest',toks) = getTokensFor checkInv forest sspan+  let (forest',toks) = getTokensFor checkInv forest (ss2s sspan)   -- let (forest',toks) = getTokensForNoIntros checkInv forest sspan   let tk' = replaceTreeInCache sspan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk'})@@ -171,7 +174,7 @@   let checkInv = rsetCheckTokenUtilsInvariant $ rsSettings st   let Just tm = rsModule st   let forest = getTreeFromCache sspan (rsTokenCache tm)-  let (forest',toks) = getTokensFor checkInv forest sspan+  let (forest',toks) = getTokensFor checkInv forest (ss2s sspan)   let tk' = replaceTreeInCache sspan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk'})   put $ st { rsModule = rsModule' }@@ -179,12 +182,12 @@   return toks  -- |Get the current tokens preceding a given GHC.SrcSpan.-getToksBeforeSpan ::  GHC.SrcSpan -> RefactGhc ReversedToks+getToksBeforeSpan ::  GHC.SrcSpan -> RefactGhc (ReversedToks PosToken) getToksBeforeSpan sspan = do   st <- get   let Just tm = rsModule st   let forest = getTreeFromCache sspan (rsTokenCache tm)-  let (forest',toks) = getTokensBefore forest sspan+  let (forest',toks) = getTokensBefore forest (ss2s sspan)   let tk' = replaceTreeInCache sspan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk'})   put $ st { rsModule = rsModule' }@@ -199,7 +202,7 @@   st <- get   let Just tm = rsModule st -  let tk' = replaceTokenInCache (rsTokenCache tm) sspan tok+  let tk' = replaceTokenInCache (rsTokenCache tm) (ss2s sspan) tok   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True })   put $ st { rsModule = rsModule' }   return ()@@ -212,10 +215,10 @@   st <- get   let Just tm = rsModule st -  let (tk',newSpan) = putToksInCache (rsTokenCache tm) sspan toks+  let (tk',newSpan) = putToksInCache (rsTokenCache tm) (ss2s sspan) toks   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True })   put $ st { rsModule = rsModule' }-  return newSpan+  return (s2ss newSpan)  -- |Replace the tokens for a given GHC.SrcSpan, return new GHC.SrcSpan -- delimiting new tokens, and update the AST fragment to reflect it@@ -239,11 +242,11 @@   let Just tm = rsModule st   let mainForest = (tkCache $ rsTokenCache tm) Map.! mainTid   let sspan = posToSrcSpan mainForest pos-  let (tk',newSpan) = putToksInCache (rsTokenCache tm) sspan toks+  let (tk',newSpan) = putToksInCache (rsTokenCache tm) (ss2s sspan) toks   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True })   put $ st { rsModule = rsModule' }   -- drawTokenTree ""-  return newSpan+  return (s2ss newSpan)  -- |Add tokens after a designated GHC.SrcSpan putToksAfterSpan :: GHC.SrcSpan -> Positioning -> [PosToken] -> RefactGhc GHC.SrcSpan@@ -252,11 +255,11 @@   st <- get   let Just tm = rsModule st   let forest = getTreeFromCache oldSpan (rsTokenCache tm)-  let (forest',newSpan) = addToksAfterSrcSpan forest oldSpan pos toks+  let (forest',newSpan) = addToksAfterSrcSpan forest (ss2s oldSpan) pos toks   let tk' = replaceTreeInCache oldSpan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True})   put $ st { rsModule = rsModule' }-  return newSpan+  return (s2ss newSpan)  -- |Add tokens after a designated position putToksAfterPos :: (SimpPos,SimpPos) -> Positioning -> [PosToken] -> RefactGhc GHC.SrcSpan@@ -267,12 +270,12 @@   let mainForest = (tkCache $ rsTokenCache tm) Map.! mainTid   let sspan = posToSrcSpan mainForest pos   let forest = getTreeFromCache sspan (rsTokenCache tm)-  let (forest',newSpan) = addToksAfterSrcSpan forest sspan position toks+  let (forest',newSpan) = addToksAfterSrcSpan forest (ss2s sspan) position toks   let tk' = replaceTreeInCache sspan forest' $ rsTokenCache tm   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True})   put $ st { rsModule = rsModule' }   -- logm $ "putToksAfterPos result:" ++ (show forest') ++ "\ntree:\n" ++ (drawTreeEntry forest')-  return newSpan+  return (s2ss newSpan)  -- |Add tokens after a designated GHC.SrcSpan, and update the AST -- fragment to reflect it@@ -294,7 +297,7 @@   logm $ "removeToksForSpan " ++ (showGhc sspan) ++ ":" ++ (showSrcSpanF sspan)   st <- get   let Just tm = rsModule st-  let tk' = removeToksFromCache (rsTokenCache tm) sspan+  let tk' = removeToksFromCache (rsTokenCache tm) (ss2s sspan)   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True})   put $ st { rsModule = rsModule' }   return ()@@ -307,7 +310,7 @@   let Just tm = rsModule st   let mainForest = (tkCache $ rsTokenCache tm) Map.! mainTid   let sspan = posToSrcSpan mainForest pos-  let tk' = removeToksFromCache (rsTokenCache tm) sspan+  let tk' = removeToksFromCache (rsTokenCache tm) (ss2s sspan)   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True})   put $ st { rsModule = rsModule' }   -- drawTokenTree "removeToksForPos result"@@ -338,7 +341,7 @@ -- ---------------------------------------------------------------------  -- |Get the Token Tree for debug purposes-getTokenTree :: RefactGhc (Tree Entry)+getTokenTree :: RefactGhc (Tree (Entry PosToken)) getTokenTree = do   st <- get   let Just tm = rsModule st@@ -382,7 +385,7 @@   let Just tm = rsModule st   let tk = rsTokenCache tm   let forest = (tkCache tk) Map.! mainTid-  let (t',forest') = indentDeclToks t forest offset+  let (t',forest') = indentDeclToks syncAST t forest offset   let tk' = tk {tkCache = Map.insert mainTid forest' (tkCache tk) }   let rsModule' = Just (tm {rsTokenCache = tk', rsStreamModified = True})   put $ st { rsModule = rsModule' }

@@ -12,33 +12,34 @@ -- This API is used internally by MonadFunctions and the other utility -- modules, it should probably never be used directly in a refactoring. -module Language.Haskell.Refact.Utils.TokenUtils(+module Language.Haskell.Refact.Utils.TokenUtils (+{-        -- * Creating          initTokenCache        , initTokenCacheLayout        , mkTreeFromTokens        , mkTreeFromSpanTokens-+-}        -- * Operations at 'TokenCache' level-       , putToksInCache+         putToksInCache        , putDeclToksInCache        , replaceTokenInCache-       , removeToksFromCache+       -- , removeToksFromCache        , getTreeFromCache        , replaceTreeInCache        , syncAstToLatestCache         -- * Operations at 'Tree' 'Entry' level-       , getTokensFor-       , getTokensForNoIntros-       , getTokensBefore-       , replaceTokenForSrcSpan-       , updateTokensForSrcSpan-       , insertSrcSpan-       , removeSrcSpan-       , getSrcSpanFor-       , getSrcSpanForDeep-       , addNewSrcSpanAndToksAfter+       -- , getTokensFor+       -- , getTokensForNoIntros+       -- , getTokensBefore+       -- , replaceTokenForSrcSpan+       -- , updateTokensForSrcSpan+       -- , insertSrcSpan+       -- , removeSrcSpan+       -- , getSrcSpanFor+       -- , getSrcSpanForDeep+       -- , addNewSrcSpanAndToksAfter        , addToksAfterSrcSpan        , addDeclToksAfterSrcSpan        , syncAST@@ -46,119 +47,123 @@        , Positioning(..)         -- * Retrieving tokens-       , retrieveTokensFinal+       -- , retrieveTokensFinal        -- , retrieveTokensPpr        -- , renderPpr-       , adjustLinesForDeleted+       -- , adjustLinesForDeleted        , retrieveTokensInterim-       , retrieveTokens' -- temporary for debug+       -- , retrieveTokens' -- temporary for debug         -- * Token Tree Selection        , treeIdFromForestSpan         -- * Token marking and re-alignment-       , reAlignMarked+       -- , reAlignMarked         -- * Utility        , posToSrcSpan        , posToSrcSpanTok        , fileNameFromTok        , treeStartEnd-       , spanStartEnd+       -- , spanStartEnd        , sf        , fs+       , ss2f,f2ss+       , ss2s,s2ss        , forestSpanFromEntry-       , combineSpans+       -- , combineSpans         -- * A token stream with last tokens first, and functions to manipulate it-       , ReversedToks(..)-       , reverseToks-       , unReverseToks-       , reversedToks+       -- , ReversedToks(..)+       -- , reverseToks+       -- , unReverseToks+       -- , reversedToks         -- * Internal, for testing-       , placeToksForSpan-       , limitPrevToks-       , reIndentToks-       , reAlignOneLine-       , reAlignToks-       , splitForestOnSpan-       , spanContains-       , containsStart, containsMiddle, containsEnd-       , doSplitTree, splitSubtree, splitSubToks+       -- , placeToksForSpan+       -- , limitPrevToks+       -- , reIndentToks+       -- , reAlignOneLine+       -- , reAlignToks+       -- , splitForestOnSpan+       -- , spanContains+       -- , containsStart, containsMiddle, containsEnd+       -- , doSplitTree, splitSubtree, splitSubToks        , nonCommentSpan-       , invariantOk-       , invariant-       , showForest+       -- , invariantOk+       -- , invariant+       -- , showForest        , showTree        , showSrcSpan        , showSrcSpanF        , ghcSpanStartEnd-       , insertNodeAfter-       , retrievePrevLineToks-       , getTreeSpansAsList-       , openZipperToNode-       , openZipperToNodeDeep-       , openZipperToSpan-       , openZipperToSpanDeep-       , openZipperToSpanAdded-       , openZipperToSpanOrig+       -- , insertNodeAfter+       -- , retrievePrevLineToks+       -- , getTreeSpansAsList+       -- , openZipperToNode+       -- , openZipperToNodeDeep+       -- , openZipperToSpan+       -- , openZipperToSpanDeep+       -- , openZipperToSpanAdded+       -- , openZipperToSpanOrig        , forestSpanToSimpPos        , forestSpanToGhcPos         , ghcLineToForestLine        , stripForestLineFromGhc        , forestLineToGhcLine-       , forestSpanToSrcSpan-       , forestPosVersionSet-       , forestPosVersionNotSet-       , forestSpanLenChanged+       , forestSpanToGhcSrcSpan+       -- , forestPosVersionSet+       -- , forestPosVersionNotSet+       -- , forestSpanLenChanged        , forestSpanVersions        , forestSpanVersionSet-       , forestSpanVersionNotSet+       -- , forestSpanVersionNotSet        , insertForestLineInSrcSpan-       , insertLenChangedInSrcSpan-       , insertVersionsInSrcSpan-       , srcSpanToForestSpan-       , nullSpan, nullPos-       , simpPosToForestSpan+       -- , insertLenChangedInSrcSpan+       -- , insertVersionsInSrcSpan+       , ghcSrcSpanToForestSpan+       , nullForestSpan, nullForestPos+       -- , simpPosToForestSpan        , srcPosToSimpPos        , showForestSpan        , deleteGapsToks        -- , deleteGapsToks'-       , calcEndGap-       , stripForestLines+       -- , calcEndGap+       -- , stripForestLines         -- * Based on Data.Tree        , drawTreeEntry-       , drawTokenCache-       , drawTokenCacheDetailed+       -- , drawTokenCache+       -- , drawTokenCacheDetailed        , drawForestEntry-       , drawEntry+       -- , drawEntry        , drawTreeCompact         ) where  import qualified FastString    as GHC import qualified GHC           as GHC-import qualified SrcLoc        as GHC+-- import qualified SrcLoc        as GHC  import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB -import qualified Data.Foldable as F+-- import qualified Data.Foldable as F  import Language.Haskell.Refact.Utils.GhcUtils-import Language.Haskell.Refact.Utils.LayoutTypes import Language.Haskell.Refact.Utils.LocUtils-import Language.Haskell.Refact.Utils.TokenUtilsTypes import Language.Haskell.Refact.Utils.TypeSyn -import Data.Bits-import Data.List+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.Utils++-- import Data.Bits+-- import Data.List import Data.Tree import qualified Data.Map as Map-import qualified Data.Tree.Zipper as Z+-- import qualified Data.Tree.Zipper as Z   -- import Debug.Trace@@ -233,11 +238,14 @@ -}  -deriving instance Show         Entry+-- deriving instance Show         Entry +{- moved to haskell-token-utils instance Ord LayoutTree where   compare (Node a _) (Node b _) = compare (forestSpanFromEntry a) (forestSpanFromEntry b)+-} +{- moved to haskell-token-utils instance Eq Entry where   (Entry fs1 lay1 toks1) == (Entry fs2 lay2 toks2)     = fs1 == fs2 && lay1 == lay2@@ -247,9 +255,10 @@     = fs1 == fs2 && pg1 == pg2 && lay1 == lay2    (==) _ _ = False+-}  -- ----------------------------------------------------------------------+{- -- |Keep track of when tokens are reversed, to avoid confusion data ReversedToks = RT [PosToken]                     deriving (Show)@@ -283,7 +292,7 @@                    -- start, num lines to add at the end                    -- relative to the indent level of the prior line                  deriving (Show)-+-} -- ---------------------------------------------------------------------  {-@@ -331,17 +340,20 @@ -- 5 bits for version : 32 values -- 20 bits for line number: 1048576 values -forestLineMask,forestVersionMask,forestTreeMask,forestLenChangedMask :: Int-forestLineMask =          0xfffff -- bottom 20 bits-forestVersionMask    =  0x1f00000 -- next 5 bits-forestTreeMask       = 0x3e000000 -- next 5 bits-forestLenChangedMask = 0x40000000 -- top (non-sign) bit+-- forestLineMask :: Int+-- forestVersionMask :: Int+-- forestTreeMask :: Int+-- forestLenChangedMask :: Int+-- forestLineMask =          0xfffff -- bottom 20 bits+-- forestVersionMask    =  0x1f00000 -- next 5 bits+-- forestTreeMask       = 0x3e000000 -- next 5 bits+-- forestLenChangedMask = 0x40000000 -- top (non-sign) bit -forestVersionShift :: Int-forestVersionShift = 20+-- forestVersionShift :: Int+-- forestVersionShift = 20 -forestTreeShift :: Int-forestTreeShift    = 25+-- forestTreeShift :: Int+-- forestTreeShift    = 25  {- This has been moved to TokenUtilsTypes@@ -357,6 +369,7 @@                   } deriving (Eq) -} +{- moved to haskell-token-utils -- | Extract an encoded ForestLine from a GHC line ghcLineToForestLine :: Int -> ForestLine ghcLineToForestLine l = ForestLine ch tr v l'@@ -365,16 +378,19 @@     v  = shiftR (l .&. forestVersionMask) forestVersionShift     tr = shiftR (l .&. forestTreeMask)    forestTreeShift     ch = (l .&. forestLenChangedMask) /= 0+-} +{- moved to haskell-token-utils -- TODO: check that the components are in range forestLineToGhcLine :: ForestLine -> Int forestLineToGhcLine fl =  (if (flSpanLengthChanged fl) then forestLenChangedMask else 0)                         + (shiftL (flTreeSelector  fl) forestTreeShift)                         + (shiftL (flInsertVersion fl) forestVersionShift)                         + (flLine fl)+-} -forestSpanToSrcSpan :: ForestSpan -> GHC.SrcSpan-forestSpanToSrcSpan ((fls,sc),(fle,ec)) = sspan+forestSpanToGhcSrcSpan :: ForestSpan -> GHC.SrcSpan+forestSpanToGhcSrcSpan ((fls,sc),(fle,ec)) = sspan   where     lineStart = forestLineToGhcLine fls     lineEnd   = forestLineToGhcLine fle@@ -383,6 +399,7 @@     sspan = GHC.mkSrcSpan locStart locEnd  +{- moved to haskell-token-utils instance Ord ForestLine where   -- Use line as the primary comparison, but break any ties with the   -- version@@ -393,11 +410,13 @@          if (l1 == l2)            then compare v1 v2            else compare l1 l2-+-}+{- -- |Gets the version numbers forestSpanVersions :: ForestSpan -> (Int,Int) forestSpanVersions ((ForestLine _ _ sv _,_),(ForestLine _ _ ev _,_)) = (sv,ev)-+-}+{- -- |Gets the AST tree numbers forestSpanAstVersions :: ForestSpan -> (Int,Int) forestSpanAstVersions ((ForestLine _ trs _ _,_),(ForestLine _ tre _ _,_)) = (trs,tre)@@ -405,11 +424,13 @@ -- |Gets the SpanLengthChanged flags forestSpanLenChangedFlags :: ForestSpan -> (Bool,Bool) forestSpanLenChangedFlags ((ForestLine chs _ _ _,_),(ForestLine che _ _ _,_)) = (chs,che)-+-}+{- moved to haskell-token-utils -- |Checks if the version is non-zero in either position forestSpanVersionSet :: ForestSpan -> Bool forestSpanVersionSet ((ForestLine _ _ sv _,_),(ForestLine _ _ ev _,_)) = sv /= 0 || ev /= 0-+-}+{- -- |Checks if the version is zero in both positions forestSpanVersionNotSet :: ForestSpan -> Bool forestSpanVersionNotSet ((ForestLine _ _ sv _,_),(ForestLine _ _ ev _,_)) = sv == 0 && ev == 0@@ -428,47 +449,53 @@  forestSpanLenChanged :: ForestSpan -> Bool forestSpanLenChanged (s,e) = (forestPosLenChanged s) || (forestPosLenChanged e)--forestPosLenChanged :: ForestPos -> Bool-forestPosLenChanged (ForestLine ch _ _ _,_) = ch-+-}+-- forestPosLenChanged :: ForestPos -> Bool+-- forestPosLenChanged (ForestLine ch _ _ _,_) = ch+{- -- |Puts a TreeId into a forestSpan treeIdIntoForestSpan :: TreeId -> ForestSpan -> ForestSpan treeIdIntoForestSpan (TId sel) ((ForestLine chs _ sv sl,sc),(ForestLine che _ ev el,ec))   = ((ForestLine chs sel sv sl,sc),(ForestLine che sel ev el,ec))-+-} +{- moved to haskell-token-utils -- |Strip out the version markers forestSpanToSimpPos :: ForestSpan -> (SimpPos,SimpPos) forestSpanToSimpPos ((ForestLine _ _ _ sr,sc),(ForestLine _ _ _ er,ec)) = ((sr,sc),(er,ec))-+-}+{- -- |Strip out the version markers forestSpanToGhcPos :: ForestSpan -> (SimpPos,SimpPos) forestSpanToGhcPos ((fls,sc),(fle,ec))   = ((forestLineToGhcLine fls,sc),(forestLineToGhcLine fle,ec))--+-}+{- simpPosToForestSpan :: (SimpPos,SimpPos) -> ForestSpan simpPosToForestSpan ((sr,sc),(er,ec))     = ((ghcLineToForestLine sr,sc),(ghcLineToForestLine er,ec))-+-}+{- moved to haskell-token-utils srcPosToSimpPos :: (Int,Int) -> (Int,Int) srcPosToSimpPos (sr,c) = (l,c)   where     (ForestLine _ _ _ l) = ghcLineToForestLine sr-+-}+{- forestSpanStart :: ForestSpan -> ForestPos forestSpanStart (start,_) = start  forestSpanEnd :: ForestSpan -> ForestPos forestSpanEnd (_,end) = end--nullSpan :: ForestSpan-nullSpan = (nullPos,nullPos)--nullPos :: ForestPos-nullPos = (ForestLine False 0 0 0,0)+-}+{-+nullForestSpan :: ForestSpan+nullForestSpan = (nullForestPos,nullForestPos) +nullForestPos :: ForestPos+nullForestPos = (ForestLine False 0 0 0,0)+-}+{- showForestSpan :: ForestSpan -> String showForestSpan ((sr,sc),(er,ec))   = show ((flToNum sr,sc),(flToNum er,ec))@@ -477,7 +504,7 @@                                    + ((fromIntegral tr) * 100000000::Integer)                                    + ((fromIntegral v)  *   1000000::Integer)                                    + (fromIntegral l)-+-} -- ---------------------------------------------------------------------  -- | Replace any ForestLine flags already in a SrcSpan with the given ones@@ -485,7 +512,7 @@ insertForestLineInSrcSpan fl@(ForestLine ch tr v _l) (GHC.RealSrcSpan ss) = ss'   where     lineStart = forestLineToGhcLine fl-    (_,(ForestLine _ _ _ le,_)) = srcSpanToForestSpan (GHC.RealSrcSpan ss)+    (_,(ForestLine _ _ _ le,_)) = ghcSrcSpanToForestSpan (GHC.RealSrcSpan ss)     lineEnd   = forestLineToGhcLine (ForestLine ch tr v le)     locStart = GHC.mkSrcLoc (GHC.srcSpanFile ss) lineStart (GHC.srcSpanStartCol ss)     locEnd   = GHC.mkSrcLoc (GHC.srcSpanFile ss) lineEnd   (GHC.srcSpanEndCol ss)@@ -494,12 +521,12 @@ insertForestLineInSrcSpan _ _ss = error $ "insertForestLineInSrcSpan: expecting a RealSrcSpan, got:" -- ++ (showGhc ss)  -- ----------------------------------------------------------------------+{- insertVersionsInSrcSpan :: Int -> Int -> GHC.SrcSpan -> GHC.SrcSpan insertVersionsInSrcSpan vs ve rss@(GHC.RealSrcSpan ss) = ss'   where-    (chs,che) = forestSpanLenChangedFlags $ srcSpanToForestSpan rss-    (trs,tre) = forestSpanAstVersions $ srcSpanToForestSpan rss+    (chs,che) = forestSpanLenChangedFlags $ ghcSrcSpanToForestSpan rss+    (trs,tre) = forestSpanAstVersions $ ghcSrcSpanToForestSpan rss     lineStart = forestLineToGhcLine (ForestLine chs trs vs (GHC.srcSpanStartLine ss))     lineEnd   = forestLineToGhcLine (ForestLine che tre ve (GHC.srcSpanEndLine ss))     locStart = GHC.mkSrcLoc (GHC.srcSpanFile ss) lineStart (GHC.srcSpanStartCol ss)@@ -507,9 +534,9 @@     ss' = GHC.mkSrcSpan locStart locEnd  insertVersionsInSrcSpan _ _ _ss = error $ "insertVersionsInSrcSpan: expecting a RealSrcSpan, got:" -- ++ (showGhc ss)-+-} -- ----------------------------------------------------------------------+{- insertLenChangedInSrcSpan :: Bool -> Bool -> GHC.SrcSpan -> GHC.SrcSpan insertLenChangedInSrcSpan chs che rss@(GHC.RealSrcSpan ss) = ss'   where@@ -524,8 +551,8 @@     locStart =  GHC.mkSrcLoc (GHC.srcSpanFile ss) sl' (GHC.srcSpanStartCol ss)     locEnd    = GHC.mkSrcLoc (GHC.srcSpanFile ss) el' (GHC.srcSpanEndCol   ss) -    -- (vs,ve)   = forestSpanVersions $ srcSpanToForestSpan rss-    -- (trs,tre) = forestSpanAstVersions $ srcSpanToForestSpan rss+    -- (vs,ve)   = forestSpanVersions $ ghcSrcSpanToForestSpan rss+    -- (trs,tre) = forestSpanAstVersions $ ghcSrcSpanToForestSpan rss     -- lineStart = forestLineToGhcLine (ForestLine chs trs vs (GHC.srcSpanStartLine ss))     -- lineEnd   = forestLineToGhcLine (ForestLine che tre ve (GHC.srcSpanEndLine ss))     -- locStart  = GHC.mkSrcLoc (GHC.srcSpanFile ss) lineStart (GHC.srcSpanStartCol ss)@@ -533,9 +560,9 @@     ss' = GHC.mkSrcSpan locStart locEnd  insertLenChangedInSrcSpan _ _ _ss = error $ "insertVersionsInSrcSpan: expecting a RealSrcSpan, got:" -- ++ (showGhc ss)-+-} -- ----------------------------------------------------------------------+{- insertVersionsInForestSpan :: Int -> Int -> ForestSpan -> ForestSpan insertVersionsInForestSpan vsNew veNew ((ForestLine chs trs _vs ls,cs),(ForestLine che tre _ve le,ce))   = ((ForestLine chs trs vsNew ls,cs),(ForestLine che tre veNew le,ce))@@ -545,41 +572,31 @@ insertLenChangedInForestSpan :: Bool -> ForestSpan -> ForestSpan insertLenChangedInForestSpan chNew ((ForestLine _chs trs vs ls,cs),(ForestLine _che tre ve le,ce))   = ((ForestLine chNew trs vs ls,cs),(ForestLine chNew tre ve le,ce))-+-} -- --------------------------------------------------------------------- -srcSpanToForestSpan :: GHC.SrcSpan -> ForestSpan-srcSpanToForestSpan sspan = ((ghcLineToForestLine startRow,startCol),(ghcLineToForestLine endRow,endCol))+ghcSrcSpanToForestSpan :: GHC.SrcSpan -> ForestSpan+ghcSrcSpanToForestSpan sspan = ((ghcLineToForestLine startRow,startCol),(ghcLineToForestLine endRow,endCol))   where     (startRow,startCol) = getGhcLoc sspan     (endRow,endCol)     = getGhcLocEnd sspan  -- ----------------------------------------------------------------------forestSpanFromEntry :: Entry -> ForestSpan-forestSpanFromEntry (Entry   ss _ _) = ss-forestSpanFromEntry (Deleted ss _ _) = ss--putForestSpanInEntry :: Entry -> ForestSpan -> Entry-putForestSpanInEntry (Entry   _ss lay toks) ssnew = (Entry ssnew lay toks)-putForestSpanInEntry (Deleted _ss pg eg) ssnew = (Deleted ssnew pg eg)---- ---------------------------------------------------------------------+{- treeIdFromForestSpan :: ForestSpan -> TreeId treeIdFromForestSpan ((ForestLine _ tr _ _,_),(ForestLine _ _ _ _,_)) = TId tr-+-} -- -----------------------------------------------------------------------initTokenCache :: [PosToken] -> TokenCache+{-+initTokenCache :: [PosToken] -> TokenCache PosToken initTokenCache toks = TK (Map.fromList [((TId 0),(mkTreeFromTokens toks))]) (TId 0) -initTokenCacheLayout :: Tree Entry -> TokenCache+initTokenCacheLayout :: Tree (Entry PosToken) -> TokenCache PosToken initTokenCacheLayout tree = TK (Map.fromList [((TId 0),tree)]) (TId 0)-+-} -- -----------------------------------------------------------------------treeIdIntoTree :: TreeId -> Tree Entry -> Tree Entry+{-+treeIdIntoTree :: TreeId -> Tree (Entry PosToken) -> Tree (Entry PosToken) treeIdIntoTree tid (Node (Entry fspan lay toks) subTree) = tree'   where     fs' = treeIdIntoForestSpan tid fspan@@ -588,10 +605,10 @@   where     fs' = treeIdIntoForestSpan tid fspan     tree' = Node (Deleted fs' pg eg) subTree-+-} -- -----------------------------------------------------------------------stash :: TokenCache -> Tree Entry -> TokenCache+{-+stash :: TokenCache PosToken -> Tree (Entry PosToken) -> TokenCache PosToken stash tk oldTree = tk'   where     (TId lastTreeId) = tkLastTreeId tk@@ -599,68 +616,64 @@     oldTree' = treeIdIntoTree lastTreeId' oldTree     cache' = Map.insert lastTreeId' oldTree' (tkCache tk)     tk' = tk {tkLastTreeId = lastTreeId', tkCache = cache' }-+-} -- -----------------------------------------------------------------------replaceTokenInCache :: TokenCache -> GHC.SrcSpan -> PosToken -> TokenCache+{-+replaceTokenInCache :: TokenCache PosToken -> GHC.SrcSpan -> PosToken -> TokenCache PosToken replaceTokenInCache tk sspan tok = tk'   where    forest = getTreeFromCache sspan tk    forest' = replaceTokenForSrcSpan forest sspan tok    tk' = replaceTreeInCache sspan forest' tk-+-} -- -----------------------------------------------------------------------putToksInCache :: TokenCache -> GHC.SrcSpan -> [PosToken] -> (TokenCache,GHC.SrcSpan)+{-+putToksInCache :: TokenCache PosToken -> GHC.SrcSpan -> [PosToken] -> (TokenCache PosToken,GHC.SrcSpan) 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-+-} -- ---------------------------------------------------------------------  putDeclToksInCache :: (SYB.Data t) =>-    TokenCache -> GHC.SrcSpan -> [PosToken] -> GHC.Located t- -> (TokenCache,GHC.SrcSpan,GHC.Located t)-putDeclToksInCache tk sspan toks t = (tk'',newSpan,t')+    TokenCache PosToken -> GHC.SrcSpan -> [PosToken] -> GHC.Located t+ -> (TokenCache PosToken,GHC.SrcSpan,GHC.Located t)+putDeclToksInCache tk sspan toks t = (tk'',s2ss newSpan,t')   where-   forest = getTreeFromCache sspan tk-   (forest',newSpan,oldTree) = updateTokensForSrcSpan forest sspan toks-   (t',forest'') = syncAST t newSpan forest'--   tk' = replaceTreeInCache sspan forest'' tk-   tk'' = stash tk' oldTree+   (tk'',newSpan) = putToksInCache tk (ss2s sspan) toks+   t' = syncAST t (sf newSpan)  -- -----------------------------------------------------------------------removeToksFromCache :: TokenCache -> GHC.SrcSpan -> TokenCache+{-+removeToksFromCache :: TokenCache PosToken -> GHC.SrcSpan -> TokenCache PosToken removeToksFromCache tk sspan = tk''   where     forest = getTreeFromCache sspan tk-    (forest',oldTree) = removeSrcSpan forest (srcSpanToForestSpan sspan)+    (forest',oldTree) = removeSrcSpan forest (ghcSrcSpanToForestSpan sspan)     tk' = replaceTreeInCache sspan forest' tk     tk'' = stash tk' oldTree-+-} -- --------------------------------------------------------------------- -getTreeFromCache :: GHC.SrcSpan -> TokenCache -> Tree Entry+getTreeFromCache :: GHC.SrcSpan -> TokenCache PosToken -> Tree (Entry PosToken) getTreeFromCache sspan tk = (tkCache tk) Map.! tid   where-    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan+    tid = treeIdFromForestSpan $ ghcSrcSpanToForestSpan sspan  -- --------------------------------------------------------------------- -replaceTreeInCache :: GHC.SrcSpan -> Tree Entry -> TokenCache -> TokenCache+replaceTreeInCache :: GHC.SrcSpan -> Tree (Entry PosToken) -> TokenCache PosToken -> TokenCache PosToken replaceTreeInCache sspan tree tk = tk'   where-    tid = treeIdFromForestSpan $ srcSpanToForestSpan sspan+    tid = treeIdFromForestSpan $ ghcSrcSpanToForestSpan sspan     -- tree' = treeIdIntoTree tid tree     tree' = putTidInTree tid tree     tk' = tk {tkCache = Map.insert tid tree' (tkCache tk) } -putTidInTree :: TreeId -> Tree Entry -> Tree Entry+putTidInTree :: TreeId -> Tree (Entry PosToken) -> Tree (Entry PosToken) 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'@@ -673,28 +686,28 @@  -- |Assuming most recent operation has stashed the old tokens, sync -- the given AST to the most recent stash entry-syncAstToLatestCache :: (SYB.Data t) => TokenCache -> GHC.Located t -> GHC.Located t+syncAstToLatestCache :: (SYB.Data t) => TokenCache PosToken -> GHC.Located t -> GHC.Located t syncAstToLatestCache tk t = t'   where     mainForest = (tkCache tk) Map.! mainTid-    forest@(Node (Entry fspan _ _) _) = (tkCache tk) Map.! (tkLastTreeId tk)+    (Node (Entry fspan _ _) _) = (tkCache tk) Map.! (tkLastTreeId tk)     pos = forestSpanToGhcPos fspan     sspan = posToSrcSpan mainForest pos-    (t',_) = syncAST t sspan forest+    t' = syncAST t (ss2f sspan)  -- ----------------------------------------------------------------------+{- -- |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 :: Bool -> Tree Entry -> GHC.SrcSpan -> (Tree Entry,[PosToken])+getTokensFor :: Bool -> Tree (Entry PosToken) -> GHC.SrcSpan -> (Tree (Entry PosToken),[PosToken]) 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)+     (forest'',tree) = getSrcSpanFor forest' (ghcSrcSpanToForestSpan sspan)       tokens = retrieveTokensInterim tree @@ -703,23 +716,23 @@ -- |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 :: Bool -> Tree Entry -> GHC.SrcSpan -> (Tree Entry,[PosToken])+getTokensForNoIntros :: Bool -> Tree (Entry PosToken) -> GHC.SrcSpan -> (Tree (Entry PosToken),[PosToken]) 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-+-} -- ----------------------------------------------------------------------+{- -- |Get the tokens preceding a given 'SrcSpan'-getTokensBefore :: Tree Entry -> GHC.SrcSpan -> (Tree Entry,ReversedToks)+getTokensBefore :: Tree (Entry PosToken) -> GHC.SrcSpan -> (Tree (Entry PosToken),ReversedToks PosToken) getTokensBefore forest sspan = (forest', prevToks')   where-    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (srcSpanToForestSpan sspan)+    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (ghcSrcSpanToForestSpan sspan) -    z = openZipperToSpan (srcSpanToForestSpan sspan) $ Z.fromTree forest'+    z = openZipperToSpan (ghcSrcSpanToForestSpan sspan) $ Z.fromTree forest'      prevToks = case (retrievePrevLineToks z) of                  RT [] -> reverseToks $ retrieveTokensInterim tree@@ -727,9 +740,9 @@      (_,rtoks) = break (\t->tokenPos t < (getGhcLoc sspan)) $ reversedToks prevToks     prevToks' = RT rtoks-+-} -- ----------------------------------------------------------------------+{- -- |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@@ -738,15 +751,15 @@  -- TODO: work at the token level, not the sspan level -- TODO: Use start of token span only, with length 1.-replaceTokenForSrcSpan :: Tree Entry -> GHC.SrcSpan -> PosToken -> Tree Entry+replaceTokenForSrcSpan :: Tree (Entry PosToken) -> GHC.SrcSpan -> PosToken -> Tree (Entry PosToken) replaceTokenForSrcSpan forest sspan tok = forest'   where     (GHC.L tl _,_) = tok     -- First open to the sspan, making use of any Forestline annotations-    z = openZipperToSpanDeep (srcSpanToForestSpan sspan) $ Z.fromTree forest+    z = openZipperToSpanDeep (ghcSrcSpanToForestSpan sspan) $ Z.fromTree forest      -- Then drill down to the specific subtree containing the token-    -- z' = openZipperToSpan (srcSpanToForestSpan tl) z+    -- z' = openZipperToSpan (ghcSrcSpanToForestSpan tl) z     z' = z -- No, pass in original token span as sspan.      -- Note: with LayoutTree, the full tree matching the AST has been@@ -756,25 +769,25 @@        (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+    ((row,col),_) = forestSpanToSimpPos $ ghcSrcSpanToForestSpan tl     toks' = replaceTokNoReAlign toks (row,col) tok      zf = Z.setTree (Node (Entry tspan lay toks') []) z'     forest' = Z.toTree zf      -- forest' = forest-+-} -- ----------------------------------------------------------------------+{- -- |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 :: Tree Entry -> GHC.SrcSpan -> [PosToken] -> (Tree Entry,GHC.SrcSpan,Tree Entry)+updateTokensForSrcSpan :: Tree (Entry PosToken) -> GHC.SrcSpan -> [PosToken] -> (Tree (Entry PosToken),GHC.SrcSpan,Tree (Entry PosToken)) updateTokensForSrcSpan forest sspan toks = (forest'',newSpan,oldTree)   where-    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (srcSpanToForestSpan sspan)+    (forest',tree@(Node (Entry _s _ _) _)) = getSrcSpanFor forest (ghcSrcSpanToForestSpan sspan)     prevToks = retrieveTokensInterim tree      endComments   = reverse $ takeWhile isWhiteSpaceOrIgnored $ reverse toks@@ -793,7 +806,7 @@            origEndComments   = reverse $ takeWhile isWhiteSpaceOrIgnored $ reverse prevToks            origStartComments = takeWhile isWhiteSpaceOrIgnored $ prevToks -           ((startRow,startCol),_) = forestSpanToGhcPos $ srcSpanToForestSpan sspan+           ((startRow,startCol),_) = forestSpanToGhcPos $ ghcSrcSpanToForestSpan sspan            core = reIndentToks (PlaceAbsolute startRow startCol) prevToks toks            trail = if (emptyList origEndComments)             then []@@ -808,7 +821,7 @@     (startPos,endPos) = nonCommentSpan toks''      -- if the original sspan had a ForestLine version, preserve it-    (((ForestLine _chs _trs vs _),_),(ForestLine _che _tre ve _,_)) = srcSpanToForestSpan sspan+    (((ForestLine _chs _trs vs _),_),(ForestLine _che _tre ve _,_)) = ghcSrcSpanToForestSpan sspan     -- Note: adding one to end version, so invariant won't fail     -- newSpan = insertVersionsInSrcSpan vs ve $ posToSrcSpan forest (startPos,endPos)      newSpan = insertLenChangedInSrcSpan True True@@ -816,28 +829,30 @@      zf = openZipperToNode tree $ Z.fromTree forest' -    zf' = Z.setTree (Node (Entry (srcSpanToForestSpan newSpan) NoChange toks'') []) zf+    zf' = Z.setTree (Node (Entry (ghcSrcSpanToForestSpan newSpan) NoChange toks'') []) zf     forest'' = Z.toTree zf'      oldTree = tree-+-}+{- -- --------------------------------------------------------------------- -- |Retrieve a path to the tree containing a ForestSpan from the forest, -- inserting it if not already present-getSrcSpanFor :: Tree Entry -> ForestSpan -> (Tree Entry, Tree Entry)+getSrcSpanFor :: Tree (Entry PosToken) -> ForestSpan -> (Tree (Entry PosToken), Tree (Entry PosToken)) 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 :: Tree Entry -> ForestSpan -> (Tree Entry, Tree Entry)+getSrcSpanForDeep :: Tree (Entry PosToken) -> ForestSpan -> (Tree (Entry PosToken), Tree (Entry PosToken)) getSrcSpanForDeep forest sspan = (forest',tree)   where     forest' = insertSrcSpan forest sspan -- Will NO-OP if already@@ -850,7 +865,7 @@ -- |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 :: Tree Entry -> ForestSpan -> Tree Entry+insertSrcSpan :: Tree (Entry PosToken) -> ForestSpan -> Tree (Entry PosToken) insertSrcSpan forest sspan = forest'   where     z = openZipperToSpan sspan $ Z.fromTree forest@@ -884,7 +899,7 @@                        else [mkTreeFromTokens endToks]              subTree = tree1 ++ tree2 ++ tree3-            subTree' = filter (\t -> treeStartEnd t /= nullSpan) subTree+            subTree' = filter (\t -> treeStartEnd t /= nullForestSpan) subTree             -- (Entry sspan2 _ _) = Z.label z             sspan2 = case Z.label z of               (Entry ss _ _) -> ss@@ -919,8 +934,8 @@ -- ---------------------------------------------------------------------  doSplitTree ::-  Tree Entry -> ForestSpan-  -> ([Tree Entry], [Tree Entry], [Tree Entry])+  Tree (Entry PosToken) -> ForestSpan+  -> ([Tree (Entry PosToken)], [Tree (Entry PosToken)], [Tree (Entry PosToken)]) 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'')@@ -957,7 +972,7 @@ -- ---------------------------------------------------------------------  -- TODO: The Bool is horrible-mkTreeListFromTokens :: [PosToken] -> ForestSpan -> Bool -> [Tree Entry]+mkTreeListFromTokens :: [PosToken] -> ForestSpan -> Bool -> [Tree (Entry PosToken)] mkTreeListFromTokens  [] _sspan _ = [] mkTreeListFromTokens toks sspan useOriginalSpan = res   where@@ -977,9 +992,9 @@ -- ---------------------------------------------------------------------  splitSubToks ::-  Tree Entry+  Tree (Entry PosToken)   -> (ForestPos, ForestPos)-  -> ([Tree Entry], [Tree Entry], [Tree Entry])+  -> ([Tree (Entry PosToken)], [Tree (Entry PosToken)], [Tree (Entry PosToken)]) splitSubToks n@(Node (Deleted (treeStart,treeEnd) _pg _eg) []) (sspanStart,sspanEnd) = (b',m',e')   where     egs = (0,0) -- TODO: calculate this@@ -1008,7 +1023,7 @@       (True, False) -> (b'',m'',e'') -- Start only                        -- error $ "splitSubToks:StartOnly:(sspan,tree,(b'',m''))=" ++ (show (sspan,tree,(b'',m'')))         where-         (_,toksb,toksm) = splitToks (forestSpanToSimpPos (nullPos,sspanStart)) toks+         (_,toksb,toksm) = splitToks (forestSpanToSimpPos (nullForestPos,sspanStart)) toks --         b'' = if (emptyList toksb) then [] else [Node (Entry (treeStart, sspanEnd) toksb) []]          b'' = if (emptyList toksb || nonCommentSpan toksb == ((0,0),(0,0)))                  then []@@ -1037,7 +1052,7 @@        (False,True) -> (b'',m'',e'') -- End only         where-         (_,toksm,tokse) = splitToks (forestSpanToSimpPos (nullPos,sspanEnd)) toks+         (_,toksm,tokse) = splitToks (forestSpanToSimpPos (nullForestPos,sspanEnd)) toks          b'' = []          m'' = let -- If the last span is changed, make sure it stays                    -- as it was@@ -1078,8 +1093,8 @@ -- srcspan, the part that is wholly included in the srcspan and the -- part the lies outside of it at the end. splitSubtree ::-  Tree Entry -> ForestSpan-  -> ([Tree Entry], [Tree Entry], [Tree Entry])+  Tree (Entry PosToken) -> ForestSpan+  -> ([Tree (Entry PosToken)], [Tree (Entry PosToken)], [Tree (Entry PosToken)]) splitSubtree tree sspan = (before,middle,end)                           -- error $ "splitSubtree:(sspan,tree,middle',end')=" ++ (show (sspan,tree,middle',end'))   where@@ -1096,12 +1111,12 @@     (middle,end) = (reverse middler,reverse endr)  -+-} -- ----------------------------------------------------------------------+{- -- | Removes a ForestSpan and its tokens from the forest.-removeSrcSpan :: Tree Entry -> ForestSpan-  -> (Tree Entry,Tree Entry) -- ^Updated forest, removed span+removeSrcSpan :: Tree (Entry PosToken) -> ForestSpan+  -> (Tree (Entry PosToken),Tree (Entry PosToken)) -- ^Updated forest, removed span removeSrcSpan forest sspan = (forest'', delTree)   where     forest' = insertSrcSpan forest sspan -- Make sure span is actually@@ -1120,13 +1135,13 @@      delTree = Z.tree z     -- forest'' = error $ "removeSrcSpan: forest'=" ++ drawTreeCompact forest'-+-} -- ----------------------------------------------------------------------+{- -- |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 :: Tree Entry -> ForestSpan -> (SimpPos,SimpPos)+calcPriorAndEndGap :: Tree (Entry PosToken) -> ForestSpan -> (SimpPos,SimpPos) calcPriorAndEndGap tree sspan = (pg,eg)   where     ((spanStartRow,spanStartCol),(spanRow,spanCol)) = forestSpanToSimpPos sspan@@ -1174,7 +1189,7 @@ -- |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 :: Tree Entry -> ForestSpan -> SimpPos+calcEndGap :: Tree (Entry PosToken) -> ForestSpan -> SimpPos calcEndGap tree sspan = gap   where     (_sspanStart,(spanRow,spanCol)) = forestSpanToSimpPos sspan@@ -1202,24 +1217,24 @@      gap = (tokRow - spanRow, tokCol - spanCol)     -- gap = error $ "calcEndGap: (sspan,(before,middle,after))=" ++ (show (sspan,(_before,middle,after)))-+-} -- ----------------------------------------------------------------------+{- -- |Retrieve all the tokens at the leaves of the tree, in order. -- Marked tokens are re-aligned, and gaps are closed.-retrieveTokensFinal :: Tree Entry -> [PosToken]+retrieveTokensFinal :: Tree (Entry PosToken) -> [PosToken] retrieveTokensFinal forest = monotonicLineToks $ stripForestLines $ reAlignMarked                       $ deleteGapsToks $ retrieveTokens' forest  -- ---------------------------------------------------------------------  -- TODO: deprecated, doing this at the Ppr level now-adjustLinesForDeleted :: Tree Entry -> Tree Entry+adjustLinesForDeleted :: Tree (Entry PosToken) -> Tree (Entry PosToken) adjustLinesForDeleted forest = forest'   where     (_,forest') = go (0,0) forest -    go :: (Int,Int) -> Tree Entry -> ((Int,Int),Tree Entry)+    go :: (Int,Int) -> Tree (Entry PosToken) -> ((Int,Int),Tree (Entry PosToken))     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')@@ -1236,7 +1251,7 @@  -- --------------------------------------------------------------------- -applyOffsetToTreeShallow :: (Int,Int) -> Tree Entry -> Tree Entry+applyOffsetToTreeShallow :: (Int,Int) -> Tree (Entry PosToken) -> Tree (Entry PosToken) applyOffsetToTreeShallow (ro,co) (Node (Entry sspan lay toks) subs)   = (Node (Entry sspan' lay toks') subs')   where@@ -1244,31 +1259,31 @@     toks' = addOffsetToToks (ro,co) toks     subs' = subs applyOffsetToTreeShallow _ n@(Node (Deleted _ _ _) _) = n-+-} -- ----------------------------------------------------------------------+{- -- |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 :: Tree Entry -> [PosToken]+retrieveTokensInterim :: Tree (Entry PosToken) -> [PosToken] retrieveTokensInterim forest = monotonicLineToks $ stripForestLines {-  reAlignMarked -}                              $ concat $ map (\t -> F.foldl accum [] t) [forest]   where-    accum :: [PosToken] -> Entry -> [PosToken]+    accum :: [PosToken] -> (Entry PosToken) -> [PosToken]     accum acc (Entry _ _ [])   = acc     accum acc (Entry _ _ toks) = acc ++ toks     accum acc (Deleted _ _ _)  = acc  -retrieveTokens' :: Tree Entry -> [Entry]+retrieveTokens' :: Tree (Entry PosToken) -> [Entry PosToken] retrieveTokens' forest = mergeDeletes $ concat $ map (\t -> F.foldl accum [] t) [forest]   where-    accum :: [Entry] -> Entry -> [Entry]+    accum :: [Entry PosToken] -> Entry PosToken -> [Entry PosToken]     accum acc   (Entry _ _ [])    = acc     accum acc e@(Entry _ _ _toks) = acc ++ [e]     accum acc e@(Deleted _ _ _)   = acc ++ [e]  -- |Merge adjacent Deleted entries-mergeDeletes :: [Entry] -> [Entry]+mergeDeletes :: [Entry PosToken] -> [Entry PosToken] mergeDeletes [] = [] mergeDeletes [x] = [x] mergeDeletes ((Deleted ss1 pg1 (r1,_)):(Deleted ss2 _ (r2,c2)):xs) = (Deleted ss pg1 o):xs@@ -1278,14 +1293,14 @@     ss = (start,end)     o = (r1+r2,c2) mergeDeletes (x:xs) = x:mergeDeletes xs-+-} -- ---------------------------------------------------------------------  -- | Process the leaf nodes of a tree to remove all deleted spans-deleteGapsToks :: [Entry] -> [PosToken]+deleteGapsToks :: [Entry PosToken] -> [PosToken] deleteGapsToks toks = goDeleteGapsToks (0,0) toks -goDeleteGapsToks :: SimpPos -> [Entry] -> [PosToken]+goDeleteGapsToks :: SimpPos -> [Entry PosToken] -> [PosToken] goDeleteGapsToks      _ []                    = [] goDeleteGapsToks offset [Entry _ _ t]         = map (increaseSrcSpan offset) t goDeleteGapsToks      _ [Deleted _ _ _]       = []@@ -1306,11 +1321,11 @@     t1' = map (increaseSrcSpan (fr,fc)) t1  -- ----------------------------------------------------------------------+{- -- |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 :: Z.TreePos Z.Full Entry -> ReversedToks+retrievePrevLineToks :: Z.TreePos Z.Full (Entry PosToken) -> ReversedToks 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,@@ -1324,7 +1339,7 @@     res' =  reverse $ concat $ reverse (prevToks : (go z))      -- TODO:  ++AZ++ what is this actually doing?-    go :: Z.TreePos Z.Full Entry -> [[PosToken]]+    go :: Z.TreePos Z.Full (Entry PosToken) -> [[PosToken]]     go zz       | not (Z.isRoot zz) = toks : (go $ gfromJust "retrievePrevLineToks" (Z.parent zz))       | otherwise = [toks]@@ -1332,27 +1347,27 @@         toks = concat $ reverse $ map retrieveTokensInterim $ Z.before zz         -- toks = concat $ map retrieveTokensInterim $ Z.before zz -+-} -- ----------------------------------------------------------------------+{- stripForestLines :: [PosToken] -> [PosToken] stripForestLines toks = map doOne toks   where     doOne (GHC.L l t,s) = (GHC.L l' t,s)       where-       ((ForestLine _ _ _ ls,_),(_,_)) = srcSpanToForestSpan l+       ((ForestLine _ _ _ ls,_),(_,_)) = ghcSrcSpanToForestSpan l        l' = insertForestLineInSrcSpan (ForestLine False 0 0 ls) l-+-} -- ---------------------------------------------------------------------  stripForestLineFromGhc :: GHC.SrcSpan -> GHC.SrcSpan stripForestLineFromGhc l = l'   where-    ((ForestLine _ _ _ ls,_),(_,_)) = srcSpanToForestSpan l+    ((ForestLine _ _ _ ls,_),(_,_)) = ghcSrcSpanToForestSpan l     l' = insertForestLineInSrcSpan (ForestLine False 0 0 ls) l  -- ----------------------------------------------------------------------+{- reAlignMarked :: [PosToken] -> [PosToken] reAlignMarked toks = concatMap alignOne $ groupTokensByLine toks   where@@ -1409,24 +1424,24 @@      l2' = GHC.mkRealSrcSpan (GHC.mkRealSrcLoc fname sr sc)                              (GHC.mkRealSrcLoc fname er ec)      tok2' = ((GHC.L (GHC.RealSrcSpan l2') t2),s2)-+-} -- ----------------------------------------------------------------------+{- -- |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 ::-  Tree Entry -- ^The forest to update+  Tree (Entry PosToken) -- ^The forest to update   -> GHC.SrcSpan -- ^The new span comes after this one   -> GHC.SrcSpan -- ^Existing span for the tokens   -> Positioning   -> [PosToken]  -- ^The new tokens belonging to the new SrcSpan-  -> (Tree Entry -- Updated forest with the new span+  -> (Tree (Entry PosToken) -- Updated forest with the new span      , GHC.SrcSpan) -- ^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)+    (forest',tree) = getSrcSpanForDeep forest (ghcSrcSpanToForestSpan oldSpan)      (ghcl,_c) = getGhcLoc newSpan     (ForestLine ch tr v l) = ghcLineToForestLine ghcl@@ -1434,22 +1449,22 @@      toks' = placeToksForSpan forest' oldSpan tree pos toks -    newNode = Node (Entry (srcSpanToForestSpan newSpan') NoChange toks') []+    newNode = Node (Entry (ghcSrcSpanToForestSpan newSpan') NoChange toks') []      forest'' = insertNodeAfter tree newNode forest'  -- ---------------------------------------------------------------------  placeToksForSpan ::-  Tree Entry+  Tree (Entry PosToken)   -> GHC.SrcSpan-  -> Tree Entry+  -> Tree (Entry PosToken)   -> Positioning   -> [PosToken]   -> [PosToken] placeToksForSpan forest oldSpan tree pos toks = toks'   where-    z = openZipperToSpanDeep (srcSpanToForestSpan oldSpan) $ Z.fromTree forest+    z = openZipperToSpanDeep (ghcSrcSpanToForestSpan oldSpan) $ Z.fromTree forest     prevToks = case (retrievePrevLineToks z) of                  RT [] -> reverseToks $ retrieveTokensInterim tree                  xs -> xs@@ -1464,15 +1479,15 @@ -- |Add new tokens after the given SrcSpan, constructing a new SrcSpan -- in the process addToksAfterSrcSpan ::-  Tree Entry  -- ^TokenTree to be modified+  Tree (Entry PosToken)  -- ^TokenTree to be modified   -> GHC.SrcSpan -- ^Preceding location for new tokens   -> Positioning   -> [PosToken] -- ^New tokens to be added-  -> (Tree Entry, GHC.SrcSpan) -- ^ updated TokenTree and SrcSpan location for+  -> (Tree (Entry PosToken), GHC.SrcSpan) -- ^ 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)+    (fwithspan,tree) = getSrcSpanForDeep forest (ghcSrcSpanToForestSpan oldSpan)      toks'' = placeToksForSpan fwithspan oldSpan tree pos toks @@ -1481,13 +1496,13 @@     newSpan = posToSrcSpan forest (startPos,endPos)      (forest',newSpan') = addNewSrcSpanAndToksAfter forest oldSpan newSpan pos toks-+-} -- ----------------------------------------------------------------------+{- limitPrevToks :: ReversedToks -> GHC.SrcSpan -> ReversedToks limitPrevToks prevToks sspan = reverseToks prevToks''   where-    ((ForestLine _ _ _ startRow,_startCol),(ForestLine _ _ _ endRow,_)) = srcSpanToForestSpan sspan+    ((ForestLine _ _ _ startRow,_startCol),(ForestLine _ _ _ endRow,_)) = ghcSrcSpanToForestSpan sspan      -- Make sure the toks do not extend past where we are     prevToks' = dropWhile (\t -> tokenRow t > endRow) $ unReverseToks prevToks@@ -1495,28 +1510,28 @@     -- 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 belonging to an AST fragment after a given SrcSpan, -- and re-sync the AST fragment to match the new location addDeclToksAfterSrcSpan :: (SYB.Data t) =>-     Tree Entry  -- ^TokenTree to be modified+     Tree (Entry PosToken)  -- ^TokenTree to be modified   -> GHC.SrcSpan -- ^Preceding location for new tokens   -> Positioning   -> [PosToken] -- ^New tokens to be added   -> GHC.Located t  -- ^Declaration the tokens belong to, to be synced-  -> (Tree Entry, GHC.SrcSpan,GHC.Located t) -- ^ updated TokenTree ,SrcSpan location for-  -- -> (Tree Entry, GHC.SrcSpan,t) -- ^ updated TokenTree ,SrcSpan location for+  -> (Tree (Entry PosToken), GHC.SrcSpan,GHC.Located t) -- ^ updated TokenTree ,SrcSpan location for+  -- -> (Tree (Entry PosToken), GHC.SrcSpan,t) -- ^ updated TokenTree ,SrcSpan location for                                -- the new tokens in the TokenTree, and                                -- updated AST element-addDeclToksAfterSrcSpan forest oldSpan pos toks t = (forest'',newSpan,t')+addDeclToksAfterSrcSpan forest oldSpan pos toks t = (forest',(s2ss newSpan),t')   where-    (forest',newSpan) = addToksAfterSrcSpan forest oldSpan pos toks-    (t',forest'') = syncAST t newSpan forest'+    (forest',newSpan) = addToksAfterSrcSpan forest (ss2s oldSpan) pos toks+    t' = syncAST t (sf newSpan)  -- ----------------------------------------------------------------------+{-  reIndentToks :: Positioning -> [PosToken] -> [PosToken] -> [PosToken] reIndentToks _ _ [] = []@@ -1583,9 +1598,9 @@     toks'' = if endNewlines > 0                then toks' ++ [(newLinesToken (endNewlines - 1) $ glast "reIndentToks.3" toks')]                else toks'-+-} -- ----------------------------------------------------------------------+{- -- |Extract the start and end position of a span, without any leading -- or trailing comments nonCommentSpan :: [PosToken] -> (SimpPos,SimpPos)@@ -1599,12 +1614,12 @@        where         startTok = ghead "nonCommentSpan.1" $ dropWhile isIgnoredNonComment $ toks         endTok   = ghead "nonCommentSpan.2" $ dropWhile isIgnoredNonComment $ reverse toks-+-} -- ---------------------------------------------------------------------  -- |Convert a simple (start,end) position to a SrcSpan belonging to -- the file in the tree-posToSrcSpan :: Tree Entry -> (SimpPos,SimpPos) -> GHC.SrcSpan+posToSrcSpan :: Tree (Entry PosToken) -> (SimpPos,SimpPos) -> GHC.SrcSpan posToSrcSpan forest ((rs,cs),(re,ce)) = sspan   where     (GHC.L l _,_) = ghead "posToSrcSpan"  $ retrieveTokensInterim forest -- ++AZ++ Ouch, performance??@@ -1636,10 +1651,10 @@   -- ----------------------------------------------------------------------+{- -- |Insert a new node after the designated one in the tree insertNodeAfter-  :: Tree Entry -> Tree Entry -> Tree Entry -> Tree Entry+  :: Tree (Entry PosToken) -> Tree (Entry PosToken) -> Tree (Entry PosToken) -> Tree (Entry PosToken) insertNodeAfter oldNode newNode forest = forest'   where     zf = openZipperToNodeDeep oldNode $ Z.fromTree forest@@ -1655,15 +1670,15 @@      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-  :: Tree Entry-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+  :: Tree (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken) openZipperToNode (Node (Entry sspan _ _) _) z   = openZipperToSpan sspan z openZipperToNode (Node (Deleted sspan _ _) _) z@@ -1672,9 +1687,9 @@ -- |Open a zipper so that its focus is the given node --  NOTE: the node must already be in the tree openZipperToNodeDeep-  :: Tree Entry-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+  :: Tree (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken) openZipperToNodeDeep (Node (Entry sspan _ _) _) z   = openZipperToSpanDeep sspan z openZipperToNodeDeep (Node (Deleted sspan _ _) _) z@@ -1686,9 +1701,9 @@   where     go acc Nothing = acc     go acc (Just zz) = go (acc ++ [zz]) (Z.next zz)-+-} -- ----------------------------------------------------------------------+{- -- |Does the first span contain the second? Takes cognisance of the -- various flags a ForestSpan can have. -- NOTE: This function relies on the Eq instance for ForestLine@@ -1700,16 +1715,16 @@         (nvs,_nve) = forestSpanVersions $ span2         (startPos,endPos)   = insertVersionsInForestSpan tvs tvs span1         (nodeStart,nodeEnd) = insertVersionsInForestSpan nvs nvs 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 openZipperToSpan   :: ForestSpan-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken) openZipperToSpan sspan z   | hasVersions = openZipperToSpanAdded sspan z   | otherwise   = openZipperToSpanOrig sspan z@@ -1725,8 +1740,8 @@ -- in the tree openZipperToSpanOrig   :: ForestSpan-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+     -> 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@@ -1780,8 +1795,8 @@ -- return that instead openZipperToSpanDeep   :: ForestSpan-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken) openZipperToSpanDeep sspan z = zf   where     z' = openZipperToSpan sspan z@@ -1801,8 +1816,8 @@ -- thus does not necessarily fall in the logical hierarchy of the tree openZipperToSpanAdded   :: ForestSpan-     -> Z.TreePos Z.Full Entry-     -> Z.TreePos Z.Full Entry+     -> Z.TreePos Z.Full (Entry PosToken)+     -> Z.TreePos Z.Full (Entry PosToken) openZipperToSpanAdded sspan z = zf   where     treeAsList = getTreeSpansAsList $ Z.tree z@@ -1824,10 +1839,10 @@  -- --------------------------------------------------------------------- -getTreeSpansAsList :: Tree Entry -> [(Int,ForestSpan)]+getTreeSpansAsList :: Tree (Entry PosToken) -> [(Int,ForestSpan)] getTreeSpansAsList = getTreeSpansAsList' 0 -getTreeSpansAsList' :: Int -> Tree Entry -> [(Int,ForestSpan)]+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)@@ -1838,8 +1853,8 @@ -- |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 -> ForestSpan-                  -> ([Tree Entry],[Tree Entry],[Tree Entry])+splitForestOnSpan :: Forest (Entry PosToken) -> ForestSpan+                  -> ([Tree (Entry PosToken)],[Tree (Entry PosToken)],[Tree (Entry PosToken)]) splitForestOnSpan forest sspan = (beginTrees,middleTrees,endTrees)   where     (spanStart,spanEnd) = sspan@@ -1858,11 +1873,11 @@   -+-} -- ----------------------------------------------------------------------+{- -- |Utility function to either return True or throw an error to report the problem-invariantOk :: Tree Entry -> Bool+invariantOk :: Tree (Entry PosToken) -> Bool invariantOk forest = ok   where     inv = invariant forest@@ -1879,20 +1894,20 @@ --   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 nullSpan entries in the tree+--   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 :: Tree Entry -> [String]+invariant :: Tree (Entry PosToken) -> [String] invariant forest = rsub   where     rsub = F.foldl checkOneTree [] [forest] -    checkOneTree :: [String] -> Tree Entry -> [String]+    checkOneTree :: [String] -> Tree (Entry PosToken) -> [String]     checkOneTree acc tree = acc ++ r       where         r = checkNode [] tree -    checkNode :: [String] -> Tree Entry -> [String]+    checkNode :: [String] -> Tree (Entry PosToken) -> [String]     checkNode _acc (Node (Deleted _sspan _ _) []) = []     checkNode _acc node@(Node (Deleted _sspan _ _) _sub)          = ["FAIL: deleted node with subtree: " ++ (prettyshow node)]@@ -1906,7 +1921,7 @@          rinc = checkInclusion node -        rnull = if (sspan == nullSpan)+        rnull = if (sspan == nullForestSpan)                  then ["FAIL: null SrcSpan in tree: " ++ (prettyshow node)]                  else [] @@ -1938,7 +1953,7 @@          rseq = checkSequence node subs -        checkSequence :: Tree Entry -> [ForestSpan] -> [String]+        checkSequence :: Tree (Entry PosToken) -> [ForestSpan] -> [String]         checkSequence _ [] = []         checkSequence _ [_x] = []         checkSequence node' ((_s1,e1):s@(s2,_e2):ss)@@ -1969,15 +1984,17 @@      False _ -> before  -}-+-} -- --------------------------------------------------------------------- +{- moved to haskell-token-utils -- |Get the start and end position of a Tree--- treeStartEnd :: Tree Entry -> (SimpPos,SimpPos)+-- treeStartEnd :: Tree (Entry PosToken) -> (SimpPos,SimpPos) -- treeStartEnd (Node (Entry sspan _) _) = (getGhcLoc sspan,getGhcLocEnd sspan)-treeStartEnd :: Tree Entry -> ForestSpan+treeStartEnd :: Tree (Entry PosToken) -> ForestSpan treeStartEnd (Node (Entry sspan _ _) _) = sspan treeStartEnd (Node (Deleted sspan _ _) _) = sspan+-}  -- |Get the start and end position of a SrcSpan -- spanStartEnd :: GHC.SrcSpan -> (SimpPos,SimpPos)@@ -1992,7 +2009,7 @@ -- showForest :: Forest Entry -> String showForest forest = map (showSubTree 0) forest   where-    -- showSubTree :: Int -> Tree Entry -> String+    -- showSubTree :: Int -> Tree (Entry PosToken) -> String     showSubTree indent tree@(Node (Entry sspan toks mp) sub)       = (take indent (repeat ' '))         ++ (show (getGhcLoc sspan, getGhcLocEnd sspan)) ++ " "@@ -2000,40 +2017,40 @@              [] -> showSubTree (indent+2) sub              _  -> "toks") -}--showForest :: [Tree Entry] -> [String]+{-+showForest :: [Tree (Entry PosToken)] -> [String] showForest forest = map showTree forest  -- ---------------------------------------------------------------------  -- |Call drawTreeEntry on the entire token cache-drawTokenCache :: TokenCache -> String+drawTokenCache :: TokenCache PosToken -> String drawTokenCache tk = Map.foldlWithKey' doOne "" (tkCache tk)   where-    doOne :: String -> TreeId -> Tree Entry -> String+    doOne :: String -> TreeId -> Tree (Entry PosToken) -> String     doOne s key val = s ++ "tree " ++ (show key) ++ ":\n"                         ++ (drawTreeEntry val)  -- ---------------------------------------------------------------------  -- |Call drawTreeEntry on the entire token cache-drawTokenCacheDetailed :: TokenCache -> String+drawTokenCacheDetailed :: TokenCache PosToken -> String drawTokenCacheDetailed tk = Map.foldlWithKey' doOne "" (tkCache tk)   where-    doOne :: String -> TreeId -> Tree Entry -> String+    doOne :: String -> TreeId -> Tree (Entry PosToken) -> String     doOne s key val = s ++ "tree " ++ (show key) ++ ":\n"                         ++ (show val)  -- --------------------------------------------------------------------- -- | Neat 2-dimensional drawing of a tree.-drawTreeEntry :: Tree Entry -> String+drawTreeEntry :: Tree (Entry PosToken) -> String drawTreeEntry  = unlines . drawEntry  -- | Neat 2-dimensional drawing of a forest.-drawForestEntry :: Forest Entry -> String+drawForestEntry :: Forest (Entry PosToken) -> String drawForestEntry  = unlines . map drawTreeEntry -drawEntry :: Tree Entry -> [String]+drawEntry :: Tree (Entry PosToken) -> [String] drawEntry (Node (Deleted sspan  _pg eg )  _ ) = [(showForestSpan sspan) ++ (show eg) ++ "D"] drawEntry (Node (Entry sspan lay _toks) ts0) = ((showForestSpan sspan) ++ (showLayout lay)): drawSubTrees ts0   where@@ -2052,21 +2069,21 @@  -- --------------------------------------------------------------------- -drawTreeCompact :: Tree Entry -> String+drawTreeCompact :: Tree (Entry PosToken) -> String drawTreeCompact = unlines . drawTreeCompact' 0 -drawTreeCompact' :: Int -> Tree Entry -> [String]+drawTreeCompact' :: Int -> Tree (Entry PosToken) -> [String] drawTreeCompact' level (Node (Deleted sspan _pg eg )  _  ) = [(show level) ++ ":" ++ (showForestSpan sspan) ++ (show eg) ++ "D"] drawTreeCompact' level (Node (Entry sspan lay _toks) ts0) = ((show level) ++ ":" ++ (showForestSpan sspan) ++ (showLayout lay))                                                           : (concatMap (drawTreeCompact' (level + 1)) ts0)-+-} -- -----------------------------------------------------------------------showTree :: Tree Entry -> String+{-+showTree :: Tree (Entry PosToken) -> String showTree = prettyshow  -- |Represent a tree in a more concise/pretty way-prettyshow :: Tree Entry -> String+prettyshow :: Tree (Entry PosToken) -> String prettyshow (Node (Deleted sspan _pg eg) _nullSubs)   = "Node (Deleted " ++ (showForestSpan sspan) ++ " " ++ (show eg) ++ ")" prettyshow (Node (Entry sspan _lay toks) sub)@@ -2080,12 +2097,12 @@ prettyToks toks@[_x] = showToks toks prettyToks toks@[_t1,_t2] = showToks toks prettyToks toks = showToks [ghead "prettyToks" toks] ++ ".." ++ showToks [last toks]-+-} -- ----------------------------------------------------------------------+{- -- |Make a tree representing a particular set of tokens-mkTreeFromTokens :: [PosToken] -> Tree Entry-mkTreeFromTokens []   = Node (Entry nullSpan NoChange []) []+mkTreeFromTokens :: [PosToken] -> Tree (Entry PosToken)+mkTreeFromTokens []   = Node (Entry nullForestSpan NoChange []) [] mkTreeFromTokens toks = Node (Entry sspan NoChange toks) []   where    (startLoc',endLoc') = nonCommentSpan toks@@ -2096,9 +2113,9 @@ -- ---------------------------------------------------------------------  -- |Make a tree representing a particular set of tokens-mkTreeFromSpanTokens :: ForestSpan -> [PosToken] -> Tree Entry+mkTreeFromSpanTokens :: ForestSpan -> [PosToken] -> Tree (Entry PosToken) mkTreeFromSpanTokens sspan toks = Node (Entry sspan NoChange toks) []-+-} -- ---------------------------------------------------------------------  ghcSpanStartEnd :: GHC.SrcSpan -> ((Int, Int), (Int, Int))@@ -2111,13 +2128,11 @@ -- TODO: Should this indent the tokens as well? syncAST :: (SYB.Data t)   => GHC.Located t -- ^The AST (or fragment)-  -> GHC.SrcSpan   -- ^The SrcSpan created in the Tree Entry-  -> Tree Entry    -- ^Existing token tree-  -> (GHC.Located t, Tree Entry) -- ^Updated AST and tokens-syncAST ast@(GHC.L l _t) sspan forest = (GHC.L sspan xx,forest')+  -> ForestSpan   -- ^The SrcSpan created in the Tree (Entry PosToken)+  -> (GHC.Located t) -- ^Updated AST and tokens+syncAST ast@(GHC.L l _t) fspan = GHC.L sspan xx   where-    forest' = forest-+    sspan = f2ss fspan     (( sr, sc),( _er, _ec)) = ghcSpanStartEnd l     ((nsr,nsc),(_ner,_nec)) = ghcSpanStartEnd sspan @@ -2126,7 +2141,7 @@      -- TODO: take cognizance of the ForestLines encoded in srcspans     -- when calculating the offsets etc-    syncSpan s  = addOffsetToSpan (rowOffset,colOffset) s+    syncSpan s  = addOffsetToSrcSpan (rowOffset,colOffset) s      (GHC.L _s xx) = everywhereStaged SYB.Renamer (               SYB.mkT hsbindlr@@ -2149,20 +2164,20 @@     lmatch (GHC.L s m)      = (GHC.L (syncSpan s) m) :: GHC.LMatch GHC.Name  -- ----------------------------------------------------------------------+{- -- | indent the tree and tokens by the given offset, and sync the AST -- to the tree too. indentDeclToks :: (SYB.Data t)   => GHC.Located t -- ^The AST (or fragment)-  -> Tree Entry    -- ^Existing token tree+  -> Tree (Entry PosToken)    -- ^Existing token tree   -> Int           -- ^ (signed) number of columns to indent/dedent-  -> (GHC.Located t, Tree Entry) -- ^Updated AST and tokens+  -> (GHC.Located t, Tree (Entry PosToken)) -- ^Updated AST and tokens indentDeclToks decl@(GHC.L sspan _) forest offset = (decl',forest'')   where     -- make sure the span is in the forest-    (forest',tree) = getSrcSpanFor forest (srcSpanToForestSpan sspan)+    (forest',tree) = getSrcSpanFor forest (ghcSrcSpanToForestSpan sspan) -    z = openZipperToSpan (srcSpanToForestSpan sspan) $ Z.fromTree forest'+    z = openZipperToSpan (ghcSrcSpanToForestSpan sspan) $ Z.fromTree forest'      tree' = go tree     -- The invariant will fail if we do not propagate this change@@ -2188,7 +2203,7 @@                 Just z'' -> Z.toTree (Z.setTree (markLenChanged $ Z.tree z'') z'')  -    (decl',_) = syncAST decl (addOffsetToSpan off sspan) tree+    decl' = syncAST decl (addOffsetToSpan off sspan) tree      off = (0,offset) @@ -2197,20 +2212,20 @@     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)-+-} -- ----------------------------------------------------------------------+{- 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))-+-} -- --------------------------------------------------------------------- -addOffsetToSpan :: (Int,Int) -> GHC.SrcSpan -> GHC.SrcSpan-addOffsetToSpan (lineOffset,colOffset) sspan = sspan'+addOffsetToSrcSpan :: (Int,Int) -> GHC.SrcSpan -> GHC.SrcSpan+addOffsetToSrcSpan (lineOffset,colOffset) sspan = sspan'   where    sspan' =  case sspan of      GHC.RealSrcSpan ss ->@@ -2231,20 +2246,29 @@ showSrcSpanF :: GHC.SrcSpan -> String showSrcSpanF sspan = show (((chs,trs,vs,ls),cs),((che,tre,ve,le),ce))   where-    ((ForestLine chs trs vs ls,cs),(ForestLine che tre ve le,ce)) = srcSpanToForestSpan sspan+    ((ForestLine chs trs vs ls,cs),(ForestLine che tre ve le,ce)) = ghcSrcSpanToForestSpan sspan     -- chsn = if chs then 1 else 0     -- chen = if che then 1 else 0   -- --------------------------------------------------------------------- -sf :: GHC.SrcSpan -> ForestSpan-sf = srcSpanToForestSpan+ss2f :: GHC.SrcSpan -> ForestSpan+ss2f = ghcSrcSpanToForestSpan -fs :: ForestSpan -> GHC.SrcSpan-fs = forestSpanToSrcSpan+f2ss :: ForestSpan -> GHC.SrcSpan+f2ss = forestSpanToGhcSrcSpan +ss2s :: GHC.SrcSpan -> Span+ss2s ss = Span (getGhcLoc ss) (getGhcLocEnd ss) +s2ss :: Span -> GHC.SrcSpan+s2ss (Span (sr,sc) (er,ec)) = GHC.mkSrcSpan locStart locEnd+  where+    fname = GHC.mkFastString "foo"+    locStart = GHC.mkSrcLoc fname sr sc+    locEnd   = GHC.mkSrcLoc fname er ec+{- -- | ForestSpan version of GHC combineSrcSpans combineSpans :: ForestSpan -> ForestSpan -> ForestSpan combineSpans fs1 fs2 = fs'@@ -2254,6 +2278,6 @@     ((ForestLine _chhs _trhs _vhs _lhs,_chs),(ForestLine  chhe  trhe  vhe  lhe, che)) = highFs      fs' = ((ForestLine chls trls vls lls,cls),(ForestLine chhe trhe vhe lhe,che))-+-}  -- EOF

@@ -6,6 +6,7 @@ --  module Language.Haskell.Refact.Utils.TokenUtilsTypes(+{-        -- * The cache of trees comprising the manipulated tokens          TokenCache(..)        , TreeId(..)@@ -21,16 +22,15 @@        , ForestLine(..)        , ForestPos        , ForestSpan-       , PprOrigin(..)+-}+         PprOrigin(..)        , Ppr(..)        -- , HDoc(..)        ) where -import Language.Haskell.Refact.Utils.TypeSyn-import Data.Tree-import qualified Data.Map as Map+import Language.Haskell.TokenUtils.Types -import Outputable+-- import Outputable  -- --------------------------------------------------------------------- @@ -69,6 +69,7 @@  -} +{- -- TODO: turn this into a record, with named accessors -- | An entry in the data structure for a particular srcspan. data Entry = Entry !ForestSpan -- The source span contained in this@@ -82,12 +83,14 @@                                  --  the start of the next in the                                  --  fringe of the tree. --             deriving (Show)-+-}+{- type RowOffset = Int type ColOffset = Int type Row       = Int type Col       = Int-+-}+{- data Layout = Above EndOffset (Row,Col) (Row,Col) EndOffset             -- ^ Initial offset from token before the             -- stacked list of items, the (r,c) of the first@@ -97,14 +100,16 @@             -- start of the next item.             | NoChange             deriving (Show,Eq)-+-}+{- data EndOffset = None                | SameLine ColOffset                | FromAlignCol (RowOffset, ColOffset)                deriving (Show,Eq)+-}  -- ----------------------------------------------------------------------+{- data ForestLine = ForestLine                   { flSpanLengthChanged :: !Bool -- ^The length of the                                                  -- span may have@@ -114,7 +119,8 @@                   , flInsertVersion :: !Int                   , flLine          :: !Int                   } -- deriving (Eq)-+-}+{- instance Eq ForestLine where   -- TODO: make this undefined, and patch all broken code to use the   --       specific fun here directly instead.@@ -129,29 +135,32 @@  instance Outputable ForestLine where   ppr fl = text (show fl)+-}  -- ----------------------------------------------------------------------+{- type ForestPos = (ForestLine,Int)   -- |Match a SrcSpan, using a ForestLine as the marker type ForestSpan = (ForestPos,ForestPos)-+-} -- --------------------------------------------------------------------- +{- data TreeId = TId !Int deriving (Eq,Ord,Show)  -- |Identifies the tree carrying the main tokens, not any work in -- progress or deleted ones mainTid :: TreeId mainTid = TId 0-+-}+{- data TokenCache = TK   { tkCache :: !(Map.Map TreeId (Tree Entry))   , tkLastTreeId :: !TreeId   }-+-} -- ---------------------------------------------------------------------  data PprOrigin = Original -- ^ Original tokens

@@ -21,7 +21,7 @@ -- type InScopes=((Relations.Rel Names.QName (Ents.Ent PosName.Id))) type InScopes = [GHC.Name] -type SimpPos = (Int,Int) -- Line, column+-- type SimpPos = (Int,Int) -- Line, column  -- Additions for GHC type PosToken = (GHC.Located GHC.Token, String)@@ -58,36 +58,42 @@ instance GHC.Outputable (GHC.MatchGroup GHC.Name) where   ppr (GHC.MatchGroup ms _ptctyp) = GHC.text "MatchGroup" GHC.<+> GHC.ppr ms + instance GHC.Outputable (GHC.Match GHC.Name) where   ppr (GHC.Match pats mtyp grhs) = GHC.text "Match" GHC.<+> GHC.ppr pats                                                     GHC.<+> GHC.ppr mtyp                                                     GHC.<+> GHC.ppr grhs + instance GHC.Outputable (GHC.GRHSs GHC.Name) where   ppr (GHC.GRHSs grhss binds) = GHC.text "GRHSs" GHC.<+> GHC.ppr grhss                                                  GHC.<+> GHC.ppr binds + instance GHC.Outputable (GHC.GRHS GHC.Name) where   ppr (GHC.GRHS guards rhs) = GHC.text "GRHS" GHC.<+> GHC.ppr guards                                               GHC.<+> GHC.ppr rhs + instance GHC.Outputable (GHC.HsTupArg GHC.Name) where   ppr (GHC.Present e)    = GHC.text "Present" GHC.<+> GHC.ppr e   ppr (GHC.Missing _typ) = GHC.text "Missing" + instance GHC.Outputable (GHC.ConDeclField GHC.Name) where   ppr (GHC.ConDeclField name typ doc) = GHC.text "ConDeclField"                                           GHC.<+> GHC.ppr name                                           GHC.<+> GHC.ppr typ                                           GHC.<+> GHC.ppr doc + -- ---------------------------------------------------------------------  type HsModuleP = GHC.Located (GHC.HsModule GHC.RdrName)  -- --------------------------------------------------------------------- -- Putting these here for the time being, to avoid import loops-+{- ghead :: String -> [a] -> a ghead  info []    = error $ "ghead "++info++" []" ghead _info (h:_) = h@@ -103,5 +109,5 @@ gfromJust :: [Char] -> Maybe a -> a gfromJust _info (Just h) = h gfromJust  info Nothing = error $ "gfromJust " ++ info ++ " Nothing"-+-} -- ---------------------------------------------------------------------

@@ -142,20 +142,23 @@     -- , lookupNameGhc  ) where -import Exception+import Control.Monad.IO.Class () import Control.Monad.State import Data.Char import Data.List import Data.Maybe import Data.Monoid+import Exception import Language.Haskell.Refact.Utils.GhcUtils import Language.Haskell.Refact.Utils.GhcVersionSpecific import Language.Haskell.Refact.Utils.LocUtils import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.MonadFunctions import Language.Haskell.Refact.Utils.TokenUtils-import Language.Haskell.Refact.Utils.TokenUtilsTypes import Language.Haskell.Refact.Utils.TypeSyn+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Types+import Language.Haskell.TokenUtils.Utils  -- Modules from GHC import qualified Bag           as GHC@@ -176,7 +179,7 @@ import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB -import Data.Generics.Strafunski.StrategyLib.StrategyLib+import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero)  -- --------------------------------------------------------------------- @@ -4303,7 +4306,7 @@    l' =  case l of      GHC.RealSrcSpan ss ->        let-         ((ForestLine _ _ _ startRow,startCol),_) = srcSpanToForestSpan l+         ((ForestLine _ _ _ startRow,startCol),_) = ghcSrcSpanToForestSpan l           locStart = GHC.mkSrcLoc (GHC.srcSpanFile ss) startRow startCol          locEnd   = GHC.mkSrcLoc (GHC.srcSpanFile ss) startRow (length newNameStr + startCol)

@@ -32,9 +32,7 @@ import Control.Monad.State import Data.List import Data.Maybe--- import Data.Monoid import Language.Haskell.GhcMod-import Language.Haskell.Refact.Utils.DualTree import Language.Haskell.Refact.Utils.GhcBugWorkArounds import Language.Haskell.Refact.Utils.GhcModuleGraph import Language.Haskell.Refact.Utils.GhcUtils@@ -44,6 +42,9 @@ import Language.Haskell.Refact.Utils.MonadFunctions import Language.Haskell.Refact.Utils.TypeSyn import Language.Haskell.Refact.Utils.TypeUtils+import Language.Haskell.TokenUtils.DualTree+import Language.Haskell.TokenUtils.TokenUtils+import Language.Haskell.TokenUtils.Utils import System.Directory import System.FilePath.Posix @@ -241,7 +242,7 @@ -- | The result of a refactoring is the file, a flag as to whether it -- was modified, the updated token stream, and the updated AST -- type ApplyRefacResult = ((FilePath, Bool), ([Ppr],[PosToken], GHC.RenamedSource))-type ApplyRefacResult = ((FilePath, Bool), ([Line],[PosToken], GHC.RenamedSource))+type ApplyRefacResult = ((FilePath, Bool), ([Line PosToken],[PosToken], GHC.RenamedSource))   -- | Manage a whole refactor session. Initialise the monad, load the@@ -314,7 +315,8 @@     res <- refac  -- Run the refactoring, updating the state as required      mod'   <- getRefactRenamed-    toks'  <- fetchToksFinal+    -- toks'  <- fetchToksFinal+    let toks' = []     -- pprVal <- fetchPprFinal     linesVal <- fetchLinesFinal     m      <- getRefactStreamModified