packages feed

haskell-tools-prettyprint 0.8.1.0 → 0.9.0.0

raw patch · 17 files changed

+811/−829 lines, 17 filesdep ~ghcdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc, haskell-tools-ast

API changes (from Hackage documentation)

- Language.Haskell.Tools.IndentationUtils: setMinimalIndent :: SourceInfoTraversal elem => Int -> elem dom SrcTemplateStage -> elem dom SrcTemplateStage
- Language.Haskell.Tools.Transform: (<>) :: SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: ChildElem :: SourceTemplateElem
- Language.Haskell.Tools.Transform: NormalText :: String -> SourceTemplateTextElem
- Language.Haskell.Tools.Transform: StayingText :: String -> String -> SourceTemplateTextElem
- Language.Haskell.Tools.Transform: TextElem :: [SourceTemplateTextElem] -> SrcSpan -> SourceTemplateElem
- Language.Haskell.Tools.Transform: [_lineEndings] :: SourceTemplateTextElem -> String
- Language.Haskell.Tools.Transform: [_sourceTemplateTextElem] :: SourceTemplateElem -> [SourceTemplateTextElem]
- Language.Haskell.Tools.Transform: [_sourceTemplateTextRange] :: SourceTemplateElem -> SrcSpan
- Language.Haskell.Tools.Transform: [_sourceTemplateText] :: SourceTemplateTextElem -> String
- Language.Haskell.Tools.Transform: after :: AfterBefore i => String -> i -> i
- Language.Haskell.Tools.Transform: child :: SpanInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: cutUpRanges :: forall node dom. SourceInfoTraversal node => Ann node dom NormRangeStage -> Ann node dom RngTemplateStage
- Language.Haskell.Tools.Transform: data SourceTemplateElem
- Language.Haskell.Tools.Transform: data SourceTemplateTextElem
- Language.Haskell.Tools.Transform: extractStayingElems :: SourceInfoTraversal node => Ann node dom SrcTemplateStage -> Ann node dom SrcTemplateStage
- Language.Haskell.Tools.Transform: fixMainRange :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom RangeStage
- Language.Haskell.Tools.Transform: fixRanges :: SourceInfoTraversal node => Ann node dom RangeStage -> Ann node dom NormRangeStage
- Language.Haskell.Tools.Transform: followedBy :: AfterBefore i => String -> i -> i
- Language.Haskell.Tools.Transform: getLocIndices :: SourceInfoTraversal e => Ann e dom RngTemplateStage -> Set (RealSrcLoc, Int)
- Language.Haskell.Tools.Transform: getNormalComments :: Map SrcSpan [Located AnnotationComment] -> Map SrcSpan [Located AnnotationComment]
- Language.Haskell.Tools.Transform: getPragmaComments :: Map SrcSpan [Located AnnotationComment] -> Map String [Located String]
- Language.Haskell.Tools.Transform: indented :: ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: isStayingText :: SourceTemplateTextElem -> Bool
- Language.Haskell.Tools.Transform: lineEndings :: Partial SourceTemplateTextElem SourceTemplateTextElem String String
- Language.Haskell.Tools.Transform: list :: ListInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: mapLocIndices :: Ord k => StringBuffer -> Set (RealSrcLoc, k) -> Map k String
- Language.Haskell.Tools.Transform: minimumIndented :: MinimumIndent i => Int -> i -> i
- Language.Haskell.Tools.Transform: opt :: OptionalInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: placeComments :: RangeInfo stage => Map ApiAnnKey [SrcSpan] -> Map SrcSpan [Located AnnotationComment] -> Ann UModule dom stage -> Ann UModule dom stage
- Language.Haskell.Tools.Transform: prepareAST :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
- Language.Haskell.Tools.Transform: prepareASTCpp :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
- Language.Haskell.Tools.Transform: rangeToSource :: SourceInfoTraversal node => StringBuffer -> Ann node dom RngTemplateStage -> Ann node dom SrcTemplateStage
- Language.Haskell.Tools.Transform: relativeIndented :: RelativeIndent i => Int -> i -> i
- Language.Haskell.Tools.Transform: separatedBy :: String -> ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
- Language.Haskell.Tools.Transform: sourceTemplateListRange :: Simple Lens (ListInfo SrcTemplateStage) SrcSpan
- Language.Haskell.Tools.Transform: sourceTemplateNodeElems :: Simple Lens (SpanInfo SrcTemplateStage) [SourceTemplateElem]
- Language.Haskell.Tools.Transform: sourceTemplateNodeRange :: Simple Lens (SpanInfo SrcTemplateStage) SrcSpan
- Language.Haskell.Tools.Transform: sourceTemplateOptRange :: Simple Lens (OptionalInfo SrcTemplateStage) SrcSpan
- Language.Haskell.Tools.Transform: sourceTemplateText :: Lens SourceTemplateTextElem SourceTemplateTextElem String String
- Language.Haskell.Tools.Transform: sourceTemplateTextElem :: Partial SourceTemplateElem SourceTemplateElem [SourceTemplateTextElem] [SourceTemplateTextElem]
- Language.Haskell.Tools.Transform: sourceTemplateTextRange :: Partial SourceTemplateElem SourceTemplateElem SrcSpan SrcSpan
- Language.Haskell.Tools.Transform: srcTmpDefaultSeparator :: Simple Lens (ListInfo SrcTemplateStage) String
- Language.Haskell.Tools.Transform: srcTmpIndented :: Simple Lens (ListInfo SrcTemplateStage) (Maybe [Bool])
- Language.Haskell.Tools.Transform: srcTmpListAfter :: Simple Lens (ListInfo SrcTemplateStage) String
- Language.Haskell.Tools.Transform: srcTmpListBefore :: Simple Lens (ListInfo SrcTemplateStage) String
- Language.Haskell.Tools.Transform: srcTmpOptAfter :: Simple Lens (OptionalInfo SrcTemplateStage) String
- Language.Haskell.Tools.Transform: srcTmpOptBefore :: Simple Lens (OptionalInfo SrcTemplateStage) String
- Language.Haskell.Tools.Transform: srcTmpSeparators :: Simple Lens (ListInfo SrcTemplateStage) [([SourceTemplateTextElem], SrcSpan)]
+ Language.Haskell.Tools.PrettyPrint.Prepare: (<>) :: SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: ChildElem :: SourceTemplateElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: NormalText :: String -> SourceTemplateTextElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: StayingText :: String -> String -> SourceTemplateTextElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: TextElem :: [SourceTemplateTextElem] -> SrcSpan -> SourceTemplateElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: [_lineEndings] :: SourceTemplateTextElem -> String
+ Language.Haskell.Tools.PrettyPrint.Prepare: [_sourceTemplateTextElem] :: SourceTemplateElem -> [SourceTemplateTextElem]
+ Language.Haskell.Tools.PrettyPrint.Prepare: [_sourceTemplateTextRange] :: SourceTemplateElem -> SrcSpan
+ Language.Haskell.Tools.PrettyPrint.Prepare: [_sourceTemplateText] :: SourceTemplateTextElem -> String
+ Language.Haskell.Tools.PrettyPrint.Prepare: after :: AfterBefore i => String -> i -> i
+ Language.Haskell.Tools.PrettyPrint.Prepare: child :: SpanInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: cutUpRanges :: forall node dom. SourceInfoTraversal node => Ann node dom NormRangeStage -> Ann node dom RngTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: data SourceTemplateElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: data SourceTemplateTextElem
+ Language.Haskell.Tools.PrettyPrint.Prepare: extractStayingElems :: SourceInfoTraversal node => Ann node dom SrcTemplateStage -> Ann node dom SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: fixMainRange :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom RangeStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: fixRanges :: SourceInfoTraversal node => Ann node dom RangeStage -> Ann node dom NormRangeStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: followedBy :: AfterBefore i => String -> i -> i
+ Language.Haskell.Tools.PrettyPrint.Prepare: getLocIndices :: SourceInfoTraversal e => Ann e dom RngTemplateStage -> Set (RealSrcLoc, Int)
+ Language.Haskell.Tools.PrettyPrint.Prepare: getNormalComments :: Map SrcSpan [Located AnnotationComment] -> Map SrcSpan [Located AnnotationComment]
+ Language.Haskell.Tools.PrettyPrint.Prepare: getPragmaComments :: Map SrcSpan [Located AnnotationComment] -> Map String [Located String]
+ Language.Haskell.Tools.PrettyPrint.Prepare: indented :: ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: isStayingText :: SourceTemplateTextElem -> Bool
+ Language.Haskell.Tools.PrettyPrint.Prepare: lineEndings :: Partial SourceTemplateTextElem SourceTemplateTextElem String String
+ Language.Haskell.Tools.PrettyPrint.Prepare: list :: ListInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: mapLocIndices :: Ord k => StringBuffer -> Set (RealSrcLoc, k) -> Map k String
+ Language.Haskell.Tools.PrettyPrint.Prepare: minimumIndented :: MinimumIndent i => Int -> i -> i
+ Language.Haskell.Tools.PrettyPrint.Prepare: opt :: OptionalInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: placeComments :: RangeInfo stage => Map ApiAnnKey [SrcSpan] -> Map SrcSpan [Located AnnotationComment] -> Ann UModule dom stage -> Ann UModule dom stage
+ Language.Haskell.Tools.PrettyPrint.Prepare: prepareAST :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: prepareASTCpp :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: rangeToSource :: SourceInfoTraversal node => StringBuffer -> Ann node dom RngTemplateStage -> Ann node dom SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: relativeIndented :: RelativeIndent i => Int -> i -> i
+ Language.Haskell.Tools.PrettyPrint.Prepare: separatedBy :: String -> ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateListRange :: Simple Lens (ListInfo SrcTemplateStage) SrcSpan
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateMinimalIndent :: Simple Lens (SpanInfo SrcTemplateStage) Int
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateNodeElems :: Simple Lens (SpanInfo SrcTemplateStage) [SourceTemplateElem]
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateNodeRange :: Simple Lens (SpanInfo SrcTemplateStage) SrcSpan
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateOptRange :: Simple Lens (OptionalInfo SrcTemplateStage) SrcSpan
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateText :: Lens SourceTemplateTextElem SourceTemplateTextElem String String
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateTextElem :: Partial SourceTemplateElem SourceTemplateElem [SourceTemplateTextElem] [SourceTemplateTextElem]
+ Language.Haskell.Tools.PrettyPrint.Prepare: sourceTemplateTextRange :: Partial SourceTemplateElem SourceTemplateElem SrcSpan SrcSpan
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpDefaultSeparator :: Simple Lens (ListInfo SrcTemplateStage) String
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpIndented :: Simple Lens (ListInfo SrcTemplateStage) (Maybe [Bool])
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpListAfter :: Simple Lens (ListInfo SrcTemplateStage) String
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpListBefore :: Simple Lens (ListInfo SrcTemplateStage) String
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpListMinimalIndent :: Simple Lens (ListInfo SrcTemplateStage) Int
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpOptAfter :: Simple Lens (OptionalInfo SrcTemplateStage) String
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpOptBefore :: Simple Lens (OptionalInfo SrcTemplateStage) String
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpOptMinimalIndent :: Simple Lens (OptionalInfo SrcTemplateStage) Int
+ Language.Haskell.Tools.PrettyPrint.Prepare: srcTmpSeparators :: Simple Lens (ListInfo SrcTemplateStage) [([SourceTemplateTextElem], SrcSpan)]

Files

− Language/Haskell/Tools/IndentationUtils.hs
@@ -1,16 +0,0 @@--- | Utilities to modify the indentation of AST fragments
-module Language.Haskell.Tools.IndentationUtils where
-
-import Control.Monad.Identity (Identity(..))
-import Control.Reference ((.=))
-
-import Language.Haskell.Tools.AST (SrcTemplateStage, SourceInfoTrf(..), SourceInfoTraversal(..))
-import Language.Haskell.Tools.Transform.SourceTemplate (sourceTemplateMinimalIndent, srcTmpListMinimalIndent, srcTmpOptMinimalIndent)
-
--- | Set the minimal indentation recursively for a part of the AST
-setMinimalIndent :: SourceInfoTraversal elem 
-                 => Int -> elem dom SrcTemplateStage -> elem dom SrcTemplateStage
-setMinimalIndent ind = runIdentity . 
-  sourceInfoTraverse (SourceInfoTrf (Identity . (sourceTemplateMinimalIndent .= ind)) 
-                                    (Identity . (srcTmpListMinimalIndent .= ind)) 
-                                    (Identity . (srcTmpOptMinimalIndent .= ind)))
Language/Haskell/Tools/PrettyPrint.hs view
@@ -11,16 +11,15 @@ import SrcLoc
 
 import Language.Haskell.Tools.AST (SrcTemplateStage, SourceInfoTraversal(..))
+import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
 import Language.Haskell.Tools.PrettyPrint.RoseTree (RoseSourceInfo(..), RoseTree(..), toRoseTree)
-import Language.Haskell.Tools.Transform.SourceTemplate
 
 import Control.Monad.State
-import Control.Reference
+import Control.Reference ((^.))
 import Data.Foldable (Foldable(..), concat)
 import Data.List as List
 import Data.List.Split (splitOn)
 import Data.Sequence hiding (null, replicate)
-import Debug.Trace
 
 -- | Pretty prints an AST by using source templates stored as node info
 prettyPrint :: (SourceInfoTraversal node) => node dom SrcTemplateStage -> String
