{-# 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