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 117 118 119
|
{-# LANGUAGE RecordWildCards, ConstraintKinds #-}
module Test.Util(
assertBool, (#=),
matchY, matchN,
arity,
substitute, substituteErr,
stepNext,
getDirectory,
TestData(..), unsafeTestData,
FP.StepNext(..)
) where
import Control.Exception.Extra
import Control.Monad.Extra
import Data.List.Extra
import Data.IORef.Extra
import System.Directory
import System.FilePath
import System.FilePattern(FilePattern)
import qualified System.FilePattern as FP
import qualified System.FilePattern.Directory as FP
import System.IO.Extra
import System.IO.Unsafe
---------------------------------------------------------------------
-- COLLECT TEST DATA
data TestData = TestData
{testDataCases :: {-# UNPACK #-} !Int
,testDataPats :: [FilePattern]
,testDataPaths :: [FilePath]
}
{-# NOINLINE testData #-}
testData :: IORef TestData
testData = unsafePerformIO $ newIORef $ TestData 0 [] []
addTestData :: [FilePattern] -> [FilePath] -> IO ()
addTestData pats paths = atomicModifyIORef'_ testData f
where f TestData{..} = TestData (testDataCases+1) (reverse pats ++ testDataPats) (reverse paths ++ testDataPaths)
unsafeTestData :: IO TestData
unsafeTestData = atomicModifyIORef' testData $ \t -> (TestData 0 [] [], f t)
where f TestData{..} = TestData testDataCases (nubSort $ reverse testDataPats) (nubSort $ reverse testDataPaths)
---------------------------------------------------------------------
-- TEST UTILITIES
assertBool :: Partial => Bool -> String -> [String] -> IO ()
assertBool b msg fields = unless b $ error $ unlines $
("ASSERTION FAILED: " ++ msg) : fields
assertException :: (Show a, Partial) => IO a -> [String] -> String -> [String] -> IO ()
assertException a parts msg fields = do
res <- try_ $ evaluate . length . show =<< a
case res of
Left e -> assertBool (all (`isInfixOf` show e) parts) msg $ ["Expected" #= parts, "Got" #= e] ++ fields
Right _ -> assertBool False msg $ ["Expected" #= parts, "Got" #= "<No exception>"] ++ fields
(#=) :: Show a => String -> a -> String
(#=) a b = a ++ ": " ++ show b
---------------------------------------------------------------------
-- TEST WRAPPERS
match :: Partial => FilePattern -> FilePath -> Maybe [String] -> IO ()
match pat path want = do
addTestData [pat] [path]
let got = FP.match pat path
assertBool (want == got) "match" ["Pattern" #= pat, "Path" #= path, "Expected" #= want, "Got" #= got]
matchY :: Partial => FilePattern -> FilePath -> [String] -> IO ()
matchY pat path xs = match pat path $ Just xs
matchN :: Partial => FilePattern -> FilePath -> IO ()
matchN pat path = match pat path Nothing
arity :: Partial => FilePattern -> Int -> IO ()
arity pat want = do
addTestData [pat] []
let got = FP.arity pat
assertBool (want == got) "arity" ["Pattern" #= pat, "Expected" #= want, "Got" #= got]
substitute :: Partial => FilePattern -> [String] -> FilePath -> IO ()
substitute pat parts want = do
addTestData [pat] [want]
let got = FP.substitute pat parts
assertBool (want == got) "substitute" ["Pattern" #= pat, "Parts" #= parts, "Expected" #= want, "Got" #= got]
substituteErr :: Partial => FilePattern -> [String] -> [String] -> IO ()
substituteErr pat parts want = do
addTestData [pat] []
assertException (pure $ FP.substitute pat parts) want "substitute" ["Pattern" #= pat, "Parts" #= parts]
stepNext :: [FilePattern] -> [String] -> FP.StepNext -> IO ()
stepNext pat path want = do
addTestData pat []
let got = f (FP.step_ pat) path
assertBool (want == got) "stepNext" ["Pattern" #= pat, "Path" #= path, "Expected" #= want, "Got" #= got]
where
f FP.Step{..} [] = stepNext
f FP.Step{..} (x:xs) = f (stepApply x) xs
getDirectory :: [FilePattern] -> [FilePattern] -> [FilePath] -> [FilePath] -> IO ()
getDirectory match ignore want avoid =
withTempDir $ \root -> do
forM_ (want ++ avoid) $ \x -> do
createDirectoryIfMissing True $ root </> takeDirectory x
writeFile (root </> x) ""
got <- FP.getDirectoryFilesIgnore root match ignore
assertBool (want == got) "getDirectory" ["Root" #= root, "Match" #= match, "Ignore" #= ignore, "Want" #= want, "Got" #= got, "Avoid" #= avoid]
|