content: {-# LANGUAGE FlexibleInstances, RankNTypes, TemplateHaskell #-}
  module Lamdu.Debug
      ( module Lamdu.Debug.Tasks
      , Monitors, Counters
      , Monitor(..), mPure, mAction
      , Evaluator(..), EvaluatorM(..)
      , makeCounters
      , makeMonitors, addBreakPoints
      , noopMonitors
      ) where
  
  import qualified Control.Lens as Lens
  import qualified Data.Text as Text
  import           Lamdu.Debug.Tasks
  import           System.CPUTime (getCPUTime)
  import           System.IO.Unsafe (unsafePerformIO)
  import qualified System.Metrics as Metrics
  import           System.Metrics.Counter (Counter)
  import qualified System.Metrics.Counter as Counter
  import qualified System.Remote.Monitoring.Shim as Ekg
  import           System.TimeIt.Pure (Evaluator(..))
  import qualified System.TimeIt.Pure as TimeIt
  
  import           Lamdu.Prelude
  
  newtype EvaluatorM = EvaluatorM { evaluateM :: forall m a. (Monad m, HasCallStack) => m a -> m a }
  
  data Monitor = Monitor
      { _mPure :: Evaluator
      , _mAction :: EvaluatorM
      }
  Lens.makeLenses ''Monitor
  
  type Monitors = Tasks Monitor
  type Counters = Tasks Counter
  
  idE :: Evaluator
  idE = Evaluator id
  
  taskNames :: Tasks Text
  taskNames =
      Tasks
      { _inference = "Inference"
      , _sugaring = "Sugaring"
      , _layout = "Layout"
      , _database = "Database"
      , _naming = "Naming"
      }
  
  unsafeGetCPUTime :: Monad m => m Integer
  unsafeGetCPUTime =
      p <&> unsafePerformIO
      where
          -- This must be separately done from unsafePerformIO so ghc
          -- sees unsafePerformIO applied to an unknown action and
          -- doesn't run it just once
          p = pure getCPUTime
  
  unsafeTimeIt :: Monad m => m a -> m (Double, a)
  unsafeTimeIt action =
      do
          before <- unsafeGetCPUTime
          result <- action
          after <- unsafeGetCPUTime
          pure (1e-12 * fromIntegral (after - before), result)
  
  actionEvaluator :: (Double -> IO ()) -> IO EvaluatorM
  actionEvaluator report =
      pure EvaluatorM
      { evaluateM =
          \x ->
          do
              (time, res) <- unsafeTimeIt x
              unsafePerformIO (report time) `seq` pure res
      }
  
  makeCounters :: Ekg.Server -> IO (Tasks Counter)
  makeCounters ekg =
      traverse (`Metrics.createCounter` Ekg.serverMetricStore ekg) taskNames
  
  counterMonitor :: Counter -> IO Monitor
  counterMonitor ctr =
      Monitor
      <$> TimeIt.timedEvaluator report
      <*> actionEvaluator report
      where
          report = Counter.add ctr . round . (*1e6)
  
  makeBreakpoint :: Text -> Bool -> Evaluator
  makeBreakpoint _ False = idE
  makeBreakpoint msg True =
      Evaluator (\_ -> error ("Breakpoint encountered: " ++ Text.unpack msg))
  
  composeEvaluator :: Evaluator -> Evaluator -> Evaluator
  composeEvaluator (Evaluator f) (Evaluator g) = Evaluator (f . g)
  
  composeEvaluatorM :: Evaluator -> EvaluatorM -> EvaluatorM
  composeEvaluatorM (Evaluator f) (EvaluatorM g) = EvaluatorM (fmap f . g)
  
  composeMonitor :: Evaluator -> Monitor -> Monitor
  composeMonitor e (Monitor p a) =
      Monitor
      { _mPure = composeEvaluator e p
      , _mAction = composeEvaluatorM e a
      }
  
  noopMonitors :: Monitors
  noopMonitors =
      pure Monitor
      { _mPure = idE
      , _mAction = EvaluatorM id
      }
  
  makeMonitors :: Counters -> IO Monitors
  makeMonitors = traverse counterMonitor
  
  addBreakPoints :: Tasks Bool -> Monitors -> Monitors
  addBreakPoints breakpoints =
      (composeMonitor <$> (makeBreakpoint <$> taskNames <*> breakpoints) <*>)
  