haskell-tools-prettyprint 0.9.0.0 → 1.0.0.0

raw patch · 10 files changed

+76/−67 lines, 10 filesdep ~basedep ~ghcdep ~haskell-tools-ast

Dependency ranges changed: base, ghc, haskell-tools-ast

Files

• Language/Haskell/Tools/PrettyPrint.hs +14/−12
• Language/Haskell/Tools/PrettyPrint/Prepare.hs +3/−2
• Language/Haskell/Tools/PrettyPrint/Prepare/PlaceComments.hs +1/−4
• Language/Haskell/Tools/PrettyPrint/Prepare/RangeTemplate.hs +12/−8
• Language/Haskell/Tools/PrettyPrint/Prepare/RangeTemplateToSourceTemplate.hs +3/−5
• Language/Haskell/Tools/PrettyPrint/Prepare/RangeToRangeTemplate.hs +20/−8
• Language/Haskell/Tools/PrettyPrint/Prepare/SourceTemplate.hs +1/−7
• Language/Haskell/Tools/PrettyPrint/Prepare/SourceTemplateHelpers.hs +1/−4
• Language/Haskell/Tools/PrettyPrint/RoseTree.hs +17/−13
• haskell-tools-prettyprint.cabal +4/−4

@@ -1,18 +1,14 @@-{-# LANGUAGE FlexibleInstances
-           , FlexibleContexts
-           , UndecidableInstances
-           , NamedFieldPuns
-           #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, NamedFieldPuns, UndecidableInstances #-}
 
 -- | Pretty printing the AST
-module Language.Haskell.Tools.PrettyPrint (prettyPrint, toRoseTree) where
+module Language.Haskell.Tools.PrettyPrint (prettyPrint, toRoseTree, PrettyPrintProblem(..)) where
 
 import FastString (fsLit)
 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.PrettyPrint.RoseTree
 
 import Control.Monad.State
 import Control.Reference ((^.))
@@ -42,8 +38,14 @@              where txt = concatMap (^. sourceTemplateText) txtElems
            printTemplateElems (ChildElem : rest) (child : children) = printRose' parent child >+< printTemplateElems rest children
            printTemplateElems [] [] = return empty
-           printTemplateElems _ [] = error $ "More child elem in template than actual children (elems: " ++ show elems ++ ", children: " ++ show children ++ ")"
-           printTemplateElems [] _ = error $ "Not all children are used to pretty printing. (elems: " ++ show elems ++ ", children: " ++ show children ++ ")"
+           printTemplateElems _ []
+             = pprProblem $ "More child elem in template than actual children (elems: " ++ show elems
+                               ++ ", children: " ++ show children
+                               ++ "). Check that the default templates for AST elements are correct."
+           printTemplateElems [] _
+             = pprProblem $ "Not all children are used to pretty printing. (elems: "
+                              ++ show elems ++ ", children: " ++ show children
+                              ++ "). Check that the default templates for AST elements are correct."
 
            min = minInd `max` getPosByRelative parent relInd
 
@@ -68,7 +70,7 @@        actRng <- get
        let min = minInd `max` getPosByRelative parent relInd
        putString slide min bef >+< printRose' actRng child >+< putString slide min aft
-printRose' _ (RoseTree (RoseOptional _) _) = error "More than one child element in an optional node."
+printRose' _ (RoseTree (RoseOptional _) _) = pprProblem "More than one child element in an optional node."
 
 getPosByRelative :: RealSrcLoc -> Maybe Int -> Int
 getPosByRelative sp (Just i) = srcLocCol sp + i - 1
@@ -85,7 +87,7 @@   = do modify $ advanceStr newStr
        return (fromList newStr)
   where start:rest = splitOn "\n" s
-        newStr = concat $ intersperse ("\n" ++ replicate slide ' ') (start : map (extendToNSpaces minInd) rest)
+        newStr = concat $ List.intersperse ("\n" ++ replicate slide ' ') (start : map (extendToNSpaces minInd) rest)
         extendToNSpaces n str = replicate n ' ' ++ (List.dropWhile (== ' ') $ List.take n str) ++ List.drop n str
 
 advanceStr :: String -> RealSrcLoc -> RealSrcLoc
@@ -131,4 +133,4 @@ printListWithSeps' _ _ parent _ _ _ [child] = printRose' parent child
 printListWithSeps' putCorrectSep i parent slide minInd (sep:seps) (child:children)
   = printRose' parent child >+< putCorrectSep i slide minInd sep >+< printListWithSeps' putCorrectSep (i+1) parent slide minInd seps children
-printListWithSeps' _ _ _ _ _ [] _ = error "printListWithSeps': the number of elements and separators does not match"
+printListWithSeps' _ _ _ _ _ [] _ = pprProblem "printListWithSeps': the number of elements and separators does not match"

@@ -13,12 +13,13 @@   -- parts of the transformation, used for debugging purposes
   , rangeToSource, fixRanges, cutUpRanges, getLocIndices, mapLocIndices, fixMainRange, extractStayingElems
   , sourceTemplateMinimalIndent, srcTmpListMinimalIndent, srcTmpOptMinimalIndent
+  , TransformationProblem(..), BreakUpProblem(..)
   ) where
 
 import Language.Haskell.Tools.PrettyPrint.Prepare.PlaceComments (getNormalComments, getPragmaComments, placeComments)
