{-# LANGUAGE QuasiQuotes #-}

-- the entire logging framework is stole from [innate](http://github.com/manveru/innate/tree/master)


module Hack.Contrib.Hub where

import Hack
import Hack.Utils
import Prelude hiding ((.), (^), (>), (+))
import MPS
import Hack.Constants
import Text.Printf
import System.Posix.Process (getProcessID)
import System.Time
import Data.Maybe (fromMaybe, fromJust)
import Text.PrettyPrint.ANSI.Leijen

data Severity = 
     Debug
  |  Info
  |  Warn
  |  Error
  |  Fatal
  |  Unknown
  deriving (Show, Eq)

hint :: Severity -> String
hint = show > slice 0 1

type Formatter = Severity -> CalendarTime -> Int -> String -> String -> String

type Logger = String -> Severity -> IO ()

hub :: Stream -> Formatter -> String -> Logger
hub stream formatter program = \message severity -> 
  do
    time <- now
    pid <- getProcessID ^ from_i
    stream $ formatter severity time pid program message



simple_logger :: Maybe Stream -> Maybe Formatter -> String -> Env -> Logger
simple_logger l f program env = do
  let stream = l.fromMaybe (env.hack_errors)
  let formatter = f.fromMaybe simple_formatter
  hub stream formatter program

simple_formatter :: Formatter
simple_formatter severity time pid program message =
  printf line_format h t pid l program s
  where
    time_format = "%Y-%m-%d %H:%M:%S"
    line_format = "%s [%s $%d] %5s | %s: %s\n"
    
    h = severity.hint
    t = time.format_time time_format
    l = severity.show.upper
    s = colorize severity message

colorize :: Severity -> String -> String
colorize severity message = color severity (text message) .show
  where
    level_color = 
      [ (   Debug           , blue    )
      , (   Info            , white   )
      , (   Warn            , yellow  )
      , (   Error           , red     )
      , (   Fatal           , red     )
      , (   Unknown         , green   )
      ]
    just_lookup s xs = xs.lookup s .fromJust

    color severity = level_color.lookup severity .fromMaybe green