anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2024-10-05 20:47:36 +03:00
Code Issues Projects Releases Wiki Activity

Use prettyString instead of show . pretty (#2711)

Browse Source 
Use `prettyString` instead of relying on `Show` instance for `Doc a` so
that it is more consistent with `prettyText`.
This commit is contained in:
Jan Mas Rovira 2024-04-12 10:26:54 +02:00 committed by GitHub
parent b472e8cdcd
commit e0ae356cd7
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
21 changed files with 51 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Juvix/Prelude/Pretty.hs
View File

@ -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

8
test/Asm/Run/Base.hs
View File

@ -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

4
test/BackendGeb/Eval/Base.hs
View File

@ -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

12
test/BackendGeb/FromCore/Base.hs
View File

@ -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 _) ->

2
test/Casm/Compilation/Base.hs
View File

@ -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

4
test/Casm/Reg/Base.hs
View File

@ -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

6
test/Casm/Run/Base.hs
View File

@ -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

4
test/Core/Asm/Base.hs
View File

@ -46,7 +46,7 @@ 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
@ -54,7 +54,7 @@ coreAsmAssertion mainFile expectedFile step = do
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

4
test/Core/Compile/Base.hs
View File

@ -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

6
test/Core/Eval/Base.hs
View File

@ -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)

4
test/Core/Normalize/Base.hs
View File

@ -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

4
test/Core/Print/Base.hs
View File

@ -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

4
test/Core/VampIR/Base.hs
View File

@ -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"

2
test/Internal/Eval/Base.hs
View File

@ -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))

2
test/Nockma/Parse/Positive.hs
View File

@ -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

4
test/Reg/Parse/Base.hs
View File

@ -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')
)

6
test/Reg/Run/Base.hs
View File

@ -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

2
test/Tree/Asm/Base.hs
View File

@ -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

10
test/Tree/Eval/Base.hs
View File

@ -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

4
test/Tree/Transformation/CheckNoAnoma.hs
View File

@ -27,11 +27,11 @@ treeEvalTransformationErrorAssertion mainFile trans checkError 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"

2
test/VampIR/Core/Base.hs
View File

@ -23,7 +23,7 @@ vampirAssertion' backend tab dataFile step = do
step "Translate to VampIR"
let vampirFile = dirPath <//> $(mkRelFile "program.pir")
case run (runReader defaultCoreOptions (runError @JuvixError (coreToVampIR' (moduleFromInfoTable tab)))) of
Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err)))
Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
Right VampIR.Result {..} -> do
writeFileEnsureLn vampirFile _resultCode