Fetching contributors…
Cannot retrieve contributors at this time
96 lines (80 sloc) 3.58 KB
{- component
Copyright (C) 2006-2008 John Goerzen <>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Main
Copyright : Copyright (C) 2006-2008 John Goerzen
License : GNU GPL, version 2 or above
Maintainer : John Goerzen <>
Stability : provisional
Portability: portable
Written by John Goerzen, jgoerzen\
import Config
import System.Log.Logger
import System.Log.Handler.Simple
import System.Console.GetOpt.Utils
import System.Console.GetOpt
import System.Environment
import Data.List
import System.Exit
import Commands
import Types
import Control.Monad
import Data.ConfigFile(emptyCP,get)
import System.IO
import Paths_twidge(version)
import Data.Version
main =
do updateGlobalLogger "" (setLevel INFO)
argv <- getArgs
case getOpt RequireOrder options argv of
(o, n, []) -> worker o n
(_, _, errors) -> usageerror (concat errors) -- ++ usageInfo header options)
options = [Option "d" ["debug"] (NoArg ("d", "")) "Enable debugging",
Option "c" ["config"] (ReqArg (stdRequired "c") "FILE")
"Use specified config file",
Option "" ["help"] (NoArg ("help", "")) "Display this help"]
expandAlias cp cmd = either (const cmd) id $ get cp "alias" cmd
worker args commandargs =
do when (lookup "help" args == Just "") $ usageerror ""
when (lookup "d" args == Just "")
(updateGlobalLogger "" (setLevel DEBUG))
handler <- streamHandler stderr DEBUG -- stdout has issues with HSH
updateGlobalLogger "" (setHandlers [handler])
let commandname = head cmdargs
cp <- if commandname `elem` ["lscommands", "setup"] -- no config file needed
then loadCP True (lookup "c" args)
else loadCP False (lookup "c" args)
let cmdargs' = (words $ expandAlias cp commandname) ++ (tail cmdargs)
let commandname' = head cmdargs'
case lookup commandname' allCommands of
Just command -> execcmd command (tail cmdargs') (lookup "c" args) cp
Nothing -> if commandname == commandname'
then usageerror ("Invalid command name " ++ commandname)
else usageerror ("Invalid command name " ++ commandname
++ " (aliased to " ++ commandname' ++ ")")
where cmdargs = case commandargs of
[] -> ["help"]
x -> x
usageerror errormsg =
do putStrLn errormsg
putStrLn (usageInfo header options)
putStrLn "Run \"twidge lscommands\" for a list of available commands.\n\
\Run \"twidge command --help\" for help on a particular command.\n"
putStr $ "This is Twidge, version " ++ showVersion version
putStrLn $ ". Copyright (c) 2008-2010 John Goerzen"
header = "Usage: twidge [global-options] command [command-options]\n\n\
\Available global-options are:\n"