PyF-0.8.0.1: test/SpecFail.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}

import Test.Hspec
import Test.HUnit.Lang

import System.Process (readProcessWithExitCode)
import System.Exit

import qualified Data.Text as Text
 
import System.IO.Temp
import qualified System.IO as IO

import Data.Hashable
import System.FilePath
import Control.Exception
import Control.DeepSeq

-- * Check compilation with external GHC (this is usefull to test compilation failure)

data CompilationStatus
  = CompileError String -- ^ Fails during compilation (with error)
  | RuntimeError String
  | Ok String
  deriving (Show, Eq)

makeTemplate :: String -> String
makeTemplate s = "{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, TypeApplications #-}\nimport PyF\ntruncate' = truncate @Float @Int\nhello = \"hello\"\nnumber = 3.14 :: Float\nmain :: IO ()\nmain = putStrLn [fmt|" ++ s ++ "|]\n"

{- | Compile a formatting string

>>> checkCompile fileContent
CompileError "Bla bla bla, Floating cannot be formatted as hexa (`x`)
-}
checkCompile :: HasCallStack => String -> IO CompilationStatus
checkCompile content = withSystemTempFile "PyFTest.hs" $ \path fd -> do
  IO.hPutStr fd content
  IO.hFlush fd

  (ecode, _stdout, stderr) <- readProcessWithExitCode "ghc" [path,
                                                             -- Include all PyF files
                                                             "-isrc",
                                                             -- Disable the usage of the annoying .ghc environment file
                                                             "-package-env", "-",
                                                            -- Tests use a filename in a temporary directory which may have a long filename which triggers
                                                            -- line wrapping, reducing the reproducibility of error message
                                                            -- By setting the column size to a high value, we ensure reproducible error messages
                                                             "-dppr-cols=10000000000000"
                                                            ] ""
  case ecode of
    ExitFailure _ -> pure (CompileError (sanitize path stderr))
    ExitSuccess -> do
      (ecode', stdout', stderr') <- readProcessWithExitCode (take (length path - 3) path) [] ""

      case ecode' of
        ExitFailure _ -> pure (RuntimeError stderr')
        ExitSuccess -> pure (Ok stdout')

-- sanitize a compilation result by removing variables strings such as
-- temporary files name
sanitize :: FilePath -> String -> String
sanitize path s =
  -- strip the filename
  let
    t = Text.pack s
  in Text.unpack (Text.replace (Text.pack path) (Text.pack "INITIALPATH") t) 

golden :: HasCallStack => String -> String -> IO ()
golden name output = do
  let
    goldenFile = "test/golden" </> (name <> ".golden")
    actualFile = "test/golden" </> (name <> ".actual")

  -- It can fail if the golden file does not exists
  goldenContentE :: Either SomeException String <- try $ readFile goldenFile

  let
    -- if no golden file, the golden file is the content
    goldenContent = case goldenContentE of
      Right e -> e
      Left _ -> output

  -- Flush lazy IO
  _ <- evaluate (force goldenContent)

  if output /= goldenContent
    then do
      writeFile actualFile output
      (_, diffOutput, _) <- readProcessWithExitCode "diff" [goldenFile, actualFile] ""

      putStrLn diffOutput

      -- Update golden file
      writeFile goldenFile output

      assertFailure diffOutput
    else do
      writeFile goldenFile output


-- if the compilation fails, runs a golden test on compilation output
-- else, fails the test
fileFailCompile :: HasCallStack => FilePath -> Spec
fileFailCompile path = do
  fileContent <- runIO $ readFile path

  -- I'm using the hash of the path, considering that the file content can evolve
  failCompileContent (hash path) path fileContent

failCompile :: HasCallStack => String -> Spec
failCompile s = failCompileContent (hash s) s (makeTemplate s)

failCompileContent :: HasCallStack => Int -> String -> String -> Spec
failCompileContent h caption fileContent = do
  before (checkCompile fileContent) $ it (show caption) $ \res -> case res of
   CompileError output -> golden (show h) output
   _ -> assertFailure (show $ ".golden/" <> show h  <> "\n" <>show res)

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "error reporting" $ do
    describe "string" $ do
      describe "integral / fractional qualifiers" $ do
        failCompile "{hello:f}"
        failCompile "{hello:d}"
        failCompile "{hello:e}"
        failCompile "{hello:b}"
        failCompile "{hello:E}"
        failCompile "{hello:G}"
        failCompile "{hello:g}"
        failCompile "{hello:%}"
        failCompile "{hello:x}"
        failCompile "{hello:X}"
        failCompile "{hello:o}"

      describe "padding center" $ do
        failCompile "{hello:=100s}"
        failCompile "{hello:=100}"

      describe "grouping" $ do
        failCompile "{hello:_s}"
        failCompile "{hello:,s}"

      describe "sign" $ do
        failCompile "{hello:+s}"
        failCompile "{hello: s}"
        failCompile "{hello:-s}"

    describe "number" $ do
      failCompile "{truncate' number:f}"
      failCompile "{truncate' number:g}"
      failCompile "{truncate' number:G}"
      failCompile "{truncate' number:e}"
      failCompile "{truncate' number:E}"
      failCompile "{truncate' number:%}"
      failCompile "{truncate number:s}"

    describe "number with precision" $ do
      failCompile "{truncate number:.3d}"
      failCompile "{truncate number:.3o}"
      failCompile "{truncate number:.3b}"
      failCompile "{truncate number:.3x}"

    describe "floats" $ do
      failCompile "{number:o}"
      failCompile "{number:b}"
      failCompile "{number:x}"
      failCompile "{number:X}"
      failCompile "{number:d}"
      failCompile "{number:s}"

    -- XXX: this are not failing for now, it should be fixed
    xdescribe "not specified" $ do
      failCompile "{truncate number:.3}"
      failCompile "{hello:#}"
      failCompile "{hello:+}"
      failCompile "{hello: }"
      failCompile "{hello:-}"
      failCompile "{hello:_}"
      failCompile "{hello:,}"

    describe "multiples lines" $ do
      failCompile "hello\n\n\n{pi:l}"

    describe "on haskell expression parsing" $ do
      describe "single line" $ do
        failCompile "{1 + - / lalalal}"
      describe "multiples lines" $ do
        failCompile "hello\n    {\nlet a = 5\n    b = 10\nin 1 + - / lalalal}"

    describe "non-doubled delimiters" $ do
      failCompile "hello } world"
      failCompile "hello { world"

    describe "fail is not enabled extension" $ do
      failCompile "{0b0001}"

    describe "lexical errors" $ do
      failCompile "foo\\Pbar"

    describe "fileFailures" $ do
      mapM_ fileFailCompile [
        "test/failureCases/bug18.hs"
        ]

    describe "Wrong type" $ do
      failCompile "{True:s}"
      failCompile "{True}"
      failCompile "{True:f}"
      failCompile "{True:d}"