From b073c6214dd62c9b8d30c5ec187375828c753d0e Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@ymhg.org>
Date: Tue, 7 May 2019 19:20:21 +0100
Subject: Create better command line output

---
 src/VeriFuzz.hs              |  2 +-
 src/VeriFuzz/Fuzz.hs         | 14 +++++++-------
 src/VeriFuzz/Sim/Internal.hs |  9 ++++++++-
 3 files changed, 16 insertions(+), 9 deletions(-)

(limited to 'src')

diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs
index cbbfb9a..cd6596c 100644
--- a/src/VeriFuzz.hs
+++ b/src/VeriFuzz.hs
@@ -154,7 +154,7 @@ runEquivalence
     -> Int         -- ^ Used to track the recursion.
     -> IO ()
 runEquivalence seed gm t d k i = do
-    (_, m) <- sampleSeed seed gm
+    (_, m) <- shelly $ sampleSeed seed gm
     let srcInfo = SourceInfo "top" m
     rand <- generateByteString 20
     shellyFailDir $ do
diff --git a/src/VeriFuzz/Fuzz.hs b/src/VeriFuzz/Fuzz.hs
index 5f0ccfb..c1bbfe4 100644
--- a/src/VeriFuzz/Fuzz.hs
+++ b/src/VeriFuzz/Fuzz.hs
@@ -204,9 +204,9 @@ fuzzMultiple n fp src conf = do
     fuzzDir n' = fuzzInDir (fromText $ "fuzz_" <> showT n') src conf
     seed = conf ^. configProperty . propSeed
 
-sampleSeed :: MonadIO m => Maybe Seed -> Gen a -> m (Seed, a)
+sampleSeed :: MonadSh m => Maybe Seed -> Gen a -> m (Seed, a)
 sampleSeed s gen =
-    liftIO
+    liftSh
         $ let
               loop n = if n <= 0
                   then
@@ -222,10 +222,10 @@ sampleSeed s gen =
                           of
                               Nothing -> loop (n - 1)
                               Just x  -> do
-                                  liftIO
-                                      .  putStrLn
-                                      $  "VeriFuzz: Chosen seed was '"
-                                      <> show seed
+                                  liftSh
+                                      .  logT
+                                      $  "Chosen seed was '"
+                                      <> showT seed
                                       <> "'"
-                                  pure $ (seed, Hog.nodeValue x)
+                                  return (seed, Hog.nodeValue x)
           in  loop (100 :: Int)
diff --git a/src/VeriFuzz/Sim/Internal.hs b/src/VeriFuzz/Sim/Internal.hs
index 06d0264..c26b888 100644
--- a/src/VeriFuzz/Sim/Internal.hs
+++ b/src/VeriFuzz/Sim/Internal.hs
@@ -45,6 +45,7 @@ import qualified Data.ByteString       as B
 import           Data.Maybe            (catMaybes)
 import           Data.Text             (Text)
 import qualified Data.Text             as T
+import           Data.Time.Format      (defaultTimeLocale, formatTime)
 import           Data.Time.LocalTime   (getZonedTime)
 import           Prelude               hiding (FilePath)
 import           Shelly
@@ -152,7 +153,13 @@ logger :: Text -> Sh ()
 logger t = do
     fn          <- pwd
     currentTime <- liftIO getZonedTime
-    echo $ bname fn <> " [" <> showT currentTime <> "] - " <> t
+    echo
+        $  "VeriFuzz ["
+        <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" currentTime)
+        <> "] "
+        <> bname fn
+        <> " - "
+        <> t
     where bname = T.pack . takeBaseName . T.unpack . toTextIgnore
 
 logCommand :: FilePath -> Text -> Sh a -> Sh a
-- 
cgit