{-# 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_
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
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
Right ReportSpec
rs -> CliOpts
copts{reportspec_=rs}
data Check =
Parseable
| Autobalanced
| Assertions
| Accounts
| Commodities
| Balanced
| 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)
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
$
(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]
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
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
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