-import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate ()
+import Language.Haskell.Tools.PrettyPrint.Prepare.RangeTemplate (TransformationProblem(..))
 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.RangeToRangeTemplate (cutUpRanges, fixRanges, BreakUpProblem(..))
 import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplate
 import Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplateHelpers
 

@@ -1,7 +1,4 @@-{-# LANGUAGE ScopedTypeVariables
-           , FlexibleContexts
-           , LambdaCase
-           #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, ScopedTypeVariables #-}
 -- | 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

@@ -1,17 +1,13 @@-{-# LANGUAGE TemplateHaskell
-           , DeriveDataTypeable
-           , RecordWildCards
-           , TypeFamilies
-           , FlexibleInstances
-           #-}
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, RecordWildCards, TypeFamilies #-}
 -- | 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.Exception (Exception, throw)
 import Control.Reference
-import Data.Data
+import Data.Data (Data)
 import Language.Haskell.Tools.AST
-import SrcLoc
+import SrcLoc (SrcSpan(..), RealSrcSpan)
 
 instance SourceInfo RngTemplateStage where
   data SpanInfo RngTemplateStage = RangeTemplateNode { _rngTemplateNodeRange :: RealSrcSpan
@@ -100,3 +96,11 @@ instance Show RangeTemplateElem where
   show (RangeElem sp) = shortShowSpan (RealSrcSpan sp)
   show RangeChildElem = "<.>"
+
+data TransformationProblem = TransformationProblem String
+  deriving Show
+
+instance Exception TransformationProblem
+
+trfProblem :: String -> a
+trfProblem = throw . TransformationProblem

@@ -1,6 +1,4 @@-{-# LANGUAGE LambdaCase
-           , FlexibleContexts
-           #-}
+{-# LANGUAGE 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
@@ -8,7 +6,7 @@ import Control.Monad.Identity
 import Control.Monad.State
 import Control.Reference
-import Data.List
+import Data.List as List
 import Data.List.Split (splitOn)
 import Data.Map as Map
 import Data.Ord (Ord(..), Ordering(..))
@@ -62,7 +60,7 @@      (\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
+         -> do (own, rest) <- List.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)))

@@ -1,13 +1,11 @@-{-# LANGUAGE ScopedTypeVariables
-           , LambdaCase
-           , FlexibleContexts
-           #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
 -- | 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
+module Language.Haskell.Tools.PrettyPrint.Prepare.RangeToRangeTemplate (cutUpRanges, fixRanges, BreakUpProblem(..)) where
 
 import Language.Haskell.Tools.AST
 
+import Control.Exception (Exception, throw)
 import Control.Monad.State
 import Control.Reference ((^.))
 import Data.List
@@ -49,9 +47,23 @@              -- 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"
+        breakFirstHit [] inner = throw $ BreakUpProblem sp inner sps
+cutOutElemSpan _ (NormNodeInfo (UnhelpfulSpan {}))
+  = trfProblem "cutOutElemSpan: no real span"
 
+data BreakUpProblem = BreakUpProblem { bupOuter :: RealSrcSpan
+                                     , bupInner :: SrcSpan
+                                     , bupSiblings :: [SrcSpan]
+                                     }
+
+instance Show BreakUpProblem where
+ show (BreakUpProblem _ (RealSrcSpan inner) _)
+   = unpackFS (srcSpanFile inner) ++ ": didn't find correct place for AST element at " ++ shortShowSpan (RealSrcSpan inner)
+ show (BreakUpProblem outer _ _)
+   = unpackFS (srcSpanFile outer) ++ ": didn't find correct place for AST element in " ++ shortShowSpan (RealSrcSpan outer)
+
+instance Exception BreakUpProblem
+
 cutOutElemList :: [SrcSpan] -> ListInfo NormRangeStage -> ListInfo RngTemplateStage
 cutOutElemList sps (NormListInfo bef aft sep indented sp)
   = let RealSrcSpan wholeRange = foldl1 combineSrcSpans $ sp : sps
@@ -126,5 +138,5 @@ checkSpans :: [SrcSpan] -> SrcSpan -> SrcSpan
 checkSpans spans res
   = if any (not . isGoodSrcSpan) spans && isGoodSrcSpan res
-      then error $ "Wrong src spans in " ++ show res
+      then trfProblem $ "Wrong src spans in " ++ show res
       else res

@@ -1,10 +1,4 @@-{-# LANGUAGE FlexibleInstances
-           , FlexibleContexts
-           , DeriveDataTypeable
-           , TemplateHaskell
-           , RecordWildCards
-           , TypeFamilies
-           #-}
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, RecordWildCards, TemplateHaskell, 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

@@ -1,7 +1,4 @@-{-# LANGUAGE OverloadedStrings
-           , FlexibleContexts
-           , FlexibleInstances
-           #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings #-}
 -- | Helper functions for working with source templates
 module Language.Haskell.Tools.PrettyPrint.Prepare.SourceTemplateHelpers where
 

@@ -1,17 +1,13 @@-{-# LANGUAGE NamedFieldPuns
-           , FlexibleContexts 
-           , LambdaCase
-           , DeriveFunctor
-           , StandaloneDeriving
-           #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, NamedFieldPuns, StandaloneDeriving #-}
 -- | A simpler representation of the original AST.
 module Language.Haskell.Tools.PrettyPrint.RoseTree where
 
+import Control.Exception (Exception(..), throw)
 import Control.Monad.State (Monad(..), execState, modify)
 import Language.Haskell.Tools.AST
 
--- | A rose tree containing additional node information         
-data RoseTree st = RoseTree { roseInfo :: RoseSourceInfo st 
+-- | A rose tree containing additional node information
+data RoseTree st = RoseTree { roseInfo :: RoseSourceInfo st
                             , roseChildren :: [RoseTree st]
                             }
 
@@ -27,16 +23,24 @@   show = show' 0
     where show' i RoseTree{roseInfo,roseChildren}
              = "\n" ++ replicate (2*i) '#'
-                    ++ show roseInfo 
+                    ++ show roseInfo
                     ++ concatMap (show' (i+1)) roseChildren
-                          
--- | Transforms the heterogeneous AST into a homogeneous representation for pretty printing                   
+
+-- | Transforms the heterogeneous AST into a homogeneous representation for pretty printing
 toRoseTree :: (SourceInfoTraversal n) => n dom st -> RoseTree st
-toRoseTree = (\case (root:_):_ -> root; _ -> error "toRoseTree: the result has no root") 
+toRoseTree = (\case (root:_):_ -> root; _ -> pprProblem "toRoseTree: the result has no root")
                 . tail . flip execState [[],[]] . toSrcRoseSt
   where toSrcRoseSt = sourceInfoTraverseUp (SourceInfoTrf (trf RoseSpan) (trf RoseList) (trf RoseOptional)) desc asc
-  
+
         desc  = modify ([]:)
         asc   = modify tail
         trf wrap inf = do modify (\(y : x : xs) -> [] : (RoseTree (wrap inf) (reverse y) : x) : xs)
                           return inf
+
+data PrettyPrintProblem = PrettyPrintProblem String
+  deriving Show
+
+instance Exception PrettyPrintProblem
+
+pprProblem :: String -> a
+pprProblem = throw . PrettyPrintProblem

@@ -1,5 +1,5 @@ name:                haskell-tools-prettyprint
-version:             0.9.0.0
+version:             1.0.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
@@ -22,13 +22,13 @@                      , 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
+  build-depends:       base              >= 4.10  && < 4.11
                      , mtl               >= 2.2  && < 2.3
                      , containers        >= 0.5  && < 0.6
                      , references        >= 0.3  && < 0.4
                      , uniplate          >= 1.6  && < 1.7
                      , split             >= 0.2  && < 0.3
                      , text              >= 1.2  && < 1.3
-                     , ghc               >= 8.0  && < 8.1
-                     , haskell-tools-ast >= 0.9  && < 0.10
+                     , ghc               >= 8.2  && < 8.3
+                     , haskell-tools-ast >= 1.0  && < 1.1
   default-language: Haskell2010