{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Hcompta.Expr.Log where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Control.Monad.Catch (MonadThrow(..), MonadCatch(..), MonadMask(..))
import qualified Control.Monad.Classes as MC
import qualified Control.Monad.Classes.Proxied as MC
import qualified Control.Monad.Classes.Run as MC
import Control.Monad.IO.Class (MonadIO(..))
import Data.Function (($), (.))
import Data.Functor (Functor(..))
import Data.Int (Int)
import Data.Monoid ((<>))
import Data.Ord (Ord(..))
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Buildable (Buildable(..))
import qualified Data.Time.LocalTime as Time
import Prelude (truncate)

import Hcompta.Lib.Data.Monoid (Monoid1)

-- * Type 'Log'

data Log a
 =   Log
 {   log_time     :: Time.ZonedTime
 ,   log_facility :: Log_Facility
 ,   log_data     :: a
 } deriving (Functor)
instance Buildable x => Buildable (Log x) where
	build Log{..} =
		let Time.TimeOfDay h m s =
			Time.localTimeOfDay $
			Time.zonedTimeToLocalTime log_time in
		"[" <> int2 h <>
		":" <> int2 m <>
		":" <> int2 (truncate s::Int) <>
		"] " <>
		build log_facility <> ": " <>
		build log_data
		where
			int2 i = (if i < 10 then "0" else "") <> build i

-- ** Type 'Log_Facility'
data Log_Facility
 =   Debug
 |   Info
 |   Warn
instance Buildable Log_Facility where
	build Debug = "debug"
	build Info  = "info"
	build Warn  = "warn"

log ::
 ( MC.MonadWriter (Log a) m
 , MonadIO m
 ) => Log_Facility -> a -> m ()
log log_facility log_data = do
	log_time <- liftIO Time.getZonedTime
	MC.tell Log
	 { log_time
	 , log_facility
	 , log_data
	 }

-- * Type 'LogT'

-- | A 'Monad' transformer to handle different log data types,
-- eventually embedded (through class instances) into a single data type
-- put in the 'Monad' stack with 'MC.MonadWriter'.
newtype LogT w m a = LogT (MC.CustomWriterT' (Log w) m m a)
 deriving
 ( Functor, Applicative, Monoid1
 , Monad, MonadIO, MonadThrow, MonadCatch, MonadMask)

evalLogWith
 :: forall w m a . (Log w -> m ())
 -> LogT w m a
 -> m a
evalLogWith tellFn a =
	MC.reify tellFn $ \px ->
		case a of
		 LogT (MC.CustomWriterT (MC.Proxied a')) -> a' px

-- ** Type 'Log_Message'

newtype Log_Message = Log_Message Text
instance Buildable Log_Message where
	build (Log_Message x) = build x
instance IsString Log_Message where
	fromString = Log_Message . fromString