summaryrefslogtreecommitdiffhomepage
path: root/tests/Language/Haskell/Stylish/Tests/Util.hs
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2020-10-02 13:08:39 +0200
committerJasper Van der Jeugt <m@jaspervdj.be>2020-10-02 13:08:39 +0200
commit250e7091edd93ce5a476706ddd968ef3ec1ef336 (patch)
tree98c1a37f8f7adf031b317f820428184c084b9b49 /tests/Language/Haskell/Stylish/Tests/Util.hs
parentce3feb1db9a0e7998a66c9dfdc7aebd9bae79477 (diff)
downloadstylish-haskell-250e7091edd93ce5a476706ddd968ef3ec1ef336.tar.gz
Use ghc-lib-parser rather than haskell-src-exts
This patch swaps out the parsing library from `haskell-src-exts` to `ghc-lib-parser`, which gives us better compatibility with GHC. Because almost every module heavily used the Haskell AST provided by `haskell-src-exts`, this was a huge effort and it would not have been possible without Felix Mulder doing an initial port, GSoC student Beatrice Vergani porting several other steps, and Łukasz Gołębiewski and Paweł Szulc who helped me finish up things in the home stretch. I've generally tried to keep styling 100% compatible with what was there before, but some issues may have unintentionally slipped in so please report those. This introduces one new import styling contributed by Felix: when wrapping import lists over multiple lines, you can repeat the module name, e.g.: import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither) import Control.Monad.Except as X (runExceptT, withExceptT) This is activated by using `import_align: repeat`. Secondly, a new Step was added, `module_header`, which formats the export list of a module, including the trailing `where` clause. Details for this new step can be found in the `data/stylish-haskell.yaml`. Co-Authored-By: Beatrice Vergani <beatrice.vergani11@gmail.com> Co-Authored-By: Paweł Szulc <paul.szulc@gmail.com> Co-Authored-By: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com> Co-Authored-By: Felix Mulder <felix.mulder@klarna.com>
Diffstat (limited to 'tests/Language/Haskell/Stylish/Tests/Util.hs')
-rw-r--r--tests/Language/Haskell/Stylish/Tests/Util.hs61
1 files changed, 58 insertions, 3 deletions
diff --git a/tests/Language/Haskell/Stylish/Tests/Util.hs b/tests/Language/Haskell/Stylish/Tests/Util.hs
index f43b6b5..b3d200f 100644
--- a/tests/Language/Haskell/Stylish/Tests/Util.hs
+++ b/tests/Language/Haskell/Stylish/Tests/Util.hs
@@ -1,11 +1,21 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeFamilies #-}
module Language.Haskell.Stylish.Tests.Util
( testStep
+ , testStep'
+ , Snippet (..)
+ , testSnippet
+ , assertSnippet
, withTestDirTree
+ , (@=??)
) where
--------------------------------------------------------------------------------
import Control.Exception (bracket, try)
+import Control.Monad.Writer (execWriter, tell)
+import Data.List (intercalate)
+import GHC.Exts (IsList (..))
import System.Directory (createDirectory,
getCurrentDirectory,
getTemporaryDirectory,
@@ -14,6 +24,8 @@ import System.Directory (createDirectory,
import System.FilePath ((</>))
import System.IO.Error (isAlreadyExistsError)
import System.Random (randomIO)
+import Test.HUnit (Assertion, assertFailure,
+ (@=?))
--------------------------------------------------------------------------------
@@ -23,14 +35,45 @@ import Language.Haskell.Stylish.Step
--------------------------------------------------------------------------------
testStep :: Step -> String -> String
-testStep step str = case parseModule [] Nothing str of
- Left err -> error err
- Right module' -> unlines $ stepFilter step ls module'
+testStep s str = case s of
+ Step _ step ->
+ case parseModule [] Nothing str of
+ Left err -> error err
+ Right module' -> unlines $ step ls module'
where
ls = lines str
--------------------------------------------------------------------------------
+testStep' :: Step -> Lines -> Lines
+testStep' s ls = lines $ testStep s (unlines ls)
+
+
+--------------------------------------------------------------------------------
+-- | 'Lines' that show as a normal string.
+newtype Snippet = Snippet {unSnippet :: Lines} deriving (Eq)
+
+-- Prefix with one newline since so HUnit will use a newline after `got: ` or
+-- `expected: `.
+instance Show Snippet where show = unlines . ("" :) . unSnippet
+
+instance IsList Snippet where
+ type Item Snippet = String
+ fromList = Snippet
+ toList = unSnippet
+
+
+--------------------------------------------------------------------------------
+testSnippet :: Step -> Snippet -> Snippet
+testSnippet s = Snippet . lines . testStep s . unlines . unSnippet
+
+
+--------------------------------------------------------------------------------
+assertSnippet :: Step -> Snippet -> Snippet -> Assertion
+assertSnippet step input expected = expected @=? testSnippet step input
+
+
+--------------------------------------------------------------------------------
-- | Create a temporary directory with a randomised name built from the template
-- provided
createTempDirectory :: String -> IO FilePath
@@ -59,3 +102,15 @@ withTestDirTree action = bracket
setCurrentDirectory current *>
removeDirectoryRecursive temp)
(\(_, temp) -> setCurrentDirectory temp *> action)
+
+(@=??) :: Lines -> Lines -> Assertion
+expected @=?? actual =
+ if expected == actual then pure ()
+ else assertFailure $ intercalate "\n" $ execWriter do
+ tell ["Expected:"]
+ printLines expected
+ tell ["Got:"]
+ printLines actual
+ where
+ printLines =
+ mapM_ \line -> tell [" " <> line]