content: -- ----------------------------------------------------------------------------
  
  {- |
    Module     : Holumbus.Console.Console
    Copyright  : Copyright (C) 2008 Stefan Schmidt
    License    : MIT
  
    Maintainer : Stefan Schmidt (stefanschmidt@web.de)
    Stability  : experimental
    Portability: portable
    Version    : 0.1
  
    This module provides a tiny and nice implementation of a little command 
    shell. It can be feed with individual commands and provides a simple but
    powerful way to interact with your program. The following functions are
    implemented by default:
      exit - exit the console loop
      help - print a nice help
  
    There was a little "bug" with the System.Console.Readline package. When
    we use this option, we make a foreign call... and the Haskell library
    documentation say this about concurrency and GHC:
    
    "If you don't use the -threaded option, then the runtime does not make 
    use of multiple OS threads. Foreign calls will block all other running 
    Haskell threads until the call returns.
    The System.IO library still does multiplexing, so there can be multiple
    threads doing IO, and this is handled internally by the runtime using 
    select."
     
    We make a foreign call, which is not in the System.IO library, so we
    have to work with -threaded when we want a fancy command history.
  
  -}
  
  -- ----------------------------------------------------------------------------
  
  
  module Holumbus.Console.Console
      (
       -- * Console datatype
       ConsoleData
      
       -- * Operations
      , nextOption
      , parseOption
      , initializeConsole
      , addConsoleCommand
      , handleUserInput
      )
  where
  
  import           Control.Concurrent
  
  import qualified Data.Map as Map
  
  import           System.Console.Readline
  
  import           Holumbus.Common.Utils	( handleAll )
  
  -- ----------------------------------------------------------------------------
  -- datatypes
  -- ----------------------------------------------------------------------------
  
  
  -- | Map which contains all commands that the user can execute
  type ConsoleData a = Map.Map String (ConsoleCommand a)
  
  
  -- | Console command, only a pair of a function which will be executed 
  --   and a description 
  type ConsoleCommand a = ( Maybe (ConsoleFunction a), String )
  
  
  -- | A console function. The string list represents the arguments
  type ConsoleFunction a = (a -> [String] -> IO())
  
  -- ----------------------------------------------------------------------------
  -- operations 
  -- ----------------------------------------------------------------------------
  
  
  -- | Creates a new console datatype
  initializeConsole :: ConsoleData a
  initializeConsole = Map.fromList [(exitString, exitCommand), (helpString, helpCommand)]
  
  
  -- | Adds a new console command to the function, an existing command with the
  --   same name will be overwritten
  addConsoleCommand 
    :: String             -- ^ command string (the word the user has to enter when he wants to execute the command)
    -> ConsoleFunction a  -- ^ the function which should be executed
    -> String             -- ^ the function description
    -> ConsoleData a      -- ^ the old console data
    -> ConsoleData a
  addConsoleCommand c f d m = Map.insert c (Just f, d) m
  
  
  -- | The exit function string.
  exitString  :: String
  exitString = "exit"
  
  
  -- | A dummy exit function (Just to print the help description, the command 
  --   is handled in the main loop.
  exitCommand :: ConsoleCommand a
  exitCommand = ( Nothing, "exit the console")
  
  
  -- | The help function string.
  helpString :: String
  helpString = "help"
  
  
  -- | A dummy help function (Just to print the help description, the command 
  --   is handled in the main loop.
  helpCommand :: ConsoleCommand a
  helpCommand = (Nothing, "print this help")
  
  
  -- | The command-line prompt string.
  shellString :: String
  shellString = "command> "
  
  -- | gets the next option from the command line as string
  nextOption :: [String] -> IO (Maybe String, [String])
  nextOption o
    = handleAll (\_ -> return (Nothing, o)) $
        do
        if ( null o ) then
            return (Nothing, o)
          else 
            return (Just $ head o, tail o) 
  
  -- | Simple "parser" for the commandline...
  parseOption :: Read a => [String] -> IO (Maybe a, [String])
  parseOption o
    = handleAll (\_ -> return (Nothing, o)) $
        do
        if ( null o ) then
            return (Nothing, o)
          else 
            return (Just $ read $ head o, tail o) 
  
  
  -- | Reads the input from the stdin.
  getCommandLine :: IO (String)
  getCommandLine 
  -- no commandline history
  {-  = do
      putStr shellString
      hFlush stdout
      maybeLine <- getLine --readline shellString
      return maybeLine
  -}
  -- with commandline history, please use -threaded option
    = do
      maybeLine <- readline shellString
      yield
      case maybeLine of
        Nothing   -> return exitString -- EOF / control-d
        Just line -> 
          do 
            if (not $ null line) then do addHistory line else return ()
            return line
            
  
  -- | The main loop. You know... read stdin, parse the input, execute command.
  --   You can quit it by the exit-command.
  handleUserInput :: ConsoleData a -> a -> IO ()
  handleUserInput cdata conf
    = do
      line  <- getCommandLine
      input <- return (words line)
      cmd   <- return (command input)
      args  <- return (arguments input)
      if (cmd == exitString) 
        then do
          return ()
        else do
          if (not $ null cmd) then do handleCommand cdata conf cmd args else return ()
          handleUserInput cdata conf
      where
        command s = if (not $ null s) then head s else ""
        arguments s = tail s
  
  
  -- | Picks the command an execute the command function.
  handleCommand :: ConsoleData a -> a -> String -> [String] -> IO ()
  handleCommand cdata conf cmd args
    = do
      if (cmd == helpString)
        then do
          printHelp cdata
        else do
          handleCommand' (Map.lookup cmd cdata)
      where
          handleCommand' Nothing              = do printError
          handleCommand' (Just (Nothing, _ )) = do printNoHandler
          handleCommand' (Just (Just f, _ ))  = do f conf args
  
  
  -- | Is executed when the function has no handler
  printNoHandler :: IO ()
  printNoHandler 
    = do
      putStrLn "no function handler found"
  
  
  -- | Prints the "command-not-found" message.
  printError :: IO ()
  printError
    = do
      putStrLn "unknown command, try help for a list of available commands"
  
  
  -- | Prints the help text.
  printHelp :: ConsoleData a -> IO ()
  printHelp cdata
    = do
      putStrLn "available Commands:"
      printCommands (Map.toAscList cdata)
      where
        printCommands [] = do return ()
        printCommands (x:xs) = do
                               printCommand x
                               printCommands xs
        printCommand (c, (_, t)) = do
                                   putStrLn ((prettyCommandName 15 c) ++ " -  " ++ t) 
  
  
  -- | Does some pretty printing for the function descriptions
  prettyCommandName :: Int -> String -> String 
  prettyCommandName n s
    | n <= 0 = s
    | (n > 0) && (null s) = ' ' : prettyCommandName (n-1) s
    | otherwise           = x : prettyCommandName (n-1) xs
      where
        (x:xs) = s
  