From 8b121bcf747287f397c8a8ff30ff533d940e8861 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Tue, 2 Aug 2022 16:11:24 +0100
Subject: [PATCH] ;feat: bin: hledger-check-postable

---
 bin/README.md                 | 12 ++++++
 bin/hledger-check-postable.hs | 72 +++++++++++++++++++++++++++++++++++
 2 files changed, 84 insertions(+)
 create mode 100755 bin/hledger-check-postable.hs

diff --git a/bin/README.md b/bin/README.md
index 9f478bfb3..a12c18826 100644
--- a/bin/README.md
+++ b/bin/README.md
@@ -123,6 +123,18 @@ interprets all tag values containing a `/` (forward slash) as file paths, and ch
 [`hledger-check-tagfiles.cabal.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-check-tagfiles.cabal.hs)
 is the same command implemented as a cabal script rather than a stack script.
 
+### hledger-check-postable
+
+[`hledger-check-postable.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-check-postable.hs)
+check that no postings are made to accounts declared with a `postable:n` or `postable:no` tag.
+This can be used as a workaround when you must declare a parent account to control display order,
+but you don't want to allow postings to it. Eg, to allow postings to assets:cash but not assets
+(remember that account tags are inherited):
+```journal
+account assets         ; postable:n
+account assets:cash    ; postable:
+```
+
 ### hledger-check-fancyassertions
 
 [`hledger-check-fancyassertions.hs`](https://github.com/simonmichael/hledger/blob/master/bin/hledger-check-fancyassertions.hs)
diff --git a/bin/hledger-check-postable.hs b/bin/hledger-check-postable.hs
new file mode 100755
index 000000000..3e83e01d5
--- /dev/null
+++ b/bin/hledger-check-postable.hs
@@ -0,0 +1,72 @@
+#!/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."
+                ]