module DPM.UI.Commandline.Interaction (

  query_yN, query_Yn, query, wait,

  abort, userAbort, warn, info, debug, darcsFailed, bug, bugHeader

) where

import qualified Data.List as List
import System.IO
import Control.Monad
import Control.Monad.Trans

import DPM.Core.DPM_Monad
import DPM.Core.Utils ( trim )
import DPM.UI.Commandline.CDPM_Monad

ynAnswers :: [(String, Bool)]
ynAnswers = [("y", True), ("n", False), ("Y", True), ("N", False)]

query_yN :: String -> CDPM Bool
query_yN msg =
    queryString (msg ++ "[y/N] ") (Just False) ynAnswers

query_Yn :: String -> CDPM Bool
query_Yn msg =
    queryString (msg ++ "[Y/n] ") (Just True) ynAnswers

query_yn :: String -> Bool -> CDPM Bool
query_yn msg defaultForBatch =
    queryString (msg ++ "[y/n] ") Nothing ynAnswers

queryString :: String -> (Maybe a) -> [(String, a)] -> CDPM a
queryString msg def opts =
    do liftIO $ putStr msg
       liftIO $ hFlush stdout
       ms <- liftIO $ do s <- getLine
                         return (Just (trim s))
                      `catch` (\_ -> return Nothing)
       case ms of
         Just s ->
             case List.lookup s opts of
               Just x -> return x
               Nothing -> returnDef
         Nothing ->
             returnDef
    where
      returnDef =
          case def of
            Just x -> return x
            Nothing -> queryString ("Invalid choice, try again: ") def opts

query :: String -> String -> CDPM String
query msg def =
    do batch <- getConfigValue cfg_batch
       if batch then return def
          else liftIO $ do putStr msg
                           hFlush stdout
                           getLine `catch` (\_ -> return "")

wait :: String -> CDPM ()
wait msg =
    do query msg ""
       return ()

darcsFailed :: String -> CDPM a
darcsFailed msg = fail ("Darcs command failed. Here is the output of darcs:\n"
                        ++ "---\n" ++ msg ++ "\n---")

userAbort :: CDPM a
userAbort = fail ("Program aborted on request of the user")

abort :: String -> CDPM a
abort msg = fail (msg ++ "\nAborting.")

info :: String -> CDPM ()
info = liftIO . putStrLn

warn :: MonadIO m => String -> m ()
warn s = liftIO $ hPutStrLn stderr ("WARNING: " ++ s)

debug :: String -> CDPM ()
debug s =
    do b <- getConfigValue cfg_verbose
       when b $ liftIO (putStrLn s)

bugHeader :: String
bugHeader = "BUG in dpm!\n"

bug :: String -> CDPM a
bug msg = fail (bugHeader ++ msg)