use prettyString instead of (show . pretty)

anoma · Apr 11, 2024 · 9ca7cb4 · 9ca7cb4
1 parent b472e8c
commit 9ca7cb4
Show file tree

Hide file tree

Showing 21 changed files with 51 additions and 47 deletions.
diff --git a/src/Juvix/Prelude/Pretty.hs b/src/Juvix/Prelude/Pretty.hs
@@ -11,6 +11,7 @@ import Data.Text qualified as Text
 import Juvix.Prelude.Base
 import Prettyprinter hiding (concatWith, defaultLayoutOptions, hsep, sep, vsep)
 import Prettyprinter qualified as PP
+import Prettyprinter.Render.String (renderString)
 import Prettyprinter.Render.Terminal (AnsiStyle)
 import Prettyprinter.Render.Terminal qualified as Ansi
 import Prettyprinter.Render.Text (renderStrict)
@@ -139,6 +140,9 @@ trimText =
 toPlainTextTrim :: (HasTextBackend a) => a -> Text
 toPlainTextTrim = trimText . toPlainText
 
+prettyString :: (Pretty a) => a -> String
+prettyString = renderString . layoutPretty defaultLayoutOptions . pretty
+
 prettyText :: (Pretty a) => a -> Text
 prettyText = Text.renderStrict . layoutPretty defaultLayoutOptions . pretty
 

diff --git a/test/Asm/Run/Base.hs b/test/Asm/Run/Base.hs
@@ -15,7 +15,7 @@ runAssertion hout sym tab = do
   case r' of
     Left err -> do
       hClose hout
-      assertFailure (show (pretty err))
+      assertFailure (prettyString err)
     Right value' -> do
       case value' of
         ValVoid -> return ()
@@ -28,7 +28,7 @@ asmRunAssertionParam' :: (Handle -> Symbol -> InfoTable -> IO ()) -> InfoTable -
 asmRunAssertionParam' interpretFun tab expectedFile step = do
   step "Validate"
   case validate' tab of
-    Just err -> assertFailure (show (pretty err))
+    Just err -> assertFailure (prettyString err)
     Nothing ->
       case tab ^. infoMainFunction of
         Just sym -> do
@@ -54,10 +54,10 @@ asmRunAssertionParam interpretFun mainFile expectedFile trans testTrans step = d
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tab0 -> do
       case trans tab0 of
-        Left err -> assertFailure (show (pretty err))
+        Left err -> assertFailure (prettyString err)
         Right tab -> do
           testTrans tab
           asmRunAssertionParam' interpretFun tab expectedFile step

diff --git a/test/BackendGeb/Eval/Base.hs b/test/BackendGeb/Eval/Base.hs
@@ -13,7 +13,7 @@ gebEvalAssertion mainFile expectedFile step = do
   step "Parse"
   input_ <- readFile mainFile
   case Geb.runParser mainFile input_ of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (Geb.ExpressionObject _) -> do
       step "No evaluation for objects"
       assertFailure (unpack Geb.objNoEvalMsg)
@@ -47,7 +47,7 @@ gebEvalAssertion' _mainFile expectedFile step gebMorphism = do
       case result of
         Left err -> do
           hClose hout
-          assertFailure (show (pretty (fromJuvixError @GenericError err)))
+          assertFailure (prettyString (fromJuvixError @GenericError err))
         Right value -> do
           hPutStrLn hout (Geb.ppPrint value)
           hClose hout

diff --git a/test/BackendGeb/FromCore/Base.hs b/test/BackendGeb/FromCore/Base.hs
@@ -19,7 +19,7 @@ coreToGebTranslationAssertion root mainFile expectedFile step = do
   input_ <- readFile mainFile
   entryPoint <- set entryPointTarget (Just TargetGeb) <$> testDefaultEntryPointIO root mainFile
   case Core.runParserMain mainFile defaultModuleId mempty input_ of
-    Left err -> assertFailure . show . pretty $ err
+    Left err -> assertFailure . prettyString $ err
     Right coreInfoTable -> coreToGebTranslationAssertion' coreInfoTable entryPoint expectedFile step
 
 coreToGebTranslationAssertion' ::
@@ -32,7 +32,7 @@ coreToGebTranslationAssertion' coreInfoTable entryPoint expectedFile step = do
   step "Prepare the Juvix Core node for translation to Geb"
   case run . runReader entryPoint . runError @Geb.JuvixError $ Core.toGeb (Core.moduleFromInfoTable coreInfoTable) of
     Left err ->
