initial import.

.gitignore

@@ -0,0 +1 @@
+dist/

Commands.hs

@@ -0,0 +1,87 @@
+module Commands where
+
+data Command = Sync
+             | Install
+             | Uninstall
+             | Installed
+             | Configure
+             | Build
+             | Info
+             | Help
+             deriving (Eq,Show)
+
+data Route = RouteFunc ([String] -> IO ())
+           | RouteProc String [String]
+
+data CommandSpec = CommandSpec {
+    command :: Command
+  , commandNames :: [String]
+  , document :: String
+  , routing :: Route
+  }
+
+type CommandDB = [CommandSpec]
+
+commandDB :: CommandDB
+commandDB = [
+    CommandSpec {
+         command = Sync
+       , commandNames = ["sync", "update"]
+       , document = "Fetchinwg the latest package index"
+       , routing = RouteProc "cabal" ["update"]
+       }
+  , CommandSpec {
+         command = Install
+       , commandNames = ["install"]
+       , document = "Install packages"
+       , routing = RouteProc "cabal" ["install"]
+       }
+  , CommandSpec {
+         command = Uninstall
+       , commandNames = ["uninstall"]
+       , document = "Uninstalling packages"
+       , routing = RouteProc "ghc-pkg" ["unregister"]
+       }
+  , CommandSpec {
+         command = Installed
+       , commandNames = ["installed"]
+       , document = "Listing installed packages"
+       , routing = RouteProc "ghc-pkg" ["list"]
+       }
+  , CommandSpec {
+         command = Configure
+       , commandNames = ["configure"]
+       , document = "Configuring a cabal package"
+       , routing = RouteProc "cabal" ["configure"]
+       }
+  , CommandSpec {
+         command = Build
+       , commandNames = ["build"]
+       , document = "Building a cabal package"
+       , routing = RouteProc "cabal" ["build"]
+       }
+  , CommandSpec {
+         command = Info
+       , commandNames = ["info"]
+       , document = "Display information of a package"
+       , routing = RouteProc "cabal" ["info"]
+       }
+  , CommandSpec {
+         command = Help
+       , commandNames = ["help"]
+       , document = undefined
+       , routing = undefined
+       }
+  ]
+
+getCommand :: String -> CommandDB -> Command
+getCommand _ [] = Help
+getCommand x (ent:ents)
+  | x `elem` commandNames ent = command ent
+  | otherwise   = getCommand x ents
+
+commandSpecByCommand :: Command -> CommandDB -> Maybe CommandSpec
+commandSpecByCommand _ [] = Nothing
+commandSpecByCommand x (ent:ents)
+    | x == command ent = Just ent
+    | otherwise        = commandSpecByCommand x ents

Help.hs

@@ -0,0 +1,31 @@
+module Help where
+
+import Commands
+import Data.List
+import Program
+import Data.Maybe
+
+displayHelp :: [String] -> IO ()
+displayHelp [] = displayHelpAll
+displayHelp (x:_) = case getCommand x commandDB of
+    Help -> displayHelpAll
+    com  -> displayHelpCommand com
+
+displayHelpAll :: IO ()
+displayHelpAll = do
+    putStrLn $ programName ++ " " ++ " -- " ++ description
+    putStrLn ""
+    putStrLn $ "Version: " ++ version
+    putStrLn "Usage:"
+    putStrLn $ "\t" ++ programName ++ " help"
+    putStrLn $ "\t" ++ programName ++ " <command> [args...]"
+    putStrLn ""
+    putStrLn $ "\t <command> = " ++ extractCommands commandDB
+  where
+    extractCommands = concat . intersperse "," . map head . map commandNames
+    -- FIXME take 5 or so
+
+displayHelpCommand :: Command -> IO ()
+displayHelpCommand com = putStrLn $ document spec
+  where
+    spec = fromJust $ commandSpecByCommand com commandDB

Main.hs

@@ -0,0 +1,43 @@
+module Main where
+
+import Commands
+import Control.Exception
+import Data.List
+import Data.Maybe
+import Help
+import Options
+import System.Cmd
+import System.Console.GetOpt
+import System.Environment (getArgs)
+
+parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
+parseArgs spec argv
+    = case getOpt Permute spec argv of
+        (o,n,[]  ) -> (foldl (flip id) defaultOptions o, n)
+        (_,_,errs) -> error "XXX" -- FIXME
+
+analyzeArgs :: Options -> [String] -> (Command, [String], Options)
+analyzeArgs opt []     = (Help, [], opt)
+analyzeArgs opt xs
+  | help opt           = (Help, xs, opt)
+analyzeArgs opt (x:xs) = (getCommand x commandDB, xs, opt)
+
+main :: IO ()
+main = flip catches handlers $ do
+    args <- getArgs
+    let (cmd, params, opts) = uncurry analyzeArgs $ parseArgs argSpec args
+    if cmd == Help
+        then displayHelp params
+        else do
+            let spec = fromJust $ commandSpecByCommand cmd commandDB
+                route = routing spec
+            case route of
+                RouteFunc func -> func params
+                RouteProc subcmd subargs -> callProcess subcmd subargs params opts
+  where
+    handlers = undefined
+
+callProcess :: String -> [String] -> [String] -> Options -> IO ()
+callProcess cmd args0 args1 _ = system script >> return ()
+  where
+    script = concat . intersperse " " $ cmd : args0 ++ args1

Options.hs

@@ -0,0 +1,19 @@
+module Options where
+
+import System.Console.GetOpt
+
+data Options = Options {
+    help :: Bool
+}
+
+defaultOptions :: Options
+defaultOptions = Options {
+    help = False
+  }
+
+argSpec :: [OptDescr (Options -> Options)]
+argSpec = [ Option "h" ["help"]
+            (NoArg (\opts -> opts { help = True }))
+            "print help messages"
+          ]
+

Program.hs

@@ -0,0 +1,10 @@
+module Program where
+
+version :: String
+version = "0.0.0"
+
+programName :: String
+programName = "cab"
+
+description :: String
+description = "A maintenance command of Haskell cabal packages"

TODO

@@ -0,0 +1,4 @@
+cabal-delete
+	https://github.com/iquiw/cabal-delete
+cabal-dev
+	https://github.com/creswick/cabal-dev