ghc-exactprint 0.5.4.0 → 0.5.5.0

raw patch · 7 files changed

+81/−33 lines, 7 filesdep ~ghc-exactprintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-exactprint

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• ghc-exactprint.cabal +2/−2
• src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs +7/−5
• src/Language/Haskell/GHC/ExactPrint/Transform.hs +24/−24
• tests/Test.hs +2/−2
• tests/examples/transform/Brittany1.hs +22/−0
• tests/examples/transform/Brittany1.hs.expected +22/−0

@@ -1,3 +1,5 @@+2017-07-23 v0.5.5.0+	* Support GHC 8.2.1 2017-05-17 v0.5.4.0 	* Support GHC 8.2 (rc2) 2017-05-05 v0.5.3.1

@@ -1,5 +1,5 @@ name:                ghc-exactprint-version:             0.5.4.0+version:             0.5.5.0 synopsis:            ExactPrint for GHC description:         Using the API Annotations available from GHC 7.10.2, this                      library provides a means to round trip any code that can@@ -146,7 +146,7 @@   if flag (dev)       build-depends: free   else-      build-depends: ghc-exactprint >= 0.5.3+      build-depends: ghc-exactprint >= 0.5.4    if impl (ghc >= 7.11)       build-depends: ghc-boot

@@ -979,8 +979,8 @@    markAST _ (GHC.Match mln pats _typ (GHC.GRHSs grhs (GHC.L _ lb))) = do     let-      get_infix (GHC.FunRhs _ f) = f-      get_infix _                = GHC.Prefix+      get_infix (GHC.FunRhs _ f _) = f+      get_infix _                  = GHC.Prefix        isFunBind GHC.FunRhs{} = True       isFunBind _            = False@@ -991,7 +991,7 @@           else mark         GHC.AnnOpenP         markLocated a         case mln of-          GHC.FunRhs n _ -> setContext (Set.singleton InfixOp) $ markLocated n+          GHC.FunRhs n _ _ -> setContext (Set.singleton InfixOp) $ markLocated n           _              -> return ()         markLocated b         if null xs@@ -1002,8 +1002,10 @@         annotationsToComments [GHC.AnnOpenP,GHC.AnnCloseP]         inContext (Set.fromList [LambdaExpr]) $ do mark GHC.AnnLam -- For HsLam         case mln of-          GHC.FunRhs n _ -> do-            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ markLocated n+          GHC.FunRhs n _ s -> do+            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ do+              when (s == GHC.SrcStrict) $ mark GHC.AnnBang+              markLocated n             mapM_ markLocated pats           _  -> markListNoPrecedingSpace False pats 

