module DAP.Log (
    DebugStatus (..)
  , DAPLog(..)
  , LogAction(..)
  , Level(..)
  , (<&)
  , cmap
  , cfilter
  , mkDebugMessage
  , renderDAPLog
) where

import Data.Text (Text)
import           Network.Socket                  ( SockAddr )
import Colog.Core
import qualified Data.Text as T
import DAP.Utils

----------------------------------------------------------------------------
data Level = DEBUG | INFO | WARN | ERROR
  deriving (Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Level -> ShowS
showsPrec :: Int -> Level -> ShowS
$cshow :: Level -> String
show :: Level -> String
$cshowList :: [Level] -> ShowS
showList :: [Level] -> ShowS
Show, Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
/= :: Level -> Level -> Bool
Eq)
----------------------------------------------------------------------------
data DebugStatus = SENT | RECEIVED
  deriving (Int -> DebugStatus -> ShowS
[DebugStatus] -> ShowS
DebugStatus -> String
(Int -> DebugStatus -> ShowS)
-> (DebugStatus -> String)
-> ([DebugStatus] -> ShowS)
-> Show DebugStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugStatus -> ShowS
showsPrec :: Int -> DebugStatus -> ShowS
$cshow :: DebugStatus -> String
show :: DebugStatus -> String
$cshowList :: [DebugStatus] -> ShowS
showList :: [DebugStatus] -> ShowS
Show, DebugStatus -> DebugStatus -> Bool
(DebugStatus -> DebugStatus -> Bool)
-> (DebugStatus -> DebugStatus -> Bool) -> Eq DebugStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugStatus -> DebugStatus -> Bool
== :: DebugStatus -> DebugStatus -> Bool
$c/= :: DebugStatus -> DebugStatus -> Bool
/= :: DebugStatus -> DebugStatus -> Bool
Eq)

data DAPLog =
  DAPLog {
      DAPLog -> Level
severity :: Level
    , DAPLog -> Maybe DebugStatus
mDebugStatus :: Maybe DebugStatus
    , DAPLog -> SockAddr
addr     :: SockAddr
    , DAPLog -> Text
message  :: Text
    }
  | GenericMessage { severity :: Level, message :: Text }

mkDebugMessage :: Text -> DAPLog
mkDebugMessage :: Text -> DAPLog
mkDebugMessage  = Level -> Text -> DAPLog
GenericMessage Level
DEBUG

renderDAPLog :: DAPLog -> Text
renderDAPLog :: DAPLog -> Text
renderDAPLog (GenericMessage Level
_ Text
t) = Text
t
renderDAPLog (DAPLog Level
level Maybe DebugStatus
maybeDebug SockAddr
log_addr Text
msg) = [Text] -> Text
T.concat
      [ Text -> Text
withBraces (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (SockAddr -> String
forall a. Show a => a -> String
show SockAddr
log_addr)
      , Text -> Text
withBraces (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Level -> String
forall a. Show a => a -> String
show Level
level)
      , Text -> (DebugStatus -> Text) -> Maybe DebugStatus -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Text -> Text
withBraces (Text -> Text) -> (DebugStatus -> Text) -> DebugStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (DebugStatus -> String) -> DebugStatus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebugStatus -> String
forall a. Show a => a -> String
show) Maybe DebugStatus
maybeDebug
      , Text
msg
      ]