check: support quoted check name + args

A "hledger check" argument may now be a quoted string containing
the check name followed by space-separated arguments, for
checks which make use of those. This means the check command
can replicate "check-dates --unique" and (in principle)
"check-fancyassertions ASSERTIONS..". Eg:

hledger check "dates --unique"

I think it'll be better for checks to take no arguments or options,
so this is probably just a transitional feature for compatibility.

hledger-lib/Hledger/Data/RawOptions.hs

@@ -11,6 +11,7 @@ module Hledger.Data.RawOptions (
   RawOpts,
   setopt,
   setboolopt,
+  appendopts,
   inRawOpts,
   boolopt,
   choiceopt,
@@ -22,7 +23,8 @@ module Hledger.Data.RawOptions (
   posintopt,
   maybeintopt,
   maybeposintopt,
-  maybecharopt
+  maybecharopt,
+  overRawOpts
 )
 where
 
@@ -47,6 +49,9 @@ setopt name val = overRawOpts (++ [(name, val)])
 setboolopt :: String -> RawOpts -> RawOpts
 setboolopt name = overRawOpts (++ [(name,"")])
 
+appendopts :: [(String,String)] -> RawOpts -> RawOpts
+appendopts new = overRawOpts $ \old -> concat [old,new]
+
 -- | Is the named option present ?
 inRawOpts :: String -> RawOpts -> Bool
 inRawOpts name = isJust . lookup name . unRawOpts

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -245,7 +245,10 @@ reportOptsToSpec day ropts = do
       , rsQueryOpts = queryopts
       }
 
--- | Regenerate a ReportSpec after updating ReportOpts.
+-- | Regenerate a ReportSpec after updating ReportOpts, or return an error
+-- message if there is a problem such as missing or unparseable options data.
+-- This helps keep the ReportSpec, its underlying ReportOpts, and the ReportOpts'
+-- data fields like querystring_ all in sync.
 updateReportSpecFromOpts :: (ReportOpts -> ReportOpts) -> ReportSpec -> Either String ReportSpec
 updateReportSpecFromOpts f rspec = reportOptsToSpec (rsToday rspec) . f $ rsOpts rspec
 

hledger/Hledger/Cli/Commands/Check.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -26,18 +28,14 @@ checkmode = hledgerCommandMode
   ([], Just $ argsFlag "[CHECKS]")
 
 check :: CliOpts -> Journal -> IO ()
-check copts@CliOpts{..} j = do
+check copts@CliOpts{rawopts_} j = do
   let 
     args = listofstringopt "args" rawopts_
-    -- we must reset the report spec generated by argsToCliOpts
+    -- reset the report spec that was generated by argsToCliOpts,
-    -- since we are not using arguments as a query in the usual way,
+    -- since we are not using arguments as a query in the usual way
-    copts' = 
+    copts' = cliOptsUpdateReportSpec (\ropts -> ropts{querystring_=[]}) copts
-      case updateReportSpecFromOpts update reportspec_ of
-        Left e -> error' e
-        Right rs -> copts{reportspec_=rs}
-      where update ropts = ropts{querystring_=[]}
 
-  case partitionEithers (map parseCheck args) of
+  case partitionEithers (map parseCheckArgument args) of
     (unknowns@(_:_), _) -> error' $ "These checks are unknown: "++unwords unknowns
     ([], checks) -> forM_ checks $ runCheck copts' j
       
@@ -47,6 +45,15 @@ data Check =
   | Leafnames
   deriving (Read,Show,Eq)
 
+-- | Parse a check argument: a string which is the lower-case name of an error check,
+-- followed by zero or more space-separated arguments for that check.
+parseCheckArgument :: String -> Either String (Check,[String])
+parseCheckArgument s =
+  dbg3 "check argument" $
+  ((,checkargs)) <$> parseCheck checkname
+  where
+    (checkname:checkargs) = words' s
+
 -- | Parse the lower-case name of an error check, or return the name unparsed.
 parseCheck :: String -> Either String Check
 parseCheck s = maybe (Left s) Right $ readMay $ capitalise s
@@ -55,13 +62,26 @@ capitalise :: String -> String
 capitalise (c:cs) = toUpper c : cs
 capitalise s = s
 
--- | Parse a check argument: a string which is the lower-case name of an error check,
+-- | Run the named error check, possibly with some arguments, 
--- followed by zero or more space-separated arguments for that check.
+-- on this journal with these options.
--- parseCheckArgument :: String -> Either String (Check,[String])
+runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
-
+runCheck copts@CliOpts{rawopts_} j (check,args) = 
-runCheck :: CliOpts -> Journal -> Check -> IO ()
+  case check of
-runCheck copts j = 
+    Dates     -> checkdates copts' j
-  \case
+    Leafnames -> checkdupes copts' j
-    Dates     -> checkdates copts j
+  where
-    Leafnames -> checkdupes copts j
+    -- Hack: append the provided args to the raw opts,
+    -- in case the check can use them (like checkdates --unique). 
+    -- Does not bother to regenerate the derived data (ReportOpts, ReportSpec..), 
+    -- so those may be inconsistent.
+    copts' = copts{rawopts_=appendopts (map (,"") args) rawopts_}
 
+-- | Regenerate this CliOpts' report specification, after updating its
+-- underlying report options with the given update function.
+-- This can raise an error if there is a problem eg due to missing or
+-- unparseable options data. See also updateReportSpecFromOpts.
+cliOptsUpdateReportSpec :: (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
+cliOptsUpdateReportSpec roptsupdate copts@CliOpts{reportspec_} =
+  case updateReportSpecFromOpts roptsupdate reportspec_ of
+    Left e   -> error' e  -- PARTIAL:
+    Right rs -> copts{reportspec_=rs}

hledger/Hledger/Cli/Commands/Checkdates.hs

@@ -25,7 +25,9 @@ checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
   let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
   let ts = filter (rsQuery rspec `matchesTransaction`) $
            jtxns $ journalSelectingAmountFromOpts ropts j
-  let unique = boolopt "unique" rawopts
+  -- pprint rawopts
+  let unique = boolopt "--unique" rawopts  -- TEMP: it's this for hledger check dates
+            || boolopt "unique" rawopts    -- and this for hledger check-dates (for some reason)
   let date = transactionDateFn ropts
   let compare a b =
         if unique