[put Log in separate file
martin.hofmann@uni-bamberg.de**20091012150719] addfile ./src/Logging/Log.hs
hunk ./src/Logging/Log.hs 1
-
+
+module Logging.Log (
+    Priority(..), LogEntry(..), Log, 
+    emptyLog, newLog,
+    verb2Int, int2Verb,
+    
+
+)where
+
+import Logging.PrettyPrinter
+import Data.List
+import Data.Monoid (Monoid(..))
+import Data.Function (on)
+
+data Priority = ERROR       -- ^General Errors
+              | WARNING     -- ^General Warnings
+              | NOTICE      -- ^Normal runtime conditions
+              | INFO        -- ^Information
+              | DEBUG       -- ^Debug messages
+    deriving (Ord, Show, Eq)
+    
+verb2Int :: Priority -> Integer
+verb2Int DEBUG   = 4
+verb2Int INFO    = 3
+verb2Int NOTICE  = 2
+verb2Int WARNING = 1
+verb2Int ERROR   = 0
+    
+int2Verb :: Integer ->  Priority
+int2Verb 4 = DEBUG
+int2Verb 3 = INFO
+int2Verb 2 = NOTICE
+int2Verb 1 = WARNING
+int2Verb 0 = ERROR
+
+
+data LogEntry = LE Priority Doc deriving (Show)
+
+instance Pretty LogEntry where
+    pretty (LE p m) = m -- (text (show p)) <+> text l <+> ( text ": " $$ m)
+    prettyList l   =  foldl' (flip ((<$>).pretty)) empty     l
+
+newtype Log = Log {unLog :: [LogEntry]} deriving(Show)
+emptyLog = Log []
+newLog = Log . (:[])
+
+instance Monoid Log where
+    mempty  = emptyLog
+-- #ifdef NOLOG    
+--    mappend = const . const $  emptyLog
+-- #else   
+    mappend = ((Log . ) . (flip (++))) `on` unLog -- const . const $  emptyLog
+-- #endif
+      
+instance Pretty Log where
+    pretty = pretty . unLog
hunk ./src/Logging/Logger.hs 7
-    Log, Logger, Message, Priority(..), emptyLog, verb2Int, int2Verb,
hunk ./src/Logging/Logger.hs 13
-    setCurrentLogger, setGlobalLogLevel,
-    getCurrentLogger, getGlobalLogLevel,
hunk ./src/Logging/Logger.hs 16
-    module Control.Monad.Writer , 
-    module Control.Monad.State,
+    module Control.Monad.Writer.Strict, 
+    module Control.Monad.State, 
hunk ./src/Logging/Logger.hs 19
+    module Logging.Log,
hunk ./src/Logging/Logger.hs 30
-import Control.Monad.Writer (MonadWriter(..), WriterT, Writer(..), runWriter, runWriterT, )
-import Control.Monad.State (MonadState, StateT, evalStateT, gets, modify)
-import Control.Monad.Reader (MonadReader(..), ReaderT(..), runReader, runReaderT, asks)
+import Control.Monad.Writer.Strict (MonadWriter(..), WriterT, Writer(..), runWriter, runWriterT, )
+import Control.Monad.State(MonadState, StateT, evalStateT, gets, modify)
hunk ./src/Logging/Logger.hs 34
-import Control.Monad.Identity (runIdentity, Identity (..))
hunk ./src/Logging/Logger.hs 38
+import Logging.Log
hunk ./src/Logging/Logger.hs 40
-_NOLOGGING = False
hunk ./src/Logging/Logger.hs 47
-data Priority = ERROR       -- ^General Errors
-              | WARNING     -- ^General Warnings
-              | NOTICE      -- ^Normal runtime conditions
-              | INFO        -- ^Information
-              | DEBUG       -- ^Debug messages
-    deriving (Ord, Show, Eq)
-    
-verb2Int :: Priority -> Integer
-verb2Int DEBUG   = 4
-verb2Int INFO    = 3
-verb2Int NOTICE  = 2
-verb2Int WARNING = 1
-verb2Int ERROR   = 0
-    
-int2Verb :: Integer ->  Priority
-int2Verb 4 = DEBUG
-int2Verb 3 = INFO
-int2Verb 2 = NOTICE
-int2Verb 1 = WARNING
-int2Verb 0 = ERROR
-
-type Logger   = String
-type Message  = Doc
-data LogEntry = LE Priority Logger Message deriving (Show)
-
-instance Pretty LogEntry where
-	pretty (LE p l m) = m -- (text (show p)) <+> text l <+> ( text ": " $$ m)
-	prettyList l   =  foldl' (flip ((<$>).pretty)) empty	 l
-
---mergeEntries :: LogEntry -> LogEntry -> [LogEntry]
---mergeEntries (LE p1 l1) (LE p2 l2)
---    | p1 == p2 && l1 == l2 = [LE p1 l1 (m1 <$$> m2)]
---    | otherwise            = [(LE p1 l1 m1),(LE p2 l2 m2)]
---    
-
hunk ./src/Logging/Logger.hs 48
-				   ,global    :: Logger    -- ^Global Logger
-				   ,current   :: Logger    -- ^Current Logger
hunk ./src/Logging/Logger.hs 51
-mkLogState vl v d = LS vl "" "" v d
-
-newtype Log = Log {unLog :: [LogEntry]}
-    deriving(Show)
-emptyLog = Log []
-
-instance Monoid Log where
-    mempty  = emptyLog
-    mappend = ((Log . ) . (flip (++))) `on` unLog
-      
-instance Pretty Log where
-    pretty = pretty . unLog
+mkLogState vl v d = LS vl v d
hunk ./src/Logging/Logger.hs 53
-logDE,logIN,logNO,logWA,logER ::  Message -> LM ()        
+logDE,logIN,logNO,logWA,logER ::  Doc -> LM ()        
hunk ./src/Logging/Logger.hs 60
-llogDE,llogIN,llogNO,llogWA,llogER ::  ( MonadTrans t) =>  Message -> t LM ()        
-llogDE = \m -> lift (logDE m)
-llogIN = \m -> lift (logIN m)
-llogNO = \m -> lift (logNO m)
-llogWA = \m -> lift (logWA m)
-llogER = \m -> lift (logER m)
+llogDE,llogIN,llogNO,llogWA,llogER ::  ( MonadTrans t) =>  Doc -> t LM ()        
+llogDE = lift . logDE
+llogIN = lift . logIN
+llogNO = lift . logNO
+llogWA = lift . logWA
+llogER = lift . logER
hunk ./src/Logging/Logger.hs 96
-logEntered p = logging p $ text "\n - - - - - - Function entered - - - - - - "
+logEntered = flip logging $ text "\n - - - - - - Function entered - - - - - - "
hunk ./src/Logging/Logger.hs 99
-llogEntered p = lift $ logEntered p
+llogEntered = lift . logEntered 
hunk ./src/Logging/Logger.hs 107
-getGlobalLogLevel ::  (MonadState LogState m, MonadWriter Log m) =>m Logger
-getGlobalLogLevel = gets global
-
-setGlobalLogLevel ::  (MonadState LogState m, MonadWriter Log m) =>Logger -> m ()
-setGlobalLogLevel gll = modify (\l -> l{global = gll})
-
-getCurrentLogger ::  (MonadState LogState m, MonadWriter Log m) =>m Logger
-getCurrentLogger = gets current
-
-setCurrentLogger ::  (MonadState LogState m, MonadWriter Log m) =>Logger -> m ()
-setCurrentLogger cl = modify (\l -> l{current = cl})
-
hunk ./src/Logging/Logger.hs 120
-logging :: Priority -> Message -> LM ()
-logging p msg   = if _NOLOGGING then return () 
-                  else getCurrentLogger >>= \l -> handle $ LE  p l msg          
-     
+logging :: Priority -> Doc -> LM ()
+logging = (handle .) . LE
hunk ./src/Logging/Logger.hs 125
-handle (LE p l msg) = 
+handle le@(LE p msg) = 
hunk ./src/Logging/Logger.hs 127
-    flip when (do
-        lvl <- getPriority
-        gll <- getGlobalLogLevel
-        when ((isPrefixOf gll l) && (p <= lvl)) (do
-            isVerbose >>= flip when (lift3 . putStrLn . show $ msg)
-            isDumping >>= flip when ( tell $ Log [LE p l msg]) >> return ()
-            )) 
+    flip when ( 
+        liftM ((<=)p) getPriority >>=
+        flip when (
+            isVerbose >>= flip when (lift3 . putStrLn . show $ msg) >>
+            isDumping >>= flip when ( tell . newLog $ le))) 
hunk ./src/Logging/Logger.hs 134
+     
+{-
+
+Another method, which is guaranteed to work, is to implement a minuscule
+custom logging monad like this:
+
+   module Logger where
+
+   type Logger m a = WriterT Log m a
+
+   runLogger = runWriterT
+   logging   = tell
+
+and replace it with
+
+   module MockLogger where
+
+   type Logger m a = m a
+
+   runLogger = fmap  $ \a -> (a,emptyLog)
+   logging   = const $ return ()
+
+when you don't want to log anything.
+-}
+
hunk ./src/Logging/Logger.hs 162
-runELT m s 
-    | _NOLOGGING = dropWriterT (runErrorT (evalStateT m s)) emptyLog 
-    | otherwise  =  runWriterT (runErrorT (evalStateT m s))
+runELT m s = runWriterT (runErrorT (evalStateT m s))
hunk ./src/Logging/Logger.hs 168
-dropWriterT :: (Monad m) => (WriterT w m a) ->  w -> m (a,w)
-dropWriterT w d = do
-    (a,_) <- runWriterT w 
-    return (a,d)