Feedback.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Code to facilitate giving feedback
--
-----------------------------------------------------------------------------

module WinDll.Utils.Feedback where

import WinDll.Session

import Control.Monad.State

import System.IO.Unsafe
import System.Exit
import System.Directory

-- | debug function that prints out de given message only if the specified debug level
-- is atleast that which was specified by the commandline options to the program
-- 
-- The debug levels are:
-- 0    - Off
-- 1    - Informational
-- 2    - Detailed informational
inform :: Int -> String -> Exec ()
inform level msg = 
 do session <- get
    let dbg = verbosity session
    liftIO $ when (level <= dbg && dbg /= 0) $ putStrLn ("*** " ++ msg)
    return ()

-- | Normal Information message
_normal = 1 :: Int

-- | Detauled Information message
_detail = 2 :: Int

-- | Give the user a warning and exits if warnings are treated like errors
warn :: String -> Exec ()
warn msg = 
 do session <- get 
    let werr = warnings_as_errors session
    let warnings_enabled = warnings session
    liftIO $ when (warnings_enabled && not werr) $ putStrLn ("Warning: " ++ msg)
    if werr then die msg
            else return ()
            
-- | Give the user a Error and exit
die :: String -> Exec a
die msg = (liftIO $ putStrLn ("Error: " ++ msg)) >> cleanup >> liftIO exitFailure
        
-- | Cleanup any temporary files we might have written, if the value keep_temps has not been set.
cleanup :: Exec ()
cleanup = 
 do inform _normal "Cleaning up...."
    session <- get
    let build  = pipeline session
        dir    = dirPath build
    case keep_temps session || null (files build) of
        True  -> inform _detail "Nothing to clean up."
              >> when (keep_temps session) (liftIO $ putStrLn $ "Preserved " ++ dir)
        False -> mapM_ (\a->inform _detail ("Cleaning '" ++ a ++ "'...") >> liftIO (removeFile (dir++a))) (files build)
              >> inform _detail ("Removing " ++ dir ++ "...")
              >> liftIO (removeDirectoryRecursive dir)
    
    inform _detail "Cleanup done..."