1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
{-# 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,
removeDirectoryRecursive,
setCurrentDirectory)
import System.FilePath ((</>))
import System.IO.Error (isAlreadyExistsError)
import System.Random (randomIO)
import Test.HUnit (Assertion, assertFailure,
(@=?))
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Parse
import Language.Haskell.Stylish.Step
--------------------------------------------------------------------------------
testStep :: Step -> String -> String
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
createTempDirectory template = do
tmpRootDir <- getTemporaryDirectory
dirId <- randomIO :: IO Word
findTempName tmpRootDir dirId
where
findTempName :: FilePath -> Word -> IO FilePath
findTempName tmpRootDir x = do
let dirpath = tmpRootDir </> template ++ show x
r <- try $ createDirectory dirpath
case r of
Right _ -> return dirpath
Left e | isAlreadyExistsError e -> findTempName tmpRootDir (x+1)
| otherwise -> ioError e
--------------------------------------------------------------------------------
-- | Perform an action inside a temporary directory tree and purge the tree
-- afterwards
withTestDirTree :: IO a -> IO a
withTestDirTree action = bracket
((,) <$> getCurrentDirectory <*> createTempDirectory "stylish_haskell")
(\(current, temp) ->
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]
|
