content: {-# LANGUAGE RecordWildCards #-}
  
  -- | Post-mortem tool main.
  
  import           Universum hiding (last)
  
  import qualified Data.ByteString.Lazy.Char8 as BSL
  import           Data.Csv as CSV (encode)
  import           Data.List (last)
  import qualified Data.Map.Strict as M
  import           System.FilePath (splitDirectories, takeBaseName, takeDirectory,
                       (<.>), (</>))
  import           System.IO (hPutStrLn)
  import           Text.Printf (hPrintf)
  
  import           Pos.Util.Util (histogram)
  
  import           Options (Options (..), parseOptions)
  import           Statistics (focusF, focusToCSV, getData, graphF, memPoolF,
                       receivedCreatedF, reportTxFate, runJSONFold, throughput,
                       txCntInChainF, txCntInChainMemPoolToCSV, txFateF,
                       txReceivedF, writeGraph)
  import           Types (Timestamp, TxHash)
  
  
  main :: IO ()
  main = parseOptions >>= \case
      Overview sampleProb logDirs -> do
          showLogDirs logDirs
          err $ "sample probability: " ++ show sampleProb
          err ""
          xs <- forM logDirs $ flip processLogDirOverview sampleProb
          BSL.writeFile "times.csv" (CSV.encode $ foldl' (\ acc (_, m) -> getData m ++  acc) [] xs)
          err "wrote times csv"
      Focus txHash logDir         -> do
          err $ "transaction hash: " ++ show txHash
          err $ "logs directory: " ++ show logDir
          let focusFile = ("focus_" ++ extractName logDir ++ "_" ++ toString txHash) <.> "csv"
          runJSONFold logDir (focusF txHash) >>= focusToCSV focusFile
          err $ "wrote result to " ++ show focusFile
      TxRelay logDirs             -> do
          showLogDirs logDirs
          err ""
          for_ logDirs processLogDirTxRelay
      Throughput txWindow waitWindow logDirs   -> do
          showLogDirs logDirs
          err $ "tx window: " ++ show txWindow
          err $ "wait window: " ++ show waitWindow
          err ""
          for_ logDirs $ processLogDirThroughput txWindow waitWindow
  
  showLogDirs :: [FilePath] -> IO ()
  showLogDirs logDirs = do
      err "log directories: "
      for_ logDirs $ \d -> err $ " - " ++ show d
  
  processLogDirOverview :: FilePath -> Double -> IO (String, Map TxHash (Maybe Timestamp))
  processLogDirOverview logDir sampleProb = do
      err $ "processing log directory " ++ show logDir ++ " ..."
  
      (rc, g, mp, cr, ft) <-
          runJSONFold logDir $ (,,,,) <$> receivedCreatedF
                                      <*> graphF
                                      <*> memPoolF
                                      <*> txCntInChainF
                                      <*> txFateF
      let total    = M.size rc
          included = sort $ mapMaybe snd $ M.toList rc
          lost     = total - length included
      err $ "total number of received transactions: " ++ show total
      err $ "included in blockchain: " ++ show (length included)
      err $ "lost transactions: " ++ show lost
      err $ "blocks in chain: " ++ show (length cr)
      err $ "mem pool entries: " ++ show (length mp)
  
      let dirName   = extractName logDir
      let graphFile = getName "graph" dirName "png"
      b <- writeGraph graphFile g
      when b $ err $ "wrote graph png to " ++ show graphFile
  
      let csvFile = getName "csv" dirName "csv"
      txCntInChainMemPoolToCSV csvFile sampleProb cr mp
      err $ "wrote csv file to " ++ show csvFile
      let reportFile = getName "report" dirName "txt"
      void (reportTxFate reportFile ft)
      err $ "wrote report file to " ++ show reportFile
      err $ "processing log directory " ++ show logDir ++ " done"
      err ""
      return (dirName, rc)
  
  processLogDirTxRelay :: FilePath -> IO ()
  processLogDirTxRelay logDir = do
      err $ "processing log directory " ++ show logDir ++ " ..."
      m <- runJSONFold logDir txReceivedF
      err $ "total number of received transactions: " ++ show (M.size m)
      let xs         = sortBy (compare `on` \(_, ys) -> negate $ length ys) $ M.toList m
          dirName    = extractName logDir
          relaysFile = getName "relays" dirName "txt"
      withFile relaysFile WriteMode $ \h ->
          for_ xs $ \(tx, ys) ->
              hPutStrLn h $ toString tx ++ ": " ++ show ys
      err $ "wrote relay data to " ++ show relaysFile
      let hist     = M.toList $ histogram $ map (length . snd) xs
          histFile = getName "histogram" dirName "txt"
      withFile histFile WriteMode $ \h ->
          for_ hist $ uncurry $ hPrintf h "%4d:%6d\n"
      err $ "wrote histogram to " ++ show histFile
  
  processLogDirThroughput :: Double -> Double -> FilePath -> IO ()
  processLogDirThroughput txWindow waitWindow logDir = do
      err $ "processing log directory " ++ show logDir ++ " ..."
      (xs, ys) <- runJSONFold logDir $ (,) <$> txCntInChainF <*> memPoolF
      err $ "chain length: " ++ show (length xs) ++ " block(s)"
      err $ show (length ys) ++ " mem pool event(s)"
      let svgFile = getName "throughput" (extractName logDir) "svg"
      throughput svgFile txWindow waitWindow 1000 xs ys
      err $ "wrote chart to " ++ show svgFile
  
  err :: String -> IO ()
  err = hPutStrLn stderr
  
  getName :: FilePath -> String -> String -> FilePath
  getName template name ext =
      let dir   = takeDirectory template
          base  = takeBaseName template
          base' =  base ++ "_" ++ name
      in  dir </> base' <.> ext
  
  extractName :: FilePath -> String
  extractName = last . splitDirectories
  