json-tracer-0.0.1.2: example/Main.hs

{-# LANGUAGE DataKinds, TypeFamilies, OverloadedLabels #-}
import Control.Monad.CTrace
import Data.PolyDict
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy as B
import Data.Time(NominalDiffTime, getCurrentTime, diffUTCTime)
import Control.Monad.Trans
import Control.Monad
import Lens.Micro
import qualified Fib
import qualified Fib2

data Main
type instance Assoc Main "elapsed_time" = NominalDiffTime
type instance Assoc Main "tag" = String
type instance Assoc Main "fib" = (Dict Fib.Fib)

doit1 :: TracerT (Dict Main) IO Int
doit1 = do
  update $ access #tag ?~ "doit1"
  t_start <- liftIO getCurrentTime
  r <- zoom (access' #fib empty) (Fib.fib 5)
  t_end <- liftIO getCurrentTime
  update $ access #elapsed_time ?~ (diffUTCTime t_end t_start)
  return r

doit2 :: TracerT (Dict Main) IO Int
doit2 = do
  update $ access #tag ?~ "doit2"
  t_start <- liftIO getCurrentTime
  r <- zoom (access' #fib empty) (Fib2.fib 5)
  t_end <- liftIO getCurrentTime
  update $ access #elapsed_time ?~ (diffUTCTime t_end t_start)
  return r


main :: IO ()
main = do
    forM_ [doit1,doit2] $ \doit -> do
        (r, d) <- ioTracerT empty doit
        B.putStr (encodePretty d)
        putStrLn ""
        print r