Permalink
Browse files

initial import.

  • Loading branch information...
0 parents commit 1345f269fefcaf6594e104170ab981991362e5c2 @kazu-yamamoto committed Mar 7, 2011
Showing with 195 additions and 0 deletions.
  1. +1 −0 .gitignore
  2. +87 −0 Commands.hs
  3. +31 −0 Help.hs
  4. +43 −0 Main.hs
  5. +19 −0 Options.hs
  6. +10 −0 Program.hs
  7. +4 −0 TODO
@@ -0,0 +1 @@
+dist/
@@ -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
31 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
43 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
@@ -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"
+ ]
+
@@ -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"
4 TODO
@@ -0,0 +1,4 @@
+cabal-delete
+ https://github.com/iquiw/cabal-delete
+cabal-dev
+ https://github.com/creswick/cabal-dev

0 comments on commit 1345f26

Please sign in to comment.