-      assertFailure . show . pretty $
+      assertFailure . prettyString $
         fromJuvixError @GenericError err
     Right readyCoreModule ->
       let readyCoreInfoTable = Core.computeCombinedInfoTable readyCoreModule
@@ -47,7 +47,7 @@ coreToGebTranslationAssertion' coreInfoTable entryPoint expectedFile step = do
                     }
             case run . runError @Geb.CheckingError $ Geb.check' typeMorph of
               Left err ->
-                assertFailure . show . pretty $
+                assertFailure . prettyString $
                   fromJuvixError @GenericError (JuvixError err)
               Right _ -> do
                 step "Try evaluating the JuvixCore node"
@@ -59,11 +59,11 @@ coreToGebTranslationAssertion' coreInfoTable entryPoint expectedFile step = do
                      ) of
                   (Left err, _) -> do
                     step "The evaluation of the translated Geb node failed"
-                    assertFailure . show . pretty $
+                    assertFailure . prettyString $
                       fromJuvixError @GenericError (JuvixError err)
                   (_, Left err) -> do
                     step "The evaluation of gebCoreEvalResult failed"
-                    assertFailure . show . pretty $ fromJuvixError @GenericError (JuvixError err)
+                    assertFailure . prettyString $ fromJuvixError @GenericError (JuvixError err)
                   ( Right resEvalTranslatedMorph,
                     Right resEvalGebCoreEvalResult
                     ) -> do
@@ -82,7 +82,7 @@ coreToGebTranslationAssertion' coreInfoTable entryPoint expectedFile step = do
                                                 <> "node is not equal to the expected output"
                                         | otherwise -> assertBool "" True
                               case Geb.runParser expectedFile expectedInput of
-                                Left parseErr -> assertFailure . show . pretty $ parseErr
+                                Left parseErr -> assertFailure . prettyString $ parseErr
                                 Right (Geb.ExpressionMorphism m) -> compareEvalOutput m
                                 Right (Geb.ExpressionTypedMorphism m) -> compareEvalOutput (m ^. Geb.typedMorphism)
                                 Right (Geb.ExpressionObject _) ->

diff --git a/test/Casm/Compilation/Base.hs b/test/Casm/Compilation/Base.hs
@@ -34,7 +34,7 @@ compileAssertionEntry adjustEntry root' bRunVM optLevel mainFile expectedFile st
   step "Translate to CASM"
   let entryPoint' = entryPoint {_entryPointOptimizationLevel = optLevel}
   case run $ runError @JuvixError $ runReader entryPoint' $ storedCoreToCasm (_pipelineResult ^. Core.coreResultModule) of
