1{-| 2hledger - a ledger-compatible accounting tool. 3Copyright (c) 2007-2011 Simon Michael <simon@joyful.com> 4Released under GPL version 3 or later. 5 6hledger is a partial haskell clone of John Wiegley's "ledger". It 7generates ledger-compatible register & balance reports from a plain text 8journal, and demonstrates a functional implementation of ledger. 9For more information, see http:\/\/hledger.org . 10 11This module provides the main function for the hledger command-line 12executable. It is exposed here so that it can be imported by eg benchmark 13scripts. 14 15You can use the command line: 16 17> $ hledger --help 18 19or ghci: 20 21> $ ghci hledger 22> > j <- readJournalFile def "examples/sample.journal" 23> > register [] ["income","expenses"] j 24> 2008/01/01 income income:salary $-1 $-1 25> 2008/06/01 gift income:gifts $-1 $-2 26> 2008/06/03 eat & shop expenses:food $1 $-1 27> expenses:supplies $1 0 28> > balance [Depth "1"] [] l 29> $-1 assets 30> $2 expenses 31> $-2 income 32> $1 liabilities 33> > l <- myLedger 34 35See "Hledger.Data.Ledger" for more examples. 36 37-} 38 39{-# LANGUAGE QuasiQuotes #-} 40 41module Hledger.Cli.Main where 42 43import Data.Char (isDigit) 44import Data.List 45import Safe 46import qualified System.Console.CmdArgs.Explicit as C 47import System.Environment 48import System.Exit 49import System.FilePath 50import System.Process 51import Text.Printf 52 53import Hledger.Cli 54 55 56-- | The overall cmdargs mode describing hledger's command-line options and subcommands. 57mainmode addons = defMode { 58 modeNames = [progname ++ " [CMD]"] 59 ,modeArgs = ([], Just $ argsFlag "[ARGS]") 60 ,modeHelp = unlines ["hledger's main command line interface. Runs builtin commands and other hledger executables. Type \"hledger\" to list available commands."] 61 ,modeGroupModes = Group { 62 -- subcommands in the unnamed group, shown first: 63 groupUnnamed = [ 64 ] 65 -- subcommands in named groups: 66 ,groupNamed = [ 67 ] 68 -- subcommands handled but not shown in the help: 69 ,groupHidden = map fst builtinCommands ++ map addonCommandMode addons 70 } 71 ,modeGroupFlags = Group { 72 -- flags in named groups: 73 groupNamed = [ 74 ( "General input flags", inputflags) 75 ,("\nGeneral reporting flags", reportflags) 76 ,("\nGeneral help flags", helpflags) 77 ] 78 -- flags in the unnamed group, shown last: 79 ,groupUnnamed = [] 80 -- flags handled but not shown in the help: 81 ,groupHidden = 82 [detailedversionflag] 83 -- ++ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND 84 } 85 ,modeHelpSuffix = "Examples:" : 86 map (progname ++) [ 87 " list commands" 88 ," CMD [--] [OPTS] [ARGS] run a command (use -- with addon commands)" 89 ,"-CMD [OPTS] [ARGS] or run addon commands directly" 90 ," -h show general usage" 91 ," CMD -h show command usage" 92 ," help [MANUAL] show any of the hledger manuals in various formats" 93 ] 94 } 95 96-- | Let's go! 97main :: IO () 98main = do 99 100 -- Choose and run the appropriate internal or external command based 101 -- on the raw command-line arguments, cmdarg's interpretation of 102 -- same, and hledger-* executables in the user's PATH. A somewhat 103 -- complex mishmash of cmdargs and custom processing, hence all the 104 -- debugging support and tests. See also Hledger.Cli.CliOptions and 105 -- command-line.test. 106 107 -- some preliminary (imperfect) argument parsing to supplement cmdargs 108 args <- getArgs >>= expandArgsAt 109 let 110 args' = moveFlagsAfterCommand $ replaceNumericFlags args 111 isFlag = ("-" `isPrefixOf`) 112 isNonEmptyNonFlag s = not (isFlag s) && not (null s) 113 rawcmd = headDef "" $ takeWhile isNonEmptyNonFlag args' 114 isNullCommand = null rawcmd 115 (argsbeforecmd, argsaftercmd') = break (==rawcmd) args 116 argsaftercmd = drop 1 argsaftercmd' 117 dbgIO :: Show a => String -> a -> IO () 118 dbgIO = ptraceAtIO 8 119 120 dbgIO "running" prognameandversion 121 dbgIO "raw args" args 122 dbgIO "raw args rearranged for cmdargs" args' 123 dbgIO "raw command is probably" rawcmd 124 dbgIO "raw args before command" argsbeforecmd 125 dbgIO "raw args after command" argsaftercmd 126 127 -- Search PATH for add-ons, excluding any that match built-in command names 128 addons' <- hledgerAddons 129 let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons' 130 131 -- parse arguments with cmdargs 132 opts <- argsToCliOpts args addons 133 134 -- select an action and run it. 135 let 136 cmd = command_ opts -- the full matched internal or external command name, if any 137 isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons) 138 isExternalCommand = not (null cmd) && cmd `elem` addons -- probably 139 isBadCommand = not (null rawcmd) && null cmd 140 hasVersion = ("--version" `elem`) 141 hasDetailedVersion = ("--version+" `elem`) 142 printUsage = putStr $ showModeUsage $ mainmode addons 143 badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: 144 hasHelpFlag args = any (`elem` args) ["-h","--help"] 145 f `orShowHelp` mode 146 | hasHelpFlag args = putStr $ showModeUsage mode 147 | otherwise = f 148 dbgIO "processed opts" opts 149 dbgIO "command matched" cmd 150 dbgIO "isNullCommand" isNullCommand 151 dbgIO "isInternalCommand" isInternalCommand 152 dbgIO "isExternalCommand" isExternalCommand 153 dbgIO "isBadCommand" isBadCommand 154 d <- getCurrentDay 155 dbgIO "period from opts" (period_ $ reportopts_ opts) 156 dbgIO "interval from opts" (interval_ $ reportopts_ opts) 157 dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts) 158 let 159 journallesserror = error "journal-less command tried to use the journal" 160 runHledgerCommand 161 -- high priority flags and situations. -h, then --help, then --info are highest priority. 162 | hasHelpFlag argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> printUsage 163 | not (hasHelpFlag argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand)) 164 = putStrLn prognameandversion 165 | not (hasHelpFlag argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand)) 166 = putStrLn prognameanddetailedversion 167 -- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname 168 -- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show) 169 | isNullCommand = dbgIO "" "no command, showing commands list" >> printCommandsList addons 170 | isBadCommand = badCommandError 171 172 -- builtin commands 173 | Just (cmdmode, cmdaction) <- findCommand cmd = 174 (case True of 175 -- these commands should not require or read the journal 176 _ | cmd `elem` ["test","help"] -> cmdaction opts journallesserror 177 -- these commands should create the journal if missing 178 _ | cmd `elem` ["add","import"] -> do 179 (ensureJournalFileExists =<< (head <$> journalFilePathFromOpts opts)) 180 withJournalDo opts (cmdaction opts) 181 -- other commands read the journal and should fail if it's missing 182 _ -> withJournalDo opts (cmdaction opts) 183 ) 184 `orShowHelp` cmdmode 185 186 -- addon commands 187 | isExternalCommand = do 188 let externalargs = argsbeforecmd ++ filter (not.(=="--")) argsaftercmd 189 let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String 190 dbgIO "external command selected" cmd 191 dbgIO "external command arguments" (map quoteIfNeeded externalargs) 192 dbgIO "running shell command" shellcmd 193 system shellcmd >>= exitWith 194 195 -- deprecated commands 196 -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure 197 198 -- shouldn't reach here 199 | otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure 200 201 runHledgerCommand 202 203-- | Parse hledger CLI options from these command line arguments and 204-- add-on command names, or raise any error. 205argsToCliOpts :: [String] -> [String] -> IO CliOpts 206argsToCliOpts args addons = do 207 let 208 args' = moveFlagsAfterCommand $ replaceNumericFlags args 209 cmdargsopts = either usageError id $ C.process (mainmode addons) args' 210 rawOptsToCliOpts cmdargsopts 211 212-- | A hacky workaround for cmdargs not accepting flags before the 213-- subcommand name: try to detect and move such flags after the 214-- command. This allows the user to put them in either position. 215-- The order of options is not preserved, but this should be ok. 216-- 217-- Since we're not parsing flags as precisely as cmdargs here, this is 218-- imperfect. We make a decent effort to: 219-- - move all no-argument help/input/report flags 220-- - move all required-argument help/input/report flags along with their values, space-separated or not 221-- - not confuse things further or cause misleading errors. 222moveFlagsAfterCommand :: [String] -> [String] 223moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args 224 where 225 -- quickly! make sure --debug has a numeric argument, or this all goes to hell 226 ensureDebugHasArg as = 227 case break (=="--debug") as of 228 (bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs 229 (bs,"--debug":[]) -> bs++"--debug=1":[] 230 _ -> as 231 232 moveArgs args = insertFlagsAfterCommand $ moveArgs' (args, []) 233 where 234 -- -h ..., --version ... 235 moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f]) 236 -- -f FILE ..., --alias ALIAS ... 237 moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) 238 -- -fFILE ..., --alias=ALIAS ... 239 moveArgs' ((fv:a:as), flags) | isMovableReqArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv]) 240 -- -f(missing arg) 241 moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f]) 242 -- anything else 243 moveArgs' (as, flags) = (as, flags) 244 245 insertFlagsAfterCommand ([], flags) = flags 246 insertFlagsAfterCommand (command:args, flags) = [command] ++ flags ++ args 247 248isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove 249 250isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove 251 252isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_:_) -> (f:fs) `elem` reqargflagstomove 253 _ -> False 254isMovableReqArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove 255isMovableReqArgFlagAndValue _ = False 256 257isValue "-" = True 258isValue ('-':_) = False 259isValue _ = True 260 261flagstomove = inputflags ++ reportflags ++ helpflags 262noargflagstomove = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove 263reqargflagstomove = -- filter (/= "debug") $ 264 concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove 265 266