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