-    Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+    Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right Result {..} -> do
       withTempDir'
         ( \dirPath -> do

diff --git a/test/Casm/Reg/Base.hs b/test/Casm/Reg/Base.hs
@@ -14,7 +14,7 @@ compileAssertion' :: Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> S
 compileAssertion' inputFile _ outputFile _ tab step = do
   step "Translate to CASM"
   case run $ runError @JuvixError $ regToCasm tab of
-    Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+    Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right Result {..} -> do
       step "Interpret"
       hout <- openFile (toFilePath outputFile) WriteMode
@@ -31,7 +31,7 @@ cairoAssertion' :: Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> Sym
 cairoAssertion' inputFile dirPath outputFile _ tab step = do
   step "Translate to Cairo"
   case run $ runError @JuvixError $ regToCairo tab of
-    Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+    Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right res -> do
       step "Serialize to Cairo bytecode"
       encodeFile (toFilePath outputFile) res

diff --git a/test/Casm/Run/Base.hs b/test/Casm/Run/Base.hs
@@ -39,7 +39,7 @@ casmRunAssertion' :: Bool -> LabelInfo -> Code -> Maybe (Path Abs File) -> Path
 casmRunAssertion' bRunVM labi instrs inputFile expectedFile step =
   case validate labi instrs of
     Left err -> do
-      assertFailure (show (pretty err))
+      assertFailure (prettyString err)
     Right () -> do
       withTempDir'
         ( \dirPath -> do
@@ -50,7 +50,7 @@ casmRunAssertion' bRunVM labi instrs inputFile expectedFile step =
             case r' of
               Left err -> do
                 hClose hout
-                assertFailure (show (pretty err))
+                assertFailure (prettyString err)
               Right value' -> do
                 hPrint hout value'
                 hClose hout
@@ -67,7 +67,7 @@ casmRunAssertion bRunVM mainFile inputFile expectedFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (labi, instrs) -> casmRunAssertion' bRunVM labi instrs inputFile expectedFile step
 
 casmRunErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion

diff --git a/test/Core/Asm/Base.hs b/test/Core/Asm/Base.hs
@@ -46,15 +46,15 @@ coreAsmAssertion mainFile expectedFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> do
       step "Empty program: compare expected and actual program output"
       expected <- readFile expectedFile
       assertEqDiffText ("Check: EVAL output = " <> toFilePath expectedFile) "" expected
     Right (tabIni, Just node) -> do
       step "Translate"
       case run $ runReader defaultCoreOptions $ runError $ toStored' >=> toStripped' Identity $ moduleFromInfoTable $ setupMainFunction defaultModuleId tabIni node of
-        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+        Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right m -> do
           let tab = Asm.fromTree $ Tree.fromCore $ Stripped.fromCore (maximum allowedFieldSizes) $ computeCombinedInfoTable m
           Asm.asmRunAssertion' tab expectedFile step
diff --git a/test/Core/Compile/Base.hs b/test/Core/Compile/Base.hs
@@ -51,7 +51,7 @@ coreCompileAssertion' ::
 coreCompileAssertion' optLevel tab mainFile expectedFile stdinText step = do
   step "Translate to JuvixAsm"
   case run . runReader opts . runError $ toStored' (moduleFromInfoTable tab) >>= toStripped' CheckExec of
-    Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+    Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right m -> do
       let tab0 = computeCombinedInfoTable m
       assertBool "Check info table" (checkInfoTable tab0)
@@ -71,7 +71,7 @@ coreCompileAssertion mainFile expectedFile stdinText step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> do
       step "Empty program: compare expected and actual program output"
       expected <- readFile expectedFile

diff --git a/test/Core/Eval/Base.hs b/test/Core/Eval/Base.hs
@@ -70,7 +70,7 @@ coreEvalAssertion' mode tab mainFile expectedFile step =
                   case r' of
                     Left err -> do
                       hClose hout
-                      assertFailure (show (pretty err))
+                      assertFailure (prettyString err)
                     Right value -> do
                       unless
                         (Info.member kNoDisplayInfo (getInfo value))
@@ -143,14 +143,14 @@ coreEvalAssertion mainFile expectedFile trans testTrans step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> do
       step "Compare expected and actual program output"
       expected <- readFile expectedFile
       assertEqDiffText ("Check: EVAL output = " <> toFilePath expectedFile) "" expected
     Right (tabIni, Just node) ->
       case run $ runReader defaultCoreOptions $ runError $ applyTransformations trans $ moduleFromInfoTable $ setupMainFunction defaultModuleId tabIni node of
-        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+        Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right m -> do
           let tab = computeCombinedInfoTable m
           assertBool "Check info table" (checkInfoTable tab)

diff --git a/test/Core/Normalize/Base.hs b/test/Core/Normalize/Base.hs
@@ -19,14 +19,14 @@ coreNormalizeAssertion mainFile expectedFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> assertFailure "Empty program"
     Right (tabIni, Just node) -> do
       step "Transform"
       let tab = setupMainFunction defaultModuleId tabIni node
           transforms = toStoredTransformations ++ toNormalizeTransformations
       case run $ runReader defaultCoreOptions $ runError @JuvixError $ applyTransformations transforms (moduleFromInfoTable tab) of
-        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+        Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right m -> do
           step "Normalize"
           let tab' = computeCombinedInfoTable m

diff --git a/test/Core/Print/Base.hs b/test/Core/Print/Base.hs
@@ -39,7 +39,7 @@ corePrintAssertion mainFile expectedFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> do
       step "Empty program: compare expected and actual program output"
       expected <- readFile expectedFile
@@ -50,5 +50,5 @@ corePrintAssertion mainFile expectedFile step = do
       step "Print and parse back"
       let r' = runParserMain mainFile defaultModuleId mempty (ppPrint tab)
       case r' of
-        Left err -> assertFailure (show (pretty err))
+        Left err -> assertFailure (prettyString err)
         Right tab' -> coreEvalAssertion' EvalModePlain tab' mainFile expectedFile step
diff --git a/test/Core/VampIR/Base.hs b/test/Core/VampIR/Base.hs
@@ -18,7 +18,7 @@ coreVampIRAssertion transforms mainFile expectedFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right (_, Nothing) -> assertFailure "Empty program"
     Right (tabIni, Just node) -> do
       coreVampIRAssertion' (setupMainFunction defaultModuleId tabIni node) transforms mainFile expectedFile step
@@ -34,7 +34,7 @@ coreVampIRAssertion' tab transforms mainFile expectedFile step = do
   step "Transform and normalize"
   case run . runReader defaultCoreOptions . runError @JuvixError $
     applyTransformations transforms (moduleFromInfoTable tab) of
-    Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+    Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
     Right m -> do
       let tab' = computeCombinedInfoTable m
       step "Check let-hoisted"

diff --git a/test/Internal/Eval/Base.hs b/test/Internal/Eval/Base.hs
@@ -29,7 +29,7 @@ internalCoreAssertion root' mainFile expectedFile step = do
             case r' of
               Left err -> do
                 hClose hout
-                assertFailure (show (pretty err))
+                assertFailure (prettyString err)
               Right value -> do
                 unless
                   (Info.member kNoDisplayInfo (getInfo value))

diff --git a/test/Nockma/Parse/Positive.hs b/test/Nockma/Parse/Positive.hs
@@ -42,7 +42,7 @@ testDescr PosTest {..} =
 
 assertParse :: Text -> IO (Term Natural)
 assertParse txt = case parseText txt of
-  Left (MegaparsecError b) -> assertFailure ("Nockma parsing failed " <> unpack (prettyText (errorBundlePretty b)))
+  Left (MegaparsecError b) -> assertFailure ("Nockma parsing failed " <> prettyString (errorBundlePretty b))
   Right t -> return t
 
 allTests :: TestTree

diff --git a/test/Reg/Parse/Base.hs b/test/Reg/Parse/Base.hs
@@ -11,7 +11,7 @@ regParseAssertion mainFile step = do
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tab -> do
       withTempDir'
         ( \dirPath -> do
@@ -21,7 +21,7 @@ regParseAssertion mainFile step = do
             step "Parse printed"
             r' <- parseFile outputFile
             case r' of
-              Left err -> assertFailure (show (pretty err))
+              Left err -> assertFailure (prettyString err)
               Right tab' -> do
                 assertBool ("Check: print . parse = print . parse . print . parse") (ppPrint tab tab == ppPrint tab' tab')
         )

diff --git a/test/Reg/Run/Base.hs b/test/Reg/Run/Base.hs
@@ -17,7 +17,7 @@ runAssertion _ outputFile sym tab step = do
   case r' of
     Left err -> do
       hClose hout
-      assertFailure (show (pretty err))
+      assertFailure (prettyString err)
     Right value' -> do
       case value' of
         ValVoid ->
@@ -52,12 +52,12 @@ regRunAssertionParam interpretFun mainFile expectedFile trans testTrans step = d
   step "Parse"
   r <- parseFile mainFile
   case r of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tab0 -> do
       unless (null trans) $
         step "Transform"
       case run $ runError @JuvixError $ applyTransformations trans tab0 of
-        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+        Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right tab -> do
           testTrans tab
           regRunAssertionParam' interpretFun tab expectedFile step

diff --git a/test/Tree/Asm/Base.hs b/test/Tree/Asm/Base.hs
@@ -15,7 +15,7 @@ treeAsmAssertion mainFile expectedFile step = do
   step "Parse"
   s <- readFile mainFile
   case runParser mainFile s of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tabIni -> do
       step "Translate"
       let tab = Asm.fromTree tabIni

diff --git a/test/Tree/Eval/Base.hs b/test/Tree/Eval/Base.hs
@@ -33,16 +33,16 @@ treeEvalAssertionParam evalParam mainFile expectedFile trans testTrans step = do
   step "Parse"
   s <- readFile mainFile
   case runParser mainFile s of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tab0 -> do
       step "Validate"
       case run $ runError @JuvixError $ applyTransformations [Validate] tab0 of
-        Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+        Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right tab1 -> do
           unless (null trans) $
             step "Transform"
           case run $ runError @JuvixError $ applyTransformations trans tab1 of
-            Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
+            Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
             Right tab -> do
               testTrans tab
               case tab ^. infoMainFunction of
@@ -67,7 +67,7 @@ evalAssertion hout sym tab = do
   case r' of
     Left err -> do
       hClose hout
-      assertFailure (show (pretty err))
+      assertFailure (prettyString err)
     Right value' -> do
       case value' of
         ValVoid -> return ()
@@ -85,7 +85,7 @@ treeEvalErrorAssertion mainFile step = do
   step "Parse"
   s <- readFile mainFile
   case runParser mainFile s of
-    Left err -> assertFailure (show (pretty err))
+    Left err -> assertFailure (prettyString err)
     Right tab ->
       case tab ^. infoMainFunction of
         Just sym -> do