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

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