@@ -1,14 +1,11 @@
11module Main where
22
33import Control.Monad
4+import Data.Char (isLetter)
45import Data.Typeable
56import Data.Proxy
67import Data.List
7−import Data.Map.Strict as Map
8−import Data.IntSet as ISet
9−import Data.IntMap as IMap
10−import qualified Data.ByteString as BS
11−import qualified Data.ByteString.Char8 as BSC
8+import qualified Data.IntMap as IMap
129
1310import System.Directory
1411import System.Environment
@@ -19,7 +16,6 @@ import System.FilePath ((</>))
1916import Options.Applicative
2017import Test.Tasty
2118import Test.Tasty.Golden
22−import Test.Tasty.Golden.Advanced
2319import Test.Tasty.Runners
2420import Test.Tasty.Options
2521import Test.Tasty.Ingredients.Rerun
@@ -51,7 +47,7 @@ instance IsOption NodeOpt where
5147 parseValue = fmap NodeOpt . safeRead
5248 optionName = return nodeArg
5349 optionHelp = return nodeHelp
54− optionCLParser = fmap NodeOpt $ switch (long nodeArg <> help nodeHelp)
50+ optionCLParser = NodeOpt <$> switch (long nodeArg <> help nodeHelp)
5551
5652ingredients :: [Ingredient]
5753ingredients = defaultIngredients ++
@@ -63,43 +59,16 @@ ingredients = defaultIngredients ++
6359-- Compare a given file contents against the golden file contents
6460-- A ripoff of goldenVsFile from Tasty.Golden
6561test :: String -> String -> IO () -> TestTree
66−test name path act =
67− goldenTest name (readFile ref) (act >> readFile new) cmp upd
68− where
69− ref = path </> "expected"
70− new = path </> "output"
71− cmp x y = return $ if normalize x == normalize y then Nothing
72− else Just $ printDiff (ref, x) (new, y)
73− upd = writeFile ref
74− -- just pretend that backslashes are slashes for comparison
75− -- purposes to avoid path problems, so don't write any tests
76− -- that depend on that distinction in other contexts.
77− -- Also compare CRLF and LF as equal, fixes a weird corner case
78− -- on Mac where basic010 and reg039 produces CRLF
79− normalize [] = []
80− normalize ('\r':'\n':xs) = '\n' : normalize xs
81− normalize ('\\':'\\':xs) = '/' : normalize xs
82− normalize ('\\':xs) = '/' : normalize xs
83− normalize (x : xs) = x : normalize xs
84−
85−
86−-- Takes the filepath and content of `expected` and `output`
87−-- and formats an error message stating their difference
88−printDiff :: (String, String) -> (String, String) -> String
89−printDiff (ref, x) (new, y) =
90− let printContent cnt =
91− if Data.List.null cnt
92− then " is empty...\n"
93− else " is: \n" ++ unlines (fmap ((++) " ") (lines cnt))
94− in
95− "Test mismatch!\n" ++
96− "Golden file " ++ ref ++ printContent x ++
97− "However, " ++ new ++ printContent y
62+test testName path = goldenVsFileDiff testName diff ref output
63+ where
64+ ref = path </> "expected"
65+ output = path </> "output"
66+ diff ref new = ["diff", "--strip-trailing-cr", "-u", new, ref]
9867
9968-- Should always output a 3-charater string from a postive Int
10069indexToString :: Int -> String
10170indexToString index = let str = show index in
102− (replicate (3 - length str) '0') ++ str
71+ replicate (3 - length str) '0' ++ str
10372
10473-- Turns the collection of TestFamily into actual tests usable by Tasty
10574mkGoldenTests :: [TestFamily] -> Flags -> TestTree
@@ -124,10 +93,15 @@ runTest path flags = do
12493 let run = (proc "bash" ("run" : flags)) {cwd = Just path,
12594 std_out = CreatePipe}
12695 (_, output, _) <- readCreateProcessWithExitCode run ""
127− writeFile (path </> "output") output
96+ writeFile (path </> "output") (normalise output)
97+ where
98+ -- Normalise paths e.g. ".\foo.idr" to "./foo.idr".
99+ normalise ('.' : '\\' : c : xs) | isLetter c = '.' : '/' : c : normalise xs
100+ normalise (x : xs) = x : normalise xs
101+ normalise [] = []
128102
129103main :: IO ()
130−main = do
104+main =
131105 defaultMainWithIngredients ingredients $
132106 askOption $ \(NodeOpt node) ->
133107 let (codegen, flags) = if node then (JS, ["--codegen", "node"])