optionsgeddon.. port to cmdargs and a fully modal cli

hledger-chart/Hledger/Chart/Main.hs

@@ -18,78 +18,49 @@ import Data.Maybe
 import Data.Ord
 import Data.Tree
 import Graphics.Rendering.Chart
-import Safe (readDef)
-import System.Console.GetOpt
 import System.Exit (exitFailure)
+import Text.Printf
 
 import Hledger
-import Prelude hiding (putStr, putStrLn)
+import Hledger.Cli hiding (progname,progversion)
-import Hledger.Utils.UTF8 (putStr, putStrLn)
+import Prelude hiding (putStrLn)
-import Hledger.Cli.Options
+import Hledger.Utils.UTF8 (putStrLn)
-import Hledger.Cli.Utils (withJournalDo)
-import Hledger.Cli.Version
 
-
+import Hledger.Chart.Options
-progname_chart = progname_cli ++ "-chart"
-
-defchartoutput   = "hledger.png"
-defchartitems    = 10
-defchartsize     = "600x400"
-
-options_chart :: [OptDescr Opt]
-options_chart = [
-  Option "o" ["output"] (ReqArg ChartOutput "FILE")       ("output filename (default: "++defchartoutput++")")
- ,Option ""  ["items"]  (ReqArg ChartItems "N")           ("number of accounts to show (default: "++show defchartitems++")")
- ,Option ""  ["size"]   (ReqArg ChartSize "WIDTHxHEIGHT") ("image size (default: "++defchartsize++")")
- ]
-
-usage_preamble_chart =
-  "Usage: hledger-chart [OPTIONS] [PATTERNS]\n" ++
-  "\n" ++
-  "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
-  "generates simple pie chart images.\n" ++
-  "\n"
-
-usage_options_chart = usageInfo "hledger-chart options:" options_chart ++ "\n"
-
-usage_chart = concat [
-             usage_preamble_chart
-            ,usage_options_chart
-            ,usage_options_cli
-            ,usage_postscript_cli
-            ]
 
 main :: IO ()
 main = do
-  (opts, args) <- parseArgumentsWith $ options_cli++options_chart
+  opts <- getHledgerChartOpts
-  run opts args
+  when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
+  runWith opts
+
+runWith :: ChartOpts -> IO ()
+runWith opts = run opts
     where
-      run opts args
+      run opts
-       | Help `elem` opts             = putStr usage_chart
+          | "help" `in_` (rawopts_ $ cliopts_ opts)            = printModeHelpAndExit chartmode
-       | Version `elem` opts          = putStrLn $ progversionstr progname_chart
+          | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
-       | BinaryFilename `elem` opts   = putStrLn $ binaryfilename progname_chart
+          | otherwise                                          = withJournalDo' opts chart
-       | otherwise                    = withJournalDo opts args "chart" chart
+
+withJournalDo' :: ChartOpts -> (ChartOpts -> Journal -> IO ()) -> IO ()
+withJournalDo' opts cmd = do
+  journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
+    either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
 
 -- | Generate an image with the pie chart and write it to a file
-chart :: [Opt] -> [String] -> Journal -> IO ()
+chart :: ChartOpts -> Journal -> IO ()
-chart opts args j = do
+chart opts j = do
   d <- getCurrentDay
   if null $ jtxns j
    then putStrLn "This journal has no transactions, can't make a chart." >> exitFailure
    else do
-     let chart = genPie opts (optsToFilterSpec opts args d) j
+     let chart = genPie opts (optsToFilterSpec ropts d) j
      renderableToPNGFile (toRenderable chart) w h filename
      return ()
       where
-        filename = getOption opts ChartOutput defchartoutput
+        filename = chart_output_ opts
-        (w,h) = parseSize $ getOption opts ChartSize defchartsize
+        (w,h) = parseSize $ chart_size_ opts
-
+        ropts = reportopts_ $ cliopts_ opts
--- | Extract string option value from a list of options or use the default
-getOption :: [Opt] -> (String->Opt) -> String -> String
-getOption opts opt def = 
-    case reverse $ optValuesForConstructor opt opts of
-        [] -> def
-        x:_ -> x
 
 -- | Parse image size from a command-line option
 parseSize :: String -> (Int,Int)
@@ -99,26 +70,28 @@ parseSize str = (read w, read h)
     (w,_:h) = splitAt x str
 
 -- | Generate pie chart
-genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout
+genPie :: ChartOpts -> FilterSpec -> Journal -> PieLayout
 genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
                                             , pie_plot_ = pie_chart }
     where
-      pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'
+      pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems
                                   , pie_start_angle_ = (-90)
                                   , pie_colors_ = mkColours hue
                                   , pie_label_style_ = defaultFontStyle{font_size_=12}
                                   }
-      chartitems' = debug "chart" $ top num samesignitems
+      chartitems = debug "chart" $ top num samesignitems
       (samesignitems, sign) = sameSignNonZero rawitems
       rawitems = debug "raw" $ flatten $ balances $
-                 ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j
+                 ledgerAccountTree (fromMaybe 99999 $ depth_ ropts) $ journalToLedger filterspec j
       top n t = topn ++ [other]
           where
             (topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t
             other = ("other", sum $ map snd rest)
-      num = readDef (fromIntegral defchartitems) (getOption opts ChartItems (show defchartitems))
+      num = chart_items_ opts
       hue = if sign > 0 then red else green where (red, green) = (0, 110)
-      debug s = if Debug `elem` opts then ltrace s else id
+      debug s = if debug_ copts then ltrace s else id
+      copts = cliopts_ opts
+      ropts = reportopts_ copts
 
 -- | Select the nonzero items with same sign as the first, and make
 -- them positive. Also return a 1 or -1 corresponding to the original sign.

hledger-chart/Hledger/Chart/Options.hs

@@ -0,0 +1,68 @@
+{-|
+
+-}
+
+module Hledger.Chart.Options
+where
+import Data.Maybe
+import System.Console.CmdArgs
+import System.Console.CmdArgs.Explicit
+
+import Hledger.Cli hiding (progname,progversion)
+import qualified Hledger.Cli (progname)
+
+progname = Hledger.Cli.progname ++ "-chart"
+progversion = progversionstr progname
+
+defchartoutput   = "hledger.png"
+defchartitems    = 10
+defchartsize     = "600x400"
+
+chartflags = [
+  flagReq ["chart-output","o"]  (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")")
+ ,flagReq ["chart-items"]  (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")")
+ ,flagReq ["chart-size"]  (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")")
+ ]
+ 
+chartmode =  (mode "hledger-chart" [("command","chart")]
+            "generate a pie chart image for the top account balances (of one sign only)"
+            commandargsflag (chartflags++generalflags1)){
+             modeHelpSuffix=[
+                  -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
+                 ]
+           }
+
+-- hledger-chart options, used in hledger-chart and above
+data ChartOpts = ChartOpts {
+     chart_output_ :: FilePath
+    ,chart_items_ :: Int
+    ,chart_size_ :: String
+    ,cliopts_   :: CliOpts
+ } deriving (Show)
+
+defchartopts = ChartOpts
+    def
+    def
+    def
+    def
+
+-- instance Default CliOpts where def = defcliopts
+
+toChartOpts :: RawOpts -> IO ChartOpts
+toChartOpts rawopts = do
+  cliopts <- toCliOpts rawopts
+  return defchartopts {
+              chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts
+             ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts
+             ,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" rawopts
+             ,cliopts_   = cliopts
+             }
+
+checkChartOpts :: ChartOpts -> IO ChartOpts
+checkChartOpts opts = do
+  checkCliOpts $ cliopts_ opts
+  return opts
+
+getHledgerChartOpts :: IO ChartOpts
+getHledgerChartOpts = processArgs chartmode >>= return . decodeRawOpts >>= toChartOpts >>= checkChartOpts
+

hledger-chart/hledger-chart.cabal

@@ -35,6 +35,7 @@ executable hledger-chart
                  ,hledger-lib == 0.15
                  -- ,HUnit
                  ,base >= 3 && < 5
+                 ,cmdargs >= 0.7   && < 0.8
                  ,containers
                  -- ,csv
                  -- ,directory

hledger-lib/Hledger/Data/Dates.hs

@@ -115,6 +115,9 @@ orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
 parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan)
 parsePeriodExpr refdate = parsewith (periodexpr refdate)
 
+maybePeriod :: Day -> String -> Maybe (Interval,DateSpan)
+maybePeriod refdate = either (const Nothing) Just . parsePeriodExpr refdate
+
 -- | Show a DateSpan as a human-readable pseudo-period-expression string.
 dateSpanAsText :: DateSpan -> String
 dateSpanAsText (DateSpan Nothing Nothing)   = "all"

hledger-lib/Hledger/Data/Matching.hs

@@ -53,7 +53,7 @@ data Matcher = MatchAny                   -- ^ always match
 
 -- | A query option changes a query's/report's behaviour and output in some way.
 
--- XXX could use regular cli Opts ?
+-- XXX could use regular CliOpts ?
 data QueryOpt = QueryOptInAcctOnly AccountName  -- ^ show an account register focussed on this account
               | QueryOptInAcct AccountName      -- ^ as above but include sub-accounts in the account register
            -- | QueryOptCostBasis      -- ^ show amounts converted to cost where possible

hledger-lib/Hledger/Data/Types.hs

@@ -36,7 +36,7 @@ import Control.Monad.Error (ErrorT)
 import Data.Time.Calendar
 import Data.Time.LocalTime
 import Data.Tree
-import Data.Typeable (Typeable)
+import Data.Typeable
 import qualified Data.Map as Map
 import System.Time (ClockTime)
 

hledger-lib/Hledger/Read.hs

@@ -15,6 +15,8 @@ module Hledger.Read (
        myJournal,
        myTimelog,
        someamount,
+       journalenvvar,
+       journaldefaultfilename
 )
 where
 import Control.Monad.Error

hledger-vty/Hledger/Vty/Main.hs

@@ -12,48 +12,34 @@ import Data.List
 import Data.Maybe
 import Data.Time.Calendar
 import Graphics.Vty
-import Safe (headDef)
+import Safe
-import System.Console.GetOpt
+import Text.Printf
 
 import Hledger
-import Prelude hiding (putStr, putStrLn)
+import Hledger.Cli hiding (progname,progversion)
-import Hledger.Utils.UTF8 (putStr, putStrLn)
+import Hledger.Vty.Options
-import Hledger.Cli
+import Prelude hiding (putStrLn)
+import Hledger.Utils.UTF8 (putStrLn)
 
 
-progname_vty = progname_cli ++ "-vty"
-
-options_vty :: [OptDescr Opt]
-options_vty = [
- Option ""  ["debug-vty"]    (NoArg  DebugVty)      "run with no terminal output, showing console"
- ]
-
-usage_preamble_vty =
-  "Usage: hledger-vty [OPTIONS] [PATTERNS]\n" ++
-  "\n" ++
-  "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
-  "starts the full-window curses ui.\n" ++
-  "\n"
-
-usage_options_vty = usageInfo "hledger-vty options:" options_vty ++ "\n"
-
-usage_vty = concat [
-             usage_preamble_vty
-            ,usage_options_vty
-            ,usage_options_cli
-            ,usage_postscript_cli
-            ]
-
 main :: IO ()
 main = do
-  (opts, args) <- parseArgumentsWith $ options_cli++options_vty
+  opts <- getHledgerVtyOpts
-  run opts args
+  when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
+  runWith opts
+
+runWith :: VtyOpts -> IO ()
+runWith opts = run opts
     where
-      run opts args
+      run opts
-       | Help `elem` opts             = putStr usage_vty
+          | "help" `in_` (rawopts_ $ cliopts_ opts)            = printModeHelpAndExit vtymode
-       | Version `elem` opts          = putStrLn $ progversionstr progname_vty
+          | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
-       | BinaryFilename `elem` opts   = putStrLn $ binaryfilename progname_vty
+          | otherwise                                          = withJournalDo' opts vty
-       | otherwise                    = withJournalDo opts args "vty" vty
+
+withJournalDo' :: VtyOpts -> (VtyOpts -> Journal -> IO ()) -> IO ()
+withJournalDo' opts cmd = do
+  journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
+    either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
 
 helpmsg = "(b)alance, (r)egister, (p)rint, (right) to drill down, (left) to back up, (q)uit"
 
