haskell-tools-prettyprint 0.4.1.3 → 0.5.0.0

raw patch · 8 files changed

+60/−51 lines, 8 filesdep ~haskell-tools-astPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-tools-ast

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/IndentationUtils.hs +1/−1
• Language/Haskell/Tools/PrettyPrint.hs +1/−1
• Language/Haskell/Tools/PrettyPrint/RoseTree.hs +3/−1
• Language/Haskell/Tools/Transform.hs +1/−1
• Language/Haskell/Tools/Transform/RangeTemplateToSourceTemplate.hs +1/−1
• Language/Haskell/Tools/Transform/RangeToRangeTemplate.hs +50/−43
• Language/Haskell/Tools/Transform/SourceTemplateHelpers.hs +1/−1
• haskell-tools-prettyprint.cabal +2/−2

@@ -4,7 +4,7 @@ import Control.Monad.Identity (Identity(..))
 import Control.Reference ((.=))
 
-import Language.Haskell.Tools.AST (SrcTemplateStage(..), SourceInfoTrf(..), SourceInfoTraversal(..))
+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

@@ -10,7 +10,7 @@ import FastString (fsLit)
 import SrcLoc
 
-import Language.Haskell.Tools.AST (SrcTemplateStage(..), SourceInfoTraversal(..))
+import Language.Haskell.Tools.AST (SrcTemplateStage, SourceInfoTraversal(..))
 import Language.Haskell.Tools.PrettyPrint.RoseTree (RoseSourceInfo(..), RoseTree(..), toRoseTree)
 import Language.Haskell.Tools.Transform.SourceTemplate
 

@@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns
            , FlexibleContexts 
+           , LambdaCase
            , DeriveFunctor
            , StandaloneDeriving
            #-}
@@ -31,7 +32,8 @@                           
 -- | Transforms the heterogeneous AST into a homogeneous representation for pretty printing                   
 toRoseTree :: (SourceInfoTraversal n) => n dom st -> RoseTree st
-toRoseTree = head . head . tail . flip execState [[],[]] . toSrcRoseSt
+toRoseTree = (\case (root:_):_ -> root; _ -> error "toRoseTree: the result has no root") 
+                . tail . flip execState [[],[]] . toSrcRoseSt
   where toSrcRoseSt = sourceInfoTraverseUp (SourceInfoTrf (trf RoseSpan) (trf RoseList) (trf RoseOptional)) desc asc
   
         desc  = modify ([]:)

@@ -21,7 +21,7 @@ import Language.Haskell.Tools.Transform.SourceTemplateHelpers
 
 import Language.Haskell.Tools.AST
-import StringBuffer (StringBuffer(..))
+import StringBuffer (StringBuffer)
 
 -- | Prepares the AST for pretty printing
 prepareAST :: SourceInfoTraversal node => StringBuffer -> Ann node dom RangeStage -> Ann node dom SrcTemplateStage

@@ -12,7 +12,7 @@ import Language.Haskell.Tools.Transform.RangeTemplate
 import Language.Haskell.Tools.Transform.SourceTemplate
 import SrcLoc
-import StringBuffer (StringBuffer(..), nextChar, atEnd)
+import StringBuffer (StringBuffer, nextChar, atEnd)
 
 rangeToSource :: SourceInfoTraversal node => StringBuffer -> Ann node dom RngTemplateStage
                                                           -> Ann node dom SrcTemplateStage

@@ -39,37 +39,6 @@                       put ([] : (top ++ [ getRange res ]) : xs)
                       return res
 
--- | 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 (RealSrcSpan $ 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 (foldl1 combineSrcSpans $ sp : cont)
-
-expandListToContain :: [SrcSpan] -> ListInfo RangeStage -> ListInfo NormRangeStage
-expandListToContain cont (ListPos bef aft def ind sp) = NormListInfo bef aft def ind (RealSrcSpan $ collectSpanRanges sp cont)
-
-expandOptToContain :: [SrcSpan] -> OptionalInfo RangeStage -> OptionalInfo NormRangeStage
-expandOptToContain cont (OptionalPos bef aft sp) = NormOptInfo bef aft (RealSrcSpan $ collectSpanRanges sp cont)
-   
 -- | Cuts out a list of source ranges from a given range
 cutOutElemSpan :: [SrcSpan] -> SpanInfo NormRangeStage -> SpanInfo RngTemplateStage
 cutOutElemSpan sps (NormNodeInfo (RealSrcSpan sp))
@@ -88,18 +57,6 @@   = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
      in RangeTemplateList wholeRange bef aft sep indented (getSeparators wholeRange sps)
 
-cutOutElemOpt :: [SrcSpan] -> OptionalInfo NormRangeStage -> OptionalInfo RngTemplateStage
-cutOutElemOpt sps (NormOptInfo bef aft sp) 
-  = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
-     in RangeTemplateOpt wholeRange bef aft
-
-collectSpanRanges :: SrcLoc -> [SrcSpan] -> RealSrcSpan
-collectSpanRanges (RealSrcLoc loc) [] = realSrcLocSpan loc
-collectSpanRanges _ [] = error "collectSpanRanges: No real src loc for empty element"
-collectSpanRanges _ ls = case foldl1 combineSrcSpans ls of 
-                           RealSrcSpan sp -> sp
-                           UnhelpfulSpan {} -> error "collectSpanRanges: combineSrcSpans resulted no real span"
-                     
 -- | Cuts out all elements from a list, the rest is the list of separators
 getSeparators :: RealSrcSpan -> [SrcSpan] -> [RealSrcSpan]
 getSeparators sp infos@(_:_:_)
@@ -107,6 +64,11 @@ -- 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]
@@ -121,4 +83,49 @@               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
 

@@ -6,7 +6,7 @@ module Language.Haskell.Tools.Transform.SourceTemplateHelpers where
 
 import Control.Reference ((.=))
-import Data.String (IsString(..), String(..))
+import Data.String (IsString(..), String)
 import Language.Haskell.Tools.AST
 import Language.Haskell.Tools.Transform.SourceTemplate
 import SrcLoc (noSrcSpan, combineSrcSpans)

@@ -1,5 +1,5 @@ name:                haskell-tools-prettyprint
-version:             0.4.1.3
+version:             0.5.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
@@ -30,5 +30,5 @@                      , uniplate          >= 1.6  && < 1.7
                      , split             >= 0.2  && < 0.3
                      , ghc               >= 8.0  && < 8.1
-                     , haskell-tools-ast >= 0.4  && < 0.5
+                     , haskell-tools-ast >= 0.5  && < 0.6
   default-language: Haskell2010