    {-# 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)
    import Control.Monad (forM_)
    import System.Console.CmdArgs.Explicit

    import Hledger
    import Hledger.Cli.CliOptions

    checkmode :: Mode RawOpts
    checkmode :: Mode RawOpts
    checkmode = String
    -> [Flag RawOpts]
    -> [(String, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Check.txt")
      []
      [(String, [Flag RawOpts])
    generalflagsgroup1]
      [Flag RawOpts]
    hiddenflags
      ([], Arg RawOpts -> Maybe (Arg RawOpts)
    forall a. a -> Maybe a
    Just (Arg RawOpts -> Maybe (Arg RawOpts))
    -> Arg RawOpts -> Maybe (Arg RawOpts)
    forall a b. (a -> b) -> a -> b
    $ String -> Arg RawOpts
    argsFlag String
    "[CHECKS]")

    check :: CliOpts -> Journal -> IO ()
    check :: CliOpts -> Journal -> IO ()
    check copts :: CliOpts
    copts@CliOpts{RawOpts
    rawopts_ :: RawOpts
    rawopts_ :: CliOpts -> RawOpts
    rawopts_} Journal
    j = do
      let
        args :: [String]
    args = String -> RawOpts -> [String]
    listofstringopt String
    "args" RawOpts
    rawopts_
        -- reset the report spec that was generated by argsToCliOpts,
        -- since we are not using arguments as a query in the usual way
        copts' :: CliOpts
    copts' = (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
    cliOptsUpdateReportSpecWith (\ReportOpts
    ropts -> ReportOpts
    ropts{querystring_=[]}) CliOpts
    copts

      case [Either String (Check, [String])]
    -> ([String], [(Check, [String])])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ((String -> Either String (Check, [String]))
    -> [String] -> [Either String (Check, [String])]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Either String (Check, [String])
    parseCheckArgument [String]
    args) of
        (unknowns :: [String]
    unknowns@(String
    _:[String]
    _), [(Check, [String])]
    _) -> String -> IO ()
    forall a. String -> a
    error' (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "These checks are unknown: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++[String] -> String
    unwords [String]
    unknowns
        ([], [(Check, [String])]
    checks) -> [(Check, [String])] -> ((Check, [String]) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Check, [String])]
    checks (((Check, [String]) -> IO ()) -> IO ())
    -> ((Check, [String]) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CliOpts -> Journal -> (Check, [String]) -> IO ()
    runCheck CliOpts
    copts' Journal
    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 :: (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
    cliOptsUpdateReportSpecWith ReportOpts -> ReportOpts
    roptsupdate copts :: CliOpts
    copts@CliOpts{ReportSpec
    reportspec_ :: ReportSpec
    reportspec_ :: CliOpts -> ReportSpec
    reportspec_} =
      case (ReportOpts -> ReportOpts)
    -> ReportSpec -> Either String ReportSpec
    updateReportSpecWith ReportOpts -> ReportOpts
    roptsupdate ReportSpec
    reportspec_ of
        Left String
    e   -> String -> CliOpts
    forall a. String -> a
    error' String
    e  -- PARTIAL:
        Right ReportSpec
    rs -> CliOpts
    copts{reportspec_=rs}

    -- | A type of error check that we can perform on the data.
    -- Some of these imply other checks that are done first,
    -- eg currently Parseable and Autobalanced are always done,
    -- and Assertions are always done unless -I is in effect.
    data Check =
      -- done always
        Parseable
      | Autobalanced
      -- done always unless -I is used
      | Assertions
      -- done when -s is used, or on demand by check
      | Accounts
      | Commodities
      | Balanced
      -- done on demand by check
      | Ordereddates
      | Payees
      | Recentassertions
      | Tags
      | Uniqueleafnames
      deriving (ReadPrec [Check]
    ReadPrec Check
    Int -> ReadS Check
    ReadS [Check]
    (Int -> ReadS Check)
    -> ReadS [Check]
    -> ReadPrec Check
    -> ReadPrec [Check]
    -> Read Check
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Check
    readsPrec :: Int -> ReadS Check
    $creadList :: ReadS [Check]
    readList :: ReadS [Check]
    $creadPrec :: ReadPrec Check
    readPrec :: ReadPrec Check
    $creadListPrec :: ReadPrec [Check]
    readListPrec :: ReadPrec [Check]
    Read,Int -> Check -> String -> String
    [Check] -> String -> String
    Check -> String
    (Int -> Check -> String -> String)
    -> (Check -> String) -> ([Check] -> String -> String) -> Show Check
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Check -> String -> String
    showsPrec :: Int -> Check -> String -> String
    $cshow :: Check -> String
    show :: Check -> String
    $cshowList :: [Check] -> String -> String
    showList :: [Check] -> String -> String
    Show,Check -> Check -> Bool
    (Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Check -> Check -> Bool
    == :: Check -> Check -> Bool
    $c/= :: Check -> Check -> Bool
    /= :: Check -> Check -> Bool
    Eq,Int -> Check
    Check -> Int
    Check -> [Check]
    Check -> Check
    Check -> Check -> [Check]
    Check -> Check -> Check -> [Check]
    (Check -> Check)
    -> (Check -> Check)
    -> (Int -> Check)
    -> (Check -> Int)
    -> (Check -> [Check])
    -> (Check -> Check -> [Check])
    -> (Check -> Check -> [Check])
    -> (Check -> Check -> Check -> [Check])
    -> Enum Check
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: Check -> Check
    succ :: Check -> Check
    $cpred :: Check -> Check
    pred :: Check -> Check
    $ctoEnum :: Int -> Check
    toEnum :: Int -> Check
    $cfromEnum :: Check -> Int
    fromEnum :: Check -> Int
    $cenumFrom :: Check -> [Check]
    enumFrom :: Check -> [Check]
    $cenumFromThen :: Check -> Check -> [Check]
    enumFromThen :: Check -> Check -> [Check]
    $cenumFromTo :: Check -> Check -> [Check]
    enumFromTo :: Check -> Check -> [Check]
    $cenumFromThenTo :: Check -> Check -> Check -> [Check]
    enumFromThenTo :: Check -> Check -> Check -> [Check]
    Enum,Check
    Check -> Check -> Bounded Check
    forall a. a -> a -> Bounded a
    $cminBound :: Check
    minBound :: Check
    $cmaxBound :: Check
    maxBound :: Check
    Bounded)

    -- | 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 :: String -> Either String Check
    parseCheck String
    s =
      Either String Check
    -> (String -> Either String Check)
    -> Maybe String
    -> Either String Check
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> Either String Check
    forall a b. a -> Either a b
    Left String
    s) (Check -> Either String Check
    forall a b. b -> Either a b
    Right (Check -> Either String Check)
    -> (String -> Check) -> String -> Either String Check
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Check
    forall a. Read a => String -> a
    read) (Maybe String -> Either String Check)
    -> Maybe String -> Either String Check
    forall a b. (a -> b) -> a -> b
    $  -- PARTIAL: read should not fail here
      (String -> Bool) -> [String] -> Maybe String
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (String
    s' String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) ([String] -> Maybe String) -> [String] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String]
    checknames
      where
        s' :: String
    s' = String -> String
    capitalise (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s
        checknames :: [String]
    checknames = (Check -> String) -> [Check] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Check -> String
    forall a. Show a => a -> String
    show [Check
    forall a. Bounded a => a
    minBound..Check
    forall a. Bounded a => a
    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 :: String -> Either String (Check, [String])
    parseCheckArgument String
    s =
      String
    -> Either String (Check, [String])
    -> Either String (Check, [String])
    forall a. Show a => String -> a -> a
    dbg3 String
    "check argument" (Either String (Check, [String])
     -> Either String (Check, [String]))
    -> Either String (Check, [String])
    -> Either String (Check, [String])
    forall a b. (a -> b) -> a -> b
    $
      ((,[String]
    checkargs)) (Check -> (Check, [String]))
    -> Either String Check -> Either String (Check, [String])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Either String Check
    parseCheck String
    checkname
      where
        (String
    checkname:[String]
    checkargs) = String -> [String]
    words' String
    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 :: CliOpts -> Journal -> (Check, [String]) -> IO ()
    runCheck CliOpts{reportspec_ :: CliOpts -> ReportSpec
    reportspec_=ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
    _rsReportOpts=ReportOpts
    ropts}} Journal
    j (Check
    chck,[String]
    _) = do
      Day
    d <- IO Day
    getCurrentDay
      let
        results :: Either String ()
    results = case Check
    chck of
          Check
    Accounts        -> Journal -> Either String ()
    journalCheckAccounts Journal
    j
          Check
    Commodities     -> Journal -> Either String ()
    journalCheckCommodities Journal
    j
          Check
    Ordereddates    -> WhichDate -> Journal -> Either String ()
    journalCheckOrdereddates (ReportOpts -> WhichDate
    whichDate ReportOpts
    ropts) Journal
    j
          Check
    Payees          -> Journal -> Either String ()
    journalCheckPayees Journal
    j
          Check
    Recentassertions -> Day -> Journal -> Either String ()
    journalCheckRecentAssertions Day
    d Journal
    j
          Check
    Tags            -> Journal -> Either String ()
    journalCheckTags Journal
    j
          Check
    Uniqueleafnames -> Journal -> Either String ()
    journalCheckUniqueleafnames Journal
    j
          -- the other checks have been done earlier during withJournalDo
          Check
    _               -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()

      case Either String ()
    results of
        Right () -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Left String
    err -> String -> IO ()
    forall a. String -> a
    error' String
    err