blob: f43b6b5695da5bb29d42bd1b992eb80b7c299906 (
plain)
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
|
module Language.Haskell.Stylish.Tests.Util
( testStep
, withTestDirTree
) where
--------------------------------------------------------------------------------
import Control.Exception (bracket, try)
import System.Directory (createDirectory,
getCurrentDirectory,
getTemporaryDirectory,
removeDirectoryRecursive,
setCurrentDirectory)
import System.FilePath ((</>))
import System.IO.Error (isAlreadyExistsError)
import System.Random (randomIO)
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Parse
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'
where
ls = lines str
--------------------------------------------------------------------------------
-- | 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)
|
