packages feed

haskell-tools-ast-trf (empty) → 0.1.2.0

raw patch · 9 files changed

+585/−0 lines, 9 filesdep +MissingHdep +basedep +containerssetup-changed

Dependencies added: MissingH, base, containers, ghc, haskell-tools-ast, mtl, references, structural-traversal, uniplate

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Haskell-Tools is Copyright (c) Boldizsár Németh, 2016, all rights reserved,
+and is distributed as free software under the following license.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+- Redistributions of source code must retain the above copyright
+notice, this list of conditions, and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions, and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+- The names of the copyright holders may not be used to endorse or
+promote products derived from this software without specific prior
+written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Haskell/Tools/AnnTrf/PlaceComments.hs view
@@ -0,0 +1,152 @@+{-# 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.AnnTrf.PlaceComments where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+import Data.List
+import Data.String.Utils
+import Data.Char (isSpace, isAlphaNum)
+import Data.Data
+import Data.Generics.Uniplate.Data
+import Control.Reference hiding (element)
+import Control.Monad.Writer
+import Control.Monad.State
+import Data.StructuralTraversal
+
+import SrcLoc
+import ApiAnnotation
+import Outputable
+import Debug.Trace
+
+import Language.Haskell.Tools.AST
+
+getNormalComments :: Map.Map SrcSpan [Located AnnotationComment] -> Map.Map SrcSpan [Located AnnotationComment] 
+getNormalComments = Map.map (filter (not . isPragma . unLoc))
+
+getPragmaComments :: Map.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) = startswith "{-#" str && endswith "#-}" str
+isPragma _ = False
+
+-- | Puts comments in the nodes they should be attached to. Leaves the AST in a state where parent nodes
+-- does not contain all of their children.
+placeComments :: (StructuralTraversable node, Data sema, Data (node (NodeInfo sema SpanInfo)), Typeable node)
+              => Map.Map SrcSpan [Located AnnotationComment] 
+              -> Ann node (NodeInfo sema SpanInfo) 
+              -> Ann node (NodeInfo sema SpanInfo)
+placeComments comms mod
+  = resizeAnnots (concatMap (map nextSrcLoc . snd) (Map.toList comms)) 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)
+  
+allElemSpans :: StructuralTraversable node => Ann node (NodeInfo sema SpanInfo) -> [SrcSpan]
+allElemSpans = execWriter . traverseDown (return ()) (return ()) 
+                             (\ni -> maybe (return ()) (tell . (:[])) (ni ^? sourceInfo&nodeSpan))
+                                                 
+resizeAnnots :: forall node sema . (Data sema, Data (node (NodeInfo sema SpanInfo)), Typeable node) 
+                  => [((SrcLoc, SrcLoc), Located AnnotationComment)]
+                  -> Ann node (NodeInfo sema SpanInfo) 
+                  -> Ann node (NodeInfo sema SpanInfo) 
+resizeAnnots comments elem
+  = flip evalState comments $ 
+        -- 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
+        
+        transformBiM (expandAnnot :: ExpandType ImportDecl sema)
+          >=> transformBiM (expandAnnotToFunArgs :: ExpandType TypeSignature sema)
+          >=> transformBiM (expandAnnot :: ExpandType Decl sema)
+          >=> transformBiM (expandAnnot :: ExpandType ClassElement sema)
+          >=> transformBiM (expandAnnot :: ExpandType ConDecl sema)
+          >=> transformBiM (expandAnnot :: ExpandType FieldDecl sema)
+          >=> transformBiM (expandAnnot :: ExpandType LocalBind sema)
+          >=> transformBiM (expandAnnot :: ExpandType Module sema)
+      $ elem
+
+type ExpandType elem sema = Ann elem (NodeInfo sema SpanInfo) 
+                              -> State [((SrcLoc, SrcLoc), Located AnnotationComment)]
+                                       (Ann elem (NodeInfo sema SpanInfo))
+
+-- | Expands tree elements to contain the comments that should be attached to them.
+expandAnnot :: forall elem sema . ExpandType elem sema
+expandAnnot elem
+  = do let Just sp = elem ^? annotation&sourceInfo&nodeSpan
+       applicable <- gets (applicableComments (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
+         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 (NodeInfo sema SpanInfo)) SrcSpan
+        nodeSp = annotation&sourceInfo&nodeSpan
+        
+-- This classification does not prefer inline comments to previous line comments, this is implicitely done
+-- by the order in which the elements are traversed.
+applicableComments :: SrcLoc -> SrcLoc 
+                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)] 
+                   -> [((SrcLoc, SrcLoc), Located AnnotationComment)]
+applicableComments start end = filter applicableComment
+  where -- A comment that starts with | binds to the next documented element
+        applicableComment ((_, before), L _ comm) 
+          | isCommentOnNext comm = before == start
+        -- A comment that starts with ^ binds to the previous documented element
+        applicableComment ((after, _), L _ comm) 
+          | isCommentOnPrev comm = after == end
+        -- All other comment binds to the previous definition if it is on the same line
+        applicableComment ((after, _), L (RealSrcSpan loc) _) 
+          | after == end && srcLocLine (realSrcSpanStart loc) == getLineLocDefault end = True
+        -- or the next one if that is on the next line and the columns line up
+        applicableComment ((_, before), L (RealSrcSpan loc) _) 
+          | before == start && srcLocLine (realSrcSpanEnd loc) + 1 == getLineLocDefault start
+                            && srcLocCol (realSrcSpanStart loc) == getLineColDefault start
+          = True
+        applicableComment _ = False
+        
+        getLineLocDefault (RealSrcLoc l) = srcLocLine l
+        getLineLocDefault _              = -1
+
+        getLineColDefault (RealSrcLoc l) = srcLocCol l
+        getLineColDefault _              = -1
+
+-- * 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))
+
+expandAnnotToFunArgs :: ExpandType TypeSignature sema
+expandAnnotToFunArgs = element&tsType&typeParams !~ expandAnnot
+ Language/Haskell/Tools/AnnTrf/RangeTemplate.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell
+           , DeriveDataTypeable
+           #-}
+-- | 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.AnnTrf.RangeTemplate where
+
+import Data.Data
+import Control.Reference
+import SrcLoc
+
+data RangeTemplateElem = RangeElem RealSrcSpan
+                       | RangeChildElem
+                       | RangeOptionalElem String String
+                       | RangeListElem String String String Bool [RealSrcSpan]
+                       deriving Data
+
+getRangeElemSpan :: RangeTemplateElem -> Maybe RealSrcSpan
+getRangeElemSpan (RangeElem sp) = Just sp
+getRangeElemSpan _ = Nothing
+                       
+instance Show RangeTemplateElem where
+  show (RangeElem sp) = show sp
+  show RangeChildElem = "«.»"
+  show (RangeOptionalElem bef aft) = "«?" ++ show bef ++ " " ++ show aft ++ "?»"
+  show (RangeListElem bef aft sep _ _) = "«*" ++ show bef ++ " " ++ show sep ++ " " ++ show aft ++ "*»"
+  
+-- | The intermediate annotation with ranges and children cut out from parents.
+data RangeTemplate = RangeTemplate { _rangeTemplateSpan :: RealSrcSpan
+                                   , _rangeTemplateElems :: [RangeTemplateElem] 
+                                   } deriving Data
+                                   
+makeReferences ''RangeTemplate      
+
+instance Show RangeTemplate where
+  show (RangeTemplate rng rngs) = show rngs
+ Language/Haskell/Tools/AnnTrf/RangeTemplateToSourceTemplate.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase 
+           , FlexibleContexts
+           #-}
+module Language.Haskell.Tools.AnnTrf.RangeTemplateToSourceTemplate where
+
+import SrcLoc
+import StringBuffer
+import Data.StructuralTraversal
+import Data.Map
+import Data.Monoid
+import Control.Reference
+import Control.Monad.State
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AnnTrf.RangeToRangeTemplate
+import Language.Haskell.Tools.AnnTrf.RangeTemplate
+import Language.Haskell.Tools.AnnTrf.SourceTemplate
+
+import Debug.Trace
+
+rangeToSource :: StructuralTraversable node => StringBuffer -> Ann node (NodeInfo sema RangeTemplate) 
+                                                            -> Ann node (NodeInfo sema SourceTemplate)
+rangeToSource srcInput tree = let locIndices = getLocIndices tree
+                                  srcMap = mapLocIndices srcInput locIndices
+                               in applyFragments (elems srcMap) tree
+
+-- maps could be strict
+
+-- | Assigns an index (in the order they are used) for each range
+getLocIndices :: StructuralTraversable e => Ann e (NodeInfo sema RangeTemplate) -> Map OrdSrcSpan Int
+getLocIndices = snd . flip execState (0, empty) .
+  traverseDown (return ()) (return ()) 
+               (mapM_ (\case RangeElem sp               -> modify (insertElem sp)
+                             RangeListElem _ _ _ _ seps -> mapM_ (modify . insertElem) seps
+                             _                          -> return ()
+                      ) . (^. sourceInfo&rangeTemplateElems))
+  where insertElem sp (i,m) = (i+1, insert (OrdSrcSpan sp) i m)
+                             
+                             
+-- | Partitions the source file in the order where the parts are used in the AST
+mapLocIndices :: Ord k => StringBuffer -> Map OrdSrcSpan k -> Map k String
+mapLocIndices inp = fst . foldlWithKey (\(new, str) sp k -> let (rem, val) = takeSpan str sp
+                                                             in (insert k (reverse val) new, rem)) (empty, inp)
+  where takeSpan :: StringBuffer -> OrdSrcSpan -> (StringBuffer, String)
+        takeSpan str (OrdSrcSpan sp) = takeSpan' (realSrcSpanStart sp) (realSrcSpanEnd sp) (str,"")
+
+        takeSpan' :: RealSrcLoc -> RealSrcLoc -> (StringBuffer, String) -> (StringBuffer, String)
+        takeSpan' start end (sb, taken) | start < end && not (atEnd sb)
+          = let (c,rem) = nextChar sb in takeSpan' (advanceSrcLoc start c) end (rem, c:taken)
+        takeSpan' _ _ (rem, taken) = (rem, taken)
+        
+-- | Replaces the ranges in the AST with the source file parts
+applyFragments :: StructuralTraversable node => [String] -> Ann node (NodeInfo sema RangeTemplate) 
+                                                         -> Ann node (NodeInfo sema SourceTemplate)
+applyFragments srcs = flip evalState srcs
+  . traverseDown 
+     (return ()) (return ())
+     (\ni -> do template <- mapM getTextFor (ni ^. sourceInfo&rangeTemplateElems)
+                return $ sourceInfo .= SourceTemplate (RealSrcSpan $ ni ^. sourceInfo&rangeTemplateSpan) template $ ni)
+  where getTextFor (RangeElem sp) = do (src:rest) <- get
+                                       put rest
+                                       return (TextElem src)
+        getTextFor RangeChildElem = return ChildElem
+        getTextFor (RangeOptionalElem bef aft) = return (OptionalChildElem bef aft)
+        getTextFor (RangeListElem bef aft sep indented seps) 
+          = do (own, rest) <- splitAt (length seps) <$> get 
+               put rest
+               return (ChildListElem bef aft sep indented own)
+
+ Language/Haskell/Tools/AnnTrf/RangeToRangeTemplate.hs view
@@ -0,0 +1,111 @@+{-# 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.AnnTrf.RangeToRangeTemplate (cutUpRanges, fixRanges) where
+
+import Language.Haskell.Tools.AST
+
+import Data.Data
+import Data.List
+import Data.Maybe
+import Control.Reference hiding (element)
+import Data.StructuralTraversal
+import Control.Monad.State
+import SrcLoc
+import Language.Haskell.Tools.AnnTrf.RangeTemplate
+
+-- | Creates a source template from the ranges and the input file.
+-- All source ranges must be good ranges.
+cutUpRanges :: forall node sema . StructuralTraversable node 
+                 => Ann node (NodeInfo sema SpanInfo) 
+                 -> Ann node (NodeInfo sema RangeTemplate)
+cutUpRanges n = evalState (cutUpRanges' n) [[],[]]
+  where cutUpRanges' :: StructuralTraversable node => Ann node (NodeInfo sema SpanInfo) 
+                                                   -> State [[SpanInfo]] (Ann node (NodeInfo sema RangeTemplate))
+        cutUpRanges' = traverseUp desc asc f
+        
+        -- 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
+        f ni = do (below : top : xs) <- get
+                  put ([] : (top ++ [ expandAsNodeInfo (ni ^. sourceInfo) below ]) : xs)
+                  return (sourceInfo .- cutOutElem below $ ni)
+
+-- | Modifies ranges to contain their children
+fixRanges :: StructuralTraversable node 
+          => Ann node (NodeInfo sema SpanInfo) 
+          -> Ann node (NodeInfo sema SpanInfo)
+fixRanges node = evalState (traverseUp desc asc f node) [[],[]]
+  where -- keep the stack to contain the children elements on the place of the parent element
+        desc = modify ([]:)
+        asc  = modify tail
+        
+        f ni = do (below : top : xs) <- get
+                  put ([] : (top ++ [ expandAsNodeToContain (ni ^. sourceInfo) below ]) : xs)
+                  return (sourceInfo .- expandToContain below $ ni)
+
+-- | Expand a list or optional node to contain its children
+expandAsNodeInfo :: SpanInfo -> [SpanInfo] -> SpanInfo
+expandAsNodeInfo ns@(NodeSpan _) _ = ns
+expandAsNodeInfo OptionalPos{_optionalPos = loc} sps = NodeSpan (RealSrcSpan (collectSpanRanges loc sps))
+expandAsNodeInfo ListPos{_listPos = loc} sps = NodeSpan (RealSrcSpan (collectSpanRanges loc sps))
+
+-- | Expand a simple node to contain its children
+expandToContain :: [SpanInfo] -> SpanInfo -> SpanInfo
+expandToContain cont (NodeSpan sp) = NodeSpan (foldl1 combineSrcSpans $ sp : map spanRange cont)
+expandToContain _ oth = oth
+
+-- | Expand any node to contain its children
+expandAsNodeToContain :: SpanInfo -> [SpanInfo] -> SpanInfo
+expandAsNodeToContain ns@(NodeSpan _) ls = expandToContain ls ns
+expandAsNodeToContain oth ls = expandAsNodeInfo oth ls
+                  
+-- | Cuts out a list of source ranges from a given range
+cutOutElem :: [SpanInfo] -> SpanInfo -> RangeTemplate
+cutOutElem sps lp@(ListPos bef aft sep indented loc)
+  = let wholeRange = collectSpanRanges loc sps 
+     in RangeTemplate wholeRange [RangeListElem bef aft sep indented (getSeparators wholeRange sps)]
+cutOutElem sps op@(OptionalPos bef aft loc) 
+  = RangeTemplate (collectSpanRanges loc sps) [RangeOptionalElem bef aft]
+cutOutElem sps (NodeSpan (RealSrcSpan sp))
+  = RangeTemplate sp $ foldl breakFirstHit (foldl breakFirstHit [RangeElem sp] loc) span
+  where (loc,span) = partition (\sp -> srcSpanStart sp == srcSpanEnd sp) (map spanRange 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 [] sp = error ("breakFirstHit: didn't find correct place for " ++ show sp)
+
+collectSpanRanges :: SrcLoc -> [SpanInfo] -> RealSrcSpan
+collectSpanRanges (RealSrcLoc loc) [] = realSrcLocSpan loc
+collectSpanRanges _ [] = error "collectSpanRanges: No real src loc for empty element"
+collectSpanRanges _ ls = case foldl1 combineSrcSpans $ map spanRange ls of RealSrcSpan sp -> sp
+                     
+-- | Cuts out all elements from a list, the rest is the list of separators
+getSeparators :: RealSrcSpan -> [SpanInfo] -> [RealSrcSpan]
+getSeparators sp infos@(_:_:_)
+  = mapMaybe getRangeElemSpan (cutOutElem infos (NodeSpan (RealSrcSpan sp)) ^. rangeTemplateElems)
+-- at least two elements needed or there can be no separators
+getSeparators sp _ = []
+                     
+-- | 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 outer inner = Nothing
+
+
+ Language/Haskell/Tools/AnnTrf/SourceTemplate.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances
+           , FlexibleContexts
+           , DeriveDataTypeable
+           , TemplateHaskell
+           , RecordWildCards
+           #-}
+-- | 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.AnnTrf.SourceTemplate where
+
+import Data.Data
+import Data.String
+import Control.Reference
+import SrcLoc
+import Language.Haskell.Tools.AST
+
+data SourceTemplateElem 
+  = TextElem String -- ^ Source text belonging to the current node
+  | ChildElem -- ^ Placeholder for the next children of the node
+  | OptionalChildElem { _srcTmpBefore :: String -- ^ Text that should be put before the element if it appears
+                      , _srcTmpAfter :: String -- ^ Text that should be put after the element if it appears
+                      }
+  | ChildListElem { _srcTmpBefore :: String -- ^ Text that should be put before the first element if the list becomes populated
+                  , _srcTmpAfter :: 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 :: Bool -- ^ True, if the elements need to be aligned in the same column
+                  , _srcTmpSeparators :: [String] -- ^ The actual separators that were found in the source code
+                  }
+     deriving (Eq, Ord, Data)
+     
+makeReferences ''SourceTemplateElem
+
+-- | A pattern that controls how the original source code can be
+-- retrieved from the AST. A source template is assigned to each node.
+-- It has holes where the content of an other node should be printed.
+data SourceTemplate = SourceTemplate { _sourceTemplateRange :: SrcSpan
+                                     , _sourceTemplateElems :: [SourceTemplateElem] 
+                                     } deriving Data 
+
+makeReferences ''SourceTemplate
+      
+instance HasRange (NodeInfo sema SourceTemplate) where 
+  getRange = (^. sourceInfo&sourceTemplateRange)
+      
+instance Show SourceTemplateElem where
+  show (TextElem s) = s
+  show ChildElem = "«.»"
+  show OptionalChildElem{..} = "«?" ++ show _srcTmpBefore ++ " " ++ show _srcTmpAfter ++ "?»"
+  show ChildListElem{..} = "«*" ++ show _srcTmpBefore ++ " " ++ show _srcTmpDefaultSeparator ++ " " ++ show _srcTmpAfter ++ "*»"
+
+instance Show SourceTemplate where
+  show (SourceTemplate rng sp) = concatMap show sp
+ Language/Haskell/Tools/AnnTrf/SourceTemplateHelpers.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings
+           , FlexibleContexts
+           #-}
+-- | Helper functions for working with source templates
+module Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers where
+
+import SrcLoc
+import Data.String
+import Data.List
+import Control.Reference
+import Data.Function (on)
+import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AnnTrf.SourceTemplate
+
+filterList :: TemplateAnnot a => (Ann e a -> Bool) -> AnnList e a -> AnnList e a
+filterList pred ls = replaceList (filter pred (ls ^. annListElems)) ls   
+       
+-- | Replaces the list with a new one with the given elements, keeping the most common separator as the new one.
+replaceList :: TemplateAnnot a => [Ann e a] -> AnnList e a -> AnnList e a
+replaceList elems (AnnList a _)
+  = AnnList (fromTemplate (listSep mostCommonSeparator)) elems
+  where mostCommonSeparator  
+          = case getTemplate a ^. sourceTemplateElems of 
+              [ChildListElem _ _ sep _ seps] -> case maximumBy (compare `on` length) $ group $ sort seps of 
+                                                  [] -> sep
+                                                  sep:_ -> sep
+                            
+-- | Inserts the element in the places where the two positioning functions (one checks the element before, one the element after)
+-- allows the placement.         
+insertWhere :: (TemplateAnnot a) => Ann e a -> (Maybe (Ann e a) -> Bool) -> (Maybe (Ann e a) -> Bool) -> AnnList e a -> AnnList e a
+insertWhere e before after al 
+  = let index = insertIndex before after (al ^? annList)
+     in case index of 
+          Nothing -> al
+          Just ind -> annListElems .- insertAt ind e 
+                        $ (if isEmptyAnnList then id else addDefaultSeparator ind)
+                        $ al 
+  where addDefaultSeparator i al 
+          = srcTemplateElems&srcTmpSeparators 
+               .- insertAt i (head $ al ^? srcTemplateElems&srcTmpDefaultSeparator) $ al
+        srcTemplateElems :: (TemplateAnnot a) => Simple Traversal (AnnList e a) SourceTemplateElem
+        srcTemplateElems = annListAnnot&template&sourceTemplateElems&traversal
+        insertAt n e ls = let (bef,aft) = splitAt n ls in bef ++ [e] ++ aft
+        isEmptyAnnList = (null :: [x] -> Bool) $ (al ^? annList)
+
+-- | Checks where the element will be inserted given the two positioning functions.
+insertIndex :: (Maybe (Ann e a) -> Bool) -> (Maybe (Ann e a) -> Bool) -> [Ann e a] -> Maybe Int
+insertIndex before after []
+  | before Nothing && after Nothing = Just 0
+  | otherwise = Nothing
+insertIndex before after list@(first:_)
+  | before Nothing && after (Just first) = Just 0
+  | otherwise = (+1) <$> insertIndex' before after list 
+  where insertIndex' before after (curr:rest@(next:_)) 
+          | before (Just curr) && after (Just next) = Just 0
+          | otherwise = (+1) <$> insertIndex' before after rest
+        insertIndex' before after (curr:[]) 
+          | before (Just curr) && after Nothing = Just 0
+          | otherwise = Nothing
+                                     
+class TemplateAnnot annot where
+  template :: Simple Lens annot SourceTemplate
+  template = iso getTemplate fromTemplate
+  fromTemplate :: SourceTemplate -> annot
+  getTemplate :: annot -> SourceTemplate
+  
+instance IsString SourceTemplate where
+  fromString s = SourceTemplate noSrcSpan [TextElem s]
+    
+child :: SourceTemplate
+child = SourceTemplate noSrcSpan [ChildElem]
+
+opt :: SourceTemplate
+opt = SourceTemplate noSrcSpan [OptionalChildElem "" ""]
+
+optBefore :: String -> SourceTemplate
+optBefore s = SourceTemplate noSrcSpan [OptionalChildElem s ""]
+
+optAfter :: String -> SourceTemplate
+optAfter s = SourceTemplate noSrcSpan [OptionalChildElem "" s]
+
+list :: SourceTemplate
+list = SourceTemplate noSrcSpan [ChildListElem "" "" "" False []]
+
+indentedList :: SourceTemplate
+indentedList = SourceTemplate noSrcSpan [ChildListElem "" "" "\n" True []]
+
+indentedListBefore :: String -> SourceTemplate
+indentedListBefore bef = SourceTemplate noSrcSpan [ChildListElem bef "" "\n" True []]
+
+indentedListAfter :: String -> SourceTemplate
+indentedListAfter aft = SourceTemplate noSrcSpan [ChildListElem "" aft "\n" True []]
+
+listSep :: String -> SourceTemplate
+listSep s = SourceTemplate noSrcSpan [ChildListElem "" "" s False []]
+
+listSepBefore :: String -> String -> SourceTemplate
+listSepBefore s bef = SourceTemplate noSrcSpan [ChildListElem bef "" s False []]
+
+listSepAfter :: String -> String -> SourceTemplate
+listSepAfter s aft = SourceTemplate noSrcSpan [ChildListElem "" aft s False []]
+
+-- | Concatenates two source templates to produce a new template with all child elements.
+(<>) :: SourceTemplate -> SourceTemplate -> SourceTemplate
+SourceTemplate sp1 el1 <> SourceTemplate sp2 el2 = SourceTemplate (combineSrcSpans sp1 sp2) (el1 ++ el2)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ haskell-tools-ast-trf.cabal view
@@ -0,0 +1,30 @@+name:                haskell-tools-ast-trf
+version:             0.1.2.0
+synopsis:            Conversions on Haskell-Tools AST to prepare for refactorings
+description:         Converts the Haskell-Tools AST between different versions to have source annotations that help refactorings. Have transformations that convert from ranges to range templates and then to source templates. Also have a transformation to put comments to their places.
+homepage:            https://github.com/nboldi/haskell-tools
+license:             BSD3
+license-file:        LICENSE
+author:              Boldizsar Nemeth
+maintainer:          nboldi@elte.hu
+category:            Language
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Language.Haskell.Tools.AnnTrf.RangeToRangeTemplate
+                     , Language.Haskell.Tools.AnnTrf.RangeTemplateToSourceTemplate
+                     , Language.Haskell.Tools.AnnTrf.RangeTemplate
+                     , Language.Haskell.Tools.AnnTrf.SourceTemplate
+                     , Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
+                     , Language.Haskell.Tools.AnnTrf.PlaceComments  
+  build-depends:       base                 >=4.9   && <5.0
+                     , ghc                  >=8.0   && <8.1
+                     , haskell-tools-ast    >=0.1   && <1.0
+                     , uniplate             >=1.6   && <2.0
+                     , references           >=0.3.2 && <1.0
+                     , structural-traversal >=0.1   && <1.0
+                     , mtl                  >=2.2   && <2.3
+                     , containers           >=0.5   && <0.6
+                     , MissingH             >=1.3   && <2.0
+  default-language:    Haskell2010