shell-utility-0.0: src/Shell/Utility/Log.hs

{- |
Primitive verbosity controlled logging.
-}
module Shell.Utility.Log (
   warn, notice, info, debug,
   wrapWords,
   ) where

import Shell.Utility.Verbosity

import qualified System.IO as IO
import Control.Monad (when)

import qualified Data.List as List


{- |
Non fatal condition that may indicate a problem.

Display on 'IO.stderr' at 'normal' verbosity and above.
-}
warn :: Verbosity -> String -> IO ()
warn = atLevel normal $ IO.hPutStrLn IO.stderr . ("Warning: " ++)

{- |
Useful status message.

Display at 'normal' verbosity and above.

This is for the ordinary helpful status messages that users see.
Just enough information to know that things are working
but not floods of detail.
-}
notice :: Verbosity -> String -> IO ()
notice = atLevel normal putStrLn

{- |
More detail on the operation of some action.

Display at 'verbose' verbosity and above.
-}
info :: Verbosity -> String -> IO ()
info = atLevel verbose putStrLn

{- |
Detailed internal debugging information

Display for 'deafening' verbosity.
-}
debug :: Verbosity -> String -> IO ()
debug = atLevel deafening putStrLn

atLevel ::
   (Monad m, Ord verbosity) =>
   verbosity -> (msg -> m ()) -> verbosity -> msg -> m ()
atLevel minVerbosity act verbosity msg =
   when (verbosity >= minVerbosity) $ act msg


wrapWords :: Int -> [String] -> String
wrapWords width =
   drop 1 . concat . snd .
   List.mapAccumL
      (\pos w ->
         let len = length w
             newPos = pos + 1 + len
         in if newPos <= width
               then (newPos, ' ':w)
               else (len, '\n':w))
      (-1)