dev:close: refactor

hledger/Hledger/Cli/Commands/Close.hs

@@ -8,7 +8,6 @@ module Hledger.Cli.Commands.Close (
 )
 where
 
-import Control.Monad (when)
 import Data.Function (on)
 import Data.List (groupBy)
 import Data.Maybe (fromMaybe)
@@ -20,6 +19,7 @@ import System.Console.CmdArgs.Explicit as C
 
 import Hledger
 import Hledger.Cli.CliOptions
+import Safe (lastDef, readMay)
 
 defretaindesc = "retain earnings"
 defclosedesc  = "closing balances"
@@ -54,25 +54,20 @@ closemode = hledgerCommandMode
   )
   ([], Just $ argsFlag "[--close | --open | --migrate | --retain] [ACCTQUERY]")
 
+-- | The close command's mode. Really a subcommand.
+data CloseMode = Migrate | Close | Open | Assert | Assign | Retain deriving (Eq,Show,Read,Enum)
+
+-- | Pick the rightmost flag spelled like a CloseMode (--migrate, --close, --open, etc), or default to Close.
+closeModeFromRawOpts :: RawOpts -> CloseMode
+closeModeFromRawOpts rawopts = lastDef Close $ collectopts (\(name,_) -> readMay (capitalise name)) rawopts
+
 -- Debugger, beware: close is incredibly devious; simple rules combine to make a horrid maze.
 -- Tests are in hledger/test/close.test.
--- This code is also used by the close command.
 close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
   let
-    -- currently only one of the six mode flags takes effect at a time (hledger close --close --open only does --open).
+    mode_ = closeModeFromRawOpts rawopts
-    (close_, open_, assert_, assign_, defclosedesc_, defopendesc_, defcloseacct_, defacctsq_) = if
+    defacctsq_    = if mode_ == Retain then Type [Revenue, Expense] else Type [Asset, Liability]
-      | boolopt "retain"  rawopts -> (True,  False, False, False, defretaindesc, undefined,   defretainacct, Type [Revenue, Expense])
+    defcloseacct_ = if mode_ == Retain then defretainacct else defcloseacct
-      | boolopt "migrate" rawopts -> (True,  True,  False, False, defclosedesc,  defopendesc, defcloseacct,  Type [Asset, Liability])
-      | boolopt "assign"  rawopts -> (False, False, False, True,  undefined,     defopendesc, defcloseacct,  Type [Asset, Liability])
-      | boolopt "assert"  rawopts -> (False, False, True,  False, defclosedesc,  undefined,   defcloseacct,  Type [Asset, Liability])
-      | boolopt "open"    rawopts -> (False, True,  False, False, undefined,     defopendesc, defcloseacct,  Type [Asset, Liability])
-      | otherwise {- close -}     -> (True,  False, False, False, defclosedesc,  undefined,   defcloseacct,  Type [Asset, Liability])
-
-    -- descriptions to use for the closing/opening transactions
-    closedesc = T.pack $ fromMaybe defclosedesc_ $ maybestringopt "close-desc" rawopts
-    opendesc  = T.pack $ fromMaybe defopendesc_  $ maybestringopt "open-desc"  rawopts
-
-    -- equity/balancing accounts to use
     closeacct = T.pack $ fromMaybe defcloseacct_ $ maybestringopt "close-acct" rawopts
     openacct  = maybe closeacct T.pack $ maybestringopt "open-acct" rawopts
 
@@ -115,10 +110,15 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
     interleaved = boolopt "interleaved" rawopts
 
     -- the closing (balance-asserting or balance-zeroing) transaction
-    closetxn = nulltransaction{tdate=closedate, tdescription=closedesc, tpostings=closeps}
+    mclosetxn
+      | mode_ `notElem` [Migrate, Close, Assert, Retain] = Nothing
+      | otherwise = Just nulltransaction{tdate=closedate, tdescription=closedesc, tpostings=closeps}
+      where
+        closedesc = T.pack $ fromMaybe defclosedesc_ $ maybestringopt "close-desc" rawopts
+          where defclosedesc_ = if mode_ == Retain then defretaindesc else defclosedesc
         closeps
           -- XXX some duplication
-      | assert_ =
+          | mode_ == Assert =
             [ posting{
                   paccount          = a
                   ,pamount           = mixedAmount $ precise b{aquantity=0, aprice=Nothing}
@@ -167,9 +167,13 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
             ++ [posting{paccount=closeacct, pamount=if explicit then mixedAmountSetFullPrecision totalamt else missingmixedamt} | not interleaved]
 
     -- the opening (balance-assigning or balance-unzeroing) transaction
-    opentxn = nulltransaction{tdate=opendate, tdescription=opendesc, tpostings=openps}
+    mopentxn
+      | mode_ `notElem` [Migrate, Open, Assign] = Nothing
+      | otherwise = Just nulltransaction{tdate=opendate, tdescription=opendesc, tpostings=openps}
+      where
+        opendesc  = T.pack $ fromMaybe defopendesc  $ maybestringopt "open-desc"  rawopts
         openps
-      | assign_ =
+          | mode_ == Assign =
             [ posting{paccount         = a
                     ,pamount           = missingmixedamt
                     ,pbalanceassertion = Just nullassertion{baamount=b}
@@ -210,5 +214,6 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do
             ++ [posting{paccount=openacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
 
   -- print them
-  when (close_ || assert_) . T.putStr $ showTransaction closetxn
+  maybe (pure ()) (T.putStr . showTransaction) mclosetxn
-  when (open_  || assign_) . T.putStr $ showTransaction opentxn
+  maybe (pure ()) (T.putStr . showTransaction) mopentxn
+