diff options
| -rw-r--r-- | src/VeriFuzz.hs | 2 | ||||
| -rw-r--r-- | src/VeriFuzz/Fuzz.hs | 14 | ||||
| -rw-r--r-- | src/VeriFuzz/Sim/Internal.hs | 9 |
3 files changed, 16 insertions, 9 deletions
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 |