@@ -127,7 +127,7 @@                          ,MonadReader ()                          ,MonadWriter [String]                          ,MonadState (Anns,Int)-                         -- ,MonadTrans+                         ,MonadTrans                          )  @@ -179,7 +179,7 @@ -- |Once we have 'Anns', a 'GHC.SrcSpan' is used purely as part of an 'AnnKey' -- to index into the 'Anns'. If we need to add new elements to the AST, they -- need their own 'GHC.SrcSpan' for this.-uniqueSrcSpanT :: Transform GHC.SrcSpan+uniqueSrcSpanT :: (Monad m) => TransformT m GHC.SrcSpan uniqueSrcSpanT = do   (an,col) <- get   put (an,col + 1 )@@ -193,12 +193,12 @@ -- --------------------------------------------------------------------- -- |Make a copy of an AST element, replacing the existing SrcSpans with new -- ones, and duplicating the matching annotations.-cloneT :: (Data a) => a -> Transform (a, [(GHC.SrcSpan, GHC.SrcSpan)])+cloneT :: (Data a,Monad m) => a -> TransformT m (a, [(GHC.SrcSpan, GHC.SrcSpan)]) cloneT ast = do   runWriterT $ SYB.everywhereM (return `SYB.ext2M` replaceLocated) ast   where-    replaceLocated :: forall loc a. (Typeable loc,Data a)-                    => (GHC.GenLocated loc a) -> WriterT [(GHC.SrcSpan, GHC.SrcSpan)] Transform (GHC.GenLocated loc a)+    replaceLocated :: forall loc a m. (Typeable loc,Data a,Monad m)+                    => (GHC.GenLocated loc a) -> WriterT [(GHC.SrcSpan, GHC.SrcSpan)] (TransformT m) (GHC.GenLocated loc a)     replaceLocated (GHC.L l t) = do       case cast l :: Maybe GHC.SrcSpan of         Just ss -> do@@ -212,11 +212,11 @@  -- --------------------------------------------------------------------- -- |Slightly more general form of cloneT-graftT :: (Data a) => Anns -> a -> Transform a+graftT :: (Data a,Monad m) => Anns -> a -> TransformT m a graftT origAnns = SYB.everywhereM (return `SYB.ext2M` replaceLocated)   where-    replaceLocated :: forall loc a. (Typeable loc, Data a)-                    => GHC.GenLocated loc a -> Transform (GHC.GenLocated loc a)+    replaceLocated :: forall loc a m. (Typeable loc, Data a, Monad m)+                    => GHC.GenLocated loc a -> TransformT m (GHC.GenLocated loc a)     replaceLocated (GHC.L l t) = do       case cast l :: Maybe GHC.SrcSpan of         Just ss -> do@@ -276,7 +276,7 @@  -- |Create a simple 'Annotation' without comments, and attach it to the first -- parameter.-addSimpleAnnT :: (Data a) => GHC.Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> Transform ()+addSimpleAnnT :: (Data a,Monad m) => GHC.Located a -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m () addSimpleAnnT ast dp kds = do   let ann = annNone { annEntryDelta = dp                     , annsDP = kds@@ -286,21 +286,21 @@ -- ---------------------------------------------------------------------  -- |Add a trailing comma annotation, unless there is already one-addTrailingCommaT :: (Data a) => GHC.Located a -> Transform ()+addTrailingCommaT :: (Data a,Monad m) => GHC.Located a -> TransformT m () addTrailingCommaT ast = do   modifyAnnsT (addTrailingComma ast (DP (0,0)))  -- ---------------------------------------------------------------------  -- |Remove a trailing comma annotation, if there is one one-removeTrailingCommaT :: (Data a) => GHC.Located a -> Transform ()+removeTrailingCommaT :: (Data a,Monad m) => GHC.Located a -> TransformT m () removeTrailingCommaT ast = do   modifyAnnsT (removeTrailingComma ast)  -- ---------------------------------------------------------------------  -- |'Transform' monad version of 'getEntryDP'-getEntryDPT :: (Data a) => GHC.Located a -> Transform DeltaPos+getEntryDPT :: (Data a,Monad m) => GHC.Located a -> TransformT m DeltaPos getEntryDPT ast = do   anns <- getAnnsT   return (getEntryDP anns ast)@@ -308,28 +308,28 @@ -- ---------------------------------------------------------------------  -- |'Transform' monad version of 'getEntryDP'-setEntryDPT :: (Data a) => GHC.Located a -> DeltaPos -> Transform ()+setEntryDPT :: (Data a,Monad m) => GHC.Located a -> DeltaPos -> TransformT m () setEntryDPT ast dp = do   modifyAnnsT (setEntryDP ast dp)  -- ---------------------------------------------------------------------  -- |'Transform' monad version of 'transferEntryDP'-transferEntryDPT :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()+transferEntryDPT :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m () transferEntryDPT a b =   modifyAnnsT (transferEntryDP a b)  -- ---------------------------------------------------------------------  -- |'Transform' monad version of 'setPrecedingLinesDecl'-setPrecedingLinesDeclT ::  GHC.LHsDecl GHC.RdrName -> Int -> Int -> Transform ()+setPrecedingLinesDeclT :: (Monad m) => GHC.LHsDecl GHC.RdrName -> Int -> Int -> TransformT m () setPrecedingLinesDeclT ld n c =   modifyAnnsT (setPrecedingLinesDecl ld n c)  -- ---------------------------------------------------------------------  -- |'Transform' monad version of 'setPrecedingLines'-setPrecedingLinesT ::  (SYB.Data a) => GHC.Located a -> Int -> Int -> Transform ()+setPrecedingLinesT ::  (SYB.Data a,Monad m) => GHC.Located a -> Int -> Int -> TransformT m () setPrecedingLinesT ld n c =   modifyAnnsT (setPrecedingLines ld n c) @@ -452,7 +452,7 @@ -- from the second one to the 'annFollowingComments' of the first if they belong -- to it instead. This is typically required before deleting or duplicating -- either of the AST elements.-balanceComments :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()+balanceComments :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m () balanceComments first second = do   -- ++AZ++ : replace the nested casts with appropriate SYB.gmapM   -- logTr $ "balanceComments entered"@@ -469,7 +469,7 @@ -- it are attached to it, and not the following element. Of necessity this is a -- heuristic process, to be tuned later. Possibly a variant should be provided -- with a passed-in decision function.-balanceComments' :: (Data a,Data b) => GHC.Located a -> GHC.Located b -> Transform ()+balanceComments' :: (Data a,Data b,Monad m) => GHC.Located a -> GHC.Located b -> TransformT m () balanceComments' first second = do   let     k1 = mkAnnKey first@@ -492,7 +492,7 @@ -- |Once 'balanceComments' has been called to move trailing comments to a -- 'GHC.FunBind', these need to be pushed down from the top level to the last -- 'GHC.Match' if that 'GHC.Match' needs to be manipulated.-balanceCommentsFB :: (Data b) => GHC.LHsBind GHC.RdrName -> GHC.Located b -> Transform ()+balanceCommentsFB :: (Data b,Monad m) => GHC.LHsBind GHC.RdrName -> GHC.Located b -> TransformT m () #if __GLASGOW_HASKELL__ <= 710 balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) second = do #else@@ -894,7 +894,7 @@ -- the general case and one specific for a 'GHC.LHsBind'. This is required -- because a 'GHC.FunBind' may have multiple 'GHC.Match' items, so we cannot -- gurantee that 'replaceDecls' after 'hsDecls' is idempotent.-hasDeclsSybTransform :: (SYB.Data t2, Monad m)+hasDeclsSybTransform :: (SYB.Data t2,Monad m)        => (forall t. HasDecls t => t -> m t)              -- ^Worker function for the general case        -> (GHC.LHsBind GHC.RdrName -> m (GHC.LHsBind GHC.RdrName))@@ -938,7 +938,7 @@ -- return anything for these as there is not meaningful 'replaceDecls' for it. -- This function provides a version of 'hsDecls' that returns the 'GHC.FunBind' -- decls too, where they are needed for analysis only.-hsDeclsGeneric :: (SYB.Data t) => t -> Transform [GHC.LHsDecl GHC.RdrName]+hsDeclsGeneric :: (SYB.Data t,Monad m) => t -> TransformT m [GHC.LHsDecl GHC.RdrName] hsDeclsGeneric t = q t   where     q = return []@@ -961,7 +961,7 @@      -- --------------------------------- -    lhsbind :: GHC.LHsBind GHC.RdrName -> Transform [GHC.LHsDecl GHC.RdrName]+    lhsbind :: (Monad m) => GHC.LHsBind GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName] #if __GLASGOW_HASKELL__ <= 710     lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = do #else@@ -980,12 +980,12 @@      -- --------------------------------- -    llocalbinds :: GHC.Located (GHC.HsLocalBinds GHC.RdrName) -> Transform [GHC.LHsDecl GHC.RdrName]+    llocalbinds :: (Monad m) => GHC.Located (GHC.HsLocalBinds GHC.RdrName) -> TransformT m [GHC.LHsDecl GHC.RdrName]     llocalbinds (GHC.L _ ds) = localbinds ds      -- --------------------------------- -    localbinds :: GHC.HsLocalBinds GHC.RdrName -> Transform [GHC.LHsDecl GHC.RdrName]+    localbinds :: (Monad m) => GHC.HsLocalBinds GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]     localbinds d = hsDeclsValBinds d  -- ---------------------------------------------------------------------

@@ -183,13 +183,13 @@ tt' :: IO (Counts,Int) tt' = runTestText (putTextToHandle stdout True) $ TestList [ -      mkPrettyRoundtrip "ghc80" "Zwaluw.hs"+      -- mkPrettyRoundtrip "ghc80" "Zwaluw.hs"       -- mkPrettyRoundtrip "ghc80" "pmc007.hs"       -- mkPrettyRoundtrip "ghc80" "MultiQuote.hs"       -- mkPrettyRoundtrip "ghc80" "T10689a.hs"       -- mkPrettyRoundtrip "ghc710" "Ann01.hs" -      , mkParserTest "ghc80" "Zwaluw.hs"+       mkParserTest "ghc82" "T13594.hs"       -- mkParserTest "ghc80" "SemicolonIf.hs"       -- mkParserTest "ghc80" "T10689a.hs"       -- mkParserTest "ghc80" "MonadT.hs"

@@ -0,0 +1,22 @@++-- From https://github.com/alanz/ghc-exactprint/issues/53#issuecomment-306839162++blah = func+  where+--                       status   standard   previous+--                       quo      layouting  /associated+--                                rule only  ast item+ func =+  -- mercury             (1, 1)   (1,1)      (1,1)+    [+        -- venus         (1, 7)   (1, 7)     (1, 7) or (1, 2) if connected to "foo x"+      foo x+         -- earth        (1, 8)   (1, 8)     (1, 3)+     |   y <- z+       -- pluto          (1, -2)  (1, 6)     (1, -2)+      -- saturn          (1, -3)  (1, 5)     (1, -3)+     ,    x <- y+           -- jupiter    (1, 2)   (1, 10)    (1, 1)+     ,      pred x+  -- nepturn             (1, 1)   (1, 1)     (1, -10)+      ]

@@ -0,0 +1,22 @@++-- From https://github.com/alanz/ghc-exactprint/issues/53#issuecomment-306839162++blah = func+  where+--                       status   standard   previous+--                       quo      layouting  /associated+--                                rule only  ast item+ func =+  -- mercury             (1, 1)   (1,1)      (1,1)+    [+        -- venus         (1, 7)   (1, 7)     (1, 7) or (1, 2) if connected to "foo x"+      foo x+         -- earth        (1, 8)   (1, 8)     (1, 3)+     |   y <- z+       -- pluto          (1, -2)  (1, 6)     (1, -2)+      -- saturn          (1, -3)  (1, 5)     (1, -3)+     ,    x <- y+           -- jupiter    (1, 2)   (1, 10)    (1, 1)+     ,      pred x+  -- nepturn             (1, 1)   (1, 1)     (1, -10)+      ]