{-# 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_
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
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)
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
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
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
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_}
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
Right ReportSpec
rs -> CliOpts
copts{reportspec_ :: ReportSpec
reportspec_=ReportSpec
rs}