{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Runtime.Logging
  ( logRoot,
    logPath,
    log,
    logError,
  )
where

import Data.Time (getCurrentTime)
import HWM.Core.Common (Name)
import Relude
import qualified System.IO as TIO

logRoot :: FilePath
logRoot :: FilePath
logRoot = FilePath
".hwm/logs"

logPath :: Name -> FilePath
logPath :: Name -> FilePath
logPath Name
name = FilePath
logRoot FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Name -> FilePath
forall a. ToString a => a -> FilePath
toString Name
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".log"

log :: (MonadIO m) => Name -> [(Text, Text)] -> Text -> m FilePath
log :: forall (m :: * -> *).
MonadIO m =>
Name -> [(Name, Name)] -> Name -> m FilePath
log Name
name [(Name, Name)]
table Name
content = do
  UTCTime
timestamp <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let logInfo :: [(Name, Name)]
logInfo = [(Name
"TIMESTAMP", UTCTime -> Name
forall b a. (Show a, IsString b) => a -> b
show UTCTime
timestamp)]
  let path :: FilePath
path = Name -> FilePath
logPath Name
name
  let boxTop :: Name
boxTop = Name
"┌──────────────────────────────────────────────────────────"
      boxBottom :: Name
boxBottom = Name
"└──────────────────────────────────────────────────────────"
      rows :: [Name]
rows = ((Name, Name) -> Name) -> [(Name, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
k, Name
v) -> Name
"│ " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
k Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
": " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
v) ([(Name, Name)]
table [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Name)]
logInfo)
      header :: Name
header = [Name] -> Name
forall t. IsText t "unlines" => [t] -> t
unlines (Name
boxTop Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
rows [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name
boxBottom, Name
"", Name
content, Name
""])
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
TIO.appendFile FilePath
path (Name -> FilePath
forall a. ToString a => a -> FilePath
toString Name
header)
  FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path

logError :: (MonadIO m) => Name -> [(Text, Text)] -> Text -> m FilePath
logError :: forall (m :: * -> *).
MonadIO m =>
Name -> [(Name, Name)] -> Name -> m FilePath
logError Name
name [(Name, Name)]
table = Name -> [(Name, Name)] -> Name -> m FilePath
forall (m :: * -> *).
MonadIO m =>
Name -> [(Name, Name)] -> Name -> m FilePath
log Name
name ([(Name, Name)]
table [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. Semigroup a => a -> a -> a
<> [(Name
"TYPE", Name
"ERROR")])