From 7f7be6fb96b8d225e77706e778a257c642b35aef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 3 Sep 2026 14:31:10 -0600 Subject: [PATCH] --- src/Gyehoek/Driver.hs | 9 ++++----- src/Gyehoek/Sexp/Grammar.hs | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index 0b4f0cc..6523d5a 100644 --- a/src/Gyehoek/Driver.hs +++ b/src/Gyehoek/Driver.hs @@ -120,13 +120,13 @@ driver opts = do hPutStrLn FS.stdout . view strict . pShowNoColor $ scm cps <- convertProgram scm when opts.dumpCPS do - hPutStrLn FS.stdout =<< S.encodeWith S.datumIso cps + S.writeDatum cps closedCps <- closeProgram cps when opts.dumpClosed do - hPutStrLn FS.stdout =<< S.encodeWith S.datumIso closedCps + S.writeData closedCps hoistedCps <- hoistProgram closedCps when opts.dumpHoisted do - hPutStrLn FS.stdout =<< S.encodeWith S.datumIso hoistedCps + S.writeData hoistedCps -- contifiedCps <- contifyProgram hoistedCps -- when opts.dumpContified do -- hPutStrLn FS.stdout =<< S.encodeWith S.datumIso contifiedCps @@ -139,8 +139,7 @@ driver opts = do >>> hPutStrLn FS.stdout) when (rt_is #CPS) do CPS.evalProgram closedCps - >>= S.encodeDataWith S.dataIso - >>= hPutStrLn FS.stdout + >>= S.writeData -- dumpOrRun opts.inspectWasm (rt_is #Wasm) -- (lowerProgram cps) -- inspectWasm diff --git a/src/Gyehoek/Sexp/Grammar.hs b/src/Gyehoek/Sexp/Grammar.hs index a5f1936..95aa2ef 100644 --- a/src/Gyehoek/Sexp/Grammar.hs +++ b/src/Gyehoek/Sexp/Grammar.hs @@ -28,6 +28,8 @@ module Gyehoek.Sexp.Grammar , fromDatumUnsafe , Control.Category.id , fromDataUnsafe + , writeDatum + , writeData ) where @@ -45,6 +47,7 @@ import qualified Control.Category import qualified Data.Vector as V import Data.String (IsString (fromString)) import qualified Data.Text as T +import System.Environment (lookupEnv) toDatum :: Jalmot :> es => DatumGrammar a -> a -> Eff es Datum @@ -126,6 +129,39 @@ encodeOrShow' g x = fromString $ Left _ -> show x Right t -> T.unpack t +encodeOrShow :: (IsString s, Show a) => DatumGrammar a -> a -> s +encodeOrShow g x = fromString $ + case runPureEff . runJalmot . encodeWith' g $ x of + Left _ -> show x + Right t -> T.unpack t + +encodeOrShowData' :: (IsString s, Show a) => DataGrammar a -> a -> s +encodeOrShowData' g x = fromString $ + case runPureEff . runJalmot . encodeDataWith' g $ x of + Left _ -> show x + Right t -> T.unpack t + +encodeOrShowData :: (IsString s, Show a) => DataGrammar a -> a -> s +encodeOrShowData g x = fromString $ + case runPureEff . runJalmot . encodeDataWith g $ x of + Left _ -> show x + Right t -> T.unpack t + +useColour :: IO Bool +useColour = maybe True (const False) <$> lookupEnv "NO_COLOR" + +writeDatum :: (Show a, DatumIso a, MonadIO m) => a -> m () +writeDatum x = do + c <- liftIO useColour + let f = if c then encodeOrShow else encodeOrShow' + liftIO . TIO.putStrLn . f datumIso $ x + +writeData :: (Show a, DataIso a, MonadIO m) => a -> m () +writeData x = do + c <- liftIO useColour + let f = if c then encodeOrShowData else encodeOrShowData' + liftIO . TIO.putStrLn . f dataIso $ x + class DatumIso a where datumIso :: DatumGrammar a