never executed always true always false

    1 {-# LANGUAGE RecordWildCards #-}
    2 
    3 module Conjure.ParserFuzz (tests) where
    4 
    5 -- conjure
    6 
    7 import Conjure.Prelude
    8 
    9 -- base
   10 
   11 -- tasty
   12 import Test.Tasty (TestTree, testGroup)
   13 import Test.Tasty.HUnit (assertFailure, testCaseSteps)
   14 
   15 import Conjure.Language.AST.ASTParser (runASTParser, parseProgram)
   16 import Conjure.Language.Lexer (runLexer, reformList)
   17 import qualified Data.Text as T (pack, unpack) 
   18 import qualified Data.Text.Lazy as L
   19 import Data.ByteString.Char8(hPutStrLn, pack)
   20 import Conjure.Language.AST.Reformer (flattenSeq)
   21 import Data.Algorithm.Diff (getGroupedDiff)
   22 import Data.Algorithm.DiffOutput (ppDiff)
   23 import GHC.IO.Handle.FD (stderr)
   24 import Shelly (run, shelly, silently)
   25 
   26 
   27 tests :: IO TestTree
   28 tests = do
   29     allFiles <-  shelly $ silently $ run  "git" ["ls-tree", "--full-tree",  "--name-only", "-r", "HEAD"] 
   30     let allFileList = lines $ T.unpack allFiles
   31     let testCases = testFile <$> allFileList
   32     return (testGroup "parse_fuzz" testCases)
   33 
   34 testFile :: FilePath -> TestTree
   35 testFile fp = testCaseSteps (map (\ch -> if ch == '/' then '.' else ch) fp) $ \step ->  do
   36     fd <- readFileIfExists fp
   37     step "Lexing"
   38     let usableFileData = concat (take 1000 . lines $ fromMaybe [] fd)
   39     let fText = T.pack usableFileData
   40     case runLexer fText (Just fp) of
   41       Left _le -> assertFailure $ "Lexer failed in:" ++ fp
   42       Right ets -> do
   43                 step "parsing"
   44                 case runASTParser parseProgram ets of
   45                   Left _pe -> assertFailure $ "Parser failed in:" ++ fp
   46                   Right pt -> do
   47                     step "RoundTripping"
   48                     let roundTrip = L.unpack $ reformList $ flattenSeq pt
   49                     unless (roundTrip == usableFileData) $ do
   50                         let diff = getGroupedDiff (lines roundTrip) (lines usableFileData)
   51                         Data.ByteString.Char8.hPutStrLn stderr $ Data.ByteString.Char8.pack $ "===DIFF: " ++ fp
   52                         Data.ByteString.Char8.hPutStrLn stderr $ Data.ByteString.Char8.pack $ ppDiff diff
   53                         Data.ByteString.Char8.hPutStrLn stderr "===------------"
   54                         assertFailure $ "Failed to rebuild :" ++ fp