@@ -65,7 +51,7 @@ data AppState = AppState {
     ,aw :: Int                   -- ^ window width
     ,ah :: Int                   -- ^ window height
     ,amsg :: String              -- ^ status message
-    ,aopts :: [Opt]              -- ^ command-line opts
+    ,aopts :: VtyOpts            -- ^ command-line opts
     ,aargs :: [String]           -- ^ command-line args at startup
     ,ajournal :: Journal         -- ^ parsed journal
     ,abuf :: [String]            -- ^ lines of the current buffered view
@@ -89,19 +75,19 @@ data Screen = BalanceScreen     -- ^ like hledger balance, shows accounts
               deriving (Eq,Show)
 
 -- | Run the vty (curses-style) ui.
-vty :: [Opt] -> [String] -> Journal -> IO ()
+vty :: VtyOpts -> Journal -> IO ()
-vty opts args j = do
+vty opts j = do
   v <- mkVty
   DisplayRegion w h <- display_bounds $ terminal v
   d <-  getCurrentDay
-  let a = enter d BalanceScreen args
+  let a = enter d BalanceScreen (patterns_ $ reportopts_ $ cliopts_ opts)
           AppState {
                   av=v
                  ,aw=fromIntegral w
                  ,ah=fromIntegral h
                  ,amsg=helpmsg
                  ,aopts=opts
-                 ,aargs=args
+                 ,aargs=patterns_ $ reportopts_ $ cliopts_ opts
                  ,ajournal=j
                  ,abuf=[]
                  ,alocs=[]
@@ -111,7 +97,7 @@ vty opts args j = do
 -- | Update the screen, wait for the next event, repeat.
 go :: AppState -> IO ()
 go a@AppState{av=av,aopts=opts} = do
-  when (notElem DebugVty opts) $ update av (renderScreen a)
+  when (not $ debug_vty_ opts) $ update av (renderScreen a)
   k <- next_event av
   d <- getCurrentDay
   case k of 
@@ -268,10 +254,11 @@ resetTrailAndEnter d scr a = enter d scr (aargs a) $ clearLocs a
 updateData :: Day -> AppState -> AppState
 updateData d a@AppState{aopts=opts,ajournal=j} =
     case screen a of
-      BalanceScreen  -> a{abuf=accountsReportAsText opts $ accountsReport opts fspec j}
+      BalanceScreen  -> a{abuf=accountsReportAsText ropts $ accountsReport ropts fspec j}
-      RegisterScreen -> a{abuf=lines $ postingsReportAsText opts $ postingsReport opts fspec j}
+      RegisterScreen -> a{abuf=lines $ postingsReportAsText ropts $ postingsReport ropts fspec j}
-      PrintScreen    -> a{abuf=lines $ showTransactions opts fspec j}
+      PrintScreen    -> a{abuf=lines $ showTransactions ropts fspec j}
-    where fspec = optsToFilterSpec opts (currentArgs a) d
+    where fspec = optsToFilterSpec ropts{patterns_=currentArgs a} d
+          ropts = reportopts_ $ cliopts_ opts
 
 backout :: Day -> AppState -> AppState
 backout d a | screen a == BalanceScreen = a

hledger-vty/Hledger/Vty/Options.hs

@@ -0,0 +1,55 @@
+{-|
+
+-}
+
+module Hledger.Vty.Options
+where
+import System.Console.CmdArgs
+import System.Console.CmdArgs.Explicit
+
+import Hledger.Cli hiding (progname,progversion)
+import qualified Hledger.Cli (progname)
+
+progname = Hledger.Cli.progname ++ "-vty"
+progversion = progversionstr progname
+
+vtyflags = [
+  flagNone ["debug-vty"]  (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
+ ]
+
+vtymode =  (mode "hledger-vty" [("command","vty")]
+            "browse accounts, postings and entries in a full-window curses interface"
+            commandargsflag (vtyflags++generalflags1)){
+             modeHelpSuffix=[
+                  -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
+                 ]
+           }
+
+-- hledger-vty options, used in hledger-vty and above
+data VtyOpts = VtyOpts {
+     debug_vty_ :: Bool
+    ,cliopts_   :: CliOpts
+ } deriving (Show)
+
+defvtyopts = VtyOpts
+    def
+    def
+
+-- instance Default CliOpts where def = defcliopts
+
+toVtyOpts :: RawOpts -> IO VtyOpts
+toVtyOpts rawopts = do
+  cliopts <- toCliOpts rawopts
+  return defvtyopts {
+              debug_vty_ = boolopt "debug-vty" rawopts
+             ,cliopts_   = cliopts
+             }
+
+checkVtyOpts :: VtyOpts -> IO VtyOpts
+checkVtyOpts opts = do
+  checkCliOpts $ cliopts_ opts
+  return opts
+
+getHledgerVtyOpts :: IO VtyOpts
+getHledgerVtyOpts = processArgs vtymode >>= return . decodeRawOpts >>= toVtyOpts >>= checkVtyOpts
+

hledger-vty/hledger-vty.cabal

@@ -35,6 +35,7 @@ executable hledger-vty
                  ,hledger-lib == 0.15
                  -- ,HUnit
                  ,base >= 3 && < 5
+                 ,cmdargs >= 0.7   && < 0.8
                  -- ,containers
                  -- ,csv
                  -- ,directory

hledger-web/Hledger/Web.hs

@@ -7,6 +7,7 @@ module Hledger.Web (
                      module Hledger.Web.AppRun,
                      module Hledger.Web.EmbeddedFiles,
                      module Hledger.Web.Handlers,
+                     module Hledger.Web.Options,
                      module Hledger.Web.Settings,
                      module Hledger.Web.StaticFiles,
                      tests_Hledger_Web
@@ -18,6 +19,7 @@ import Hledger.Web.App
 import Hledger.Web.AppRun
 import Hledger.Web.EmbeddedFiles
 import Hledger.Web.Handlers
+import Hledger.Web.Options
 import Hledger.Web.Settings
 import Hledger.Web.StaticFiles
 

hledger-web/Hledger/Web/App.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
-{-# LANGUAGE OverloadedStrings #-}
 module Hledger.Web.App
     ( App (..)
     , AppRoute (..)
@@ -22,8 +21,8 @@ import Text.Hamlet hiding (hamletFile)
 import Yesod.Core
 import Yesod.Helpers.Static
 
-import Hledger.Cli.Options
 import Hledger.Data
+import Hledger.Web.Options
 import Hledger.Web.Settings
 import Hledger.Web.StaticFiles
 
@@ -34,7 +33,7 @@ import Hledger.Web.StaticFiles
 data App = App
     {getStatic :: Static -- ^ Settings for static file serving.
     ,appRoot    :: T.Text
-    ,appOpts    :: [Opt]
+    ,appOpts    :: WebOpts
     ,appArgs    :: [String]
     ,appJournal :: Journal
     }

hledger-web/Hledger/Web/AppRun.hs

@@ -18,6 +18,7 @@ import Hledger
 import Hledger.Cli
 import Hledger.Web.App
 import Hledger.Web.Handlers
+import Hledger.Web.Options
 import Hledger.Web.Settings
 
 -- This line actually creates our YesodSite instance. It is the second half
@@ -38,7 +39,7 @@ withDevelApp = toDyn (withApp a :: (Application -> IO ()) -> IO ())
    where a = App{
               getStatic=static Hledger.Web.Settings.staticdir
              ,appRoot=Hledger.Web.Settings.defapproot
-             ,appOpts=[]
+             ,appOpts=defwebopts
              ,appArgs=[]
              ,appJournal=nulljournal
              }
@@ -53,7 +54,7 @@ withWaiHandlerDevelApp func = do
   let a = App{
               getStatic=static Hledger.Web.Settings.staticdir
              ,appRoot=Settings.defapproot
-             ,appOpts=[File f]
+             ,appOpts=defwebopts{cliopts_=defcliopts{file_=Just f}}
              ,appArgs=[]
              ,appJournal=j
              }

hledger-web/Hledger/Web/Handlers.hs

@@ -29,6 +29,7 @@ import Yesod.Json
 import Hledger hiding (today)
 import Hledger.Cli
 import Hledger.Web.App
+import Hledger.Web.Options
 import Hledger.Web.Settings
 
 
@@ -60,7 +61,7 @@ getJournalR = do
                                   where andsubs = if subs then " (and subaccounts)" else ""
                 where
                   filter = if filtering then ", filtered" else ""
-      maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport opts j m
+      maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
   defaultLayout $ do
       setTitle "hledger-web journal"
       addHamlet [$hamlet|
@@ -93,7 +94,7 @@ getJournalEntriesR = do
   let
       sidecontent = sidebar vd
       title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String
-      maincontent = entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j
+      maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
   defaultLayout $ do
       setTitle "hledger-web journal"
       addHamlet [$hamlet|
@@ -117,7 +118,7 @@ getJournalOnlyR = do
   vd@VD{..} <- getViewData
   defaultLayout $ do
       setTitle "hledger-web journal only"
-      addHamlet $ entriesReportAsHtml opts vd $ entriesReport opts nullfilterspec $ filterJournalTransactions2 m j
+      addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
 
 ----------------------------------------------------------------------
 
@@ -133,7 +134,7 @@ getRegisterR = do
                  (a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts
                  andsubs = if subs then " (and subaccounts)" else ""
                  filter = if filtering then ", filtered" else ""
-      maincontent = registerReportHtml opts vd $ accountTransactionsReport opts j m $ fromMaybe MatchAny $ inAccountMatcher qopts
+      maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe MatchAny $ inAccountMatcher qopts
   defaultLayout $ do
       setTitle "hledger-web register"
       addHamlet [$hamlet|
@@ -158,8 +159,8 @@ getRegisterOnlyR = do
   defaultLayout $ do
       setTitle "hledger-web register only"
       addHamlet $
-          case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport opts j m m'
+          case inAccountMatcher qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m'
-                                         Nothing -> registerReportHtml opts vd $ journalTransactionsReport opts j m
+                                         Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
 
 ----------------------------------------------------------------------
 
@@ -171,7 +172,7 @@ getAccountsR = do
   let j' = filterJournalPostings2 m j
       html = do
         setTitle "hledger-web accounts"
-        addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 opts am j'
+        addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
       json = jsonMap [("accounts", toJSON $ journalAccountNames j')]
   defaultLayoutJson html json
 
@@ -187,10 +188,10 @@ getAccountsJsonR = do
 
 -- | Render the sidebar used on most views.
 sidebar :: ViewData -> Hamlet AppRoute
-sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 opts am j
+sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j
 
 -- | Render a "AccountsReport" as HTML.
-accountsReportAsHtml :: [Opt] -> ViewData -> AccountsReport -> Hamlet AppRoute
+accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> Hamlet AppRoute
 accountsReportAsHtml _ vd@VD{..} (items',total) =
  [$hamlet|
 <div#accountsheading
@@ -271,7 +272,7 @@ accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRe
 accountUrl r a = (r, [("q",pack $ accountQuery a)])
 
 -- | Render a "EntriesReport" as HTML for the journal entries view.
-entriesReportAsHtml :: [Opt] -> ViewData -> EntriesReport -> Hamlet AppRoute
+entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> Hamlet AppRoute
 entriesReportAsHtml _ vd items = [$hamlet|
 <table.journalreport>
  $forall i <- numbered items
@@ -289,7 +290,7 @@ entriesReportAsHtml _ vd items = [$hamlet|
        txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
 
 -- | Render an "TransactionsReport" as HTML for the formatted journal view.
-journalTransactionsReportAsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
+journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
 journalTransactionsReportAsHtml _ vd (_,items) = [$hamlet|
 <table.journalreport
  <tr.headings
@@ -327,14 +328,14 @@ $forall p <- tpostings t
        showamt = not split || not (isZeroMixedAmount amt)
 
 -- Generate html for an account register, including a balance chart and transaction list.
-registerReportHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
+registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
 registerReportHtml opts vd r@(_,items) = [$hamlet|
  ^{registerChartHtml items}
  ^{registerItemsHtml opts vd r}
 |]
 
 -- Generate html for a transaction list from an "TransactionsReport".
-registerItemsHtml :: [Opt] -> ViewData -> TransactionsReport -> Hamlet AppRoute
+registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> Hamlet AppRoute
 registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
 <table.registerreport
  <tr.headings
@@ -825,7 +826,7 @@ nulltemplate = [$hamlet||]
 
 -- | A bundle of data useful for hledger-web request handlers and templates.
 data ViewData = VD {
-     opts         :: [Opt]      -- ^ the command-line options at startup
+     opts         :: WebOpts    -- ^ the command-line options at startup
     ,here         :: AppRoute   -- ^ the current route
     ,msg          :: Maybe Html -- ^ the current UI message if any, possibly from the current request
     ,today        :: Day        -- ^ today's date (for queries containing relative dates)
@@ -848,7 +849,7 @@ viewdataWithDateAndParams d q a p =
     let (querymatcher,queryopts) = parseQuery d q
         (acctsmatcher,acctsopts) = parseQuery d a
     in VD {
-           opts         = [NoElide]
+           opts         = defwebopts{cliopts_=defcliopts{reportopts_=defreportopts{no_elide_=True}}}
           ,j            = nulljournal
           ,here         = RootR
           ,msg          = Nothing
@@ -865,8 +866,8 @@ viewdataWithDateAndParams d q a p =
 getViewData :: Handler ViewData
 getViewData = do
   app        <- getYesod
-  let opts = appOpts app ++ [NoElide]
+  let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app
-  (j, err)   <- getCurrentJournal opts
+  (j, err)   <- getCurrentJournal $ copts{reportopts_=ropts{no_elide_=True}}
   msg        <- getMessageOr err
   Just here  <- getCurrentRoute
   today      <- liftIO getCurrentDay
@@ -884,7 +885,7 @@ getViewData = do
       -- | Update our copy of the journal if the file changed. If there is an
       -- error while reloading, keep the old one and return the error, and set a
       -- ui message.
-      getCurrentJournal :: [Opt] -> Handler (Journal, Maybe String)
+      getCurrentJournal :: CliOpts -> Handler (Journal, Maybe String)
       getCurrentJournal opts = do
         j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
         (jE, changed) <- liftIO $ journalReloadIfChanged opts j

hledger-web/Hledger/Web/Options.hs

@@ -0,0 +1,66 @@
+{-|
+
+-}
+
+module Hledger.Web.Options
+where
+import Data.Maybe
+import Data.Text (unpack)
+import System.Console.CmdArgs
+import System.Console.CmdArgs.Explicit
+
+import Hledger.Cli hiding (progname,progversion)
+import qualified Hledger.Cli (progname)
+
+import Hledger.Web.Settings
+
+progname = Hledger.Cli.progname ++ "-web"
+progversion = progversionstr progname
+
+defbaseurl = unpack defapproot
+defbaseurl' = (reverse $ drop 4 $ reverse defbaseurl) ++ "PORT"
+
+webflags = [
+  flagReq ["base-url"]  (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurl'++")")
+ ,flagReq ["port"]  (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this tcp port (default: "++show defport++")")
+ ]
+ 
+webmode =  (mode "hledger-web" [("command","web")]
+            "start serving the hledger web interface"
+            commandargsflag (webflags++generalflags1)){
+             modeHelpSuffix=[
+                  -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
+                 ]
+           }
+
+-- hledger-web options, used in hledger-web and above
+data WebOpts = WebOpts {
+     base_url_ :: String
+    ,port_     :: Int
+    ,cliopts_  :: CliOpts
+ } deriving (Show)
+
+defwebopts = WebOpts
+    def
+    def
+    def
+
+-- instance Default WebOpts where def = defwebopts
+
+toWebOpts :: RawOpts -> IO WebOpts
+toWebOpts rawopts = do
+  cliopts <- toCliOpts rawopts
+  return defwebopts {
+              base_url_ = fromMaybe defbaseurl $ maybestringopt "base-url" rawopts
+             ,port_ = fromMaybe defport $ maybeintopt "port" rawopts
+             ,cliopts_   = cliopts
+             }
+
+checkWebOpts :: WebOpts -> IO WebOpts
+checkWebOpts opts = do
+  checkCliOpts $ cliopts_ opts
+  return opts
+
+getHledgerWebOpts :: IO WebOpts
+getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= toWebOpts >>= checkWebOpts
+

hledger-web/hledger-web.cabal

@@ -64,6 +64,7 @@ executable hledger-web
                  ,HUnit
                  ,base >= 4 && < 5
                  ,bytestring
+                 ,cmdargs >= 0.7   && < 0.8
                  -- ,containers
                  -- ,csv
                  ,directory

hledger-web/hledger-web.hs

@@ -9,6 +9,7 @@ module Main
 where
 
 -- import Control.Concurrent (forkIO, threadDelay)
+import Control.Monad
 import Data.Maybe
 import Data.Text(pack)
 import Network.Wai.Handler.Warp (run)
@@ -16,58 +17,41 @@ import Network.Wai.Handler.Warp (run)
 #else
 import Network.Wai.Middleware.Debug (debug)
 #endif
-import System.Console.GetOpt
 import System.Exit (exitFailure)
 import System.IO.Storage (withStore, putValue)
 import Text.Printf
 import Yesod.Helpers.Static
 
-import Hledger.Cli
+import Hledger
-import Hledger.Cli.Tests (runTestsOrExit)
+import Hledger.Cli hiding (progname,progversion)
-import Hledger.Data
+import Hledger.Cli.Tests
-import Prelude hiding (putStr, putStrLn)
+import Prelude hiding (putStrLn)
-import Hledger.Utils.UTF8 (putStr, putStrLn)
+import Hledger.Utils.UTF8 (putStrLn)
 import Hledger.Web
 
 
-progname_web = progname_cli ++ "-web"
-
-options_web :: [OptDescr Opt]
-options_web = [
-  Option ""  ["base-url"]     (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)"
- ,Option ""  ["port"]         (ReqArg Port "N")      "serve on tcp port N (default 5000)"
- ]
-
-usage_preamble_web =
-  "Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++
-  "\n" ++
-  "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
-  "starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++
-  "\n"
-
-usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n"
-
-usage_web = concat [
-             usage_preamble_web
-            ,usage_options_web
-            ,usage_options_cli
-            ,usage_postscript_cli
-            ]
-
 main :: IO ()
 main = do
-  (opts, args) <- parseArgumentsWith $ options_cli++options_web
+  opts <- getHledgerWebOpts
-  run opts args
+  when (debug_ $ cliopts_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
+  runWith opts
+
+runWith :: WebOpts -> IO ()
+runWith opts = run opts
     where
-      run opts args
+      run opts
-       | Help `elem` opts             = putStr usage_web
+          | "help" `in_` (rawopts_ $ cliopts_ opts)            = printModeHelpAndExit webmode
-       | Version `elem` opts          = putStrLn $ progversionstr progname_web
+          | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
-       | BinaryFilename `elem` opts   = putStrLn $ binaryfilename progname_web
+          | otherwise                                          = withJournalDo' opts web
-       | otherwise                    = withJournalDo opts args "web" web
+
+withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
+withJournalDo' opts cmd = do
+  journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
+    either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
 
 -- | The web command.
-web :: [Opt] -> [String] -> Journal -> IO ()
+web :: WebOpts -> Journal -> IO ()
-web opts args j = do
+web opts j = do
   created <- createFilesIfMissing
   if created
    then do
@@ -75,13 +59,10 @@ web opts args j = do
      exitFailure
    else do
      putStrLn $ "Running self-tests..."
-     runTestsOrExit opts args
+     runTestsOrExit $ cliopts_ opts
      putStrLn $ "Using support files in "++datadir
-     let host    = defhost
+     -- unless (debug_ $ cliopts_ opts) $ forkIO (browser baseurl) >> return ()
-         port    = fromMaybe defport $ portFromOpts opts
+     server (base_url_ opts) (port_ opts) opts j
-         baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
-     -- unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
-     server baseurl port opts args j
 
 -- browser :: String -> IO ()
 -- browser baseurl = do
@@ -89,17 +70,18 @@ web opts args j = do
 --   putStrLn "Attempting to start a web browser"
 --   openBrowserOn baseurl >> return ()
 
-server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
+server :: String -> Int -> WebOpts -> Journal -> IO ()
-server baseurl port opts args j = do
+server baseurl port opts j = do
   printf "Starting http server on port %d with base url %s\n" port baseurl
   let a = App{getStatic=static staticdir
              ,appRoot=pack baseurl
              ,appOpts=opts
-             ,appArgs=args
+             ,appArgs=patterns_ $ reportopts_ $ cliopts_ opts
              ,appJournal=j
              }
   withStore "hledger" $ do
     putValue "hledger" "journal" j
+    return ()
 #if PRODUCTION
     withApp a (run port)
 #else

hledger/Hledger/Cli.hs

@@ -37,7 +37,6 @@ import Hledger.Cli.Options
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
 
-
 -- | hledger and hledger-lib's unit tests aggregated from all modules
 -- plus some more which are easier to define here for now.
 tests_Hledger_Cli :: Test
@@ -108,15 +107,14 @@ tests_Hledger_Cli = TestList
       "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
 
   ,"balance report tests" ~:
-   let (opts,args) `gives` es = do 
+   let opts `gives` es = do
         j <- samplejournal
         d <- getCurrentDay
-        accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts args d) j) `is` es
+        accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts d) j) `is` es
    in TestList
    [
-
     "balance report with no args" ~:
-    ([], []) `gives`
+    defreportopts `gives`
     ["                 $-1  assets"
     ,"                  $1    bank:saving"
     ,"                 $-2    cash"
@@ -132,7 +130,7 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report can be limited with --depth" ~:
-    ([Depth "1"], []) `gives`
+    defreportopts{depth_=Just 1} `gives`
     ["                 $-1  assets"
     ,"                  $2  expenses"
     ,"                 $-2  income"
@@ -142,7 +140,7 @@ tests_Hledger_Cli = TestList
     ]
     
    ,"balance report with account pattern o" ~:
-    ([], ["o"]) `gives`
+    defreportopts{patterns_=["o"]} `gives`
     ["                  $1  expenses:food"
     ,"                 $-2  income"
     ,"                 $-1    gifts"
@@ -152,7 +150,7 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report with account pattern o and --depth 1" ~:
-    ([Depth "1"], ["o"]) `gives`
+    defreportopts{patterns_=["o"],depth_=Just 1} `gives`
     ["                  $1  expenses"
     ,"                 $-2  income"
     ,"--------------------"
@@ -160,7 +158,7 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report with account pattern a" ~:
-    ([], ["a"]) `gives`
+    defreportopts{patterns_=["a"]} `gives`
     ["                 $-1  assets"
     ,"                  $1    bank:saving"
     ,"                 $-2    cash"
@@ -171,7 +169,7 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report with account pattern e" ~:
-    ([], ["e"]) `gives`
+    defreportopts{patterns_=["e"]} `gives`
     ["                 $-1  assets"
     ,"                  $1    bank:saving"
     ,"                 $-2    cash"
@@ -187,7 +185,7 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report with unmatched parent of two matched subaccounts" ~: 
-    ([], ["cash","saving"]) `gives`
+    defreportopts{patterns_=["cash","saving"]} `gives`
     ["                 $-1  assets"
     ,"                  $1    bank:saving"
     ,"                 $-2    cash"
@@ -196,14 +194,14 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report with multi-part account name" ~: 
-    ([], ["expenses:food"]) `gives`
+    defreportopts{patterns_=["expenses:food"]} `gives`
     ["                  $1  expenses:food"
     ,"--------------------"
     ,"                  $1"
     ]
 
    ,"balance report with negative account pattern" ~:
-    ([], ["not:assets"]) `gives`
+    defreportopts{patterns_=["not:assets"]} `gives`
     ["                  $2  expenses"
     ,"                  $1    food"
     ,"                  $1    supplies"
@@ -216,20 +214,20 @@ tests_Hledger_Cli = TestList
     ]
 
    ,"balance report negative account pattern always matches full name" ~: 
-    ([], ["not:e"]) `gives`
+    defreportopts{patterns_=["not:e"]} `gives`
     ["--------------------"
     ,"                   0"
     ]
 
    ,"balance report negative patterns affect totals" ~: 
-    ([], ["expenses","not:food"]) `gives`
+    defreportopts{patterns_=["expenses","not:food"]} `gives`
     ["                  $1  expenses:supplies"
     ,"--------------------"
     ,"                  $1"
     ]
 
    ,"balance report with -E shows zero-balance accounts" ~:
-    ([Empty], ["assets"]) `gives`
+    defreportopts{patterns_=["assets"],empty_=True} `gives`
     ["                 $-1  assets"
     ,"                  $1    bank"
     ,"                   0      checking"
@@ -247,7 +245,7 @@ tests_Hledger_Cli = TestList
              ,"  c:d                   "
              ]) >>= either error' return
       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
-      accountsReportAsText [] (accountsReport [] nullfilterspec j') `is`
+      accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j') `is`
         ["                $500  a:b"
         ,"               $-500  c:d"
         ,"--------------------"
@@ -261,7 +259,7 @@ tests_Hledger_Cli = TestList
               ,"  test:a  1"
               ,"  test:b"
               ])
-      accountsReportAsText [] (accountsReport [] nullfilterspec j) `is`
+      accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j) `is`
         ["                   1  test:a"
         ,"                  -1  test:b"
         ,"--------------------"
@@ -294,11 +292,10 @@ tests_Hledger_Cli = TestList
 
    "print expenses" ~:
    do 
-    let args = ["expenses"]
+    let opts = defreportopts{patterns_=["expenses"]}
-        opts = []
     j <- samplejournal
     d <- getCurrentDay
-    showTransactions opts (optsToFilterSpec opts args d) j `is` unlines
+    showTransactions opts (optsToFilterSpec opts d) j `is` unlines
      ["2008/06/03 * eat & shop"
      ,"    expenses:food                $1"
      ,"    expenses:supplies            $1"
@@ -308,9 +305,10 @@ tests_Hledger_Cli = TestList
 
   , "print report with depth arg" ~:
    do 
+    let opts = defreportopts{depth_=Just 2}
     j <- samplejournal
     d <- getCurrentDay
-    showTransactions [] (optsToFilterSpec [Depth "2"] [] d) j `is` unlines
+    showTransactions opts (optsToFilterSpec opts d) j `is` unlines
       ["2008/01/01 income"
       ,"    income:salary           $-1"
       ,""
@@ -338,7 +336,8 @@ tests_Hledger_Cli = TestList
    "register report with no args" ~:
    do 
     j <- samplejournal
-    (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
+    let opts = defreportopts
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/01/01 income               assets:bank:checking             $1           $1"
      ,"                                income:salary                   $-1            0"
      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
@@ -354,9 +353,9 @@ tests_Hledger_Cli = TestList
 
   ,"register report with cleared option" ~:
    do 
-    let opts = [Cleared]
+    let opts = defreportopts{cleared_=True}
     j <- readJournal' sample_journal_str
-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/06/03 eat & shop           expenses:food                    $1           $1"
      ,"                                expenses:supplies                $1           $2"
      ,"                                assets:cash                     $-2            0"
@@ -366,9 +365,9 @@ tests_Hledger_Cli = TestList
 
   ,"register report with uncleared option" ~:
    do 
-    let opts = [UnCleared]
+    let opts = defreportopts{uncleared_=True}
     j <- readJournal' sample_journal_str
-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/01/01 income               assets:bank:checking             $1           $1"
      ,"                                income:salary                   $-1            0"
      ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
@@ -388,19 +387,22 @@ tests_Hledger_Cli = TestList
         ,"  e  1"
         ,"  f"
         ]
-    registerdates (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` ["2008/01/01","2008/02/02"]
+    let opts = defreportopts
+    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/02/02"]
 
   ,"register report with account pattern" ~:
    do
     j <- samplejournal
-    (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cash"] date1) j) `is` unlines
+    let opts = defreportopts{patterns_=["cash"]}
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
      ]
 
   ,"register report with account pattern, case insensitive" ~:
    do 
     j <- samplejournal
-    (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] ["cAsH"] date1) j) `is` unlines
+    let opts = defreportopts{patterns_=["cAsH"]}
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
      ]
 
@@ -408,8 +410,8 @@ tests_Hledger_Cli = TestList
    do 
     j <- samplejournal
     let gives displayexpr = 
-            (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is`)
+            (registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is`)
-                where opts = [Display displayexpr]
+                where opts = defreportopts{display_=Just displayexpr}
     "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]
     "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
     "d=[2008/6/2]"  `gives` ["2008/06/02"]
@@ -421,16 +423,16 @@ tests_Hledger_Cli = TestList
     j <- samplejournal
     let periodexpr `gives` dates = do
           j' <- samplejournal
-          registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j') `is` dates
+          registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j') `is` dates
-              where opts = [Period periodexpr]
+              where opts = defreportopts{period_=maybePeriod date1 periodexpr}
     ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
     "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
     "2007" `gives` []
     "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
     "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
     "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
-    let opts = [Period "yearly"]
+    let opts = defreportopts{period_=maybePeriod date1 "yearly"}
-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"
      ,"                                assets:cash                     $-2          $-1"
      ,"                                expenses:food                    $1            0"
@@ -439,18 +441,18 @@ tests_Hledger_Cli = TestList
      ,"                                income:salary                   $-1          $-1"
      ,"                                liabilities:debts                $1            0"
      ]
-    let opts = [Period "quarterly"]
+    let opts = defreportopts{period_=maybePeriod date1 "quarterly"}
-    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
+    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
-    let opts = [Period "quarterly",Empty]
+    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}
-    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
+    registerdates (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
 
   ]
 
   , "register report with depth arg" ~:
    do 
     j <- samplejournal
-    let opts = [Depth "2"]
+    let opts = defreportopts{depth_=Just 2}
-    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] date1) j) `is` unlines
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
      ["2008/01/01 income               assets:bank                      $1           $1"
      ,"                                income:salary                   $-1            0"
      ,"2008/06/01 gift                 assets:bank                      $1           $1"
@@ -471,7 +473,8 @@ tests_Hledger_Cli = TestList
   ,"unicode in balance layout" ~: do
     j <- readJournal'
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    accountsReportAsText [] (accountsReport [] (optsToFilterSpec [] [] date1) j) `is`
+    let opts = defreportopts
+    accountsReportAsText opts (accountsReport opts (optsToFilterSpec opts date1) j) `is`
       ["                -100  актив:наличные"
       ,"                 100  расходы:покупки"
       ,"--------------------"
@@ -481,7 +484,8 @@ tests_Hledger_Cli = TestList
   ,"unicode in register layout" ~: do
     j <- readJournal'
       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
-    (postingsReportAsText [] $ postingsReport [] (optsToFilterSpec [] [] date1) j) `is` unlines
+    let opts = defreportopts
+    (postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts date1) j) `is` unlines
       ["2009/01/01 медвежья шкура       расходы:покупки                 100          100"
       ,"                                актив:наличные                 -100            0"]
 
@@ -921,4 +925,3 @@ journalWithAmounts as =
         []
         (TOD 0 0)
     where parse = fromparse . parseWithCtx nullctx someamount
-

hledger/Hledger/Cli/Add.hs

@@ -49,8 +49,8 @@ data PostingState = PostingState {
 -- | Read transactions from the terminal, prompting for each field,
 -- and append them to the journal file. If the journal came from stdin, this
 -- command has no effect.
-add :: [Opt] -> [String] -> Journal -> IO ()
+add :: CliOpts -> Journal -> IO ()
-add opts args j
+add opts j
     | f == "-" = return ()
     | otherwise = do
   hPutStrLn stderr $
@@ -58,7 +58,7 @@ add opts args j
     ++"To complete a transaction, enter . when prompted for an account.\n"
     ++"To quit, press control-d or control-c."
   today <- getCurrentDay
-  getAndAddTransactions j opts args today
+  getAndAddTransactions j opts today
         `catch` (\e -> unless (isEOFError e) $ ioError e)
       where f = journalFilePath j
 
@@ -66,29 +66,29 @@ add opts args j
 -- validating, displaying and appending them to the journal file, until
 -- end of input (then raise an EOF exception). Any command-line arguments
 -- are used as the first transaction's description.
-getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
+getAndAddTransactions :: Journal -> CliOpts -> Day -> IO ()
-getAndAddTransactions j opts args defaultDate = do
+getAndAddTransactions j opts defaultDate = do
-  (t, d) <- getTransaction j opts args defaultDate
+  (t, d) <- getTransaction j opts defaultDate
   j <- journalAddTransaction j opts t
-  getAndAddTransactions j opts args d
+  getAndAddTransactions j opts d
 
 -- | Read a transaction from the command line, with history-aware prompting.
-getTransaction :: Journal -> [Opt] -> [String] -> Day
+getTransaction :: Journal -> CliOpts -> Day
                     -> IO (Transaction,Day)
-getTransaction j opts args defaultDate = do
+getTransaction j opts defaultDate = do
   today <- getCurrentDay
   datestr <- runInteractionDefault $ askFor "date" 
             (Just $ showDate defaultDate)
             (Just $ \s -> null s || 
              isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
   description <- runInteractionDefault $ askFor "description" (Just "") Nothing
-  let historymatches = transactionsSimilarTo j args description
+  let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description
       bestmatch | null historymatches = Nothing
                 | otherwise = Just $ snd $ head historymatches
       bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch
       date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr
       accept x = x == "." || (not . null) x &&
-        if NoNewAccts `elem` opts
+        if no_new_accounts_ opts
             then isJust $ Foldable.find (== x) ant
             else True
         where (ant,_,_,_) = groupPostings $ journalPostings j
@@ -190,11 +190,11 @@ askFor prompt def validator = do
 
 -- | Append this transaction to the journal's file, and to the journal's
 -- transaction list.
-journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal
+journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal
 journalAddTransaction j@Journal{jtxns=ts} opts t = do
   let f = journalFilePath j
   appendToJournalFile f $ showTransaction t
-  when (Debug `elem` opts) $ do
+  when (debug_ opts) $ do
     putStrLn $ printf "\nAdded transaction to %s:" f
     putStrLn =<< registerFromString (show t)
   return j{jtxns=ts++[t]}
@@ -219,8 +219,8 @@ registerFromString :: String -> IO String
 registerFromString s = do
   d <- getCurrentDay
   j <- readJournal' s
-  return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts [] d) j
+  return $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts d) j
-    where opts = [Empty]
+      where opts = defreportopts{empty_=True}
 
 -- | Return a similarity measure, from 0 to 1, for two strings.
 -- This is Simon White's letter pairs algorithm from

hledger/Hledger/Cli/Balance.hs

@@ -115,21 +115,22 @@ import Hledger.Cli.Reports
 
 
 -- | Print a balance report.
-balance :: [Opt] -> [String] -> Journal -> IO ()
+balance :: CliOpts -> Journal -> IO ()
-balance opts args j = do
+balance CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
-  let lines = case parseFormatFromOpts opts of
+  let lines = case formatFromOpts ropts of
             Left err -> [err]
-            Right _ -> accountsReportAsText opts $ accountsReport opts (optsToFilterSpec opts args d) j
+            Right _ -> accountsReportAsText ropts $ accountsReport ropts (optsToFilterSpec ropts d) j
   putStr $ unlines lines
 
 -- | Render a balance report as plain text suitable for console output.
-accountsReportAsText :: [Opt] -> AccountsReport -> [String]
+accountsReportAsText :: ReportOpts -> AccountsReport -> [String]
 accountsReportAsText opts (items, total) = concat lines ++ t
     where
-      lines = map (accountsReportItemAsText opts format) items
+      lines = case formatFromOpts opts of
-      format = formatFromOpts opts
+                Right f -> map (accountsReportItemAsText opts f) items
-      t = if NoTotal `elem` opts
+                Left err -> [[err]]
+      t = if no_total_ opts
            then []
            else ["--------------------"
                  -- TODO: This must use the format somehow
@@ -147,7 +148,7 @@ This implementation turned out to be a bit convoluted but implements the followi
     b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line.
 -}
 -- | Render one balance report line item as plain text.
-accountsReportItemAsText :: [Opt] -> [FormatString] -> AccountsReportItem -> [String]
+accountsReportItemAsText :: ReportOpts -> [FormatString] -> AccountsReportItem -> [String]
 accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
     case amounts of
       [] -> []
@@ -159,7 +160,7 @@ accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
       asText [a]    = [formatAccountsReportItem opts (Just accountName) depth a format]
       asText (a:as) = (formatAccountsReportItem opts Nothing depth a format) : asText as
 
-formatAccountsReportItem :: [Opt] -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String
+formatAccountsReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String
 formatAccountsReportItem _ _ _ _ [] = ""
 formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAccountsReportItem opts accountName depth amount fs)
   where
@@ -167,7 +168,7 @@ formatAccountsReportItem opts accountName depth amount (f:fs) = s ++ (formatAcco
             FormatLiteral l -> l
             FormatField leftJustified min max field  -> formatAccount opts accountName depth amount leftJustified min max field
 
-formatAccount :: [Opt] -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
+formatAccount :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
 formatAccount opts accountName depth balance leftJustified min max field = case field of
         Format.Account  -> formatValue leftJustified min max a
         DepthSpacer     -> case min of
@@ -176,7 +177,7 @@ formatAccount opts accountName depth balance leftJustified min max field = case
         Total           -> formatValue leftJustified min max $ showAmountWithoutPrice balance
         _	        -> ""
     where
-      a = maybe "" (accountNameDrop (dropFromOpts opts)) accountName
+      a = maybe "" (accountNameDrop (drop_ opts)) accountName
 
 tests_Hledger_Cli_Balance = TestList
  [

hledger/Hledger/Cli/Convert.hs

@@ -8,8 +8,7 @@ import Prelude hiding (getContents)
 import Control.Monad (when, guard, liftM)
 import Data.Maybe
 import Data.Time.Format (parseTime)
-import Safe (atDef, atMay, maximumDef)
+import Safe
-import Safe (readDef, readMay)
 import System.Directory (doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (takeBaseName, replaceExtension)
@@ -23,13 +22,14 @@ import Text.Printf (hPrintf)
 import Hledger.Cli.Format
 import qualified Hledger.Cli.Format as Format
 import Hledger.Cli.Version
-import Hledger.Cli.Options (Opt(Debug), progname_cli, rulesFileFromOpts)
+import Hledger.Cli.Options
+import Hledger.Cli.Reports
 import Hledger.Data.Amount (nullmixedamt, costOfMixedAmount)
 import Hledger.Data.Dates (firstJust, showDate, parsedate)
 import Hledger.Data (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
 import Hledger.Data.Journal (nullctx)
 import Hledger.Read.JournalReader (someamount,ledgeraccountname)
-import Hledger.Utils (choice', strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error', regexMatchesCI, regexReplaceCI)
+import Hledger.Utils
 import Hledger.Utils.UTF8 (getContents)
 
 {- |
@@ -84,20 +84,19 @@ type CsvRecord = [String]
 
 -- | Read the CSV file named as an argument and print equivalent journal transactions,
 -- using/creating a .rules file.
-convert :: [Opt] -> [String] -> Journal -> IO ()
+convert :: CliOpts -> Journal -> IO ()
-convert opts args _ = do
+convert opts _ = do
-  when (null args) $ error' "please specify a csv data file."
+  let csvfile = headDef "" $ patterns_ $ reportopts_ opts
-  let csvfile = head args
+  when (null csvfile) $ error' "please specify a csv data file."
   let 
-    rulesFileSpecified = isJust $ rulesFileFromOpts opts
+    rulesFileSpecified = isJust $ rules_file_ opts
+    rulesfile = rulesFileFor opts csvfile
     usingStdin = csvfile == "-"
   when (usingStdin && (not rulesFileSpecified)) $ error' "please specify a files file when converting stdin"
   csvparse <- parseCsv csvfile
   let records = case csvparse of
                   Left e -> error' $ show e
                   Right rs -> reverse $ filter (/= [""]) rs
-  let debug = Debug `elem` opts
-      rulesfile = rulesFileFor opts csvfile
   exists <- doesFileExist rulesfile
   if (not exists) then do
                   hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile
@@ -106,12 +105,12 @@ convert opts args _ = do
       hPrintf stderr "using conversion rules file %s\n" rulesfile
   rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
   let invalid = validateRules rules
-  when debug $ hPrintf stderr "rules: %s\n" (show rules)
+  when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
   when (isJust invalid) $ error (fromJust invalid)
   let requiredfields = max 2 (maxFieldIndex rules + 1)
       badrecords = take 1 $ filter ((< requiredfields).length) records
   if null badrecords
-   then mapM_ (printTxn debug rules) records
+   then mapM_ (printTxn (debug_ opts) rules) records
    else do
      hPrintf stderr (unlines [
                       "Warning, at least one CSV record does not contain a field referenced by the"
@@ -142,17 +141,13 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [
                   ,effectiveDateField r
                   ]
 
-rulesFileFor :: [Opt] -> FilePath -> FilePath
+rulesFileFor :: CliOpts -> FilePath -> FilePath
-rulesFileFor opts csvfile = 
+rulesFileFor CliOpts{rules_file_=Just f} _ = f
-    case opt of
+rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules"
-      Just path -> path
-      Nothing   -> replaceExtension csvfile ".rules"
-    where
-      opt = rulesFileFromOpts opts
 
 initialRulesFileContent :: String
 initialRulesFileContent =
-    "# csv conversion rules file generated by "++(progversionstr progname_cli)++"\n" ++
+    "# csv conversion rules file generated by "++(progversionstr progname)++"\n" ++
     "# Add rules to this file for more accurate conversion, see\n"++
     "# http://hledger.org/MANUAL.html#convert\n" ++
     "\n" ++

hledger/Hledger/Cli/Histogram.hs

@@ -13,6 +13,7 @@ import Data.Ord
 import Text.Printf
 
 import Hledger.Cli.Options
+import Hledger.Cli.Reports
 import Hledger.Data
 import Prelude hiding (putStr)
 import Hledger.Utils.UTF8 (putStr)
@@ -22,12 +23,12 @@ barchar = '*'
 
 -- | Print a histogram of some statistic per reporting interval, such as
 -- number of postings per day.
-histogram :: [Opt] -> [String] -> Journal -> IO ()
+histogram :: CliOpts -> Journal -> IO ()
-histogram opts args j = do
+histogram CliOpts{reportopts_=reportopts_} j = do
   d <- getCurrentDay
-  putStr $ showHistogram opts (optsToFilterSpec opts args d) j
+  putStr $ showHistogram reportopts_ (optsToFilterSpec reportopts_ d) j
 
-showHistogram :: [Opt] -> FilterSpec -> Journal -> String
+showHistogram :: ReportOpts -> FilterSpec -> Journal -> String
 showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
     where
       i = intervalFromOpts opts
@@ -40,13 +41,13 @@ showHistogram opts filterspec j = concatMap (printDayWith countBar) spanps
       -- should count transactions, not postings ?
       ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
       filterempties
-          | Empty `elem` opts = id
+          | empty_ opts = id
           | otherwise = filter (not . isZeroMixedAmount . pamount)
       matchapats = matchpats apats . paccount
       apats = acctpats filterspec
       filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
                   | otherwise = id
-      depth = fromMaybe 99999 $ depthFromOpts opts
+      depth = fromMaybe 99999 $ depth_ opts
 
 printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)
 

hledger/Hledger/Cli/Main.hs

@@ -39,7 +39,9 @@ See "Hledger.Data.Ledger" for more examples.
 
 module Hledger.Cli.Main where
 
+import Control.Monad
 import Data.List
+import Text.Printf
 
 import Hledger.Cli.Add
 import Hledger.Cli.Balance
@@ -52,38 +54,49 @@ import Hledger.Cli.Options
 import Hledger.Cli.Tests
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
-import Hledger.Utils
-import Prelude hiding (putStr, putStrLn)
-import Hledger.Utils.UTF8 (putStr, putStrLn)
 
 main :: IO ()
 main = do
-  (opts, args) <- parseArgumentsWith options_cli
+  opts <- getHledgerOpts
-  case validateOpts opts of
+  when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts)
-    Just err -> error' err
+  runWith opts
-    Nothing -> run opts args
 
-run opts args =
+runWith :: CliOpts -> IO ()
-  run opts args
+runWith opts = run' opts
     where 
-      run opts _
+      cmd = command_ opts
-       | Help `elem` opts             = putStr usage_cli
+      run' opts
-       | Version `elem` opts          = putStrLn $ progversionstr progname_cli
+          | null cmd                                       = printModeHelpAndExit mainmode
-       | BinaryFilename `elem` opts   = putStrLn $ binaryfilename progname_cli
+          | any (cmd `isPrefixOf`) ["accounts","balance"]  = showModeHelpOr accountsmode $ withJournalDo opts balance
-      run _ []                        = argsError "a command is required."
+          | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram
-      run opts (cmd:args)
+          | cmd `isPrefixOf` "add"                         = showModeHelpOr addmode $ withJournalDo opts add
-       | cmd `isPrefixOf` "balance"   = withJournalDo opts args cmd balance
+          | cmd `isPrefixOf` "convert"                     = showModeHelpOr convertmode $ withJournalDo opts convert
-       | cmd `isPrefixOf` "convert"   = withJournalDo opts args cmd convert
+          | any (cmd `isPrefixOf`) ["entries","print"]     = showModeHelpOr entriesmode $ withJournalDo opts print'
-       | cmd `isPrefixOf` "print"     = withJournalDo opts args cmd print'
+          | any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register
-       | cmd `isPrefixOf` "register"  = withJournalDo opts args cmd register
+          | cmd `isPrefixOf` "stats"                       = showModeHelpOr statsmode $ withJournalDo opts stats
-       | cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram
+          | cmd `isPrefixOf` "test"                        = showModeHelpOr testmode $ runtests opts >> return ()
-       | cmd `isPrefixOf` "add"       = withJournalDo opts args cmd add
+          | cmd `isPrefixOf` "binaryfilename"              = showModeHelpOr binaryfilenamemode $ putStrLn $ binaryfilename progname
-       | cmd `isPrefixOf` "stats"     = withJournalDo opts args cmd stats
+          | otherwise                                      = showModeHelpOr mainmode $ optserror $ "command "++cmd++" is not recognized"
-       | cmd `isPrefixOf` "test"      = runtests opts args >> return ()
+      showModeHelpOr mode f = do
-       | otherwise                    = argsError $ "command "++cmd++" is unrecognized."
+        when ("help" `in_` (rawopts_ opts)) $ printModeHelpAndExit mode
+        when ("version" `in_` (rawopts_ opts)) $ printVersionAndExit
+        f
 
-validateOpts :: [Opt] -> Maybe String
+{- tests:
-validateOpts opts =
+
-  case parseFormatFromOpts opts of
+hledger -> main help
-    Left err -> Just $ unlines ["Invalid format", err]
+hledger --help -> main help
-    Right _ -> Nothing
+hledger --help command -> command help
+hledger command --help -> command help
+hledger badcommand -> unrecognized command, try --help (non-zero exit)
+hledger badcommand --help -> main help
+hledger --help badcommand -> main help
+hledger --mainflag command -> works
+hledger command --mainflag -> works
+hledger command --commandflag -> works
+hledger command --mainflag --commandflag -> works
+XX hledger --mainflag command --commandflag -> works
+XX hledger --commandflag command -> works
+XX hledger --commandflag command --mainflag -> works
+
+-}

hledger/Hledger/Cli/Options.hs

@@ -1,234 +1,401 @@
 {-|
-Command-line options for the application.
+
+Command-line options for the hledger program, and option-parsing utilities.
+
 -}
 
 module Hledger.Cli.Options
 where
-import Data.Char (toLower)
 import Data.List
 import Data.Maybe
 import Data.Time.Calendar
-import System.Console.GetOpt
+import Safe
+import System.Console.CmdArgs
+import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Text
 import System.Environment
+import System.Exit
 import Test.HUnit
 
-import Hledger.Data
 import Hledger.Cli.Format as Format
-import Hledger.Read (myJournalPath, myTimelogPath)
+import Hledger.Cli.Reports
+import Hledger.Cli.Version
+import Hledger.Data
+import Hledger.Read
 import Hledger.Utils
 
 
-progname_cli = "hledger"
+progname = "hledger"
+progversion = progversionstr progname
 
--- | The program name which, if we are invoked as (via symlink or
+-- 1. cmdargs mode and flag definitions, for the main and subcommand modes.
--- renaming), causes us to default to reading the user's time log instead
+-- Flag values are parsed initially to simple RawOpts to permit reuse.
--- of their journal.
-progname_cli_time  = "hours"
 
-usage_preamble_cli =
+type RawOpts = [(String,String)]
-  "Usage: hledger [OPTIONS] COMMAND [PATTERNS]\n" ++
-  "       hledger [OPTIONS] convert CSVFILE\n" ++
-  "\n" ++
-  "Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
-  "runs the specified command (may be abbreviated):\n" ++
-  "\n" ++
-  "  add       - prompt for new transactions and add them to the journal\n" ++
-  "  balance   - show accounts, with balances\n" ++
-  "  convert   - show the specified CSV file as a hledger journal\n" ++
-  "  histogram - show a barchart of transactions per day or other interval\n" ++
-  "  print     - show transactions in journal format\n" ++
-  "  register  - show transactions as a register with running balance\n" ++
-  "  stats     - show various statistics for a journal\n" ++
-  "  test      - run self-tests\n" ++
-  "\n"
 
-usage_options_cli = usageInfo "hledger options:" options_cli
+defmode :: Mode RawOpts
+defmode =   Mode {
+  modeNames = []
+ ,modeHelp = ""
+ ,modeHelpSuffix = []
+ ,modeValue = []
+ ,modeCheck = Right
+ ,modeReform = const Nothing
+ ,modeGroupFlags = toGroup []
+ ,modeArgs = Nothing
+ ,modeGroupModes = toGroup []
+ }
 
-usage_postscript_cli =
+mainmode = defmode {
- "\n" ++
+  modeNames = [progname]
- "DATES can be y/m/d or smart dates like \"last month\".  PATTERNS are regular\n" ++
+ ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. When mixing general and command-specific flags, put them all after COMMAND."
- "expressions which filter by account name.  Prefix a pattern with desc: to\n" ++
+ ,modeHelpSuffix = help_postscript
- "filter by transaction description instead, prefix with not: to negate it.\n" ++
+ ,modeGroupFlags = Group {
- "When using both, not: comes last.\n"
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ ,modeArgs = Just mainargsflag
+ ,modeGroupModes = Group {
+     groupUnnamed = [
+     ]
+    ,groupHidden = [
+      binaryfilenamemode
+     ]
+    ,groupNamed = [
+      ("Misc commands", [
+        addmode
+       ,convertmode
+       ,testmode
+       ])
+     ,("\nReport commands", [
+        accountsmode
+       ,entriesmode
+       ,postingsmode
+       -- ,transactionsmode
+       ,activitymode
+       ,statsmode
+       ])
+     ]
+    }
+ }
 
-usage_cli = concat [
+help_postscript = [
-             usage_preamble_cli
+  -- "DATES can be Y/M/D or smart dates like \"last month\"."
-            ,usage_options_cli
+  -- ,"PATTERNS are regular"
-            ,usage_postscript_cli
+  -- ,"expressions which filter by account name.  Prefix a pattern with desc: to"
+  -- ,"filter by transaction description instead, prefix with not: to negate it."
+  -- ,"When using both, not: comes last."
  ]
 
--- | Command-line options we accept.
+generalflagstitle = "\nGeneral flags"
-options_cli :: [OptDescr Opt]
+generalflags1 = fileflags ++ reportflags ++ helpflags
-options_cli = [
+generalflags2 = fileflags ++ helpflags
-  Option "f" ["file"]         (ReqArg File "FILE")   "use a different journal/timelog file; - means stdin"
+generalflags3 = helpflags
- ,Option "b" ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date"
+
- ,Option "e" ["end"]          (ReqArg End "DATE")    "report on transactions before this date"
+fileflags = [
- ,Option "p" ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++
+  flagReq ["file","f"]  (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin"
-                                                      "and/or with the specified reporting interval\n")
+ ,flagReq ["alias"]  (\s opts -> Right $ setopt "alias" s opts)  "ACCT=ALIAS" "display ACCT's name as ALIAS in reports"
- ,Option "C" ["cleared"]      (NoArg  Cleared)       "report only on cleared transactions"
- ,Option "U" ["uncleared"]    (NoArg  UnCleared)     "report only on uncleared transactions"
- ,Option "B" ["cost","basis"] (NoArg  CostBasis)     "report cost of commodities"
- ,Option ""  ["alias"]        (ReqArg Alias "ACCT=ALIAS")  "display ACCT's name as ALIAS in reports"
- ,Option ""  ["depth"]        (ReqArg Depth "N")     "hide accounts/transactions deeper than this"
- ,Option "d" ["display"]      (ReqArg Display "EXPR") ("show only transactions matching EXPR (where\n" ++
-                                                       "EXPR is 'dOP[DATE]' and OP is <, <=, =, >=, >)")
- ,Option ""  ["effective"]    (NoArg  Effective)     "use transactions' effective dates, if any"
- ,Option "E" ["empty"]        (NoArg  Empty)         "show empty/zero things which are normally elided"
- ,Option ""  ["no-elide"]     (NoArg  NoElide)       "no eliding at all, stronger than -E (eg for balance report)"
- ,Option "R" ["real"]         (NoArg  Real)          "report only on real (non-virtual) transactions"
- ,Option ""  ["flat"]         (NoArg  Flat)          "balance: show full account names, unindented"
- ,Option ""  ["drop"]         (ReqArg Drop "N")      "balance: with --flat, elide first N account name components"
- ,Option ""  ["no-total"]     (NoArg  NoTotal)       "balance: hide the final total"
- ,Option "D" ["daily"]        (NoArg  DailyOpt)      "register, stats: report by day"
- ,Option "W" ["weekly"]       (NoArg  WeeklyOpt)     "register, stats: report by week"
- ,Option "M" ["monthly"]      (NoArg  MonthlyOpt)    "register, stats: report by month"
- ,Option "Q" ["quarterly"]    (NoArg  QuarterlyOpt)  "register, stats: report by quarter"
- ,Option "Y" ["yearly"]       (NoArg  YearlyOpt)     "register, stats: report by year"
- ,Option ""  ["no-new-accounts"] (NoArg NoNewAccts)  "add: don't allow creating new accounts"
- ,Option "r" ["rules"]        (ReqArg RulesFile "FILE") "convert: rules file to use (default:JOURNAL.rules)"
- ,Option "F" ["format"]       (ReqArg ReportFormat "STR") "use STR as the format"
- ,Option "v" ["verbose"]      (NoArg  Verbose)       "show more verbose output"
- ,Option ""  ["debug"]        (NoArg  Debug)         "show extra debug output; implies verbose"
- ,Option ""  ["binary-filename"] (NoArg BinaryFilename) "show the download filename for this hledger build"
- ,Option "V" ["version"]      (NoArg  Version)       "show version information"
- ,Option "h" ["help"]         (NoArg  Help)          "show command-line usage"
  ]
 
--- | An option value from a command-line flag.
+reportflags = [
-data Opt = 
+  flagReq  ["begin","b"]     (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"
-    File          {value::String}
+ ,flagReq  ["end","e"]       (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"
-    | NoNewAccts
+ ,flagReq  ["period","p"]    (\s opts -> Right $ setopt "period" s opts) "PERIODEXPR" "report on transactions during the specified period and/or with the specified reporting interval"
-    | Begin       {value::String}
+ ,flagNone ["daily","D"]     (\opts -> setboolopt "daily" opts) "report by day"
-    | End         {value::String}
+ ,flagNone ["weekly","W"]    (\opts -> setboolopt "weekly" opts) "report by week"
-    | Period      {value::String}
+ ,flagNone ["monthly","M"]   (\opts -> setboolopt "monthly" opts) "report by month"
-    | Cleared
+ ,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter"
-    | UnCleared
+ ,flagNone ["yearly","Y"]    (\opts -> setboolopt "yearly" opts) "report by year"
-    | CostBasis
+ ,flagNone ["cleared","C"]   (\opts -> setboolopt "cleared" opts) "report only on cleared transactions"
-    | Alias       {value::String}
+ ,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions"
-    | Depth       {value::String}
+ ,flagNone ["cost","B"]      (\opts -> setboolopt "cost" opts) "report cost of commodities"
-    | Display     {value::String}
+ ,flagReq  ["depth"]         (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this"
-    | Effective
+ ,flagReq  ["display","d"]   (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXPR" "show only transactions matching the expr, which is 'dOP[DATE]' where OP is <, <=, =, >=, >"
-    | Empty
+ ,flagNone ["effective"]     (\opts -> setboolopt "effective" opts) "use transactions' effective dates, if any"
-    | NoElide
+ ,flagNone ["empty","E"]     (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided"
-    | Real
+ ,flagNone ["real","R"]      (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"
-    | Flat
+ ]
-    | Drop        {value::String}
-    | NoTotal
-    | DailyOpt
-    | WeeklyOpt
-    | MonthlyOpt
-    | QuarterlyOpt
-    | YearlyOpt
-    | RulesFile   {value::String}
-    | ReportFormat {value::String}
-    | Help
-    | Verbose
-    | Version
-    | BinaryFilename
-    | Debug
-    -- XXX add-on options, must be defined here for now
-    -- vty
-    | DebugVty
-    -- web
-    | BaseUrl     {value::String}
-    | Port        {value::String}
-    -- chart
-    | ChartOutput {value::String}
-    | ChartItems  {value::String}
-    | ChartSize   {value::String}
-    deriving (Show,Eq)
 
--- these make me nervous
+helpflags = [
-optsWithConstructor f opts = concatMap get opts
+  flagHelpSimple (setboolopt "help")
-    where get o = [o | f v == o] where v = value o
+ ,flagNone ["debug"] (setboolopt "debug") "Show extra debug output"
+ ,flagVersion (setboolopt "version")
+ ]
 
-optsWithConstructors fs opts = concatMap get opts
+mainargsflag = flagArg f ""
-    where get o = [o | any (== o) fs]
+    where f s opts = let as = words' s
+                         cmd = headDef "" as
+                         args = drop (length cmd + 1) s
+                     in Right $ setopt "command" cmd $ setopt "args" args opts
 
-optValuesForConstructor f opts = concatMap get opts
+commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]"
-    where get o = [v | f v == o] where v = value o
 
-optValuesForConstructors fs opts = concatMap get opts
+commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]}
-    where get o = [v | any (\f -> f v == o) fs] where v = value o
 
--- | Parse the command-line arguments into options and arguments using the
+addmode = (commandmode ["add"]) {
--- specified option descriptors. Any smart dates in the options are
+  modeHelp = "prompt for new transactions and append them to the journal"
--- converted to explicit YYYY/MM/DD format based on the current time. If
+ ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
--- parsing fails, raise an error, displaying the problem along with the
+ ,modeArgs = Just commandargsflag
--- provided usage string.
+ ,modeGroupFlags = Group {
-parseArgumentsWith :: [OptDescr Opt] -> IO ([Opt], [String])
+     groupUnnamed = [
-parseArgumentsWith options = do
+      flagNone ["no-new-accounts"]  (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
-  rawargs <- map fromPlatformString `fmap` getArgs
+     ]
-  parseArgumentsWith' options rawargs
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags2)]
+    }
+ }
 
-parseArgumentsWith' options rawargs = do
+convertmode = (commandmode ["convert"]) {
-  let (opts,args,errs) = getOpt Permute options rawargs
+  modeValue = [("command","convert")]
-  opts' <- fixOptDates opts
+ ,modeHelp = "show the specified CSV file as hledger journal entries"
-  let opts'' = if Debug `elem` opts' then Verbose:opts' else opts'
+ ,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "CSVFILE"
-  if null errs
+ ,modeGroupFlags = Group {
-   then return (opts'',args)
+     groupUnnamed = [
-   else argsError (concat errs) >> return ([],[])
+      flagReq ["rules-file"]  (\s opts -> Right $ setopt "rules-file" s opts) "FILE" "rules file to use (default: CSVFILE.rules)"
+     ]
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags3)]
+    }
+ }
 
-argsError :: String -> IO ()
+testmode = (commandmode ["test"]) {
-argsError = ioError . userError' . (++ " Run with --help to see usage.")
+  modeHelp = "run self-tests, or just the ones matching REGEXPS"
+ ,modeArgs = Just $ flagArg (\s opts -> Right $ setopt "args" s opts) "[REGEXPS]"
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags3)]
+    }
+ }
 
--- | Convert any fuzzy dates within these option values to explicit ones,
+accountsmode = (commandmode ["accounts","balance"]) {
--- based on today's date.
+  modeHelp = "(or balance) show matched accounts and their balances"
-fixOptDates :: [Opt] -> IO [Opt]
+ ,modeArgs = Just commandargsflag
-fixOptDates opts = do
+ ,modeGroupFlags = Group {
+     groupUnnamed = [
+      flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
+     ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
+     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
+     ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
+     ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
+     ]
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+entriesmode = (commandmode ["entries","print"]) {
+  modeHelp = "(or print) show matched journal entries"
+ ,modeArgs = Just commandargsflag
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+postingsmode = (commandmode ["postings","register"]) {
+  modeHelp = "(or register) show matched postings and running total"
+ ,modeArgs = Just commandargsflag
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+transactionsmode = (commandmode ["transactions"]) {
+  modeHelp = "show matched transactions and balance in some account(s)"
+ ,modeArgs = Just commandargsflag
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+activitymode = (commandmode ["activity","histogram"]) {
+  modeHelp = "show a barchart of transactions per interval"
+ ,modeHelpSuffix = ["The default interval is daily."]
+ ,modeArgs = Just commandargsflag
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+statsmode = (commandmode ["stats"]) {
+  modeHelp = "show quick statistics for a journal (or part of it)"
+ ,modeArgs = Just commandargsflag
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags1)]
+    }
+ }
+
+binaryfilenamemode = (commandmode ["binaryfilename"]) {
+  modeHelp = "show the download filename for this hledger build, and exit"
+ ,modeArgs = Nothing
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = [(generalflagstitle, generalflags3)]
+    }
+ }
+
+-- 2. ADT holding options used in this package and above, parsed from RawOpts.
+-- This represents the command-line options that were provided, with all
+-- parsing completed, but before adding defaults or derived values (XXX add)
+
+-- cli options, used in hledger and above
+data CliOpts = CliOpts {
+     rawopts_         :: RawOpts
+    ,command_         :: String
+    ,file_            :: Maybe FilePath
+    ,alias_           :: [String]
+    ,debug_           :: Bool
+    ,no_new_accounts_ :: Bool           -- add
+    ,rules_file_      :: Maybe FilePath -- convert
+    ,reportopts_      :: ReportOpts
+ } deriving (Show)
+
+defcliopts = CliOpts
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+
+instance Default CliOpts where def = defcliopts
+
+-- | Parse raw option string values to the desired final data types.
+-- Any relative smart dates will be converted to fixed dates based on
+-- today's date. Parsing failures will raise an error.
+toCliOpts :: RawOpts -> IO CliOpts
+toCliOpts rawopts = do
   d <- getCurrentDay
-  return $ map (fixopt d) opts
+  return defcliopts {
-  where
+              rawopts_         = rawopts
-    fixopt d (Begin s)   = Begin $ fixSmartDateStr d s
+             ,command_         = stringopt "command" rawopts
-    fixopt d (End s)     = End $ fixSmartDateStr d s
+             ,file_            = maybestringopt "file" rawopts
-    fixopt d (Display s) = -- hacky
+             ,alias_           = listofstringopt "alias" rawopts
-        Display $ regexReplaceBy "\\[.+?\\]" fixbracketeddatestr s
+             ,debug_           = boolopt "debug" rawopts
-        where fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
+             ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
-    fixopt _ o            = o
+             ,rules_file_      = maybestringopt "rules-file" rawopts -- convert
+             ,reportopts_ = defreportopts {
+                             begin_     = maybesmartdateopt d "begin" rawopts
+                            ,end_       = maybesmartdateopt d "end" rawopts
+                            ,period_    = maybeperiodopt d rawopts
+                            ,cleared_   = boolopt "cleared" rawopts
+                            ,uncleared_ = boolopt "uncleared" rawopts
+                            ,cost_      = boolopt "cost" rawopts
+                            ,depth_     = maybeintopt "depth" rawopts
+                            ,display_   = maybedisplayopt d rawopts
+                            ,effective_ = boolopt "effective" rawopts
+                            ,empty_     = boolopt "empty" rawopts
+                            ,no_elide_  = boolopt "no-elide" rawopts
+                            ,real_      = boolopt "real" rawopts
+                            ,flat_      = boolopt "flat" rawopts -- balance
+                            ,drop_      = intopt "drop" rawopts -- balance
+                            ,no_total_  = boolopt "no-total" rawopts -- balance
+                            ,daily_     = boolopt "daily" rawopts
+                            ,weekly_    = boolopt "weekly" rawopts
+                            ,monthly_   = boolopt "monthly" rawopts
+                            ,quarterly_ = boolopt "quarterly" rawopts
+                            ,yearly_    = boolopt "yearly" rawopts
+                            ,format_    = maybestringopt "format" rawopts
+                            ,patterns_  = words'' prefixes $ singleQuoteIfNeeded $ stringopt "args" rawopts
+                            }
+             }
 
--- | Figure out the overall date span we should report on, based on any
+-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457
--- begin/end/period options provided. If there is a period option, the
+-- just handles commonest cases
--- others are ignored.
+moveFlagsAfterCommand ("-f":f:cmd:rest) = cmd:"-f":f:rest
-dateSpanFromOpts :: Day -> [Opt] -> DateSpan
+moveFlagsAfterCommand (first:cmd:rest) | "-f" `isPrefixOf` first = cmd:first:rest
-dateSpanFromOpts refdate opts
+moveFlagsAfterCommand as = as
-    | not (null popts) = case parsePeriodExpr refdate $ last popts of
-                         Right (_, s) -> s
-                         Left e       -> parseerror e
-    | otherwise = DateSpan lastb laste
-    where
-      popts = optValuesForConstructor Period opts
-      bopts = optValuesForConstructor Begin opts
-      eopts = optValuesForConstructor End opts
-      lastb = listtomaybeday bopts
-      laste = listtomaybeday eopts
-      listtomaybeday vs = if null vs then Nothing else Just $ parse $ last vs
-          where parse = parsedate . fixSmartDateStr refdate
 
--- | Figure out the reporting interval, if any, specified by the options.
+-- | Convert possibly encoded option values to regular unicode strings.
--- If there is a period option, the others are ignored.
+decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val))
-intervalFromOpts :: [Opt] -> Interval
-intervalFromOpts opts =
-    case (periodopts, intervalopts) of
-      ((p:_), _)            -> case parsePeriodExpr (parsedate "0001/01/01") p of
-                                Right (i, _) -> i
-                                Left e       -> parseerror e
-      (_, (DailyOpt:_))     -> Days 1
-      (_, (WeeklyOpt:_))    -> Weeks 1
-      (_, (MonthlyOpt:_))   -> Months 1
-      (_, (QuarterlyOpt:_)) -> Quarters 1
-      (_, (YearlyOpt:_))    -> Years 1
-      (_, _)                -> NoInterval
-    where
-      periodopts   = reverse $ optValuesForConstructor Period opts
-      intervalopts = reverse $ filter (`elem` [DailyOpt,WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
 
-rulesFileFromOpts :: [Opt] -> Maybe FilePath
+-- | Get all command-line options, failing on any parse errors.
-rulesFileFromOpts opts = listtomaybe $ optValuesForConstructor RulesFile opts
+getHledgerOpts :: IO CliOpts
-    where
+-- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts
-      listtomaybe [] = Nothing
+getHledgerOpts = do
-      listtomaybe vs = Just $ head vs
+  args <- getArgs
+  toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts
 
--- | Default balance format string: "%20(total)  %2(depth_spacer)%-(account)"
+-- utils
+
+optserror = error' . (++ " (run with --help for usage)")
+
+setopt name val = (++ [(name,singleQuoteIfNeeded val)])
+
+setboolopt name = (++ [(name,"")])
+
+in_ :: String -> RawOpts -> Bool
+in_ name = isJust . lookup name
+
+boolopt = in_
+
+maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name
+
+stringopt name = fromMaybe "" . maybestringopt name
+
+listofstringopt name rawopts = [stripquotes v | (n,v) <- rawopts, n==name]
+
+maybeintopt :: String -> RawOpts -> Maybe Int
+maybeintopt name rawopts =
+    let ms = maybestringopt name rawopts in
+    case ms of Nothing -> Nothing
+               Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s
+
+intopt name = fromMaybe 0 . maybeintopt name
+
+maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day
+maybesmartdateopt d name rawopts =
+        case maybestringopt name rawopts of
+          Nothing -> Nothing
+          Just s -> either
+                    (\e -> optserror $ "could not parse "++name++" date: "++show e)
+                    Just
+                    $ fixSmartDateStrEither' d s
+
+maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExpr
+maybedisplayopt d rawopts =
+    maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
+    where
+      fixbracketeddatestr "" = ""
+      fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"
+
+maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)
+maybeperiodopt d rawopts =
+    case maybestringopt "period" rawopts of
+      Nothing -> Nothing
+      Just s -> either
+                (\e -> optserror $ "could not parse period option: "++show e)
+                Just
+                $ parsePeriodExpr d s
+
+-- | Do final validation of processed opts, raising an error if there is trouble.
+checkCliOpts :: CliOpts -> IO CliOpts -- or pure..
+checkCliOpts opts@CliOpts{reportopts_=ropts} = do
+  case formatFromOpts ropts of
+    Left err -> optserror $ "could not parse format option: "++err
+    Right _ -> return ()
+  return opts
+
+-- | Parse any format option provided, possibly raising an error, or get
+-- the default value.
+formatFromOpts :: ReportOpts -> Either String [FormatString]
+formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_
+
+-- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
 defaultBalanceFormatString :: [FormatString]
 defaultBalanceFormatString = [
       FormatField False (Just 20) Nothing Total
@@ -237,81 +404,14 @@ defaultBalanceFormatString = [
     , FormatField True Nothing Nothing Format.Account
     ]
 
--- | Parses the --format string to either an error message or a format string.
-parseFormatFromOpts :: [Opt] -> Either String [FormatString]
-parseFormatFromOpts opts = listtomaybe $ optValuesForConstructor ReportFormat opts
-    where
-      listtomaybe :: [String] -> Either String [FormatString]
-      listtomaybe [] = Right defaultBalanceFormatString
-      listtomaybe vs = parseFormatString $ head vs
-
--- | Returns the format string. If the string can't be parsed it fails with error'.
-formatFromOpts :: [Opt] -> [FormatString]
-formatFromOpts opts = case parseFormatFromOpts opts of
-    Left err -> error' err
-    Right format -> format
-
--- | Get the value of the (last) depth option, if any.
-depthFromOpts :: [Opt] -> Maybe Int
-depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
-    where
-      listtomaybeint [] = Nothing
-      listtomaybeint vs = Just $ read $ last vs
-
--- | Get the value of the (last) drop option, if any, otherwise 0.
-dropFromOpts :: [Opt] -> Int
-dropFromOpts opts = fromMaybe 0 $ listtomaybeint $ optValuesForConstructor Drop opts
-    where
-      listtomaybeint [] = Nothing
-      listtomaybeint vs = Just $ read $ last vs
-
--- | Get the value of the (last) display option, if any.
-displayExprFromOpts :: [Opt] -> Maybe String
-displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
-    where
-      listtomaybe [] = Nothing
-      listtomaybe vs = Just $ last vs
-
--- | Get the value of the (last) baseurl option, if any.
-baseUrlFromOpts :: [Opt] -> Maybe String
-baseUrlFromOpts opts = listtomaybe $ optValuesForConstructor BaseUrl opts
-    where
-      listtomaybe [] = Nothing
-      listtomaybe vs = Just $ last vs
-
--- | Get the value of the (last) port option, if any.
-portFromOpts :: [Opt] -> Maybe Int
-portFromOpts opts = listtomaybeint $ optValuesForConstructor Port opts
-    where
-      listtomaybeint [] = Nothing
-      listtomaybeint vs = Just $ read $ last vs
-
-
--- | Get a maybe boolean representing the last cleared/uncleared option if any.
-clearedValueFromOpts opts | null os = Nothing
-                          | last os == Cleared = Just True
-                          | otherwise = Just False
-    where os = optsWithConstructors [Cleared,UnCleared] opts
-
--- | Detect which date we will report on, based on --effective.
-whichDateFromOpts :: [Opt] -> WhichDate
-whichDateFromOpts opts = if Effective `elem` opts then EffectiveDate else ActualDate
-
--- | Were we invoked as \"hours\" ?
-usingTimeProgramName :: IO Bool
-usingTimeProgramName = do
-  progname <- getProgName
-  return $ map toLower progname == progname_cli_time
-
 -- | Get the journal file path from options, an environment variable, or a default
-journalFilePathFromOpts :: [Opt] -> IO String
+journalFilePathFromOpts :: CliOpts -> IO String
 journalFilePathFromOpts opts = do
-  istimequery <- usingTimeProgramName
+  f <- myJournalPath
-  f <- if istimequery then myTimelogPath else myJournalPath
+  return $ fromMaybe f $ file_ opts
-  return $ last $ f : optValuesForConstructor File opts
 
-aliasesFromOpts :: [Opt] -> [(AccountName,AccountName)]
+aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]
-aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts
+aliasesFromOpts = map parseAlias . alias_
     where
       -- similar to ledgerAlias
       parseAlias :: String -> (AccountName,AccountName)
@@ -322,57 +422,11 @@ aliasesFromOpts opts = map parseAlias $ optValuesForConstructor Alias opts
             alias' = case alias of ('=':rest) -> rest
                                    _ -> orig
 
--- | Gather filter pattern arguments into a list of account patterns and a
+printModeHelpAndExit mode = putStrLn progversion >> putStr help >> exitSuccess
--- list of description patterns. We interpret pattern arguments as
+    where help = showText defaultWrap $ helpText HelpFormatDefault mode
--- follows: those prefixed with "desc:" are description patterns, all
--- others are account patterns; also patterns prefixed with "not:" are
--- negated. not: should come after desc: if both are used.
-parsePatternArgs :: [String] -> ([String],[String])
-parsePatternArgs args = (as, ds')
-    where
-      descprefix = "desc:"
-      (ds, as) = partition (descprefix `isPrefixOf`) args
-      ds' = map (drop (length descprefix)) ds
 
--- | Convert application options to the library's generic filter specification.
+printVersionAndExit = putStrLn progversion >> exitSuccess
-optsToFilterSpec :: [Opt] -> [String] -> Day -> FilterSpec
-optsToFilterSpec opts args d = FilterSpec {
-                                datespan=dateSpanFromOpts d opts
-                               ,cleared=clearedValueFromOpts opts
-                               ,real=Real `elem` opts
-                               ,empty=Empty `elem` opts
-                               ,acctpats=apats
-                               ,descpats=dpats
-                               ,depth = depthFromOpts opts
-                               }
-    where (apats,dpats) = parsePatternArgs args
-
--- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts
---     where
---       listtomaybe [] = Nothing
---       listtomaybe vs = Just $ last vs
 
 tests_Hledger_Cli_Options = TestList
  [
-  "dateSpanFromOpts" ~: do
-    let todaysdate = parsedate "2008/11/26"
-    let gives = is . show . dateSpanFromOpts todaysdate
-    [] `gives` "DateSpan Nothing Nothing"
-    [Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
-    [Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
-    [Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
-
-  ,"intervalFromOpts" ~: do
-    let gives = is . intervalFromOpts
-    [] `gives` NoInterval
-    [DailyOpt] `gives` Days 1
-    [WeeklyOpt] `gives` Weeks 1
-    [MonthlyOpt] `gives` Months 1
-    [QuarterlyOpt] `gives` Quarters 1
-    [YearlyOpt] `gives` Years 1
-    [Period "weekly"] `gives` Weeks 1
-    [Period "monthly"] `gives` Months 1
-    [Period "quarterly"] `gives` Quarters 1
-    [WeeklyOpt, Period "yearly"] `gives` Years 1
-
  ]

hledger/Hledger/Cli/Print.hs

@@ -18,15 +18,14 @@ import Hledger.Cli.Options
 import Hledger.Cli.Reports
 
 -- | Print journal transactions in standard format.
-print' :: [Opt] -> [String] -> Journal -> IO ()
+print' :: CliOpts -> Journal -> IO ()
-print' opts args j = do
+print' CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
-  putStr $ showTransactions opts (optsToFilterSpec opts args d) j
+  putStr $ showTransactions ropts (optsToFilterSpec ropts d) j
 
-showTransactions :: [Opt] -> FilterSpec -> Journal -> String
+showTransactions :: ReportOpts -> FilterSpec -> Journal -> String
 showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j
 
-entriesReportAsText :: [Opt] -> FilterSpec -> EntriesReport -> String
+entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String
-entriesReportAsText opts _ items = concatMap (showTransactionForPrint effective) items
+entriesReportAsText opts _ items = concatMap (showTransactionForPrint (effective_ opts)) items
-    where effective = Effective `elem` opts
 

hledger/Hledger/Cli/Register.hs

@@ -25,13 +25,13 @@ import Hledger.Cli.Reports
 
 
 -- | Print a (posting) register report.
-register :: [Opt] -> [String] -> Journal -> IO ()
+register :: CliOpts -> Journal -> IO ()
-register opts args j = do
+register CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
-  putStr $ postingsReportAsText opts $ postingsReport opts (optsToFilterSpec opts args d) j
+  putStr $ postingsReportAsText ropts $ postingsReport ropts (optsToFilterSpec ropts d) j
 
 -- | Render a register report as plain text suitable for console output.
-postingsReportAsText :: [Opt] -> PostingsReport -> String
+postingsReportAsText :: ReportOpts -> PostingsReport -> String
 postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
 
 -- | Render one register report line item as plain text. Eg:
@@ -41,7 +41,7 @@ postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd
 -- ^ displayed for first postings^
 --   only, otherwise blank
 -- @
-postingsReportItemAsText :: [Opt] -> PostingsReportItem -> String
+postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String
 postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
     where
       datedesc = case dd of Nothing -> replicate datedescwidth ' '
@@ -57,7 +57,7 @@ postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", ba
       bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b)
 
 -- XXX
-showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText [] $ mkpostingsReportItem showtxninfo p b
+showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
 
 tests_Hledger_Cli_Register :: Test
 tests_Hledger_Cli_Register = TestList

hledger/Hledger/Cli/Reports.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 {-|
 
 Generate several common kinds of report from a journal, as \"*Report\" -
@@ -9,6 +10,17 @@ on the command-line options, should move to hledger-lib later.
 -}
 
 module Hledger.Cli.Reports (
+  ReportOpts(..),
+  DisplayExpr,
+  FormatStr,
+  defreportopts,
+  dateSpanFromOpts,
+  intervalFromOpts,
+  clearedValueFromOpts,
+  whichDateFromOpts,
+  journalSelectingDateFromOpts,
+  journalSelectingAmountFromOpts,
+  optsToFilterSpec,
   -- * Entries report
   EntriesReport,
   EntriesReportItem,
@@ -42,14 +54,138 @@ import Data.Ord
 import Data.Time.Calendar
 import Data.Tree
 import Safe (headMay, lastMay)
+import System.Console.CmdArgs  -- for defaults support
 import Test.HUnit
 import Text.ParserCombinators.Parsec
 import Text.Printf
 
 import Hledger.Data
 import Hledger.Utils
-import Hledger.Cli.Options
+-- import Hledger.Cli.Utils
-import Hledger.Cli.Utils
+
+-- report options, used in hledger-lib and above
+data ReportOpts = ReportOpts {
+     begin_          :: Maybe Day
+    ,end_            :: Maybe Day
+    ,period_         :: Maybe (Interval,DateSpan)
+    ,cleared_        :: Bool
+    ,uncleared_      :: Bool
+    ,cost_           :: Bool
+    ,depth_          :: Maybe Int
+    ,display_        :: Maybe DisplayExpr
+    ,effective_      :: Bool
+    ,empty_          :: Bool
+    ,no_elide_       :: Bool
+    ,real_           :: Bool
+    ,flat_           :: Bool -- balance
+    ,drop_           :: Int  -- balance
+    ,no_total_       :: Bool -- balance
+    ,daily_          :: Bool
+    ,weekly_         :: Bool
+    ,monthly_        :: Bool
+    ,quarterly_      :: Bool
+    ,yearly_         :: Bool
+    ,format_         :: Maybe FormatStr
+    ,patterns_       :: [String]
+ } deriving (Show)
+
+type DisplayExpr = String
+type FormatStr = String
+
+defreportopts = ReportOpts
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+    def
+
+instance Default ReportOpts where def = defreportopts
+
+-- | Figure out the date span we should report on, based on any
+-- begin/end/period options provided. A period option will cause begin and
+-- end options to be ignored.
+dateSpanFromOpts :: Day -> ReportOpts -> DateSpan
+dateSpanFromOpts _ ReportOpts{..} =
+    case period_ of Just (_,span) -> span
+                    Nothing -> DateSpan begin_ end_
+
+-- | Figure out the reporting interval, if any, specified by the options.
+-- --period overrides --daily overrides --weekly overrides --monthly etc.
+intervalFromOpts :: ReportOpts -> Interval
+intervalFromOpts ReportOpts{..} =
+    case period_ of
+      Just (interval,_) -> interval
+      Nothing -> i
+          where i | daily_ = Days 1
+                  | weekly_ = Weeks 1
+                  | monthly_ = Months 1
+                  | quarterly_ = Quarters 1
+                  | yearly_ = Years 1
+                  | otherwise =  NoInterval
+
+-- | Get a maybe boolean representing the last cleared/uncleared option if any.
+clearedValueFromOpts :: ReportOpts -> Maybe Bool
+clearedValueFromOpts ReportOpts{..} | cleared_   = Just True
+                                    | uncleared_ = Just False
+                                    | otherwise  = Nothing
+
+-- | Detect which date we will report on, based on --effective.
+whichDateFromOpts :: ReportOpts -> WhichDate
+whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate
+
+-- | Convert this journal's transactions' primary date to either the
+-- actual or effective date, as per options.
+journalSelectingDateFromOpts :: ReportOpts -> Journal -> Journal
+journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts)
+
+-- | Convert this journal's postings' amounts to the cost basis amounts if
+-- specified by options.
+journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
+journalSelectingAmountFromOpts opts
+    | cost_ opts = journalConvertAmountsToCost
+    | otherwise = id
+
+-- | Convert application options to the library's generic filter specification.
+optsToFilterSpec :: ReportOpts -> Day -> FilterSpec
+optsToFilterSpec opts@ReportOpts{..} d = FilterSpec {
+                                datespan=dateSpanFromOpts d opts
+                               ,cleared= clearedValueFromOpts opts
+                               ,real=real_
+                               ,empty=empty_
+                               ,acctpats=apats
+                               ,descpats=dpats
+                               ,depth = depth_
+                               }
+    where (apats,dpats) = parsePatternArgs patterns_
+
+-- | Gather filter pattern arguments into a list of account patterns and a
+-- list of description patterns. We interpret pattern arguments as
+-- follows: those prefixed with "desc:" are description patterns, all
+-- others are account patterns; also patterns prefixed with "not:" are
+-- negated. not: should come after desc: if both are used.
+parsePatternArgs :: [String] -> ([String],[String])
+parsePatternArgs args = (as, ds')
+    where
+      descprefix = "desc:"
+      (ds, as) = partition (descprefix `isPrefixOf`) args
+      ds' = map (drop (length descprefix)) ds
 
 -------------------------------------------------------------------------------
 
@@ -60,7 +196,7 @@ type EntriesReport = [EntriesReportItem]
 type EntriesReportItem = Transaction
 
 -- | Select transactions for an entries report.
-entriesReport :: [Opt] -> FilterSpec -> Journal -> EntriesReport
+entriesReport :: ReportOpts -> FilterSpec -> Journal -> EntriesReport
 entriesReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j'
     where
       j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
@@ -79,12 +215,12 @@ type PostingsReportItem = (Maybe (Day, String) -- transaction date and descripti
 
 -- | Select postings from the journal and add running balance and other
 -- information to make a postings report. Used by eg hledger's register command.
-postingsReport :: [Opt] -> FilterSpec -> Journal -> PostingsReport
+postingsReport :: ReportOpts -> FilterSpec -> Journal -> PostingsReport
 postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting startbal (+))
     where
       ps | interval == NoInterval = displayableps
          | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayableps
-      (precedingps, displayableps, _) = postingsMatchingDisplayExpr (displayExprFromOpts opts)
+      (precedingps, displayableps, _) = postingsMatchingDisplayExpr (display_ opts)
                                         $ depthClipPostings depth
                                         $ journalPostings
                                         $ filterJournalPostings fspec{depth=Nothing}
@@ -93,7 +229,7 @@ postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting st
                                         j
       startbal = sumPostings precedingps
       filterspan = datespan fspec
-      (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
+      (interval, depth, empty) = (intervalFromOpts opts, depth_ opts, empty_ opts)
 
 totallabel = "Total"
 balancelabel = "Balance"
@@ -238,7 +374,7 @@ triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"
 -- "postingsReport" except it uses matchers and transaction-based report
 -- items and the items are most recent first. Used by eg hledger-web's
 -- journal view.
-journalTransactionsReport :: [Opt] -> Journal -> Matcher -> TransactionsReport
+journalTransactionsReport :: ReportOpts -> Journal -> Matcher -> TransactionsReport
 journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
    where
      ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
@@ -261,7 +397,7 @@ journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)
 -- Currently, reporting intervals are not supported, and report items are
 -- most recent first. Used by eg hledger-web's account register view.
 --
-accountTransactionsReport :: [Opt] -> Journal -> Matcher -> Matcher -> TransactionsReport
+accountTransactionsReport :: ReportOpts -> Journal -> Matcher -> Matcher -> TransactionsReport
 accountTransactionsReport opts j m thisacctmatcher = (label, items)
  where
      -- transactions affecting this account, in date order
@@ -269,7 +405,7 @@ accountTransactionsReport opts j m thisacctmatcher = (label, items)
      -- starting balance: if we are filtering by a start date and nothing else,
      -- the sum of postings to this account before that date; otherwise zero.
      (startbal,label) | matcherIsNull m                           = (nullmixedamt,        balancelabel)
-                      | matcherIsStartDateOnly effective m = (sumPostings priorps, balancelabel)
+                      | matcherIsStartDateOnly (effective_ opts) m = (sumPostings priorps, balancelabel)
                       | otherwise                                 = (nullmixedamt,        totallabel)
                       where
                         priorps = -- ltrace "priorps" $
@@ -278,8 +414,7 @@ accountTransactionsReport opts j m thisacctmatcher = (label, items)
                                            MatchAnd [thisacctmatcher, tostartdatematcher]))
                                          $ transactionsPostings ts
                         tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
-                        startdate = matcherStartDate effective m
+                        startdate = matcherStartDate (effective_ opts) m
-                        effective = Effective `elem` opts
      items = reverse $ accountTransactionsReportItems m (Just thisacctmatcher) startbal negate ts
 
 -- | Generate transactions report items from a list of transactions,
@@ -344,25 +479,25 @@ type AccountsReportItem = (AccountName  -- full account name
 -- | Select accounts, and get their balances at the end of the selected
 -- period, and misc. display information, for an accounts report. Used by
 -- eg hledger's balance command.
-accountsReport :: [Opt] -> FilterSpec -> Journal -> AccountsReport
+accountsReport :: ReportOpts -> FilterSpec -> Journal -> AccountsReport
 accountsReport opts filterspec j = accountsReport' opts j (journalToLedger filterspec)
 
 -- | Select accounts, and get their balances at the end of the selected
 -- period, and misc. display information, for an accounts report. Like
 -- "accountsReport" but uses the new matchers. Used by eg hledger-web's
 -- accounts sidebar.
-accountsReport2 :: [Opt] -> Matcher -> Journal -> AccountsReport
+accountsReport2 :: ReportOpts -> Matcher -> Journal -> AccountsReport
 accountsReport2 opts matcher j = accountsReport' opts j (journalToLedger2 matcher)
 
 -- Accounts report helper.
-accountsReport' :: [Opt] -> Journal -> (Journal -> Ledger) -> AccountsReport
+accountsReport' :: ReportOpts -> Journal -> (Journal -> Ledger) -> AccountsReport
 accountsReport' opts j jtol = (items, total)
     where
       items = map mkitem interestingaccts
-      interestingaccts | NoElide `elem` opts = acctnames
+      interestingaccts | no_elide_ opts = acctnames
                        | otherwise = filter (isInteresting opts l) acctnames
       acctnames = sort $ tail $ flatten $ treemap aname accttree
-      accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
+      accttree = ledgerAccountTree (fromMaybe 99999 $ depth_ opts) l
       total = sum $ map abalance $ ledgerTopAccounts l
       l =  jtol $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j
 
@@ -370,14 +505,14 @@ accountsReport' opts j jtol = (items, total)
       mkitem :: AccountName -> AccountsReportItem
       mkitem a = (a, adisplay, indent, abal)
           where
-            adisplay | Flat `elem` opts = a
+            adisplay | flat_ opts = a
                      | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a]
                 where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
-            indent | Flat `elem` opts = 0
+            indent | flat_ opts = 0
                    | otherwise = length interestingparents
             interestingparents = filter (`elem` interestingaccts) parents
             parents = parentAccountNames a
-            abal | Flat `elem` opts = exclusiveBalance acct
+            abal | flat_ opts = exclusiveBalance acct
                  | otherwise = abalance acct
                  where acct = ledgerAccount l a
 
@@ -386,24 +521,24 @@ exclusiveBalance = sumPostings . apostings
 
 -- | Is the named account considered interesting for this ledger's accounts report,
 -- following the eliding style of ledger's balance command ?
-isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
+isInteresting :: ReportOpts -> Ledger -> AccountName -> Bool
-isInteresting opts l a | Flat `elem` opts = isInterestingFlat opts l a
+isInteresting opts l a | flat_ opts = isInterestingFlat opts l a
                        | otherwise = isInterestingIndented opts l a
 
-isInterestingFlat :: [Opt] -> Ledger -> AccountName -> Bool
+isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool
 isInterestingFlat opts l a = notempty || emptyflag
     where
       acct = ledgerAccount l a
       notempty = not $ isZeroMixedAmount $ exclusiveBalance acct
-      emptyflag = Empty `elem` opts
+      emptyflag = empty_ opts
 
-isInterestingIndented :: [Opt] -> Ledger -> AccountName -> Bool
+isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool
 isInterestingIndented opts l a
     | numinterestingsubs==1 && not atmaxdepth = notlikesub
     | otherwise = notzero || emptyflag
     where
-      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
+      atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depth_ opts
-      emptyflag = Empty `elem` opts
+      emptyflag = empty_ opts
       acct = ledgerAccount l a
       notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
       notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct

hledger/Hledger/Cli/Stats.hs

@@ -15,6 +15,7 @@ import Text.Printf
 import qualified Data.Map as Map
 
 import Hledger.Cli.Options
+import Hledger.Cli.Reports
 import Hledger.Data
 import Prelude hiding (putStr)
 import Hledger.Utils.UTF8 (putStr)
@@ -22,19 +23,19 @@ import Hledger.Utils.UTF8 (putStr)
 
 -- like Register.summarisePostings
 -- | Print various statistics for the journal.
-stats :: [Opt] -> [String] -> Journal -> IO ()
+stats :: CliOpts -> Journal -> IO ()
-stats opts args j = do
+stats CliOpts{reportopts_=reportopts_} j = do
   d <- getCurrentDay
-  let filterspec = optsToFilterSpec opts args d
+  let filterspec = optsToFilterSpec reportopts_ d
       l = journalToLedger filterspec j
       reportspan = (ledgerDateSpan l) `orDatesFrom` (datespan filterspec)
-      intervalspans = splitSpan (intervalFromOpts opts) reportspan
+      intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
-      showstats = showLedgerStats opts args l d
+      showstats = showLedgerStats l d
       s = intercalate "\n" $ map showstats intervalspans
   putStr s
 
-showLedgerStats :: [Opt] -> [String] -> Ledger -> Day -> DateSpan -> String
+showLedgerStats :: Ledger -> Day -> DateSpan -> String
-showLedgerStats _ _ l today span =
+showLedgerStats l today span =
     unlines (map (uncurry (printf fmt)) stats)
     where
       fmt = "%-" ++ show w1 ++ "s: %-" ++ show w2 ++ "s"

hledger/Hledger/Cli/Tests.hs

@@ -38,22 +38,22 @@ import Hledger.Utils
 
 
 -- | Run unit tests and exit with success or failure.
-runtests :: [Opt] -> [String] -> IO ()
+runtests :: CliOpts -> IO ()
-runtests opts args = do
+runtests opts = do
-  (hunitcounts,_) <- runtests' opts args
+  (hunitcounts,_) <- runtests' opts
   if errors hunitcounts > 0 || (failures hunitcounts > 0)
    then exitFailure
    else exitWith ExitSuccess
 
 -- | Run unit tests and exit on failure.
-runTestsOrExit :: [Opt] -> [String] -> IO ()
+runTestsOrExit :: CliOpts -> IO ()
-runTestsOrExit opts args = do
+runTestsOrExit opts = do
-  (hunitcounts,_) <- runtests' opts args
+  (hunitcounts,_) <- runtests' opts
   when (errors hunitcounts > 0 || (failures hunitcounts > 0)) $ exitFailure
 
-runtests' :: Num b => t -> [String] -> IO (Counts, b)
+runtests' :: Num b => CliOpts -> IO (Counts, b)
-runtests' _ args = liftM (flip (,) 0) $ runTestTT ts
+runtests' opts = liftM (flip (,) 0) $ runTestTT ts
     where
       ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli  -- show flat test names
       -- ts = tfilter matchname $ TestList tests -- show hierarchical test names
-      matchname = matchpats args . tname
+      matchname = matchpats (patterns_ $ reportopts_ opts) . tname

hledger/Hledger/Cli/Utils.hs

@@ -10,8 +10,6 @@ module Hledger.Cli.Utils
     (
      withJournalDo,
      readJournal',
-     journalSelectingDateFromOpts,
-     journalSelectingAmountFromOpts,
      journalReload,
      journalReloadIfChanged,
      journalFileIsNewer,
@@ -25,10 +23,10 @@ module Hledger.Cli.Utils
     )
 where
 import Control.Exception
-import Control.Monad
 import Data.List
 import Data.Maybe
 import Safe (readMay)
+import System.Console.CmdArgs
 import System.Directory (getModificationTime, getDirectoryContents, copyFile)
 import System.Exit
 import System.FilePath ((</>), splitFileName, takeDirectory)
@@ -46,34 +44,22 @@ import Hledger.Utils
 
 -- | Parse the user's specified journal file and run a hledger command on
 -- it, or throw an error.
-withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
+withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
-withJournalDo opts args _ cmd = do
+withJournalDo opts cmd = do
   -- We kludgily read the file before parsing to grab the full text, unless
   -- it's stdin, or it doesn't exist and we are adding. We read it strictly
   -- to let the add command work.
   journalFilePathFromOpts opts >>= readJournalFile Nothing >>=
-    either error' (cmd opts args . journalApplyAliases (aliasesFromOpts opts))
+    either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts))
 
 -- -- | Get a journal from the given string and options, or throw an error.
--- readJournalWithOpts :: [Opt] -> String -> IO Journal
+-- readJournalWithOpts :: CliOpts -> String -> IO Journal
 -- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return
 
 -- | Get a journal from the given string, or throw an error.
 readJournal' :: String -> IO Journal
 readJournal' s = readJournal Nothing s >>= either error' return
 
--- | Convert this journal's transactions' primary date to either the
--- actual or effective date, as per options.
-journalSelectingDateFromOpts :: [Opt] -> Journal -> Journal
-journalSelectingDateFromOpts opts = journalSelectingDate (whichDateFromOpts opts)
-
--- | Convert this journal's postings' amounts to the cost basis amounts if
--- specified by options.
-journalSelectingAmountFromOpts :: [Opt] -> Journal -> Journal
-journalSelectingAmountFromOpts opts
-    | CostBasis `elem` opts = journalConvertAmountsToCost
-    | otherwise             = id
-
 -- | Re-read a journal from its data file, or return an error string.
 journalReload :: Journal -> IO (Either String Journal)
 journalReload j = readJournalFile Nothing $ journalFilePath j
@@ -83,14 +69,14 @@ journalReload j = readJournalFile Nothing $ journalFilePath j
 -- stdin). The provided options are mostly ignored. Return a journal or
 -- the error message while reading it, and a flag indicating whether it
 -- was re-read or not.
-journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool)
+journalReloadIfChanged :: CliOpts -> Journal -> IO (Either String Journal, Bool)
-journalReloadIfChanged opts j = do
+journalReloadIfChanged _ j = do
   let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
                                   return $ if newer then Just f else Nothing
   changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
   if not $ null changedfiles
    then do
-     when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles)
+     whenLoud $ printf "%s has changed, reloading\n" (head changedfiles)
      jE <- journalReload j
      return (jE, True)
    else

hledger/hledger.cabal

@@ -60,6 +60,7 @@ library
                   hledger-lib == 0.15
                  ,base >= 3 && < 5
                  ,containers
+                 ,cmdargs >= 0.7   && < 0.8
                  ,csv
                  ,directory
                  ,filepath
@@ -110,6 +111,7 @@ executable hledger
                   hledger-lib == 0.15
                  ,base >= 3 && < 5
                  ,containers
+                 ,cmdargs >= 0.7   && < 0.8
                  ,csv
                  ,directory
                  ,filepath

tests/convert-with-in-and-out-fields.test

@@ -1,5 +1,5 @@
 # Conversion from CSV to Ledger with in-field and out-field
-rm -rf unused.journal$$ convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert --rules convert.rules$$ - ; rm -rf *$$
+rm -rf convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; bin/hledger convert --rules-file convert.rules$$ - ; rm -rf *$$
 <<<
 10/2009/09,Flubber Co,50,
 11/2009/09,Flubber Co,,50

tests/convert.test

@@ -1,5 +1,5 @@
 # Conversion from CSV to Ledger
-rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert input.csv$$ ; rm -rf input.rules *$$
+rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; bin/hledger convert input.csv$$ ; rm -rf input.rules *$$
 >>>
 2009/09/10 Flubber Co
     income:unknown            $-50

tests/prices.test

@@ -12,8 +12,8 @@ bin/hledger -f- print
 
 >>>=0
 
-# 2. convert to cost basis
+# 2. convert to cost
-bin/hledger -f- print -B
+bin/hledger -f- print --cost
 <<<
 2011/01/01
     expenses:foreign currency       €100 @ $1.35
@@ -135,7 +135,7 @@ bin/hledger -f - balance -B
                    0
 >>>=0
 # 10. transaction in two commodities should balance out properly
-bin/hledger -f - balance --basis
+bin/hledger -f - balance --cost
 <<<
 2011/01/01 x
   a  10£ @@ 16$