haskell-tools-prettyprint 0.1.2.0 → 0.1.3.0

raw patch · 3 files changed

+46/−35 lines, 3 filesdep −structural-traversaldep ~haskell-tools-astdep ~haskell-tools-ast-trfPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: structural-traversal

Dependency ranges changed: haskell-tools-ast, haskell-tools-ast-trf

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/PrettyPrint.hs +25/−23
• Language/Haskell/Tools/PrettyPrint/RoseTree.hs +18/−8
• haskell-tools-prettyprint.cabal +3/−4

@@ -19,41 +19,43 @@ import Data.Maybe
 import Data.List.Split
 import Data.Foldable
-import Data.StructuralTraversal
 import Data.Sequence hiding (null, replicate)
+import Language.Haskell.Tools.AST
 
 -- | Pretty prints an AST by using source templates stored as node info
-prettyPrint :: (StructuralTraversable node) => node (NodeInfo sema SourceTemplate) -> String
+prettyPrint :: (SourceInfoTraversal node) => node dom SrcTemplateStage -> String
 prettyPrint = toList . printRose . toRoseTree
 
-printRose :: RoseTree (NodeInfo sema SourceTemplate) -> Seq Char      
-printRose rt = evalState (printRose' $ fmap (^. sourceInfo&sourceTemplateElems) rt) (mkRealSrcLoc (fsLit "") 1 1)
+printRose :: RoseTree SrcTemplateStage -> Seq Char      
+printRose rt = evalState (printRose' rt) (mkRealSrcLoc (fsLit "") 1 1)
        
 type PPState = State RealSrcLoc
-       
+
 -- | Pretty prints a rose tree according to the source templates remaining from the original AST
-printRose' :: RoseTree [SourceTemplateElem] -> PPState (Seq Char)
+printRose' :: RoseTree SrcTemplateStage -> PPState (Seq Char)
 -- simple implementation could be optimized a bit
 -- warning: the length of the file should not exceed maxbound::Int
-printRose' (RoseTree (TextElem txt : rest) children) 
-  = putString txt >+< printRose' (RoseTree rest children) 
-printRose' (RoseTree (ChildElem : rest) (child : children)) 
-  = printRose' child >+< printRose' (RoseTree rest children) 
+printRose' (RoseTree (RoseSpan (SourceTemplateNode _ elems)) children) 
+  = printTemplateElems elems children
+  where printTemplateElems :: [SourceTemplateElem] -> [RoseTree SrcTemplateStage] -> PPState (Seq Char)
+        printTemplateElems (TextElem txt : rest) children = putString txt >+< printTemplateElems rest children
+        printTemplateElems (ChildElem : rest) (child : children) = printRose' 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 ++ ")"
   
-printRose' (RoseTree [ChildListElem {}] []) = return empty
-printRose' (RoseTree [ChildListElem bef aft defSep indented []] children) 
+printRose' (RoseTree (RoseList (SourceTemplateList {})) []) = return empty
+printRose' (RoseTree (RoseList (SourceTemplateList _ bef aft defSep indented [])) children) 
   = putString bef >+< (if indented then printListWithSepsIndented else printListWithSeps) (repeat defSep) children >+< putString aft
-printRose' (RoseTree [ChildListElem bef aft _ indented seps] children) 
+printRose' (RoseTree (RoseList (SourceTemplateList _ bef aft _ indented seps)) children) 
   = putString bef >+< (if indented then printListWithSepsIndented else printListWithSeps) (seps ++ repeat (last seps)) children >+< putString aft
       
-printRose' (RoseTree [OptionalChildElem _ _] []) = return empty
-printRose' (RoseTree [OptionalChildElem bef aft] [child]) = putString bef >+< printRose' child >+< putString aft
-printRose' (RoseTree [OptionalChildElem _ _] _) = error "More than one child element in an optional node."
-printRose' (RoseTree [] []) = return empty 
-printRose' r@(RoseTree (ChildElem : rest) []) = error ("More child elem in template than actual children. In: " ++ show r)
-printRose' r@(RoseTree [] children) = error ("Not all children are used to pretty printing. In: " ++ show r) 
-printRose' r = error ("printRose': unexpected input: " ++ show r) 
+printRose' (RoseTree (RoseOptional (SourceTemplateOpt {})) []) = return empty
+printRose' (RoseTree (RoseOptional (SourceTemplateOpt _ bef aft)) [child]) = putString bef >+< printRose' child >+< putString aft
+printRose' (RoseTree (RoseOptional _) _) = error "More than one child element in an optional node."
     
+
+
 putString :: String -> PPState (Seq Char)
 putString s = do modify $ advanceStr s
                  return (fromList s)
@@ -80,10 +82,10 @@ (>+<) :: PPState (Seq Char) -> PPState (Seq Char) -> PPState (Seq Char)
 (>+<) = liftM2 (><)
     
-printListWithSeps :: [String] -> [RoseTree [SourceTemplateElem]] -> PPState (Seq Char)
+printListWithSeps :: [String] -> [RoseTree SrcTemplateStage] -> PPState (Seq Char)
 printListWithSeps = printListWithSeps' putString
 
-printListWithSepsIndented :: [String] -> [RoseTree [SourceTemplateElem]] -> PPState (Seq Char)
+printListWithSepsIndented :: [String] -> [RoseTree SrcTemplateStage] -> PPState (Seq Char)
 printListWithSepsIndented seps children
   = do base <- get
        let putCorrectSep s = do curr <- get
@@ -91,7 +93,7 @@                                 putString $ shortened ++ replicate (srcLocCol base - currCol) ' '
        printListWithSeps' putCorrectSep seps children
     
-printListWithSeps' :: (String -> PPState (Seq Char)) -> [String] -> [RoseTree [SourceTemplateElem]] -> PPState (Seq Char)
+printListWithSeps' :: (String -> PPState (Seq Char)) -> [String] -> [RoseTree SrcTemplateStage] -> PPState (Seq Char)
 printListWithSeps' _ _ [] = return empty
 printListWithSeps' putCorrectSep _ [child] = printRose' child
 printListWithSeps' putCorrectSep (sep:seps) (child:children) 

@@ -1,19 +1,28 @@ {-# LANGUAGE NamedFieldPuns
            , FlexibleContexts 
            , DeriveFunctor
+           , StandaloneDeriving
            #-}
 -- | A simpler representation of the original AST.
 module Language.Haskell.Tools.PrettyPrint.RoseTree where
 
 import Control.Monad.State
-import Data.StructuralTraversal
+import Language.Haskell.Tools.AST
 
 -- | A rose tree containing additional node information         
-data RoseTree a = RoseTree { roseInfo :: a 
-                           , roseChildren :: [RoseTree a]
-                           } deriving Functor
+data RoseTree st = RoseTree { roseInfo :: RoseSourceInfo st 
+                            , roseChildren :: [RoseTree st]
+                            }
 
-instance Show a => Show (RoseTree a) where
+-- | Heterogenous representation of source information, for pretty printing
+data RoseSourceInfo st
+  = RoseSpan (SpanInfo st)
+  | RoseList (ListInfo st)
+  | RoseOptional (OptionalInfo st)
+
+deriving instance SourceInfo st => Show (RoseSourceInfo st)
+
+instance SourceInfo st => Show (RoseTree st) where
   show = show' 0
     where show' i RoseTree{roseInfo,roseChildren}
              = "\n" ++ replicate (2*i) '#'
@@ -21,10 +30,11 @@                     ++ concatMap (show' (i+1)) roseChildren
                           
 -- | Transforms the heterogeneous AST into a homogeneous representation for pretty printing                   
-toRoseTree :: (StructuralTraversable n) => n inf -> RoseTree inf
+toRoseTree :: (SourceInfoTraversal n) => n dom st -> RoseTree st
 toRoseTree = head . head . tail . flip execState [[],[]] . toSrcRoseSt
-  where toSrcRoseSt = traverseUp desc asc f
+  where toSrcRoseSt = sourceInfoTraverseUp (SourceInfoTrf (trf RoseSpan) (trf RoseList) (trf RoseOptional)) desc asc
   
         desc  = modify ([]:)
         asc   = modify tail
-        f inf = modify (\(y : x : xs) -> [] : (RoseTree inf (reverse y) : x) : xs)
+        trf wrap inf = do modify (\(y : x : xs) -> [] : (RoseTree (wrap inf) (reverse y) : x) : xs)
+                          return inf

@@ -1,5 +1,5 @@ name:                haskell-tools-prettyprint
-version:             0.1.2.0
+version:             0.1.3.0
 synopsis:            Pretty printing of Haskell-Tools AST
 description:         Converts the Haskell-Tools AST to the original source text. 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
@@ -19,8 +19,7 @@                      , mtl                   >=2.2   && <2.3
                      , containers            >=0.5   && <0.6
                      , references            >=0.3.2 && <1.0
-                     , structural-traversal  >=0.1   && <0.2
-                     , haskell-tools-ast     >=0.1   && <1.0
-                     , haskell-tools-ast-trf >=0.1   && <1.0
+                     , haskell-tools-ast     >=0.1.3 && <1.0
+                     , haskell-tools-ast-trf >=0.1.3 && <1.0
                      , split                 >=0.2   && <1.0
   default-language:    Haskell2010