summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlanZimmerman <>2019-03-01 15:39:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-03-01 15:39:00 (GMT)
commitc5a4f67e2083afdb74d66c1f985def080409bf1f (patch)
treee5daee5d5ffb171deeb79de30a617b6ae3259e45
parent458b6745c5d7dca5de9f1d4f84f14c665417de58 (diff)
version 0.60.6
-rwxr-xr-xChangeLog7
-rw-r--r--ghc-exactprint.cabal14
-rw-r--r--src/Language/Haskell/GHC/ExactPrint/Transform.hs33
-rw-r--r--tests/Test/Transform.hs14
4 files changed, 43 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index 07f26f8..2d1d965 100755
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-01 v0.6
+ * Remove orphan MonadFail Identity instance
+ * MonadFail TransformT instance is defined unconditionally
+ * Generalise HasTransform (TransformT Identity) to
+ Monad m => HasTransform (TransformT m)
+ * Add hoistTransform function
+ The 0.6 changes are all thanks to @phadej
2018-10-27 v0.5.8.2
* Support GHC 8.4.4 by selecting correct source directory
2018-09-23 v0.5.8.1
diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal
index 6151e42..43fe923 100644
--- a/ghc-exactprint.cabal
+++ b/ghc-exactprint.cabal
@@ -1,5 +1,5 @@
name: ghc-exactprint
-version: 0.5.8.2
+version: 0.6
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
@@ -37,6 +37,8 @@ tested-with: GHC == 7.10.3
, GHC == 8.4.3
, GHC == 8.4.4
, GHC == 8.6.1
+ , GHC == 8.6.2
+ , GHC == 8.6.3
extra-source-files: ChangeLog
src-ghc710/Language/Haskell/GHC/ExactPrint/*.hs
tests/examples/failing/*.hs
@@ -90,7 +92,7 @@ library
-- other-modules:
-- other-extensions:
GHC-Options: -Wall
- build-depends: base >=4.7 && <4.13
+ build-depends: base >=4.8 && <4.13
, bytestring >= 0.10.6
, containers >= 0.5
, directory >= 1.2
@@ -100,6 +102,11 @@ library
, mtl >= 2.2.1
, syb >= 0.5
, free >= 4.12
+
+ if !impl (ghc >= 8.0)
+ build-depends:
+ fail >= 4.9 && <4.10
+
if impl (ghc >= 7.11)
build-depends: ghc-boot
hs-source-dirs: src
@@ -167,6 +174,9 @@ Test-Suite test
, silently >= 1.2
, filemanip >= 0.3
-- for the lib only
+ if !impl (ghc >= 8.0)
+ build-depends:
+ fail >= 4.9 && <4.10
if flag (dev)
build-depends: free
else
diff --git a/src/Language/Haskell/GHC/ExactPrint/Transform.hs b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
index cf9ae9d..bf5bdea 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Transform.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
@@ -23,7 +23,9 @@ module Language.Haskell.GHC.ExactPrint.Transform
-- * The Transform Monad
Transform
, TransformT(..)
+ , hoistTransform
, runTransform
+ , runTransformT
, runTransformFrom
, runTransformFromT
@@ -92,11 +94,8 @@ module Language.Haskell.GHC.ExactPrint.Transform
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils
-#if __GLASGOW_HASKELL__ > 804
-import Control.Monad.Fail
-#endif
import Control.Monad.RWS
-
+import qualified Control.Monad.Fail as Fail
import qualified Bag as GHC
import qualified FastString as GHC
@@ -124,36 +123,38 @@ import Control.Monad.Writer
type Transform = TransformT Identity
-- |Monad transformer version of 'Transform' monad
-newtype TransformT m a = TransformT { runTransformT :: RWST () [String] (Anns,Int) m a }
+newtype TransformT m a = TransformT { unTransformT :: RWST () [String] (Anns,Int) m a }
deriving (Monad,Applicative,Functor
,MonadReader ()
,MonadWriter [String]
,MonadState (Anns,Int)
,MonadTrans
-#if __GLASGOW_HASKELL__ > 804
- ,MonadFail
-#endif
)
-#if __GLASGOW_HASKELL__ > 804
-instance MonadFail Identity where
- fail x = Control.Monad.Fail.fail x
-#endif
+instance Fail.MonadFail m => Fail.MonadFail (TransformT m) where
+ fail msg = TransformT $ RWST $ \_ _ -> Fail.fail msg
-- | Run a transformation in the 'Transform' monad, returning the updated
-- annotations and any logging generated via 'logTr'
runTransform :: Anns -> Transform a -> (a,(Anns,Int),[String])
runTransform ans f = runTransformFrom 0 ans f
+runTransformT :: Anns -> TransformT m a -> m (a,(Anns,Int),[String])
+runTransformT ans f = runTransformFromT 0 ans f
+
-- | Run a transformation in the 'Transform' monad, returning the updated
-- annotations and any logging generated via 'logTr', allocating any new
-- SrcSpans from the provided initial value.
runTransformFrom :: Int -> Anns -> Transform a -> (a,(Anns,Int),[String])
-runTransformFrom seed ans f = runRWS (runTransformT f) () (ans,seed)
+runTransformFrom seed ans f = runRWS (unTransformT f) () (ans,seed)
-- |Run a monad transformer stack for the 'TransformT' monad transformer
runTransformFromT :: Int -> Anns -> TransformT m a -> m (a,(Anns,Int),[String])
-runTransformFromT seed ans f = runRWST (runTransformT f) () (ans,seed)
+runTransformFromT seed ans f = runRWST (unTransformT f) () (ans,seed)
+
+-- | Change inner monad of 'TransformT'.
+hoistTransform :: (forall x. m x -> n x) -> TransformT m a -> TransformT n a
+hoistTransform nt (TransformT m) = TransformT (mapRWST nt m)
-- |Log a string to the output of the Monad
logTr :: (Monad m) => String -> TransformT m ()
@@ -1296,8 +1297,8 @@ modifyValD p ast f = do
class (Monad m) => (HasTransform m) where
liftT :: Transform a -> m a
-instance HasTransform (TransformT Identity) where
- liftT = id
+instance Monad m => HasTransform (TransformT m) where
+ liftT = hoistTransform (return . runIdentity)
-- ---------------------------------------------------------------------
diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs
index c6bfb72..0eb3561 100644
--- a/tests/Test/Transform.hs
+++ b/tests/Test/Transform.hs
@@ -435,7 +435,7 @@ addLocaLDecl1 ans lp = do
return ((newDecl : d),Nothing)
replaceDecls lp [d1', d2]
- let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+ (lp',(ans',_),_w) <- runTransformT (mergeAnns ans declAnns') doAddLocal
-- putStrLn $ "log:\n" ++ intercalate "\n" _w
return (ans',lp')
@@ -523,7 +523,7 @@ addLocaLDecl5 ans lp = do
return ([d2],Nothing)
replaceDecls lp [s1,d1',d3]
- let (lp',(ans',_),_w) = runTransform ans doAddLocal
+ (lp',(ans',_),_w) <- runTransformT ans doAddLocal
-- putStrLn $ "log\n" ++ intercalate "\n" _w
return (ans',lp')
@@ -550,7 +550,7 @@ addLocaLDecl6 ans lp = do
return ((newDecl : decls),Nothing)
replaceDecls lp [d1', d2]
- let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+ (lp',(ans',_),_w) <- runTransformT (mergeAnns ans declAnns') doAddLocal
-- putStrLn $ "log:\n" ++ intercalate "\n" _w
return (ans',lp')
-- ---------------------------------------------------------------------
@@ -576,7 +576,7 @@ rmDecl1 ans lp = do
transferEntryDPT s1' (head ds') -- required in HaRe.
replaceDecls lp (d1':ds')
- let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ (lp',(ans',_),_w) <- runTransformT ans doRmDecl
return (ans',lp')
-- ---------------------------------------------------------------------
@@ -613,7 +613,7 @@ rmDecl3 ans lp = do
replaceDecls lp [d1',sd1,d2]
- let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ (lp',(ans',_),_w) <- runTransformT ans doRmDecl
-- putStrLn $ "log:\n" ++ intercalate "\n" _w
return (ans',lp')
@@ -635,7 +635,7 @@ rmDecl4 ans lp = do
replaceDecls lp [d1',sd1]
- let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ (lp',(ans',_),_w) <- runTransformT ans doRmDecl
return (ans',lp')
-- ---------------------------------------------------------------------
@@ -688,7 +688,7 @@ rmDecl6 ans lp = do
replaceDecls lp [d1']
- let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ (lp',(ans',_),_w) <- runTransformT ans doRmDecl
-- putStrLn $ "log:" ++ intercalate "\n" _w
return (ans',lp')