summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlanZimmerman <>2018-08-11 11:48:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-08-11 11:48:00 (GMT)
commit50239cf5b883b43136a02d2524e5091ce4b0ca61 (patch)
tree99c44d07be13ff3afae6f871374f7c6648de1d1b
parentacc46b7da4e695bf357c5fb5f311382686c1d105 (diff)
version 0.5.7.10.5.7.1
-rw-r--r--ChangeLog2
-rw-r--r--ghc-exactprint.cabal4
-rw-r--r--src/Language/Haskell/GHC/ExactPrint/Transform.hs12
-rw-r--r--tests/Test/CommonUtils.hs130
4 files changed, 145 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index fcbb025..a4af6d8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,5 @@
+2018-08-11 v0.5.7.0
+ * Include support for GHC 8.6.1 beta 1
2018-07-11 v0.5.7.0
* Include support for GHC 8.6.1 alpha 1
2018-03-11 v0.5.6.1
diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal
index 19efc7c..c0c6488 100644
--- a/ghc-exactprint.cabal
+++ b/ghc-exactprint.cabal
@@ -1,5 +1,5 @@
name: ghc-exactprint
-version: 0.5.7.0
+version: 0.5.7.1
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
@@ -172,6 +172,8 @@ executable roundtrip
main-is: Roundtrip.hs
hs-source-dirs: tests
other-modules: Test.Common
+ Test.CommonUtils
+ Test.Consistency
default-language: Haskell2010
if impl (ghc >= 7.10.2) && flag (roundtrip)
build-depends:
diff --git a/src/Language/Haskell/GHC/ExactPrint/Transform.hs b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
index c9ee237..cf9ae9d 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Transform.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
@@ -92,6 +92,9 @@ 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
@@ -108,7 +111,6 @@ import Data.Maybe
import qualified Data.Map as Map
import Data.Functor.Identity
--- import Control.Monad.Identity
import Control.Monad.State
import Control.Monad.Writer
@@ -128,9 +130,15 @@ newtype TransformT m a = TransformT { runTransformT :: RWST () [String] (Anns,In
,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
-- | Run a transformation in the 'Transform' monad, returning the updated
-- annotations and any logging generated via 'logTr'
diff --git a/tests/Test/CommonUtils.hs b/tests/Test/CommonUtils.hs
new file mode 100644
index 0000000..20f6565
--- /dev/null
+++ b/tests/Test/CommonUtils.hs
@@ -0,0 +1,130 @@
+module Test.CommonUtils
+ (
+ findSrcFiles
+ , readFileGhc
+
+ -- * File paths and directories
+ , hackageWorkDir
+ , workDir
+ , configDir
+ , failuresDir
+ , failuresHtmlDir
+ , cppFile
+ , parseFailFile
+ , processed
+ , processedFailFile
+ , logFile
+ , origFailuresFile
+ , badpackagesFile
+ , blackListed
+ , knownFailuresFile
+ , failuresHtmlFile
+ ) where
+
+import Data.List hiding (find)
+import System.FilePath
+import System.FilePath.Find
+import qualified StringBuffer as GHC
+
+-- ---------------------------------------------------------------------
+
+-- | Round trip working dir holding current hackage contents, can be deleted
+hackageWorkDir :: FilePath
+hackageWorkDir = "./hackage-roundtrip-work"
+
+-- ---------------------------------------------------------------------
+
+-- | Round trip working dir, can be deleted
+workDir :: FilePath
+workDir = "./roundtrip-work"
+
+-- | Round trip configuration dir, keept under version control
+configDir :: FilePath
+configDir = "./roundtrip-config"
+
+-- |Directory where results of failing tests are stored for later analysis
+failuresDir :: FilePath
+failuresDir = workDir </> "failures"
+
+-- |Directory where results of failing tests are provided in html format
+failuresHtmlDir :: FilePath
+failuresHtmlDir = workDir </> "html"
+
+-- |Generated:files known to fail due to CPP parse failures, caused by an Exception
+cppFile :: FilePath
+cppFile = workDir </> "cpp.txt"
+
+-- |Generated:files returning ParseFail status
+parseFailFile :: FilePath
+parseFailFile = workDir </> "pfail.txt"
+
+-- |Generated:files successfully processed
+processed :: FilePath
+processed = workDir </> "processed.txt"
+
+-- |Generated:files which failed comparison
+processedFailFile :: FilePath
+processedFailFile = workDir </> "failed.txt"
+
+-- |log of current file being processed, for knowing what to blacklist
+logFile :: FilePath
+logFile = workDir </> "roundtrip.log"
+
+-- |list of original failures, when rerunning tests after static processing
+origFailuresFile :: FilePath
+origFailuresFile = workDir </> "origfailures.txt"
+
+-- |name of index html page
+failuresHtmlFile :: FilePath
+failuresHtmlFile = "failures.html"
+
+-- -- |location and name of index html page
+-- failuresHtmlFile :: FilePath
+-- failuresHtmlFile = failuresHtmlDir </> "failures.html"
+
+-- ---------------------------------------------------------------------
+
+-- |Hand edited list of files known to segfault
+badpackagesFile :: FilePath
+badpackagesFile = configDir </> "badpackages.txt"
+
+-- |Hand edited list of files known to segfault
+blackListed :: FilePath
+blackListed = configDir </> "blacklist.txt"
+
+-- |Hand edited list of files known to fail, no fix required/possible
+knownFailuresFile :: FilePath
+knownFailuresFile = configDir </> "knownfailures.txt"
+
+-- ---------------------------------------------------------------------
+
+-- Given base directory finds all haskell source files
+findSrcFiles :: FilePath -> IO [FilePath]
+findSrcFiles = find filterDirectory filterFilename
+
+filterDirectory :: FindClause Bool
+filterDirectory =
+ p <$> fileName
+ where
+ p x
+ | "." `isPrefixOf` x = False
+ | otherwise = True
+
+filterFilename :: FindClause Bool
+filterFilename = do
+ ext <- extension
+ fname <- fileName
+ return (ext == ".hs" && p fname)
+ where
+ p x
+ | "refactored" `isInfixOf` x = False
+ | "Setup.hs" `isInfixOf` x = False
+ | "HLint.hs" `isInfixOf` x = False -- HLint config files
+ | otherwise = True
+
+-- ---------------------------------------------------------------------
+
+readFileGhc :: FilePath -> IO String
+readFileGhc file = do
+ buf@(GHC.StringBuffer _ len _) <- GHC.hGetStringBuffer file
+ return (GHC.lexemeToString buf len)