mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-16 00:37:33 +03:00
73 lines
2.4 KiB
Haskell
Executable File
73 lines
2.4 KiB
Haskell
Executable File
#!/usr/bin/env stack
|
|
-- stack runghc --verbosity info --package hledger-lib --package hledger --package string-qq --package safe --package text
|
|
|
|
-- --package time
|
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
-- import Data.Either
|
|
import Data.Maybe
|
|
import Data.String.QQ (s)
|
|
import Text.Printf
|
|
import Control.Monad
|
|
import Data.List
|
|
import qualified Data.Text as T
|
|
-- import Data.Time.Calendar
|
|
import Safe
|
|
import System.Exit
|
|
import Hledger
|
|
import Hledger.Cli
|
|
|
|
------------------------------------------------------------------------------
|
|
cmdmode :: Mode RawOpts
|
|
cmdmode = hledgerCommandMode
|
|
[s| check-postable
|
|
Check that no postings are made to accounts with a postable:(n|no) tag.
|
|
|
|
_FLAGS
|
|
|]
|
|
[]
|
|
[generalflagsgroup1]
|
|
[]
|
|
([], Nothing) -- Just $ argsFlag "[QUERY]")
|
|
------------------------------------------------------------------------------
|
|
|
|
main :: IO ()
|
|
main = do
|
|
opts@CliOpts{reportspec_=_rspec} <- getHledgerCliOpts cmdmode
|
|
withJournalDo opts $ \j -> do
|
|
let
|
|
postedaccts = journalAccountNamesUsed j
|
|
checkAcctPostable :: Journal -> AccountName -> Either AccountName ()
|
|
checkAcctPostable j a =
|
|
case lookup "postable" $ journalInheritedAccountTags j a of
|
|
Just v | T.toLower v `elem` ["no","n"] -> Left a
|
|
_ -> Right ()
|
|
case mapM_ (checkAcctPostable j) postedaccts of
|
|
Right () -> exitSuccess
|
|
Left a -> putStrLn errmsg >> exitFailure
|
|
where
|
|
firstp = headDef (error' "(unexpected: missing account)") $ -- PARTIAL: shouldn't happen
|
|
filter ((==a).paccount) $ journalPostings j
|
|
errmsg = chomp $ printf
|
|
(unlines [
|
|
"%s:%d:"
|
|
,"%s\n"
|
|
,"The postable check is enabled, so postings are disallowed in accounts with"
|
|
,"a postable:n (or postable:no) tag. This account (or one of its parents) was"
|
|
,"declared with that tag:"
|
|
,"%s"
|
|
,""
|
|
,"%s"
|
|
])
|
|
f l (textChomp excerpt) a recommendation
|
|
where
|
|
(f,l,_mcols,excerpt) = makePostingAccountErrorExcerpt firstp
|
|
recommendation = chomp $ unlines [
|
|
"Consider posting to a more specific account, or removing the postable: tag"
|
|
,"from the appropriate account directive."
|
|
]
|