content: {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module Hledger.Cli.Commands.Check (
    checkmode
   ,check
  ) where
  
  import Data.Char (toLower)
  import Data.Either (partitionEithers)
  import Data.List (isPrefixOf, find, sort)
  import Control.Monad (forM_)
  import System.Console.CmdArgs.Explicit
  
  import Hledger
  import Hledger.Cli.CliOptions
  
  checkmode :: Mode RawOpts
  checkmode = hledgerCommandMode
    $(embedFileRelative "Hledger/Cli/Commands/Check.txt")
    []
    cligeneralflagsgroups1
    hiddenflags
    ([], Just $ argsFlag "[CHECKS]")
  
  check :: CliOpts -> Journal -> IO ()
  check copts@CliOpts{rawopts_} j = do
    let 
      args = listofstringopt "args" rawopts_
      -- reset the report spec that was generated by argsToCliOpts,
      -- since we are not using arguments as a query in the usual way
      copts' = cliOptsUpdateReportSpecWith (\ropts -> ropts{querystring_=[]}) copts
  
    case partitionEithers (map parseCheckArgument args) of
      (unknowns@(_:_), _) -> error' $ "These checks are unknown: "++unwords unknowns
      ([], checks) -> forM_ (sort checks) $ runCheck copts' j
        
  -- | 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.
  cliOptsUpdateReportSpecWith :: (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
  cliOptsUpdateReportSpecWith roptsupdate copts@CliOpts{reportspec_} =
    case updateReportSpecWith roptsupdate reportspec_ of
      Left e   -> error' e  -- PARTIAL:
      Right rs -> copts{reportspec_=rs}
  
  -- | A type of error check that we can perform on the data.
  -- If performing multiple checks, they will be performed in the order defined here, generally.
  -- (We report only the first failure, so the more useful checks should come first.)
  data Check =
    -- keep the order here synced with Check.md and Hledger.Data.JournalChecks.journalStrictChecks.
    -- done always
      Parseable
    | Autobalanced
    | Assertions  -- unless -I is used
    -- done when --strict is used, or when specified with the check command
    | Balanced
    | Commodities
    | Accounts
    -- done when specified with the check command
    | Ordereddates
    | Payees
    | Tags
    | Recentassertions
    | Uniqueleafnames
    deriving (Read,Show,Eq,Enum,Bounded,Ord)
  
  -- | Parse the name (or a name prefix) of an error check, or return the name unparsed.
  -- Check names are conventionally all lower case, but this parses case insensitively.
  parseCheck :: String -> Either String Check
  parseCheck s = 
    maybe (Left s) (Right . read) $  -- PARTIAL: read should not fail here
    find (s' `isPrefixOf`) $ checknames
    where
      s' = capitalise $ map toLower s
      checknames = map show [minBound..maxBound::Check]
  
  -- | Parse a check argument: a string which is the lower-case name of an error check,
  -- or a prefix thereof, 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
  
  -- XXX do all of these print on stderr ?
  -- | Run the named error check, possibly with some arguments, 
  -- on this journal with these options.
  runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
  runCheck _opts j (chck,_) = do
    let
      results = case chck of
        -- these checks are assumed to have passed earlier during journal parsing (if enabled):
        Parseable       -> Right ()
        Autobalanced    -> Right ()
        Balanced        -> Right ()
        Assertions      -> Right ()
        Accounts        -> journalCheckAccounts j
        Commodities     -> journalCheckCommodities j
        Ordereddates    -> journalCheckOrdereddates j
        Payees          -> journalCheckPayees j
        Recentassertions -> journalCheckRecentAssertions j
        Tags            -> journalCheckTags j
        Uniqueleafnames -> journalCheckUniqueleafnames j
  
    case results of
      Right () -> return ()
      Left err -> error' err
  