infinity-0.3: Logger.hs

module Logger (logger,logstr,pluglog,PrintStatus(..)) where
import Control.Exception as Ex
import System.Directory
import System.Time
import Text.Printf
import List

data PrintStatus = 
    Normal   |
    Warning  | 
    Error    |
    Critical

-- regular file logger
logger :: FilePath -> PrintStatus -> String -> IO ()
logger lfile stat str = do
  time  <- (getClockTime >>= toCalendarTime)
  let stime = calendarTimeToString time
      p = case stat of
            Normal   -> "Normal["++stime++"]:\t\t"
            Warning  -> "WARN["++stime++"]:\t\t"
            Error    -> "ERROR["++stime++"]:\t\t"
            Critical -> "CRITICAL["++stime++"]:\t\t"

  write lfile (printf "%s %s\n" p str :: String)

-- logs channel strings
logstr :: String -> (String,String,String) -> IO ()
logstr server (u,c,s) = do
  time <- (getClockTime >>= toCalendarTime)
  let hour  = show $ ctHour time
      hour' = if (length hour == 1) then ("0"++hour) else hour
      min   = show $ ctMin time
      min'  = if (length min == 1) then ("0"++min) else min
      str   = ci " " [(hour'++":"++min'),"::",("<"++u++">"),s]
      date  = ci "-" . map show $ [(fromEnum $ ctMonth time)+1,(ctDay time),(ctYear time)]
      fpath = ci "/" ["Log",server,c,date]
  mkdir $ ci "/" ["Log",server]
  mkdir $ ci "/" ["Log",server,c] 

  write fpath (printf "%s\n" str :: String)
 where
  mkdir d = do
    b <- doesDirectoryExist d
    if (not b) then do createDirectory d
     else return ()
  ci x l = (concat . intersperse x) l


write f s = write' f s 1
write' :: FilePath -> String -> Int -> IO ()
write' f s i = do
  b <- doesFileExist f
  let g = if b then appendFile else writeFile
  Ex.catch (g f s) (\_ -> write' (f++(show i)) s $! i+1)

-- used to log plugin activity; it's actually just a wrapper around logger
pluglog :: PrintStatus -> String -> IO ()
pluglog = logger "Log/plugins.log"