packages feed

raaz-0.1.0: bin/Main.hs

{-# LANGUAGE RecordWildCards #-}
--
-- The main function that drives other commands.
--

import Control.Monad
import Data.Version          (showVersion)
import Data.Monoid
import Raaz                  (version)
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO



import Command.Checksum
import Command.Rand


-- The commands know to raaz executable.
commands :: [(String, [String] -> IO ())]
commands = [ ("checksum", checksum)
           , ("rand"    , rand    )
           ]



----------------- Command line parsing -------------------------------------

data Options = Options { optVersion :: Bool
                       , optHelp    :: Bool
                       }

defaultOpts :: Options
defaultOpts = Options { optVersion    = False, optHelp  = False }

options :: [OptDescr (Endo Options)]
options = [ Option ['v'] ["version"] (NoArg setVersion) "print the version"
          , Option ['h'] ["help"]    (NoArg setHelp)    "print the help"
          ]
  where setVersion   = Endo $ \ opt -> opt { optVersion = True }
        setHelp      = Endo $ \ opt -> opt { optHelp    = True }


-- | parse options
parseOpts :: [String] -> IO Options
parseOpts args = case getOpt Permute options args of
  (o,[],[])  -> return $ appEndo (mconcat o) defaultOpts
  (_,_,errs) -> errorBailout errs

-- The usage message for the program.
usage :: [String] -> String
usage errs | null errs = usageInfo header options
           | otherwise = "raaz: " ++ unlines errs ++ usageInfo header options
  where header = unlines $ [ "Usage: raaz [COMMAND] [OPTIONS]"
                           , "       raaz [OPTIONS]"
                           , ""
                           , "Supported Commands: "
                           ] ++ cmds
        cmds     = map (("\t"++) . fst) commands


---------------------- The main function and stuff ------------------------------

main :: IO ()
main = do args <- getArgs
          case args of
            (c:restArgs) -> maybe (noCommand args) (runCmd restArgs) $ lookup c commands
            _ -> errorBailout ["empty command line"]
     where runCmd    = flip ($)
           noCommand = parseOpts >=> run

run :: Options -> IO ()
run (Options{..}) = do
  when optVersion $ printVersion
  when optHelp    $ printHelp
  where printHelp    = putStrLn $ usage []
        printVersion = putStrLn $ "raaz: " ++ showVersion version


-- | Bail out on error
errorBailout :: [String]-> IO a
errorBailout errs = do
  hPutStrLn stderr $ usage errs
  exitFailure