{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Check (
  checkmode
 ,check
) where

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Checkdupes (checkdupes)
import Hledger.Cli.Commands.Checkdates (checkdates)
import System.Console.CmdArgs.Explicit
import Data.Either (partitionEithers)
import Data.Char (toUpper)
import Safe (readMay)
import Control.Monad (forM_)

checkmode :: Mode RawOpts
checkmode :: Mode RawOpts
checkmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Check.txt")
  []
  [(CommandDoc, [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
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[CHECKS]")

check :: CliOpts -> Journal -> IO ()
check :: CliOpts -> Journal -> IO ()
check copts :: CliOpts
copts@CliOpts{RawOpts
rawopts_ :: CliOpts -> RawOpts
rawopts_ :: RawOpts
rawopts_} Journal
j = do
  let 
    args :: [CommandDoc]
args = CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"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_ :: [Text]
querystring_=[]}) CliOpts
copts

  case [Either CommandDoc (Check, [CommandDoc])]
-> ([CommandDoc], [(Check, [CommandDoc])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((CommandDoc -> Either CommandDoc (Check, [CommandDoc]))
-> [CommandDoc] -> [Either CommandDoc (Check, [CommandDoc])]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Either CommandDoc (Check, [CommandDoc])
parseCheckArgument [CommandDoc]
args) of
    (unknowns :: [CommandDoc]
unknowns@(CommandDoc
_:[CommandDoc]
_), [(Check, [CommandDoc])]
_) -> CommandDoc -> IO ()
forall a. CommandDoc -> a
error' (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandDoc
"These checks are unknown: "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++[CommandDoc] -> CommandDoc
unwords [CommandDoc]
unknowns
    ([], [(Check, [CommandDoc])]
checks) -> [(Check, [CommandDoc])]
-> ((Check, [CommandDoc]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Check, [CommandDoc])]
checks (((Check, [CommandDoc]) -> IO ()) -> IO ())
-> ((Check, [CommandDoc]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> (Check, [CommandDoc]) -> IO ()
runCheck CliOpts
copts' Journal
j
      
-- | A type of error check that we can perform on the data.
data Check =
    Ordereddates
  | 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
readListPrec :: ReadPrec [Check]
$creadListPrec :: ReadPrec [Check]
readPrec :: ReadPrec Check
$creadPrec :: ReadPrec Check
readList :: ReadS [Check]
$creadList :: ReadS [Check]
readsPrec :: Int -> ReadS Check
$creadsPrec :: Int -> ReadS Check
Read,Int -> Check -> CommandDoc -> CommandDoc
[Check] -> CommandDoc -> CommandDoc
Check -> CommandDoc
(Int -> Check -> CommandDoc -> CommandDoc)
-> (Check -> CommandDoc)
-> ([Check] -> CommandDoc -> CommandDoc)
-> Show Check
forall a.
(Int -> a -> CommandDoc -> CommandDoc)
-> (a -> CommandDoc) -> ([a] -> CommandDoc -> CommandDoc) -> Show a
showList :: [Check] -> CommandDoc -> CommandDoc
$cshowList :: [Check] -> CommandDoc -> CommandDoc
show :: Check -> CommandDoc
$cshow :: Check -> CommandDoc
showsPrec :: Int -> Check -> CommandDoc -> CommandDoc
$cshowsPrec :: Int -> Check -> CommandDoc -> CommandDoc
Show,Check -> Check -> Bool
(Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Check -> Check -> Bool
$c/= :: Check -> Check -> Bool
== :: Check -> Check -> Bool
$c== :: Check -> Check -> Bool
Eq)

-- | Parse the name of an error check, or return the name unparsed.
-- Names are conventionally all lower case, but this parses case insensitively.
parseCheck :: String -> Either String Check
parseCheck :: CommandDoc -> Either CommandDoc Check
parseCheck CommandDoc
s = Either CommandDoc Check
-> (Check -> Either CommandDoc Check)
-> Maybe Check
-> Either CommandDoc Check
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CommandDoc -> Either CommandDoc Check
forall a b. a -> Either a b
Left CommandDoc
s) Check -> Either CommandDoc Check
forall a b. b -> Either a b
Right (Maybe Check -> Either CommandDoc Check)
-> Maybe Check -> Either CommandDoc Check
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Maybe Check
forall a. Read a => CommandDoc -> Maybe a
readMay (CommandDoc -> Maybe Check) -> CommandDoc -> Maybe Check
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
capitalise CommandDoc
s

capitalise :: String -> String
capitalise :: CommandDoc -> CommandDoc
capitalise (Char
c:CommandDoc
cs) = Char -> Char
toUpper Char
c Char -> CommandDoc -> CommandDoc
forall a. a -> [a] -> [a]
: CommandDoc
cs
capitalise CommandDoc
s = CommandDoc
s

-- | 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 :: CommandDoc -> Either CommandDoc (Check, [CommandDoc])
parseCheckArgument CommandDoc
s =
  CommandDoc
-> Either CommandDoc (Check, [CommandDoc])
-> Either CommandDoc (Check, [CommandDoc])
forall a. Show a => CommandDoc -> a -> a
dbg3 CommandDoc
"check argument" (Either CommandDoc (Check, [CommandDoc])
 -> Either CommandDoc (Check, [CommandDoc]))
-> Either CommandDoc (Check, [CommandDoc])
-> Either CommandDoc (Check, [CommandDoc])
forall a b. (a -> b) -> a -> b
$
  ((,[CommandDoc]
checkargs)) (Check -> (Check, [CommandDoc]))
-> Either CommandDoc Check
-> Either CommandDoc (Check, [CommandDoc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandDoc -> Either CommandDoc Check
parseCheck CommandDoc
checkname
  where
    (CommandDoc
checkname:[CommandDoc]
checkargs) = CommandDoc -> [CommandDoc]
words' CommandDoc
s

-- | 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, [CommandDoc]) -> IO ()
runCheck copts :: CliOpts
copts@CliOpts{RawOpts
rawopts_ :: RawOpts
rawopts_ :: CliOpts -> RawOpts
rawopts_} Journal
j (Check
check,[CommandDoc]
args) = 
  case Check
check of
    Check
Ordereddates     -> CliOpts -> Journal -> IO ()
checkdates CliOpts
copts' Journal
j
    Check
Uniqueleafnames -> CliOpts -> Journal -> IO ()
forall p. p -> Journal -> IO ()
checkdupes CliOpts
copts' Journal
j
  where
    -- 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' :: CliOpts
copts' = CliOpts
copts{rawopts_ :: RawOpts
rawopts_=[(CommandDoc, CommandDoc)] -> RawOpts -> RawOpts
appendopts ((CommandDoc -> (CommandDoc, CommandDoc))
-> [CommandDoc] -> [(CommandDoc, CommandDoc)]
forall a b. (a -> b) -> [a] -> [b]
map (,CommandDoc
"") [CommandDoc]
args) RawOpts
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.
cliOptsUpdateReportSpecWith :: (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
cliOptsUpdateReportSpecWith :: (ReportOpts -> ReportOpts) -> CliOpts -> CliOpts
cliOptsUpdateReportSpecWith ReportOpts -> ReportOpts
roptsupdate copts :: CliOpts
copts@CliOpts{ReportSpec
reportspec_ :: CliOpts -> ReportSpec
reportspec_ :: ReportSpec
reportspec_} =
  case (ReportOpts -> ReportOpts)
-> ReportSpec -> Either CommandDoc ReportSpec
updateReportSpecWith ReportOpts -> ReportOpts
roptsupdate ReportSpec
reportspec_ of
    Left CommandDoc
e   -> CommandDoc -> CliOpts
forall a. CommandDoc -> a
error' CommandDoc
e  -- PARTIAL:
    Right ReportSpec
rs -> CliOpts
copts{reportspec_ :: ReportSpec
reportspec_=ReportSpec
rs}