+ Language/Haskell/Tools/PrettyPrint/Prepare.hs view
@@ -0,0 +1,41 @@+-- | A module for preparing the representation of the AST for pretty printing.
+module Language.Haskell.Tools.PrettyPrint.Prepare
+  ( prepareAST, prepareASTCpp
+  -- comment handling
+  , placeComments, getNormalComments, getPragmaComments
+  -- generating source templates
+  , child, opt, list, after, followedBy, relativeIndented, minimumIndented, separatedBy, indented, (<>)
+  -- references on source templates
+  , sourceTemplateNodeRange, sourceTemplateNodeElems
+  , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators
+  , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter
+  , SourceTemplateElem(..), sourceTemplateTextElem, sourceTemplateTextRange, SourceTemplateTextElem(..), sourceTemplateText, lineEndings, isStayingText
+  -- parts of the transformation, used for debugging purposes
+  , rangeToSource, fixRanges, cutUpRanges, getLocIndices, mapLocIndices, fixMainRange, extractStayingElems
+  , sourceTemplateMinimalIndent, srcTmpListMinimalIndent, srcTmpOptMinimalIndent
+  ) where
+
+import Language.Haskell.Tools.PrettyPrint.Prepare.PlaceComments (getNormalComments, getPragmaComments, placeComments)
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate ()
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplateToSourceTemplate (rangeToSource, getLocIndices, mapLocIndices, extractStayingElems)
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeToRangeTemplate (cutUpRanges, fixRanges)
+import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
+import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplateHelpers
+
+import FastString (mkFastString)
+import Language.Haskell.Tools.AST
+import SrcLoc
+import StringBuffer (StringBuffer, nextChar, atEnd)
+
+-- | Prepares the AST for pretty printing
+prepareAST :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
+prepareAST srcBuffer = rangeToSource srcBuffer . cutUpRanges . fixRanges
+
+prepareASTCpp :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
+prepareASTCpp srcBuffer = extractStayingElems . rangeToSource srcBuffer . cutUpRanges . fixRanges . fixMainRange srcBuffer
+
+fixMainRange :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom RangeStage
+fixMainRange buffer mod = setRange (mkSrcSpan (srcSpanStart $ getRange mod) (RealSrcLoc (endPos startPos buffer))) mod
+  where startPos = mkRealSrcLoc (mkFastString "") 1 1
+        endPos pos buf | atEnd buf = pos
+        endPos pos buf = let (ch,buf') = nextChar buf in endPos (advanceSrcLoc pos ch) buf'
+ Language/Haskell/Tools/PrettyPrint/Prepare/PlaceComments.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE ScopedTypeVariables
+           , FlexibleContexts
+           , LambdaCase
+           #-}
+-- | This transformation expands nodes to contain the comments that should be attached to them. After this, a
+-- normalizing transformation should be performed that expands parents to contain their children.
+module Language.Haskell.Tools.PrettyPrint.Prepare.PlaceComments where
+
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Reference hiding (element)
+import Data.Char (isSpace, isAlphaNum)
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Set (Set)
+
+import ApiAnnotation (ApiAnnKey, AnnotationComment(..))
+import SrcLoc
+
+import Language.Haskell.Tools.AST
+
+getNormalComments :: Map SrcSpan [Located AnnotationComment] -> Map.Map SrcSpan [Located AnnotationComment]
+getNormalComments = Map.map (filter (not . isPragma . unLoc))
+
+getPragmaComments :: Map SrcSpan [Located AnnotationComment] -> Map.Map String [Located String]
+getPragmaComments comms = Map.fromListWith (++) $ map (\(L l (AnnBlockComment str)) -> (getPragmaCommand str, [L l str]))
+                                                $ filter (isPragma . unLoc) $ concatMap snd $ Map.toList comms
+  where getPragmaCommand = takeWhile (\c -> isAlphaNum c || c == '_') . dropWhile isSpace . drop 3
+
+isPragma :: AnnotationComment -> Bool
+isPragma (AnnBlockComment str) = take 3 str == "{-#" && take 3 (reverse str) == "}-#"
+isPragma _ = False
+
+-- | Puts comments in the nodes they should be attached to. Watches for lexical tokens
+-- that may divide the comment and the supposed element.
+-- Leaves the AST in a state where parent nodes does not contain all of their children.
+placeComments :: RangeInfo stage => Map ApiAnnKey [SrcSpan] -> Map.Map SrcSpan [Located AnnotationComment]
+              -> Ann UModule dom stage -> Ann UModule dom stage
+placeComments tokens comms mod
+  = resizeAnnots (Set.filter (\rng -> srcSpanStart rng /= srcSpanEnd rng) $ Set.fromList $ concat (Map.elems tokens))
+      (concatMap (map nextSrcLoc . snd) (Map.toList cleanedComments)) mod
+  where spans = allElemSpans mod
+        sortedElemStarts = Set.fromList $ map srcSpanStart spans
+        sortedElemEnds = Set.fromList $ map srcSpanEnd spans
+        nextSrcLoc comm@(L sp _)
+          = let after = fromMaybe noSrcLoc (Set.lookupLE (srcSpanStart sp) sortedElemEnds)
+                before = fromMaybe noSrcLoc (Set.lookupGE (srcSpanEnd sp) sortedElemStarts)
+             in ((after,before),comm)
+        cleanedComments = Map.map (map cleanComment) comms
+        cleanComment (L loc (AnnLineComment txt))
+          | last txt `elem` "\n\r" = L (mkSrcSpan (srcSpanStart loc) (decreaseCol (srcSpanEnd loc))) (AnnLineComment (init txt))
+        cleanComment c = c
+        decreaseCol (RealSrcLoc l) = mkSrcLoc (srcLocFile l) (srcLocLine l) (srcLocCol l - 1)
+        decreaseCol l = l
+
+allElemSpans :: (SourceInfoTraversal node, RangeInfo stage) => Ann node dom stage -> [SrcSpan]
+allElemSpans = execWriter . sourceInfoTraverse (SourceInfoTrf (\ni -> tell [ni ^. nodeSpan] >> pure ni) pure pure)
+
+resizeAnnots :: RangeInfo stage => Set SrcSpan -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
+              -> Ann UModule dom stage
+              -> Ann UModule dom stage
+resizeAnnots tokens comments elem
+  = flip evalState comments $ flip runReaderT tokens $
+        -- if a comment that could be attached to more than one documentable element (possibly nested)
+        -- the order of different documentable elements here decide which will be chosen
+
+        modImports&annList !~ expandAnnot -- expand imports to cover their comments
+          >=> modDecl&annList !~ expandTopLevelDecl -- expand declarations to cover their comments
+          >=> expandAnnot -- expand the module itself to cover its comments
+      $ elem
+
+type ExpandType elem dom stage = Ann elem dom stage -> ReaderT (Set SrcSpan) (State [((SrcLoc, SrcLoc), Located AnnotationComment)]) (Ann elem dom stage)
+
+expandTopLevelDecl :: RangeInfo stage => ExpandType UDecl dom stage
+expandTopLevelDecl
+  = declBody & annJust & cbElements & annList !~ expandClsElement
+      >=> declCons & annList !~ expandConDecl
+      >=> declGadt & annList !~ expandGadtConDecl
+      >=> declTypeSig !~ expandTypeSig
+      >=> expandAnnot
+
+expandTypeSig :: RangeInfo stage => ExpandType UTypeSignature dom stage
+expandTypeSig
+  = tsType & typeParams !~ expandAnnot >=> expandAnnot
+
+expandClsElement :: RangeInfo stage => ExpandType UClassElement dom stage
+expandClsElement
+  = ceTypeSig !~ expandTypeSig
+      >=> ceBind !~ expandValueBind
+      >=> expandAnnot
+
+expandValueBind :: RangeInfo stage => ExpandType UValueBind dom stage
+expandValueBind
+  = valBindLocals & annJust & localBinds & annList !~ expandLocalBind
+      >=> funBindMatches & annList & matchBinds & annJust & localBinds & annList !~ expandLocalBind
+      >=> expandAnnot
+
+expandLocalBind :: RangeInfo stage => ExpandType ULocalBind dom stage
+expandLocalBind
+  = localVal !~ expandValueBind
+      >=> localSig !~ expandTypeSig
+      >=> expandAnnot
+
+expandConDecl :: RangeInfo stage => ExpandType UConDecl dom stage
+expandConDecl
+  = conDeclFields & annList !~ expandAnnot >=> expandAnnot
+
+expandGadtConDecl :: RangeInfo stage => ExpandType UGadtConDecl dom stage
+expandGadtConDecl
+  = gadtConType & gadtConRecordFields & annList !~ expandAnnot >=> expandAnnot
+
+-- | Expands tree elements to contain the comments that should be attached to them.
+expandAnnot :: forall elem dom stage . RangeInfo stage => ExpandType elem dom stage
+expandAnnot elem
+  = do let Just sp = elem ^? annotation&sourceInfo&nodeSpan
+       tokens <- ask
+       applicable <- lift $ gets (applicableComments tokens (srcSpanStart sp) (srcSpanEnd sp))
+
+       -- this check is just for performance (quick return if no modification is needed)
+       if not (null applicable) then do
+         -- the new span is the original plus all the covered spans
+         let newSp@(RealSrcSpan newSpan)
+               = foldl combineSrcSpans (fromJust $ elem ^? nodeSp) (map (getLoc . snd) applicable)
+         -- take out all comments that are now covered
+         lift $ modify (filter (not . (\case RealSrcSpan s -> newSpan `containsSpan` s; _ -> True) . getLoc . snd))
+         return $ nodeSp .= newSp $ elem
+       else return elem
+  where nodeSp :: Simple Partial (Ann elem dom stage) SrcSpan
+        nodeSp = annotation&sourceInfo&nodeSpan
+
+-- This classification does not prefer inline comments to previous line comments, this is implicitly done
+-- by the order in which the elements are traversed.
+applicableComments :: Set SrcSpan -> SrcLoc -> SrcLoc
+                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
+                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
+applicableComments tokens start end = filter applicableComment
+  where -- A comment that starts with | binds to the next documented element
+        applicableComment ((_, before), L sp comm)
+          | isCommentOnNext comm = before == start && noTokenBetween (srcSpanEnd sp) start
+        -- A comment that starts with ^ binds to the previous documented element
+        applicableComment ((after, _), L sp comm)
+          | isCommentOnPrev comm = after == end && noTokenBetween end (srcSpanStart sp)
+        -- All other comment binds to the previous definition if it is on the same line
+        applicableComment ((after, _), L sp@(RealSrcSpan loc) _)
+          | after == end && srcLocLine (realSrcSpanStart loc) == getLineLocDefault end = True
+                         && noTokenBetween end (srcSpanStart sp)
+        -- or the next one if that is on the next line and the columns line up
+        applicableComment ((_, before), L sp@(RealSrcSpan loc) _)
+          | before == start && srcLocLine (realSrcSpanEnd loc) + 1 == getLineLocDefault start
+                            && srcLocCol (realSrcSpanStart loc) == getLineColDefault start
+                            && noTokenBetween (srcSpanEnd sp) start
+          = True
+        applicableComment _ = False
+
+        getLineLocDefault (RealSrcLoc l) = srcLocLine l
+        getLineLocDefault _              = -1
+
+        getLineColDefault (RealSrcLoc l) = srcLocCol l
+        getLineColDefault _              = -1
+
+        noTokenBetween start end
+          = case Set.lookupGE (srcLocSpan start) tokens of
+              Just tok -> srcSpanStart tok >= end
+              Nothing -> True
+
+-- * GHC mistakenly parses -- ^ and -- | comments as simple line comments.
+-- These functions check if a given comment is attached to the previous or next comment.
+
+-- | Checks if a doc comment belongs to the next definition.
+isCommentOnNext :: AnnotationComment -> Bool
+isCommentOnNext (AnnDocCommentNext _) = True
+isCommentOnNext (AnnLineComment s) = firstNonspaceCharIs '|' s
+isCommentOnNext (AnnBlockComment s) = firstNonspaceCharIs '|' s
+isCommentOnNext _ = False
+
+-- | Checks if a doc comment belongs to the previous definition.
+isCommentOnPrev :: AnnotationComment -> Bool
+isCommentOnPrev (AnnDocCommentPrev _) = True
+isCommentOnPrev (AnnLineComment s) = firstNonspaceCharIs '^' s
+isCommentOnPrev (AnnBlockComment s) = firstNonspaceCharIs '^' s
+isCommentOnPrev _ = False
+
+-- the comment string contains the -- or {- characters
+firstNonspaceCharIs :: Char -> String -> Bool
+firstNonspaceCharIs c s = Just c == listToMaybe (dropWhile isSpace (drop 2 s))
+ Language/Haskell/Tools/PrettyPrint/Prepare/RangeTemplate.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TemplateHaskell
+           , DeriveDataTypeable
+           , RecordWildCards
+           , TypeFamilies
+           , FlexibleInstances
+           #-}
+-- | The range template is an intermediate annotation level, where the children nodes of the tree
+-- had been cut from the parent nodes, but the annotations still contain ranges instead of text.
+module Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate where
+
+import Control.Reference
+import Data.Data
+import Language.Haskell.Tools.AST
+import SrcLoc
+
+instance SourceInfo RngTemplateStage where
+  data SpanInfo RngTemplateStage = RangeTemplateNode { _rngTemplateNodeRange :: RealSrcSpan
+                                                     , _rngTemplateNodeElems :: [RangeTemplateElem]
+                                                     }
+    deriving Data
+  data ListInfo RngTemplateStage = RangeTemplateList { _rngTemplateListRange :: RealSrcSpan
+                                                     , _rngTmpListBefore :: String -- ^ Text that should be put before the first element if the list becomes populated
+                                                     , _rngTmpListAfter :: String -- ^ Text that should be put after the last element if the list becomes populated
+                                                     , _rngTmpDefaultSeparator :: String -- ^ The default separator if the list were empty
+                                                     , _rngTmpIndented :: Maybe [Bool] -- ^ False for elements that should be not aligned
+                                                     , _rngTmpSeparators :: [RealSrcSpan] -- ^ The actual separators that were found in the source code
+                                                     }
+    deriving Data
+  data OptionalInfo RngTemplateStage = RangeTemplateOpt { _rngTemplateOptRange :: RealSrcSpan
+                                                        , _rngTmpOptBefore :: String -- ^ Text that should be put before the element if it appears
+                                                        , _rngTmpOptAfter :: String -- ^ Text that should be put after the element if it appears
+                                                        }
+    deriving Data
+
+
+rngTemplateNodeRange :: Simple Lens (SpanInfo RngTemplateStage) RealSrcSpan
+rngTemplateNodeRange = lens _rngTemplateNodeRange (\v s -> s { _rngTemplateNodeRange = v })
+
+rngTemplateNodeElems :: Simple Lens (SpanInfo RngTemplateStage) [RangeTemplateElem]
+rngTemplateNodeElems = lens _rngTemplateNodeElems (\v s -> s { _rngTemplateNodeElems = v })
+
+rngTemplateListRange :: Simple Lens (ListInfo RngTemplateStage) RealSrcSpan
+rngTemplateListRange = lens _rngTemplateListRange (\v s -> s { _rngTemplateListRange = v })
+
+rngTmpListBefore :: Simple Lens (ListInfo RngTemplateStage) String
+rngTmpListBefore = lens _rngTmpListBefore (\v s -> s { _rngTmpListBefore = v })
+
+rngTmpListAfter :: Simple Lens (ListInfo RngTemplateStage) String
+rngTmpListAfter = lens _rngTmpListAfter (\v s -> s { _rngTmpListAfter = v })
+
+rngTmpDefaultSeparator :: Simple Lens (ListInfo RngTemplateStage) String
+rngTmpDefaultSeparator = lens _rngTmpDefaultSeparator (\v s -> s { _rngTmpDefaultSeparator = v })
+
+rngTmpIndented :: Simple Lens (ListInfo RngTemplateStage) (Maybe [Bool])
+rngTmpIndented = lens _rngTmpIndented (\v s -> s { _rngTmpIndented = v })
+
+rngTmpSeparators :: Simple Lens (ListInfo RngTemplateStage) [RealSrcSpan]
+rngTmpSeparators = lens _rngTmpSeparators (\v s -> s { _rngTmpSeparators = v })
+
+rngTemplateOptRange :: Simple Lens (OptionalInfo RngTemplateStage) RealSrcSpan
+rngTemplateOptRange = lens _rngTemplateOptRange (\v s -> s { _rngTemplateOptRange = v })
+
+rngTmpOptBefore :: Simple Lens (OptionalInfo RngTemplateStage) String
+rngTmpOptBefore = lens _rngTmpOptBefore (\v s -> s { _rngTmpOptBefore = v })
+
+rngTmpOptAfter :: Simple Lens (OptionalInfo RngTemplateStage) String
+rngTmpOptAfter = lens _rngTmpOptAfter (\v s -> s { _rngTmpOptAfter = v })
+
+-- | An element of a range template for a singleton AST node.
+data RangeTemplateElem = RangeElem RealSrcSpan -- ^ A range for the source code of the element
+                       | RangeChildElem        -- ^ The place for a child element
+                       deriving Data
+
+getRangeElemSpan :: RangeTemplateElem -> Maybe RealSrcSpan
+getRangeElemSpan (RangeElem sp) = Just sp
+getRangeElemSpan _ = Nothing
+
+instance HasRange (SpanInfo RngTemplateStage) where
+  getRange = RealSrcSpan . (^. rngTemplateNodeRange)
+  setRange (RealSrcSpan sp) = rngTemplateNodeRange .= sp
+  setRange _ = id
+
+instance HasRange (ListInfo RngTemplateStage) where
+  getRange = RealSrcSpan . (^. rngTemplateListRange)
+  setRange (RealSrcSpan sp) = rngTemplateListRange .= sp
+  setRange _ = id
+
+instance HasRange (OptionalInfo RngTemplateStage) where
+  getRange = RealSrcSpan . (^. rngTemplateOptRange)
+  setRange (RealSrcSpan sp) = rngTemplateOptRange .= sp
+  setRange _ = id
+
+instance Show (SpanInfo RngTemplateStage) where
+  show rngNode = concatMap show $ rngNode ^. rngTemplateNodeElems
+instance Show (ListInfo RngTemplateStage) where
+  show RangeTemplateList{..} = "<*" ++ shortShowSpan (RealSrcSpan _rngTemplateListRange) ++ " " ++ show _rngTmpListBefore ++ " " ++ show _rngTmpDefaultSeparator ++ " " ++ show _rngTmpListAfter ++ "*>"
+instance Show (OptionalInfo RngTemplateStage) where
+  show RangeTemplateOpt{..} = "<?" ++ shortShowSpan (RealSrcSpan _rngTemplateOptRange) ++ " " ++ show _rngTmpOptBefore ++ " " ++ show _rngTmpOptAfter ++ "?>"
+
+instance Show RangeTemplateElem where
+  show (RangeElem sp) = shortShowSpan (RealSrcSpan sp)
+  show RangeChildElem = "<.>"
+ Language/Haskell/Tools/PrettyPrint/Prepare/RangeTemplateToSourceTemplate.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE LambdaCase
+           , FlexibleContexts
+           #-}
+-- | This module converts range templates into source templates.
+-- Basically it reads the source file and attaches parts of the source file to the AST elements that have the range of the given source code fragment.
+module Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplateToSourceTemplate where
+
+import Control.Monad.Identity
+import Control.Monad.State
+import Control.Reference
+import Data.List
+import Data.List.Split (splitOn)
+import Data.Map as Map
+import Data.Ord (Ord(..), Ordering(..))
+import Data.Set as Set
+import FastString (mkFastString)
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate
+import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
+import SrcLoc
+import StringBuffer (StringBuffer, nextChar, atEnd)
+
+rangeToSource :: SourceInfoTraversal node => StringBuffer -> Ann node dom RngTemplateStage
+                                                          -> Ann node dom SrcTemplateStage
+rangeToSource srcInput tree = let locIndices = getLocIndices tree
+                                  srcMap = mapLocIndices srcInput locIndices
+                               in applyFragments (Map.elems srcMap) tree
+
+-- maps could be strict
+
+-- | Assigns an index (in the order they are used) for each range
+getLocIndices :: SourceInfoTraversal e => Ann e dom RngTemplateStage -> Set (RealSrcLoc, Int)
+getLocIndices = snd . flip execState (0, Set.empty) .
+  sourceInfoTraverseDown (SourceInfoTrf
+      (\ni -> do { mapM_ (\el -> case getRangeElemSpan el of Just sp -> modify (insertElem sp); _ -> return ()) (ni ^. rngTemplateNodeElems); return ni })
+      (\ni -> do { mapM_ (modify . insertElem) (ni ^. rngTmpSeparators); return ni })
+      pure )
+    (return ()) (return ())
+  where insertElem sp (i,m) = (i+1, Set.insert (realSrcSpanEnd sp, i) m)
+
+-- | Partitions the source file in the order where the parts are used in the AST
+mapLocIndices :: Ord k => StringBuffer -> Set (RealSrcLoc, k) -> Map k String
+mapLocIndices inp = (^. _1) . Set.foldl (\(new, str, pos) (sp, k) -> let (rem, val, newPos) = takeSpan str pos sp
+                                                                      in (Map.insert k (reverse val) new, rem, newPos))
+                                        (Map.empty, inp, mkRealSrcLoc (mkFastString "") 1 1)
+  where takeSpan :: StringBuffer -> RealSrcLoc -> RealSrcLoc -> (StringBuffer, String, RealSrcLoc)
+        takeSpan str pos end = takeSpan' end (str,"", pos)
+
+        takeSpan' :: RealSrcLoc -> (StringBuffer, String, RealSrcLoc) -> (StringBuffer, String, RealSrcLoc)
+        takeSpan' end (sb, taken, pos) | (srcLocLine pos `compare` srcLocLine end) `thenCmp` (srcLocCol pos `compare` srcLocCol end) == LT && not (atEnd sb)
+          = let (c,rem) = nextChar sb in takeSpan' end (rem, c:taken, advanceSrcLoc pos c)
+        takeSpan' _ (rem, taken, pos) = (rem, taken, pos)
+
+        thenCmp EQ o2 = o2
+        thenCmp o1 _  = o1
+
+-- | Replaces the ranges in the AST with the source file parts
+applyFragments :: SourceInfoTraversal node => [String] -> Ann node dom RngTemplateStage
+                                                       -> Ann node dom SrcTemplateStage
+applyFragments srcs = flip evalState srcs
+  . sourceInfoTraverseDown (SourceInfoTrf
+     (\ni -> do template <- mapM getTextFor (ni ^. rngTemplateNodeElems)
+                return $ SourceTemplateNode (RealSrcSpan $ ni ^. rngTemplateNodeRange) (concat template) 0 Nothing)
+     (\(RangeTemplateList rng bef aft sep indented seps)
+         -> do (own, rest) <- splitAt (length seps) <$> get
+               put rest
+               return (SourceTemplateList (RealSrcSpan rng) bef aft sep indented (Prelude.zip (Prelude.map ((:[]) . NormalText) own) (Prelude.map RealSrcSpan seps)) 0 Nothing))
+     (\(RangeTemplateOpt rng bef aft) -> return (SourceTemplateOpt (RealSrcSpan rng) bef aft 0 Nothing)))
+     (return ()) (return ())
+  where getTextFor RangeChildElem = return [ChildElem]
+        getTextFor (RangeElem rng) = do (src:rest) <- get
+                                        put rest
+                                        return [TextElem [NormalText src] (RealSrcSpan rng)]
+
+-- | Marks template elements in the AST that should always be present in the source code, regardless of their
+-- containing elements being deleted.
+-- Currently it recognizes CPP pragmas (lines starting with #)
+-- This function should only be applied to an AST if CPP is enabled.
+extractStayingElems :: SourceInfoTraversal node => Ann node dom SrcTemplateStage -> Ann node dom SrcTemplateStage
+extractStayingElems = runIdentity . sourceInfoTraverse (SourceInfoTrf
+    (sourceTemplateNodeElems & traversal & sourceTemplateTextElem !- breakStaying)
+    (srcTmpSeparators & traversal & _1 !- breakStaying)
+    pure)
+
+    where -- splits the elements into separate lines and then recombines them
+          breakStaying :: [SourceTemplateTextElem] -> [SourceTemplateTextElem]
+          breakStaying = concat . Prelude.map (\(NormalText s) -> toTxtElems s)
+
+          toTxtElems :: String -> [SourceTemplateTextElem]
+          toTxtElems str = extractStaying $ splitOn "\n" $ str
+            where
+              extractStaying lines | not (any ("#" `isPrefixOf`) lines) = [NormalText str]
+              extractStaying lines = Prelude.foldr appendTxt []
+                                       $ Prelude.map (\ln -> if "#" `isPrefixOf` ln then StayingText ln "\n" else NormalText ln) lines
+          -- recombines the lines if they are both normal text
+          -- otherwise it moves the windows '\r' characters to the correct position
+          appendTxt (NormalText n1) (NormalText n2 : rest) = NormalText (n1 ++ '\n':n2) : rest
+          appendTxt e (next@NormalText{} : ls) = case reverse (e ^. sourceTemplateText) of
+                                              -- fix '\r' characters that are separated from '\n'
+                                    '\r':_ -> ((sourceTemplateText .- init) . (lineEndings .= "\r\n") $ e) : (sourceTemplateText .- ("\r\n" ++) $ next) : ls
+                                    _      -> e : (sourceTemplateText .- ('\n':) $ next) : ls
+          appendTxt e (next : ls) = case reverse (e ^. sourceTemplateText) of
+                                              -- fix '\r' characters that are separated from '\n'
+                                    '\r':_ -> ((sourceTemplateText .- init) . (lineEndings .= "\r\n") $ e) : NormalText "\r\n" : next : ls
+                                    _      -> e : NormalText "\n" : next : ls
+          appendTxt e [] = [e]
+ Language/Haskell/Tools/PrettyPrint/Prepare/RangeToRangeTemplate.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE ScopedTypeVariables
+           , LambdaCase
+           , FlexibleContexts
+           #-}
+-- | Transform a syntax tree with ranges to a syntax tree that has range templates. Cuts the ranges of children
+-- from the ranges of their parents and replaces it with placeholders.
+module Language.Haskell.Tools.PrettyPrint.Prepare.RangeToRangeTemplate (cutUpRanges, fixRanges) where
+
+import Language.Haskell.Tools.AST
+
+import Control.Monad.State
+import Control.Reference ((^.))
+import Data.List
+import Data.Maybe (Maybe(..), mapMaybe)
+
+import FastString as GHC (unpackFS)
+import SrcLoc
+
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate
+
+-- | Creates a source template from the ranges and the input file.
+-- All source ranges must be good ranges.
+cutUpRanges :: forall node dom . SourceInfoTraversal node
+                 => Ann node dom NormRangeStage
+                 -> Ann node dom RngTemplateStage
+cutUpRanges n = evalState (cutUpRanges' n) [[],[]]
+  where cutUpRanges' :: Ann node dom NormRangeStage -> State [[SrcSpan]] (Ann node dom RngTemplateStage)
+        cutUpRanges' = sourceInfoTraverseUp (SourceInfoTrf (trf cutOutElemSpan) (trf cutOutElemList) (trf cutOutElemOpt)) desc asc
+
+        -- keep the stack to contain the children elements on the place of the parent element
+        desc = modify ([]:)
+        asc  = modify tail
+
+        -- combine the current node with its children, and add it to the list of current nodes
+        trf :: HasRange (x RngTemplateStage)
+            => ([SrcSpan] -> x NormRangeStage -> x RngTemplateStage) -> x NormRangeStage -> State [[SrcSpan]] (x RngTemplateStage)
+        trf f ni = do (below : top : xs) <- get
+                      let res = f below ni
+                      put ([] : (top ++ [ getRange res ]) : xs)
+                      return res
+
+-- | Cuts out a list of source ranges from a given range
+cutOutElemSpan :: [SrcSpan] -> SpanInfo NormRangeStage -> SpanInfo RngTemplateStage
+cutOutElemSpan sps (NormNodeInfo (RealSrcSpan sp))
+  = RangeTemplateNode sp $ foldl breakFirstHit (foldl breakFirstHit [RangeElem sp] loc) span
+  where (loc,span) = partition (\sp -> srcSpanStart sp == srcSpanEnd sp) sps
+        breakFirstHit (elem:rest) sp
+          = case breakUpRangeElem elem sp of
+             -- only continue if the correct place for the child range is not found
+              Just pieces -> pieces ++ rest
+              Nothing -> elem : breakFirstHit rest sp
+        breakFirstHit [] inner = error ("breakFirstHit: " ++ unpackFS (srcSpanFile sp) ++ " didn't find correct place for " ++ shortShowSpan inner ++ " in " ++ shortShowSpan (RealSrcSpan sp) ++ " with [" ++ concat (intersperse "," (map shortShowSpan sps)) ++ "]")
+cutOutElemSpan _ (NormNodeInfo (UnhelpfulSpan {})) = error "cutOutElemSpan: no real span"
+
+cutOutElemList :: [SrcSpan] -> ListInfo NormRangeStage -> ListInfo RngTemplateStage
+cutOutElemList sps (NormListInfo bef aft sep indented sp)
+  = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
+     in RangeTemplateList wholeRange bef aft sep indented (getSeparators wholeRange sps)
+
+-- | Cuts out all elements from a list, the rest is the list of separators
+getSeparators :: RealSrcSpan -> [SrcSpan] -> [RealSrcSpan]
+getSeparators sp infos@(_:_:_)
+  = mapMaybe getRangeElemSpan (cutOutElemSpan infos (NormNodeInfo (RealSrcSpan sp)) ^. rngTemplateNodeElems)
+-- at least two elements needed or there can be no separators
+getSeparators _ _ = []
+
+cutOutElemOpt :: [SrcSpan] -> OptionalInfo NormRangeStage -> OptionalInfo RngTemplateStage
+cutOutElemOpt sps (NormOptInfo bef aft sp)
+  = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
+     in RangeTemplateOpt wholeRange bef aft
+
+-- | Breaks the given template element into possibly 2 or 3 parts by cutting out the given part
+-- if it is inside the range of the template element. Returns Nothing if the second argument is not inside.
+breakUpRangeElem :: RangeTemplateElem -> SrcSpan -> Maybe [RangeTemplateElem]
+breakUpRangeElem (RangeElem outer) (RealSrcSpan inner)
+  | outer `containsSpan` inner
+  = Just $ (if (realSrcSpanStart outer) < (realSrcSpanStart inner)
+              then [ RangeElem (mkRealSrcSpan (realSrcSpanStart outer) (realSrcSpanStart inner)) ]
+              else []) ++
+           [ RangeChildElem ] ++
+           (if (realSrcSpanEnd inner) < (realSrcSpanEnd outer)
+              then [ RangeElem (mkRealSrcSpan (realSrcSpanEnd inner) (realSrcSpanEnd outer)) ]
+              else [])
+breakUpRangeElem _ _ = Nothing
+
+
+-- | Modifies ranges to contain their children
+fixRanges :: SourceInfoTraversal node
+          => Ann node dom RangeStage
+          -> Ann node dom NormRangeStage
+fixRanges node = evalState (sourceInfoTraverseUp (SourceInfoTrf (trf expandToContain) (trf expandListToContain) (trf expandOptToContain)) desc asc node) [[],[]]
+  where -- keep the stack to contain the children elements on the place of the parent element
+        desc = modify ([]:)
+        asc  = modify tail
+
+        trf :: HasRange (x NormRangeStage)
+            => ([SrcSpan] -> x RangeStage -> x NormRangeStage) -> x RangeStage -> State [[SrcSpan]] (x NormRangeStage)
+        trf f ni = do (below : top : xs) <- get
+                      let res = f below ni
+                          resRange = getRange res
+                          endOfSiblings = srcSpanEnd (collectSpanRanges (srcSpanStart resRange) top)
+                          correctedRange = if endOfSiblings > srcSpanStart resRange
+                                             then mkSrcSpan endOfSiblings (max endOfSiblings (srcSpanEnd resRange))
+                                             else resRange
+                      put ([] : (top ++ [ correctedRange ]) : xs)
+                      return $ setRange correctedRange res
+
+-- | Expand a simple node to contain its children
+expandToContain :: [SrcSpan] -> SpanInfo RangeStage -> SpanInfo NormRangeStage
+expandToContain cont (NodeSpan sp)
+  = NormNodeInfo (checkSpans cont $ foldl1 combineSrcSpans $ sp : cont)
+
+expandListToContain :: [SrcSpan] -> ListInfo RangeStage -> ListInfo NormRangeStage
+expandListToContain cont (ListPos bef aft def ind sp)
+  = NormListInfo bef aft def ind (checkSpans cont $ collectSpanRanges sp cont)
+
+expandOptToContain :: [SrcSpan] -> OptionalInfo RangeStage -> OptionalInfo NormRangeStage
+expandOptToContain cont (OptionalPos bef aft sp)
+  = NormOptInfo bef aft (checkSpans cont $ collectSpanRanges sp cont)
+
+collectSpanRanges :: SrcLoc -> [SrcSpan] -> SrcSpan
+collectSpanRanges loc@(RealSrcLoc _) [] = srcLocSpan loc
+collectSpanRanges _ ls = foldl combineSrcSpans noSrcSpan ls
+
+-- | Checks the contained source ranges to detect the convertion problems where we can see their location.
+checkSpans :: [SrcSpan] -> SrcSpan -> SrcSpan
+checkSpans spans res
+  = if any (not . isGoodSrcSpan) spans && isGoodSrcSpan res
+      then error $ "Wrong src spans in " ++ show res
+      else res
+ Language/Haskell/Tools/PrettyPrint/Prepare/SourceTemplate.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE FlexibleInstances
+           , FlexibleContexts
+           , DeriveDataTypeable
+           , TemplateHaskell
+           , RecordWildCards
+           , TypeFamilies
+           #-}
+-- | The final version of the source annotation. Each node contains its original textual format, with the places of
+-- the children specified by placeholders.
+module Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate where
+
+import Control.Reference
+import Data.Data
+import Language.Haskell.Tools.AST
+import SrcLoc
+
+instance SourceInfo SrcTemplateStage where
+  data SpanInfo SrcTemplateStage
+         = SourceTemplateNode { _sourceTemplateNodeRange :: SrcSpan -- ^ The (original) range of the given element
+                              , _sourceTemplateNodeElems :: [SourceTemplateElem] -- ^ The children of the given node, could be text or child nodes
+                              , _srcTmpMinInd :: Int -- ^ Minimum indentation for the element
+                              , _srcTmpRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
+                              }
+    deriving (Eq, Ord, Data)
+  data ListInfo SrcTemplateStage
+         = SourceTemplateList { _sourceTemplateListRange :: SrcSpan -- ^ The (original) range of the given element
+                              , _srcTmpListBefore :: String -- ^ Text that should be put before the first element if the list becomes populated
+                              , _srcTmpListAfter :: String -- ^ Text that should be put after the last element if the list becomes populated
+                              , _srcTmpDefaultSeparator :: String -- ^ The default separator if the list were empty
+                              , _srcTmpIndented :: Maybe [Bool] -- ^ False for elements that should be not aligned
+                              , _srcTmpSeparators :: [([SourceTemplateTextElem], SrcSpan)] -- ^ The actual separators that were found in the source code
+                              , _srcTmpListMinInd :: Int -- ^ Minimum indentation for the element
+                              , _srcTmpListRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
+                              }
+    deriving (Eq, Ord, Data)
+  data OptionalInfo SrcTemplateStage
+         = SourceTemplateOpt { _sourceTemplateOptRange :: SrcSpan -- ^ The (original) range of the given element
+                             , _srcTmpOptBefore :: String -- ^ Text that should be put before the element if it appears
+                             , _srcTmpOptAfter :: String -- ^ Text that should be put after the element if it appears
+                             , _srcTmpOptMinInd :: Int -- ^ Minimum indentation for the element
+                             , _srcTmpOptRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
+                             }
+    deriving (Eq, Ord, Data)
+
+-- * References for span infos
+
+sourceTemplateNodeRange :: Simple Lens (SpanInfo SrcTemplateStage) SrcSpan
+sourceTemplateNodeRange = lens _sourceTemplateNodeRange (\v s -> s { _sourceTemplateNodeRange = v })
+
+sourceTemplateNodeElems :: Simple Lens (SpanInfo SrcTemplateStage) [SourceTemplateElem]
+sourceTemplateNodeElems = lens _sourceTemplateNodeElems (\v s -> s { _sourceTemplateNodeElems = v })
+
+sourceTemplateMinimalIndent :: Simple Lens (SpanInfo SrcTemplateStage) Int
+sourceTemplateMinimalIndent = lens _srcTmpMinInd (\v s -> s { _srcTmpMinInd = v })
+
+srcTmpRelPos :: Simple Lens (SpanInfo SrcTemplateStage) (Maybe Int)
+srcTmpRelPos = lens _srcTmpRelPos (\v s -> s { _srcTmpRelPos = v })
+
+-- * References for list infos
+
+sourceTemplateListRange :: Simple Lens (ListInfo SrcTemplateStage) SrcSpan
+sourceTemplateListRange = lens _sourceTemplateListRange (\v s -> s { _sourceTemplateListRange = v })
+
+srcTmpListBefore :: Simple Lens (ListInfo SrcTemplateStage) String
+srcTmpListBefore = lens _srcTmpListBefore (\v s -> s { _srcTmpListBefore = v })
+
+srcTmpListAfter :: Simple Lens (ListInfo SrcTemplateStage) String
+srcTmpListAfter = lens _srcTmpListAfter (\v s -> s { _srcTmpListAfter = v })
+
+srcTmpDefaultSeparator :: Simple Lens (ListInfo SrcTemplateStage) String
+srcTmpDefaultSeparator = lens _srcTmpDefaultSeparator (\v s -> s { _srcTmpDefaultSeparator = v })
+
+srcTmpIndented :: Simple Lens (ListInfo SrcTemplateStage) (Maybe [Bool])
+srcTmpIndented = lens _srcTmpIndented (\v s -> s { _srcTmpIndented = v })
+
+srcTmpSeparators :: Simple Lens (ListInfo SrcTemplateStage) [([SourceTemplateTextElem], SrcSpan)]
+srcTmpSeparators = lens _srcTmpSeparators (\v s -> s { _srcTmpSeparators = v })
+
+srcTmpListMinimalIndent :: Simple Lens (ListInfo SrcTemplateStage) Int
+srcTmpListMinimalIndent = lens _srcTmpListMinInd (\v s -> s { _srcTmpListMinInd = v })
+
+srcTmpListRelPos :: Simple Lens (ListInfo SrcTemplateStage) (Maybe Int)
+srcTmpListRelPos = lens _srcTmpListRelPos (\v s -> s { _srcTmpListRelPos = v })
+
+-- * References for optional infos
+
+sourceTemplateOptRange :: Simple Lens (OptionalInfo SrcTemplateStage) SrcSpan
+sourceTemplateOptRange = lens _sourceTemplateOptRange (\v s -> s { _sourceTemplateOptRange = v })
+
+srcTmpOptBefore :: Simple Lens (OptionalInfo SrcTemplateStage) String
+srcTmpOptBefore = lens _srcTmpOptBefore (\v s -> s { _srcTmpOptBefore = v })
+
+srcTmpOptAfter :: Simple Lens (OptionalInfo SrcTemplateStage) String
+srcTmpOptAfter = lens _srcTmpOptAfter (\v s -> s { _srcTmpOptAfter = v })
+
+srcTmpOptMinimalIndent :: Simple Lens (OptionalInfo SrcTemplateStage) Int
+srcTmpOptMinimalIndent = lens _srcTmpOptMinInd (\v s -> s { _srcTmpOptMinInd = v })
+
+srcTmpOptRelPos :: Simple Lens (OptionalInfo SrcTemplateStage) (Maybe Int)
+srcTmpOptRelPos = lens _srcTmpOptRelPos (\v s -> s { _srcTmpOptRelPos = v })
+
+
+-- | An element of a source template for a singleton AST node.
+data SourceTemplateElem
+  = TextElem { _sourceTemplateTextElem :: [SourceTemplateTextElem]
+             , _sourceTemplateTextRange :: SrcSpan
+             } -- ^ Source text belonging to the current node
+  | ChildElem -- ^ Placeholder for the next children of the node
+     deriving (Eq, Ord, Data)
+
+isStayingText :: SourceTemplateTextElem -> Bool
+isStayingText StayingText{} = True
+isStayingText _ = False
+
+data SourceTemplateTextElem
+  = NormalText { _sourceTemplateText :: String }
+  | StayingText { _sourceTemplateText :: String, _lineEndings :: String }
+     deriving (Eq, Ord, Data)
+
+makeReferences ''SourceTemplateElem
+makeReferences ''SourceTemplateTextElem
+
+instance HasRange (SpanInfo SrcTemplateStage) where
+  getRange = (^. sourceTemplateNodeRange)
+  setRange = (sourceTemplateNodeRange .=)
+
+instance HasRange (ListInfo SrcTemplateStage) where
+  getRange = (^. sourceTemplateListRange)
+  setRange = (sourceTemplateListRange .=)
+
+instance HasRange (OptionalInfo SrcTemplateStage) where
+  getRange = (^. sourceTemplateOptRange)
+  setRange = (sourceTemplateOptRange .=)
+
+instance Show (SpanInfo SrcTemplateStage) where
+  show (SourceTemplateNode _ sp _ _) = concatMap show sp
+instance Show (ListInfo SrcTemplateStage) where
+  show SourceTemplateList{..} = "<*" ++ show _srcTmpListBefore ++ " " ++ show _srcTmpDefaultSeparator ++ " " ++ show _srcTmpListAfter ++ " " ++ show _srcTmpSeparators ++ "*>"
+instance Show (OptionalInfo SrcTemplateStage) where
+  show SourceTemplateOpt{..} = "<?" ++ show _srcTmpOptBefore ++ " " ++ show _srcTmpOptAfter ++ "?>"
+
+instance Show SourceTemplateElem where
+  show (TextElem s _) = show s
+  show ChildElem = "<.>"
+
+instance Show SourceTemplateTextElem where
+  show (NormalText s) = show s
+  show (StayingText s _) = "|" ++ show s ++ "|"
+ Language/Haskell/Tools/PrettyPrint/Prepare/SourceTemplateHelpers.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings
+           , FlexibleContexts
+           , FlexibleInstances
+           #-}
+-- | Helper functions for working with source templates
+module Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplateHelpers where
+
+import Control.Reference ((.=))
+import Data.String (IsString(..), String)
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
+import SrcLoc (noSrcSpan, combineSrcSpans)
+
+type ASTElement node dom = Ann node dom SrcTemplateStage
+type ASTOptional node dom = AnnMaybeG node dom SrcTemplateStage
+type ASTMulti node dom = AnnListG node dom SrcTemplateStage
+
+instance IsString (SpanInfo SrcTemplateStage) where
+  fromString s = SourceTemplateNode noSrcSpan [TextElem [NormalText s] noSrcSpan] 0 Nothing
+
+-- * Basic elements
+child :: SpanInfo SrcTemplateStage
+child = SourceTemplateNode noSrcSpan [ChildElem] 0 Nothing
+
+opt :: OptionalInfo SrcTemplateStage
+opt = SourceTemplateOpt noSrcSpan "" "" 0 Nothing
+
+list :: ListInfo SrcTemplateStage
+list = SourceTemplateList noSrcSpan "" "" "" Nothing [] 0 Nothing
+
+-- * Modifiers
+
+class AfterBefore i where
+  -- | Put the given string before the element if it is not empty
+  after :: String -> i -> i
+  -- | The given string should follow the element if it is not empty
+  followedBy :: String -> i -> i
+
+instance AfterBefore (ListInfo SrcTemplateStage) where
+  after str = srcTmpListBefore .= str
+  followedBy str = srcTmpListAfter .= str
+
+instance AfterBefore (OptionalInfo SrcTemplateStage) where
+  after str = srcTmpOptBefore .= str
+  followedBy str = srcTmpOptAfter .= str
+
+class RelativeIndent i where
+  -- | The element should be indented relatively to its parent
+  relativeIndented :: Int -> i -> i
+
+instance RelativeIndent (SpanInfo SrcTemplateStage) where
+  relativeIndented i = srcTmpRelPos .= Just i
+
+instance RelativeIndent (ListInfo SrcTemplateStage) where
+  relativeIndented i = srcTmpListRelPos .= Just i
+
+instance RelativeIndent (OptionalInfo SrcTemplateStage) where
+  relativeIndented i = srcTmpOptRelPos .= Just i
+
+
+class MinimumIndent i where
+  -- | The elements should be indented at least to the given number of spaces
+  minimumIndented :: Int -> i -> i
+
+instance MinimumIndent (SpanInfo SrcTemplateStage) where
+  minimumIndented i = sourceTemplateMinimalIndent .= i
+
+instance MinimumIndent (ListInfo SrcTemplateStage) where
+  minimumIndented i = srcTmpListMinimalIndent .= i
+
+instance MinimumIndent (OptionalInfo SrcTemplateStage) where
+  minimumIndented i = srcTmpOptMinimalIndent .= i
+
+-- | The elements of the list should be separated by the given string by default (might be overridden)
+separatedBy :: String -> ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
+separatedBy sep = srcTmpDefaultSeparator .= sep
+
+-- | The elements of the list should be indented on the same column
+indented :: ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
+indented = (srcTmpIndented .= Just []) . (srcTmpDefaultSeparator .= "\n")
+
+-- | Concatenates two source templates to produce a new template with all child elements.
+(<>) :: SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage
+SourceTemplateNode sp1 el1 _ _ <> SourceTemplateNode sp2 el2 _ _ = SourceTemplateNode (combineSrcSpans sp1 sp2) (el1 ++ el2) 0 Nothing
− Language/Haskell/Tools/Transform.hs
@@ -1,40 +0,0 @@--- | A module for preparing the representation of the AST for pretty printing.
-module Language.Haskell.Tools.Transform
-  ( prepareAST, prepareASTCpp
-  -- comment handling
-  , placeComments, getNormalComments, getPragmaComments
-  -- generating source templates
-  , child, opt, list, after, followedBy, relativeIndented, minimumIndented, separatedBy, indented, (<>)
-  -- references on source templates
-  , sourceTemplateNodeRange, sourceTemplateNodeElems
-  , sourceTemplateListRange, srcTmpListBefore, srcTmpListAfter, srcTmpDefaultSeparator, srcTmpIndented, srcTmpSeparators
-  , sourceTemplateOptRange, srcTmpOptBefore, srcTmpOptAfter
-  , SourceTemplateElem(..), sourceTemplateTextElem, sourceTemplateTextRange, SourceTemplateTextElem(..), sourceTemplateText, lineEndings, isStayingText
-  -- parts of the transformation, used for debugging purposes
-  , rangeToSource, fixRanges, cutUpRanges, getLocIndices, mapLocIndices, fixMainRange, extractStayingElems
-  ) where
-
-import Language.Haskell.Tools.Transform.PlaceComments (getNormalComments, getPragmaComments, placeComments)
-import Language.Haskell.Tools.Transform.RangeTemplate ()
-import Language.Haskell.Tools.Transform.RangeTemplateToSourceTemplate (rangeToSource, getLocIndices, mapLocIndices, extractStayingElems)
-import Language.Haskell.Tools.Transform.RangeToRangeTemplate (cutUpRanges, fixRanges)
-import Language.Haskell.Tools.Transform.SourceTemplate
-import Language.Haskell.Tools.Transform.SourceTemplateHelpers
-
-import FastString (mkFastString)
-import Language.Haskell.Tools.AST
-import SrcLoc
-import StringBuffer (StringBuffer, nextChar, atEnd)
-
--- | Prepares the AST for pretty printing
-prepareAST :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
-prepareAST srcBuffer = rangeToSource srcBuffer . cutUpRanges . fixRanges
-
-prepareASTCpp :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom SrcTemplateStage
-prepareASTCpp srcBuffer = extractStayingElems . rangeToSource srcBuffer . cutUpRanges . fixRanges . fixMainRange srcBuffer
-
-fixMainRange :: StringBuffer -> Ann UModule dom RangeStage -> Ann UModule dom RangeStage
-fixMainRange buffer mod = setRange (mkSrcSpan (srcSpanStart $ getRange mod) (RealSrcLoc (endPos startPos buffer))) mod
-  where startPos = mkRealSrcLoc (mkFastString "") 1 1
-        endPos pos buf | atEnd buf = pos
-        endPos pos buf = let (ch,buf') = nextChar buf in endPos (advanceSrcLoc pos ch) buf'
− Language/Haskell/Tools/Transform/PlaceComments.hs
@@ -1,188 +0,0 @@-{-# LANGUAGE ScopedTypeVariables
-           , FlexibleContexts
-           , LambdaCase
-           #-}
--- | This transformation expands nodes to contain the comments that should be attached to them. After this, a
--- normalizing transformation should be performed that expands parents to contain their children.
-module Language.Haskell.Tools.Transform.PlaceComments where
-
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Writer
-import Control.Reference hiding (element)
-import Data.Char (isSpace, isAlphaNum)
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Maybe
-import qualified Data.Set as Set
-import Data.Set (Set)
-
-import ApiAnnotation (ApiAnnKey, AnnotationComment(..))
-import SrcLoc
-
-import Language.Haskell.Tools.AST
-
-getNormalComments :: Map SrcSpan [Located AnnotationComment] -> Map.Map SrcSpan [Located AnnotationComment]
-getNormalComments = Map.map (filter (not . isPragma . unLoc))
-
-getPragmaComments :: Map SrcSpan [Located AnnotationComment] -> Map.Map String [Located String]
-getPragmaComments comms = Map.fromListWith (++) $ map (\(L l (AnnBlockComment str)) -> (getPragmaCommand str, [L l str]))
-                                                $ filter (isPragma . unLoc) $ concatMap snd $ Map.toList comms
-  where getPragmaCommand = takeWhile (\c -> isAlphaNum c || c == '_') . dropWhile isSpace . drop 3
-
-isPragma :: AnnotationComment -> Bool
-isPragma (AnnBlockComment str) = take 3 str == "{-#" && take 3 (reverse str) == "}-#"
-isPragma _ = False
-
--- | Puts comments in the nodes they should be attached to. Watches for lexical tokens
--- that may divide the comment and the supposed element.
--- Leaves the AST in a state where parent nodes does not contain all of their children.
-placeComments :: RangeInfo stage => Map ApiAnnKey [SrcSpan] -> Map.Map SrcSpan [Located AnnotationComment]
-              -> Ann UModule dom stage -> Ann UModule dom stage
-placeComments tokens comms mod
-  = resizeAnnots (Set.filter (\rng -> srcSpanStart rng /= srcSpanEnd rng) $ Set.fromList $ concat (Map.elems tokens))
-      (concatMap (map nextSrcLoc . snd) (Map.toList cleanedComments)) mod
-  where spans = allElemSpans mod
-        sortedElemStarts = Set.fromList $ map srcSpanStart spans
-        sortedElemEnds = Set.fromList $ map srcSpanEnd spans
-        nextSrcLoc comm@(L sp _)
-          = let after = fromMaybe noSrcLoc (Set.lookupLE (srcSpanStart sp) sortedElemEnds)
-                before = fromMaybe noSrcLoc (Set.lookupGE (srcSpanEnd sp) sortedElemStarts)
-             in ((after,before),comm)
-        cleanedComments = Map.map (map cleanComment) comms
-        cleanComment (L loc (AnnLineComment txt))
-          | last txt `elem` "\n\r" = L (mkSrcSpan (srcSpanStart loc) (decreaseCol (srcSpanEnd loc))) (AnnLineComment (init txt))
-        cleanComment c = c
-        decreaseCol (RealSrcLoc l) = mkSrcLoc (srcLocFile l) (srcLocLine l) (srcLocCol l - 1)
-        decreaseCol l = l
-
-allElemSpans :: (SourceInfoTraversal node, RangeInfo stage) => Ann node dom stage -> [SrcSpan]
-allElemSpans = execWriter . sourceInfoTraverse (SourceInfoTrf (\ni -> tell [ni ^. nodeSpan] >> pure ni) pure pure)
-
-resizeAnnots :: RangeInfo stage => Set SrcSpan -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
-              -> Ann UModule dom stage
-              -> Ann UModule dom stage
-resizeAnnots tokens comments elem
-  = flip evalState comments $ flip runReaderT tokens $
-        -- if a comment that could be attached to more than one documentable element (possibly nested)
-        -- the order of different documentable elements here decide which will be chosen
-
-        modImports&annList !~ expandAnnot -- expand imports to cover their comments
-          >=> modDecl&annList !~ expandTopLevelDecl -- expand declarations to cover their comments
-          >=> expandAnnot -- expand the module itself to cover its comments
-      $ elem
-
-type ExpandType elem dom stage = Ann elem dom stage -> ReaderT (Set SrcSpan) (State [((SrcLoc, SrcLoc), Located AnnotationComment)]) (Ann elem dom stage)
-
-expandTopLevelDecl :: RangeInfo stage => ExpandType UDecl dom stage
-expandTopLevelDecl
-  = declBody & annJust & cbElements & annList !~ expandClsElement
-      >=> declCons & annList !~ expandConDecl
-      >=> declGadt & annList !~ expandGadtConDecl
-      >=> declTypeSig !~ expandTypeSig
-      >=> expandAnnot
-
-expandTypeSig :: RangeInfo stage => ExpandType UTypeSignature dom stage
-expandTypeSig
-  = tsType & typeParams !~ expandAnnot >=> expandAnnot
-
-expandClsElement :: RangeInfo stage => ExpandType UClassElement dom stage
-expandClsElement
-  = ceTypeSig !~ expandTypeSig
-      >=> ceBind !~ expandValueBind
-      >=> expandAnnot
-
-expandValueBind :: RangeInfo stage => ExpandType UValueBind dom stage
-expandValueBind
-  = valBindLocals & annJust & localBinds & annList !~ expandLocalBind
-      >=> funBindMatches & annList & matchBinds & annJust & localBinds & annList !~ expandLocalBind
-      >=> expandAnnot
-
-expandLocalBind :: RangeInfo stage => ExpandType ULocalBind dom stage
-expandLocalBind
-  = localVal !~ expandValueBind
-      >=> localSig !~ expandTypeSig
-      >=> expandAnnot
-
-expandConDecl :: RangeInfo stage => ExpandType UConDecl dom stage
-expandConDecl
-  = conDeclFields & annList !~ expandAnnot >=> expandAnnot
-
-expandGadtConDecl :: RangeInfo stage => ExpandType UGadtConDecl dom stage
-expandGadtConDecl
-  = gadtConType & gadtConRecordFields & annList !~ expandAnnot >=> expandAnnot
-
--- | Expands tree elements to contain the comments that should be attached to them.
-expandAnnot :: forall elem dom stage . RangeInfo stage => ExpandType elem dom stage
-expandAnnot elem
-  = do let Just sp = elem ^? annotation&sourceInfo&nodeSpan
-       tokens <- ask
-       applicable <- lift $ gets (applicableComments tokens (srcSpanStart sp) (srcSpanEnd sp))
-
-       -- this check is just for performance (quick return if no modification is needed)
-       if not (null applicable) then do
-         -- the new span is the original plus all the covered spans
-         let newSp@(RealSrcSpan newSpan)
-               = foldl combineSrcSpans (fromJust $ elem ^? nodeSp) (map (getLoc . snd) applicable)
-         -- take out all comments that are now covered
-         lift $ modify (filter (not . (\case RealSrcSpan s -> newSpan `containsSpan` s; _ -> True) . getLoc . snd))
-         return $ nodeSp .= newSp $ elem
-       else return elem
-  where nodeSp :: Simple Partial (Ann elem dom stage) SrcSpan
-        nodeSp = annotation&sourceInfo&nodeSpan
-
--- This classification does not prefer inline comments to previous line comments, this is implicitly done
--- by the order in which the elements are traversed.
-applicableComments :: Set SrcSpan -> SrcLoc -> SrcLoc
-                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
-                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
-applicableComments tokens start end = filter applicableComment
-  where -- A comment that starts with | binds to the next documented element
-        applicableComment ((_, before), L sp comm)
-          | isCommentOnNext comm = before == start && noTokenBetween (srcSpanEnd sp) start
-        -- A comment that starts with ^ binds to the previous documented element
-        applicableComment ((after, _), L sp comm)
-          | isCommentOnPrev comm = after == end && noTokenBetween end (srcSpanStart sp)
-        -- All other comment binds to the previous definition if it is on the same line
-        applicableComment ((after, _), L sp@(RealSrcSpan loc) _)
-          | after == end && srcLocLine (realSrcSpanStart loc) == getLineLocDefault end = True
-                         && noTokenBetween end (srcSpanStart sp)
-        -- or the next one if that is on the next line and the columns line up
-        applicableComment ((_, before), L sp@(RealSrcSpan loc) _)
-          | before == start && srcLocLine (realSrcSpanEnd loc) + 1 == getLineLocDefault start
-                            && srcLocCol (realSrcSpanStart loc) == getLineColDefault start
-                            && noTokenBetween (srcSpanEnd sp) start
-          = True
-        applicableComment _ = False
-
-        getLineLocDefault (RealSrcLoc l) = srcLocLine l
-        getLineLocDefault _              = -1
-
-        getLineColDefault (RealSrcLoc l) = srcLocCol l
-        getLineColDefault _              = -1
-
-        noTokenBetween start end
-          = case Set.lookupGE (srcLocSpan start) tokens of
-              Just tok -> srcSpanStart tok >= end
-              Nothing -> True
-
--- * GHC mistakenly parses -- ^ and -- | comments as simple line comments.
--- These functions check if a given comment is attached to the previous or next comment.
-
--- | Checks if a doc comment belongs to the next definition.
-isCommentOnNext :: AnnotationComment -> Bool
-isCommentOnNext (AnnDocCommentNext _) = True
-isCommentOnNext (AnnLineComment s) = firstNonspaceCharIs '|' s
-isCommentOnNext (AnnBlockComment s) = firstNonspaceCharIs '|' s
-isCommentOnNext _ = False
-
--- | Checks if a doc comment belongs to the previous definition.
-isCommentOnPrev :: AnnotationComment -> Bool
-isCommentOnPrev (AnnDocCommentPrev _) = True
-isCommentOnPrev (AnnLineComment s) = firstNonspaceCharIs '^' s
-isCommentOnPrev (AnnBlockComment s) = firstNonspaceCharIs '^' s
-isCommentOnPrev _ = False
-
--- the comment string contains the -- or {- characters
-firstNonspaceCharIs :: Char -> String -> Bool
-firstNonspaceCharIs c s = Just c == listToMaybe (dropWhile isSpace (drop 2 s))
− Language/Haskell/Tools/Transform/RangeTemplate.hs
@@ -1,102 +0,0 @@-{-# LANGUAGE TemplateHaskell
-           , DeriveDataTypeable
-           , RecordWildCards
-           , TypeFamilies
-           , FlexibleInstances
-           #-}
--- | The range template is an intermediate annotation level, where the children nodes of the tree
--- had been cut from the parent nodes, but the annotations still contain ranges instead of text.
-module Language.Haskell.Tools.Transform.RangeTemplate where
-
-import Control.Reference
-import Data.Data
-import Language.Haskell.Tools.AST
-import SrcLoc
-
-instance SourceInfo RngTemplateStage where
-  data SpanInfo RngTemplateStage = RangeTemplateNode { _rngTemplateNodeRange :: RealSrcSpan
-                                                     , _rngTemplateNodeElems :: [RangeTemplateElem]
-                                                     }
-    deriving Data
-  data ListInfo RngTemplateStage = RangeTemplateList { _rngTemplateListRange :: RealSrcSpan
-                                                     , _rngTmpListBefore :: String -- ^ Text that should be put before the first element if the list becomes populated
-                                                     , _rngTmpListAfter :: String -- ^ Text that should be put after the last element if the list becomes populated
-                                                     , _rngTmpDefaultSeparator :: String -- ^ The default separator if the list were empty
-                                                     , _rngTmpIndented :: Maybe [Bool] -- ^ False for elements that should be not aligned
-                                                     , _rngTmpSeparators :: [RealSrcSpan] -- ^ The actual separators that were found in the source code
-                                                     }
-    deriving Data
-  data OptionalInfo RngTemplateStage = RangeTemplateOpt { _rngTemplateOptRange :: RealSrcSpan
-                                                        , _rngTmpOptBefore :: String -- ^ Text that should be put before the element if it appears
-                                                        , _rngTmpOptAfter :: String -- ^ Text that should be put after the element if it appears
-                                                        }
-    deriving Data
-
-
-rngTemplateNodeRange :: Simple Lens (SpanInfo RngTemplateStage) RealSrcSpan
-rngTemplateNodeRange = lens _rngTemplateNodeRange (\v s -> s { _rngTemplateNodeRange = v })
-
-rngTemplateNodeElems :: Simple Lens (SpanInfo RngTemplateStage) [RangeTemplateElem]
-rngTemplateNodeElems = lens _rngTemplateNodeElems (\v s -> s { _rngTemplateNodeElems = v })
-
-rngTemplateListRange :: Simple Lens (ListInfo RngTemplateStage) RealSrcSpan
-rngTemplateListRange = lens _rngTemplateListRange (\v s -> s { _rngTemplateListRange = v })
-
-rngTmpListBefore :: Simple Lens (ListInfo RngTemplateStage) String
-rngTmpListBefore = lens _rngTmpListBefore (\v s -> s { _rngTmpListBefore = v })
-
-rngTmpListAfter :: Simple Lens (ListInfo RngTemplateStage) String
-rngTmpListAfter = lens _rngTmpListAfter (\v s -> s { _rngTmpListAfter = v })
-
-rngTmpDefaultSeparator :: Simple Lens (ListInfo RngTemplateStage) String
-rngTmpDefaultSeparator = lens _rngTmpDefaultSeparator (\v s -> s { _rngTmpDefaultSeparator = v })
-
-rngTmpIndented :: Simple Lens (ListInfo RngTemplateStage) (Maybe [Bool])
-rngTmpIndented = lens _rngTmpIndented (\v s -> s { _rngTmpIndented = v })
-
-rngTmpSeparators :: Simple Lens (ListInfo RngTemplateStage) [RealSrcSpan]
-rngTmpSeparators = lens _rngTmpSeparators (\v s -> s { _rngTmpSeparators = v })
-
-rngTemplateOptRange :: Simple Lens (OptionalInfo RngTemplateStage) RealSrcSpan
-rngTemplateOptRange = lens _rngTemplateOptRange (\v s -> s { _rngTemplateOptRange = v })
-
-rngTmpOptBefore :: Simple Lens (OptionalInfo RngTemplateStage) String
-rngTmpOptBefore = lens _rngTmpOptBefore (\v s -> s { _rngTmpOptBefore = v })
-
-rngTmpOptAfter :: Simple Lens (OptionalInfo RngTemplateStage) String
-rngTmpOptAfter = lens _rngTmpOptAfter (\v s -> s { _rngTmpOptAfter = v })
-
--- | An element of a range template for a singleton AST node.
-data RangeTemplateElem = RangeElem RealSrcSpan -- ^ A range for the source code of the element
-                       | RangeChildElem        -- ^ The place for a child element
-                       deriving Data
-
-getRangeElemSpan :: RangeTemplateElem -> Maybe RealSrcSpan
-getRangeElemSpan (RangeElem sp) = Just sp
-getRangeElemSpan _ = Nothing
-
-instance HasRange (SpanInfo RngTemplateStage) where
-  getRange = RealSrcSpan . (^. rngTemplateNodeRange)
-  setRange (RealSrcSpan sp) = rngTemplateNodeRange .= sp
-  setRange _ = id
-
-instance HasRange (ListInfo RngTemplateStage) where
-  getRange = RealSrcSpan . (^. rngTemplateListRange)
-  setRange (RealSrcSpan sp) = rngTemplateListRange .= sp
-  setRange _ = id
-
-instance HasRange (OptionalInfo RngTemplateStage) where
-  getRange = RealSrcSpan . (^. rngTemplateOptRange)
-  setRange (RealSrcSpan sp) = rngTemplateOptRange .= sp
-  setRange _ = id
-
-instance Show (SpanInfo RngTemplateStage) where
-  show rngNode = concatMap show $ rngNode ^. rngTemplateNodeElems
-instance Show (ListInfo RngTemplateStage) where
-  show RangeTemplateList{..} = "<*" ++ shortShowSpan (RealSrcSpan _rngTemplateListRange) ++ " " ++ show _rngTmpListBefore ++ " " ++ show _rngTmpDefaultSeparator ++ " " ++ show _rngTmpListAfter ++ "*>"
-instance Show (OptionalInfo RngTemplateStage) where
-  show RangeTemplateOpt{..} = "<?" ++ shortShowSpan (RealSrcSpan _rngTemplateOptRange) ++ " " ++ show _rngTmpOptBefore ++ " " ++ show _rngTmpOptAfter ++ "?>"
-
-instance Show RangeTemplateElem where
-  show (RangeElem sp) = shortShowSpan (RealSrcSpan sp)
-  show RangeChildElem = "<.>"
− Language/Haskell/Tools/Transform/RangeTemplateToSourceTemplate.hs
@@ -1,107 +0,0 @@-{-# LANGUAGE LambdaCase
-           , FlexibleContexts
-           #-}
--- | This module converts range templates into source templates.
--- Basically it reads the source file and attaches parts of the source file to the AST elements that have the range of the given source code fragment.
-module Language.Haskell.Tools.Transform.RangeTemplateToSourceTemplate where
-
-import Control.Monad.Identity
-import Control.Monad.State
-import Control.Reference
-import Data.Map as Map
-import Data.Ord (Ord(..), Ordering(..))
-import Data.Set as Set
-import Data.List
-import Data.List.Split
-import FastString (mkFastString)
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.Transform.RangeTemplate
-import Language.Haskell.Tools.Transform.SourceTemplate
-import SrcLoc
-import StringBuffer (StringBuffer, nextChar, atEnd)
-import Debug.Trace
-
-rangeToSource :: SourceInfoTraversal node => StringBuffer -> Ann node dom RngTemplateStage
-                                                          -> Ann node dom SrcTemplateStage
-rangeToSource srcInput tree = let locIndices = getLocIndices tree
-                                  srcMap = mapLocIndices srcInput locIndices
-                               in applyFragments (Map.elems srcMap) tree
-
--- maps could be strict
-
--- | Assigns an index (in the order they are used) for each range
-getLocIndices :: SourceInfoTraversal e => Ann e dom RngTemplateStage -> Set (RealSrcLoc, Int)
-getLocIndices = snd . flip execState (0, Set.empty) .
-  sourceInfoTraverseDown (SourceInfoTrf
-      (\ni -> do { mapM_ (\el -> case getRangeElemSpan el of Just sp -> modify (insertElem sp); _ -> return ()) (ni ^. rngTemplateNodeElems); return ni })
-      (\ni -> do { mapM_ (modify . insertElem) (ni ^. rngTmpSeparators); return ni })
-      pure )
-    (return ()) (return ())
-  where insertElem sp (i,m) = (i+1, Set.insert (realSrcSpanEnd sp, i) m)
-
--- | Partitions the source file in the order where the parts are used in the AST
-mapLocIndices :: Ord k => StringBuffer -> Set (RealSrcLoc, k) -> Map k String
-mapLocIndices inp = (^. _1) . Set.foldl (\(new, str, pos) (sp, k) -> let (rem, val, newPos) = takeSpan str pos sp
-                                                                      in (Map.insert k (reverse val) new, rem, newPos))
-                                        (Map.empty, inp, mkRealSrcLoc (mkFastString "") 1 1)
-  where takeSpan :: StringBuffer -> RealSrcLoc -> RealSrcLoc -> (StringBuffer, String, RealSrcLoc)
-        takeSpan str pos end = takeSpan' end (str,"", pos)
-
-        takeSpan' :: RealSrcLoc -> (StringBuffer, String, RealSrcLoc) -> (StringBuffer, String, RealSrcLoc)
-        takeSpan' end (sb, taken, pos) | (srcLocLine pos `compare` srcLocLine end) `thenCmp` (srcLocCol pos `compare` srcLocCol end) == LT && not (atEnd sb)
-          = let (c,rem) = nextChar sb in takeSpan' end (rem, c:taken, advanceSrcLoc pos c)
-        takeSpan' _ (rem, taken, pos) = (rem, taken, pos)
-
-        thenCmp EQ o2 = o2
-        thenCmp o1 _  = o1
-
--- | Replaces the ranges in the AST with the source file parts
-applyFragments :: SourceInfoTraversal node => [String] -> Ann node dom RngTemplateStage
-                                                       -> Ann node dom SrcTemplateStage
-applyFragments srcs = flip evalState srcs
-  . sourceInfoTraverseDown (SourceInfoTrf
-     (\ni -> do template <- mapM getTextFor (ni ^. rngTemplateNodeElems)
-                return $ SourceTemplateNode (RealSrcSpan $ ni ^. rngTemplateNodeRange) (concat template) 0 Nothing)
-     (\(RangeTemplateList rng bef aft sep indented seps)
-         -> do (own, rest) <- splitAt (length seps) <$> get
-               put rest
-               return (SourceTemplateList (RealSrcSpan rng) bef aft sep indented (Prelude.zip (Prelude.map ((:[]) . NormalText) own) (Prelude.map RealSrcSpan seps)) 0 Nothing))
-     (\(RangeTemplateOpt rng bef aft) -> return (SourceTemplateOpt (RealSrcSpan rng) bef aft 0 Nothing)))
-     (return ()) (return ())
-  where getTextFor RangeChildElem = return [ChildElem]
-        getTextFor (RangeElem rng) = do (src:rest) <- get
-                                        put rest
-                                        return [TextElem [NormalText src] (RealSrcSpan rng)]
-
--- | Marks template elements in the AST that should always be present in the source code, regardless of their
--- containing elements being deleted.
--- Currently it recognizes CPP pragmas (lines starting with #)
--- This function should only be applied to an AST if CPP is enabled.
-extractStayingElems :: SourceInfoTraversal node => Ann node dom SrcTemplateStage -> Ann node dom SrcTemplateStage
-extractStayingElems = runIdentity . sourceInfoTraverse (SourceInfoTrf
-    (sourceTemplateNodeElems & traversal & sourceTemplateTextElem !- breakStaying)
-    (srcTmpSeparators & traversal & _1 !- breakStaying)
-    pure)
-
-    where -- splits the elements into separate lines and then recombines them
-          breakStaying :: [SourceTemplateTextElem] -> [SourceTemplateTextElem]
-          breakStaying = concat . Prelude.map (\(NormalText s) -> toTxtElems s)
-
-          toTxtElems :: String -> [SourceTemplateTextElem]
-          toTxtElems str = extractStaying $ splitOn "\n" $ str
-            where
-              extractStaying lines | not (any ("#" `isPrefixOf`) lines) = [NormalText str]
-              extractStaying lines = Prelude.foldr appendTxt []
-                                       $ Prelude.map (\ln -> if "#" `isPrefixOf` ln then StayingText ln "\n" else NormalText ln) lines
-          -- recombines the lines if they are both normal text
-          -- otherwise it moves the windows '\r' characters to the correct position
-          appendTxt (NormalText n1) (NormalText n2 : rest) = NormalText (n1 ++ '\n':n2) : rest
-          appendTxt e (next@NormalText{} : ls) = case reverse (e ^. sourceTemplateText) of
-                                              -- fix '\r' characters that are separated from '\n'
-                                    '\r':_ -> ((sourceTemplateText .- init) . (lineEndings .= "\r\n") $ e) : (sourceTemplateText .- ("\r\n" ++) $ next) : ls
-                                    _      -> e : (sourceTemplateText .- ('\n':) $ next) : ls
-          appendTxt e (next : ls) = case reverse (e ^. sourceTemplateText) of
-                                              -- fix '\r' characters that are separated from '\n'
-                                    '\r':_ -> ((sourceTemplateText .- init) . (lineEndings .= "\r\n") $ e) : NormalText "\r\n" : next : ls
-                                    _      -> e : NormalText "\n" : next : ls
-          appendTxt e [] = [e]
− Language/Haskell/Tools/Transform/RangeToRangeTemplate.hs
@@ -1,130 +0,0 @@-{-# LANGUAGE ScopedTypeVariables
-           , LambdaCase
-           , FlexibleContexts
-           #-}
--- | Transform a syntax tree with ranges to a syntax tree that has range templates. Cuts the ranges of children
--- from the ranges of their parents and replaces it with placeholders.
-module Language.Haskell.Tools.Transform.RangeToRangeTemplate (cutUpRanges, fixRanges) where
-
-import Language.Haskell.Tools.AST
-
-import Control.Monad.State
-import Control.Reference ((^.))
-import Data.List
-import Data.Maybe (Maybe(..), mapMaybe)
-
-import FastString as GHC (unpackFS)
-import SrcLoc
-
-import Language.Haskell.Tools.Transform.RangeTemplate
-
--- | Creates a source template from the ranges and the input file.
--- All source ranges must be good ranges.
-cutUpRanges :: forall node dom . SourceInfoTraversal node
-                 => Ann node dom NormRangeStage
-                 -> Ann node dom RngTemplateStage
-cutUpRanges n = evalState (cutUpRanges' n) [[],[]]
-  where cutUpRanges' :: Ann node dom NormRangeStage -> State [[SrcSpan]] (Ann node dom RngTemplateStage)
-        cutUpRanges' = sourceInfoTraverseUp (SourceInfoTrf (trf cutOutElemSpan) (trf cutOutElemList) (trf cutOutElemOpt)) desc asc
-
-        -- keep the stack to contain the children elements on the place of the parent element
-        desc = modify ([]:)
-        asc  = modify tail
-
-        -- combine the current node with its children, and add it to the list of current nodes
-        trf :: HasRange (x RngTemplateStage)
-            => ([SrcSpan] -> x NormRangeStage -> x RngTemplateStage) -> x NormRangeStage -> State [[SrcSpan]] (x RngTemplateStage)
-        trf f ni = do (below : top : xs) <- get
-                      let res = f below ni
-                      put ([] : (top ++ [ getRange res ]) : xs)
-                      return res
-
--- | Cuts out a list of source ranges from a given range
-cutOutElemSpan :: [SrcSpan] -> SpanInfo NormRangeStage -> SpanInfo RngTemplateStage
-cutOutElemSpan sps (NormNodeInfo (RealSrcSpan sp))
-  = RangeTemplateNode sp $ foldl breakFirstHit (foldl breakFirstHit [RangeElem sp] loc) span
-  where (loc,span) = partition (\sp -> srcSpanStart sp == srcSpanEnd sp) sps
-        breakFirstHit (elem:rest) sp
-          = case breakUpRangeElem elem sp of
-             -- only continue if the correct place for the child range is not found
-              Just pieces -> pieces ++ rest
-              Nothing -> elem : breakFirstHit rest sp
-        breakFirstHit [] inner = error ("breakFirstHit: " ++ unpackFS (srcSpanFile sp) ++ " didn't find correct place for " ++ shortShowSpan inner ++ " in " ++ shortShowSpan (RealSrcSpan sp) ++ " with [" ++ concat (intersperse "," (map shortShowSpan sps)) ++ "]")
-cutOutElemSpan _ (NormNodeInfo (UnhelpfulSpan {})) = error "cutOutElemSpan: no real span"
-
-cutOutElemList :: [SrcSpan] -> ListInfo NormRangeStage -> ListInfo RngTemplateStage
-cutOutElemList sps (NormListInfo bef aft sep indented sp)
-  = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
-     in RangeTemplateList wholeRange bef aft sep indented (getSeparators wholeRange sps)
-
--- | Cuts out all elements from a list, the rest is the list of separators
-getSeparators :: RealSrcSpan -> [SrcSpan] -> [RealSrcSpan]
-getSeparators sp infos@(_:_:_)
-  = mapMaybe getRangeElemSpan (cutOutElemSpan infos (NormNodeInfo (RealSrcSpan sp)) ^. rngTemplateNodeElems)
--- at least two elements needed or there can be no separators
-getSeparators _ _ = []
-
-cutOutElemOpt :: [SrcSpan] -> OptionalInfo NormRangeStage -> OptionalInfo RngTemplateStage
-cutOutElemOpt sps (NormOptInfo bef aft sp)
-  = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
-     in RangeTemplateOpt wholeRange bef aft
-
--- | Breaks the given template element into possibly 2 or 3 parts by cutting out the given part
--- if it is inside the range of the template element. Returns Nothing if the second argument is not inside.
-breakUpRangeElem :: RangeTemplateElem -> SrcSpan -> Maybe [RangeTemplateElem]
-breakUpRangeElem (RangeElem outer) (RealSrcSpan inner)
-  | outer `containsSpan` inner
-  = Just $ (if (realSrcSpanStart outer) < (realSrcSpanStart inner)
-              then [ RangeElem (mkRealSrcSpan (realSrcSpanStart outer) (realSrcSpanStart inner)) ]
-              else []) ++
-           [ RangeChildElem ] ++
-           (if (realSrcSpanEnd inner) < (realSrcSpanEnd outer)
-              then [ RangeElem (mkRealSrcSpan (realSrcSpanEnd inner) (realSrcSpanEnd outer)) ]
-              else [])
-breakUpRangeElem _ _ = Nothing
-
-
--- | Modifies ranges to contain their children
-fixRanges :: SourceInfoTraversal node
-          => Ann node dom RangeStage
-          -> Ann node dom NormRangeStage
-fixRanges node = evalState (sourceInfoTraverseUp (SourceInfoTrf (trf expandToContain) (trf expandListToContain) (trf expandOptToContain)) desc asc node) [[],[]]
-  where -- keep the stack to contain the children elements on the place of the parent element
-        desc = modify ([]:)
-        asc  = modify tail
-
-        trf :: HasRange (x NormRangeStage)
-            => ([SrcSpan] -> x RangeStage -> x NormRangeStage) -> x RangeStage -> State [[SrcSpan]] (x NormRangeStage)
-        trf f ni = do (below : top : xs) <- get
-                      let res = f below ni
-                          resRange = getRange res
-                          endOfSiblings = srcSpanEnd (collectSpanRanges (srcSpanStart resRange) top)
-                          correctedRange = if endOfSiblings > srcSpanStart resRange
-                                             then mkSrcSpan endOfSiblings (max endOfSiblings (srcSpanEnd resRange))
-                                             else resRange
-                      put ([] : (top ++ [ correctedRange ]) : xs)
-                      return $ setRange correctedRange res
-
--- | Expand a simple node to contain its children
-expandToContain :: [SrcSpan] -> SpanInfo RangeStage -> SpanInfo NormRangeStage
-expandToContain cont (NodeSpan sp)
-  = NormNodeInfo (checkSpans cont $ foldl1 combineSrcSpans $ sp : cont)
-
-expandListToContain :: [SrcSpan] -> ListInfo RangeStage -> ListInfo NormRangeStage
-expandListToContain cont (ListPos bef aft def ind sp)
-  = NormListInfo bef aft def ind (checkSpans cont $ collectSpanRanges sp cont)
-
-expandOptToContain :: [SrcSpan] -> OptionalInfo RangeStage -> OptionalInfo NormRangeStage
-expandOptToContain cont (OptionalPos bef aft sp)
-  = NormOptInfo bef aft (checkSpans cont $ collectSpanRanges sp cont)
-
-collectSpanRanges :: SrcLoc -> [SrcSpan] -> SrcSpan
-collectSpanRanges loc@(RealSrcLoc _) [] = srcLocSpan loc
-collectSpanRanges _ ls = foldl combineSrcSpans noSrcSpan ls
-
--- | Checks the contained source ranges to detect the convertion problems where we can see their location.
-checkSpans :: [SrcSpan] -> SrcSpan -> SrcSpan
-checkSpans spans res
-  = if any (not . isGoodSrcSpan) spans && isGoodSrcSpan res
-      then error $ "Wrong src spans in " ++ show res
-      else res
− Language/Haskell/Tools/Transform/SourceTemplate.hs
@@ -1,148 +0,0 @@-{-# LANGUAGE FlexibleInstances
-           , FlexibleContexts
-           , DeriveDataTypeable
-           , TemplateHaskell
-           , RecordWildCards
-           , TypeFamilies
-           #-}
--- | The final version of the source annotation. Each node contains its original textual format, with the places of
--- the children specified by placeholders.
-module Language.Haskell.Tools.Transform.SourceTemplate where
-
-import Control.Reference
-import Data.Data
-import Language.Haskell.Tools.AST
-import SrcLoc
-
-instance SourceInfo SrcTemplateStage where
-  data SpanInfo SrcTemplateStage
-         = SourceTemplateNode { _sourceTemplateNodeRange :: SrcSpan -- ^ The (original) range of the given element
-                              , _sourceTemplateNodeElems :: [SourceTemplateElem] -- ^ The children of the given node, could be text or child nodes
-                              , _srcTmpMinInd :: Int -- ^ Minimum indentation for the element
-                              , _srcTmpRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
-                              }
-    deriving (Eq, Ord, Data)
-  data ListInfo SrcTemplateStage
-         = SourceTemplateList { _sourceTemplateListRange :: SrcSpan -- ^ The (original) range of the given element
-                              , _srcTmpListBefore :: String -- ^ Text that should be put before the first element if the list becomes populated
-                              , _srcTmpListAfter :: String -- ^ Text that should be put after the last element if the list becomes populated
-                              , _srcTmpDefaultSeparator :: String -- ^ The default separator if the list were empty
-                              , _srcTmpIndented :: Maybe [Bool] -- ^ False for elements that should be not aligned
-                              , _srcTmpSeparators :: [([SourceTemplateTextElem], SrcSpan)] -- ^ The actual separators that were found in the source code
-                              , _srcTmpListMinInd :: Int -- ^ Minimum indentation for the element
-                              , _srcTmpListRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
-                              }
-    deriving (Eq, Ord, Data)
-  data OptionalInfo SrcTemplateStage
-         = SourceTemplateOpt { _sourceTemplateOptRange :: SrcSpan -- ^ The (original) range of the given element
-                             , _srcTmpOptBefore :: String -- ^ Text that should be put before the element if it appears
-                             , _srcTmpOptAfter :: String -- ^ Text that should be put after the element if it appears
-                             , _srcTmpOptMinInd :: Int -- ^ Minimum indentation for the element
-                             , _srcTmpOptRelPos :: Maybe Int -- ^ Relative indentation for newly created elements
-                             }
-    deriving (Eq, Ord, Data)
-
--- * References for span infos
-
-sourceTemplateNodeRange :: Simple Lens (SpanInfo SrcTemplateStage) SrcSpan
-sourceTemplateNodeRange = lens _sourceTemplateNodeRange (\v s -> s { _sourceTemplateNodeRange = v })
-
-sourceTemplateNodeElems :: Simple Lens (SpanInfo SrcTemplateStage) [SourceTemplateElem]
-sourceTemplateNodeElems = lens _sourceTemplateNodeElems (\v s -> s { _sourceTemplateNodeElems = v })
-
-sourceTemplateMinimalIndent :: Simple Lens (SpanInfo SrcTemplateStage) Int
-sourceTemplateMinimalIndent = lens _srcTmpMinInd (\v s -> s { _srcTmpMinInd = v })
-
-srcTmpRelPos :: Simple Lens (SpanInfo SrcTemplateStage) (Maybe Int)
-srcTmpRelPos = lens _srcTmpRelPos (\v s -> s { _srcTmpRelPos = v })
-
--- * References for list infos
-
-sourceTemplateListRange :: Simple Lens (ListInfo SrcTemplateStage) SrcSpan
-sourceTemplateListRange = lens _sourceTemplateListRange (\v s -> s { _sourceTemplateListRange = v })
-
-srcTmpListBefore :: Simple Lens (ListInfo SrcTemplateStage) String
-srcTmpListBefore = lens _srcTmpListBefore (\v s -> s { _srcTmpListBefore = v })
-
-srcTmpListAfter :: Simple Lens (ListInfo SrcTemplateStage) String
-srcTmpListAfter = lens _srcTmpListAfter (\v s -> s { _srcTmpListAfter = v })
-
-srcTmpDefaultSeparator :: Simple Lens (ListInfo SrcTemplateStage) String
-srcTmpDefaultSeparator = lens _srcTmpDefaultSeparator (\v s -> s { _srcTmpDefaultSeparator = v })
-
-srcTmpIndented :: Simple Lens (ListInfo SrcTemplateStage) (Maybe [Bool])
-srcTmpIndented = lens _srcTmpIndented (\v s -> s { _srcTmpIndented = v })
-
-srcTmpSeparators :: Simple Lens (ListInfo SrcTemplateStage) [([SourceTemplateTextElem], SrcSpan)]
-srcTmpSeparators = lens _srcTmpSeparators (\v s -> s { _srcTmpSeparators = v })
-
-srcTmpListMinimalIndent :: Simple Lens (ListInfo SrcTemplateStage) Int
-srcTmpListMinimalIndent = lens _srcTmpListMinInd (\v s -> s { _srcTmpListMinInd = v })
-
-srcTmpListRelPos :: Simple Lens (ListInfo SrcTemplateStage) (Maybe Int)
-srcTmpListRelPos = lens _srcTmpListRelPos (\v s -> s { _srcTmpListRelPos = v })
-
--- * References for optional infos
-
-sourceTemplateOptRange :: Simple Lens (OptionalInfo SrcTemplateStage) SrcSpan
-sourceTemplateOptRange = lens _sourceTemplateOptRange (\v s -> s { _sourceTemplateOptRange = v })
-
-srcTmpOptBefore :: Simple Lens (OptionalInfo SrcTemplateStage) String
-srcTmpOptBefore = lens _srcTmpOptBefore (\v s -> s { _srcTmpOptBefore = v })
-
-srcTmpOptAfter :: Simple Lens (OptionalInfo SrcTemplateStage) String
-srcTmpOptAfter = lens _srcTmpOptAfter (\v s -> s { _srcTmpOptAfter = v })
-
-srcTmpOptMinimalIndent :: Simple Lens (OptionalInfo SrcTemplateStage) Int
-srcTmpOptMinimalIndent = lens _srcTmpOptMinInd (\v s -> s { _srcTmpOptMinInd = v })
-
-srcTmpOptRelPos :: Simple Lens (OptionalInfo SrcTemplateStage) (Maybe Int)
-srcTmpOptRelPos = lens _srcTmpOptRelPos (\v s -> s { _srcTmpOptRelPos = v })
-
-
--- | An element of a source template for a singleton AST node.
-data SourceTemplateElem
-  = TextElem { _sourceTemplateTextElem :: [SourceTemplateTextElem]
-             , _sourceTemplateTextRange :: SrcSpan
-             } -- ^ Source text belonging to the current node
-  | ChildElem -- ^ Placeholder for the next children of the node
-     deriving (Eq, Ord, Data)
-
-isStayingText :: SourceTemplateTextElem -> Bool
-isStayingText StayingText{} = True
-isStayingText _ = False
-
-data SourceTemplateTextElem
-  = NormalText { _sourceTemplateText :: String }
-  | StayingText { _sourceTemplateText :: String, _lineEndings :: String }
-     deriving (Eq, Ord, Data)
-
-makeReferences ''SourceTemplateElem
-makeReferences ''SourceTemplateTextElem
-
-instance HasRange (SpanInfo SrcTemplateStage) where
-  getRange = (^. sourceTemplateNodeRange)
-  setRange = (sourceTemplateNodeRange .=)
-
-instance HasRange (ListInfo SrcTemplateStage) where
-  getRange = (^. sourceTemplateListRange)
-  setRange = (sourceTemplateListRange .=)
-
-instance HasRange (OptionalInfo SrcTemplateStage) where
-  getRange = (^. sourceTemplateOptRange)
-  setRange = (sourceTemplateOptRange .=)
-
-instance Show (SpanInfo SrcTemplateStage) where
-  show (SourceTemplateNode _ sp _ _) = concatMap show sp
-instance Show (ListInfo SrcTemplateStage) where
-  show SourceTemplateList{..} = "<*" ++ show _srcTmpListBefore ++ " " ++ show _srcTmpDefaultSeparator ++ " " ++ show _srcTmpListAfter ++ " " ++ show _srcTmpSeparators ++ "*>"
-instance Show (OptionalInfo SrcTemplateStage) where
-  show SourceTemplateOpt{..} = "<?" ++ show _srcTmpOptBefore ++ " " ++ show _srcTmpOptAfter ++ "?>"
-
-instance Show SourceTemplateElem where
-  show (TextElem s _) = show s
-  show ChildElem = "<.>"
-
-instance Show SourceTemplateTextElem where
-  show (NormalText s) = show s
-  show (StayingText s _) = "|" ++ show s ++ "|"
− Language/Haskell/Tools/Transform/SourceTemplateHelpers.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE OverloadedStrings
-           , FlexibleContexts
-           , FlexibleInstances
-           #-}
--- | Helper functions for working with source templates
-module Language.Haskell.Tools.Transform.SourceTemplateHelpers where
-
-import Control.Reference ((.=))
-import Data.String (IsString(..), String)
-import Language.Haskell.Tools.AST
-import Language.Haskell.Tools.Transform.SourceTemplate
-import SrcLoc (noSrcSpan, combineSrcSpans)
-
-type ASTElement node dom = Ann node dom SrcTemplateStage
-type ASTOptional node dom = AnnMaybeG node dom SrcTemplateStage
-type ASTMulti node dom = AnnListG node dom SrcTemplateStage
-
-instance IsString (SpanInfo SrcTemplateStage) where
-  fromString s = SourceTemplateNode noSrcSpan [TextElem [NormalText s] noSrcSpan] 0 Nothing
-
--- * Basic elements
-child :: SpanInfo SrcTemplateStage
-child = SourceTemplateNode noSrcSpan [ChildElem] 0 Nothing
-
-opt :: OptionalInfo SrcTemplateStage
-opt = SourceTemplateOpt noSrcSpan "" "" 0 Nothing
-
-list :: ListInfo SrcTemplateStage
-list = SourceTemplateList noSrcSpan "" "" "" Nothing [] 0 Nothing
-
--- * Modifiers
-
-class AfterBefore i where
-  -- | Put the given string before the element if it is not empty
-  after :: String -> i -> i
-  -- | The given string should follow the element if it is not empty
-  followedBy :: String -> i -> i
-
-instance AfterBefore (ListInfo SrcTemplateStage) where
-  after str = srcTmpListBefore .= str
-  followedBy str = srcTmpListAfter .= str
-
-instance AfterBefore (OptionalInfo SrcTemplateStage) where
-  after str = srcTmpOptBefore .= str
-  followedBy str = srcTmpOptAfter .= str
-
-class RelativeIndent i where
-  -- | The element should be indented relatively to its parent
-  relativeIndented :: Int -> i -> i
-
-instance RelativeIndent (SpanInfo SrcTemplateStage) where
-  relativeIndented i = srcTmpRelPos .= Just i
-
-instance RelativeIndent (ListInfo SrcTemplateStage) where
-  relativeIndented i = srcTmpListRelPos .= Just i
-
-instance RelativeIndent (OptionalInfo SrcTemplateStage) where
-  relativeIndented i = srcTmpOptRelPos .= Just i
-
-
-class MinimumIndent i where
-  -- | The elements should be indented at least to the given number of spaces
-  minimumIndented :: Int -> i -> i
-
-instance MinimumIndent (SpanInfo SrcTemplateStage) where
-  minimumIndented i = sourceTemplateMinimalIndent .= i
-
-instance MinimumIndent (ListInfo SrcTemplateStage) where
-  minimumIndented i = srcTmpListMinimalIndent .= i
-
-instance MinimumIndent (OptionalInfo SrcTemplateStage) where
-  minimumIndented i = srcTmpOptMinimalIndent .= i
-
--- | The elements of the list should be separated by the given string by default (might be overridden)
-separatedBy :: String -> ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
-separatedBy sep = srcTmpDefaultSeparator .= sep
-
--- | The elements of the list should be indented on the same column
-indented :: ListInfo SrcTemplateStage -> ListInfo SrcTemplateStage
-indented = (srcTmpIndented .= Just []) . (srcTmpDefaultSeparator .= "\n")
-
--- | Concatenates two source templates to produce a new template with all child elements.
-(<>) :: SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage -> SpanInfo SrcTemplateStage
-SourceTemplateNode sp1 el1 _ _ <> SourceTemplateNode sp2 el2 _ _ = SourceTemplateNode (combineSrcSpans sp1 sp2) (el1 ++ el2) 0 Nothing
haskell-tools-prettyprint.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-prettyprint
-version:             0.8.1.0
+version:             0.9.0.0
 synopsis:            Pretty printing of Haskell-Tools AST
 description:         Converts the Haskell-Tools AST to text. Prepares the AST for this conversion. If the AST was created from the GHC AST this pretty printing will result in the original source code. Generated AST parts will get the default formatting. Works using the source annotations that are present in the AST. Creates a rose tree first to simplify the conversion.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -14,15 +14,14 @@ library
   ghc-options: -O2
   exposed-modules:     Language.Haskell.Tools.PrettyPrint
-                     , Language.Haskell.Tools.Transform
-                     , Language.Haskell.Tools.IndentationUtils
+                     , Language.Haskell.Tools.PrettyPrint.Prepare
   other-modules:       Language.Haskell.Tools.PrettyPrint.RoseTree
-                     , Language.Haskell.Tools.Transform.RangeToRangeTemplate
-                     , Language.Haskell.Tools.Transform.RangeTemplateToSourceTemplate
-                     , Language.Haskell.Tools.Transform.RangeTemplate
-                     , Language.Haskell.Tools.Transform.SourceTemplate
-                     , Language.Haskell.Tools.Transform.SourceTemplateHelpers
-                     , Language.Haskell.Tools.Transform.PlaceComments
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.RangeToRangeTemplate
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplateToSourceTemplate
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplateHelpers
+                     , Language.Haskell.Tools.PrettyPrint.Prepare.PlaceComments
   build-depends:       base              >= 4.9  && < 4.10
                      , mtl               >= 2.2  && < 2.3
                      , containers        >= 0.5  && < 0.6
@@ -30,6 +29,6 @@                      , uniplate          >= 1.6  && < 1.7
                      , split             >= 0.2  && < 0.3
                      , text              >= 1.2  && < 1.3
-                     , ghc               >= 8.0  && < 8.3
-                     , haskell-tools-ast >= 0.8  && < 0.9
+                     , ghc               >= 8.0  && < 8.1
+                     , haskell-tools-ast >= 0.9  && < 0.10
   default-language: Haskell2010