From dcc58d4a2b9997ee814c948740081d73aa61a5bc Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 15 Jun 2017 16:54:34 -0700 Subject: [PATCH] lib: rename ClearedStatus type to Status (and fix hard-coded enum count) --- hledger-api/hledger-api.hs | 4 +-- hledger-lib/Hledger/Data/Journal.hs | 16 ++++----- hledger-lib/Hledger/Data/Posting.hs | 2 +- hledger-lib/Hledger/Data/Types.hs | 12 +++---- hledger-lib/Hledger/Query.hs | 4 +-- hledger-lib/Hledger/Read/Common.hs | 2 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 34 ++++++++++++-------- hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger-ui/Hledger/UI/UIState.hs | 2 +- hledger-ui/Hledger/UI/UIUtils.hs | 2 +- 12 files changed, 46 insertions(+), 38 deletions(-) diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index 4b041df04..d053b0d4b 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -165,7 +165,7 @@ hledgerApiApp staticdir j = Servant.serve api server thisacctq = Acct $ accountNameToAccountRegex a -- includes subs return $ accountTransactionsReport ropts j q thisacctq -instance ToJSON ClearedStatus where toJSON = genericToJSON defaultOptions -- avoiding https://github.com/bos/aeson/issues/290 +instance ToJSON Status where toJSON = genericToJSON defaultOptions -- avoiding https://github.com/bos/aeson/issues/290 instance ToJSON GenericSourcePos where toJSON = genericToJSON defaultOptions instance ToJSON Decimal where toJSON = toJSON . show @@ -203,7 +203,7 @@ instance ToJSON Account where ,"aparentname" .= toJSON (maybe "" aname $ aparent a) ,"asubs" .= toJSON (map toJSON $ asubs a) ] -instance ToSchema ClearedStatus +instance ToSchema Status instance ToSchema GenericSourcePos instance ToSchema Decimal where diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 727c4df30..6ccaf4f19 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -346,7 +346,7 @@ filterJournalTransactions FilterSpec{datespan=datespan ,depth=depth ,fMetadata=md } = - filterJournalTransactionsByClearedStatus cleared . + filterJournalTransactionsByStatus cleared . filterJournalPostingsByDepth depth . filterJournalTransactionsByAccount apats . filterJournalTransactionsByMetadata md . @@ -366,7 +366,7 @@ filterJournalPostings FilterSpec{datespan=datespan ,fMetadata=md } = filterJournalPostingsByRealness real . - filterJournalPostingsByClearedStatus cleared . + filterJournalPostingsByStatus cleared . filterJournalPostingsByEmpty empty . filterJournalPostingsByDepth depth . filterJournalPostingsByAccount apats . @@ -393,16 +393,16 @@ filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtx -- | Keep only transactions which have the requested cleared/uncleared -- status, if there is one. -filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal -filterJournalTransactionsByClearedStatus Nothing j = j -filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} +filterJournalTransactionsByStatus :: Maybe Bool -> Journal -> Journal +filterJournalTransactionsByStatus Nothing j = j +filterJournalTransactionsByStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} where match = (==val).tstatus -- | Keep only postings which have the requested cleared/uncleared status, -- if there is one. -filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal -filterJournalPostingsByClearedStatus Nothing j = j -filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} +filterJournalPostingsByStatus :: Maybe Bool -> Journal -> Journal +filterJournalPostingsByStatus Nothing j = j +filterJournalPostingsByStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps} -- | Strip out any virtual postings, if the flag is true, otherwise do diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 1a6bca4b1..1e9324ab0 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -169,7 +169,7 @@ postingDate2 p = headDef nulldate $ catMaybes dates -- transaction, or unmarked if there is no parent transaction. (Note -- the ambiguity, unmarked can mean "posting and transaction are both -- unmarked" or "posting is unmarked and don't know about the transaction". -postingStatus :: Posting -> ClearedStatus +postingStatus :: Posting -> Status postingStatus Posting{pstatus=s, ptransaction=mt} | s == Unmarked = case mt of Just t -> tstatus t Nothing -> Unmarked diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index f4d44b9d5..fac089dfd 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -182,12 +182,12 @@ type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value. -- | The status of a transaction or posting, recorded with a status mark -- (nothing, !, or *). What these mean is ultimately user defined. -data ClearedStatus = Unmarked | Pending | Cleared - deriving (Eq,Ord,Typeable,Data,Generic) +data Status = Unmarked | Pending | Cleared + deriving (Eq,Ord,Bounded,Enum,Typeable,Data,Generic) -instance NFData ClearedStatus +instance NFData Status -instance Show ClearedStatus where -- custom show.. bad idea.. don't do it.. +instance Show Status where -- custom show.. bad idea.. don't do it.. show Unmarked = "" show Pending = "!" show Cleared = "*" @@ -195,7 +195,7 @@ instance Show ClearedStatus where -- custom show.. bad idea.. don't do it.. data Posting = Posting { pdate :: Maybe Day, -- ^ this posting's date, if different from the transaction's pdate2 :: Maybe Day, -- ^ this posting's secondary date, if different from the transaction's - pstatus :: ClearedStatus, + pstatus :: Status, paccount :: AccountName, pamount :: MixedAmount, pcomment :: Text, -- ^ this posting's comment lines, as a single non-indented multi-line string @@ -227,7 +227,7 @@ data Transaction = Transaction { tsourcepos :: GenericSourcePos, tdate :: Day, tdate2 :: Maybe Day, - tstatus :: ClearedStatus, + tstatus :: Status, tcode :: Text, tdescription :: Text, tcomment :: Text, -- ^ this transaction's comment lines, as a single non-indented multi-line string diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 5da852d69..9c3bb9e2b 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -79,7 +79,7 @@ data Query = Any -- ^ always match | Acct Regexp -- ^ match postings whose account matches this regexp | Date DateSpan -- ^ match if primary date in this date span | Date2 DateSpan -- ^ match if secondary date in this date span - | StatusQ ClearedStatus -- ^ match txns/postings with this status + | StatusQ Status -- ^ match txns/postings with this status | Real Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value | Amt OrdPlus Quantity -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value | Sym Regexp -- ^ match if the entire commodity symbol is matched by this regexp @@ -364,7 +364,7 @@ parseTag s | "=" `T.isInfixOf` s = (T.unpack n, Just $ tail $ T.unpack v) where (n,v) = T.break (=='=') s -- | Parse the value part of a "status:" query, or return an error. -parseStatus :: T.Text -> Either String ClearedStatus +parseStatus :: T.Text -> Either String Status parseStatus s | s `elem` ["*","1"] = Right Cleared | s `elem` ["!"] = Right Pending | s `elem` ["","0"] = Right Unmarked diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 0cf787556..86312346b 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -169,7 +169,7 @@ parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s --- * parsers --- ** transaction bits -statusp :: TextParser m ClearedStatus +statusp :: TextParser m Status statusp = choice' [ many spacenonewline >> char '*' >> return Cleared diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index eb03bb288..d63e46c59 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -74,7 +74,7 @@ instance Default AccountListMode where def = ALDefault data ReportOpts = ReportOpts { period_ :: Period ,interval_ :: Interval - ,clearedstatus_ :: [ClearedStatus] -- ^ Zero, one, or two statuses to be matched + ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,cost_ :: Bool ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp @@ -134,7 +134,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do return defreportopts{ period_ = periodFromRawOpts d rawopts' ,interval_ = intervalFromRawOpts rawopts' - ,clearedstatus_ = clearedStatusFromRawOpts rawopts' + ,statuses_ = statusesFromRawOpts rawopts' ,cost_ = boolopt "cost" rawopts' ,depth_ = maybeintopt "depth" rawopts' ,display_ = maybedisplayopt d rawopts' @@ -263,18 +263,26 @@ intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt | n == "yearly" = Just $ Years 1 | otherwise = Nothing --- | Get any cleared statuses to be matched, as specified by -C/--cleared, --- -P/--pending, -U/--unmarked options. -UPC is equivalent to no flags, --- so this returns a list of 0-2 unique statuses. -clearedStatusFromRawOpts :: RawOpts -> [ClearedStatus] -clearedStatusFromRawOpts = simplify . nub . sort . catMaybes . map clearedstatusfromrawopt +-- | Get any statuses to be matched, as specified by -U/--unmarked, +-- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags, +-- so this returns a list of 0-2 unique statuses. +statusesFromRawOpts :: RawOpts -> [Status] +statusesFromRawOpts = simplifyStatuses . catMaybes . map statusfromrawopt where - clearedstatusfromrawopt (n,_) - | n == "cleared" = Just Cleared - | n == "pending" = Just Pending + statusfromrawopt (n,_) | n == "unmarked" = Just Unmarked + | n == "pending" = Just Pending + | n == "cleared" = Just Cleared | otherwise = Nothing - simplify l = if length l == 3 then [] else l -- TODO: (maxBound :: ClearedStatus) or something + +-- | Reduce a list of statuses to just one of each status, +-- and if all statuses are present return the empty list. +simplifyStatuses l + | length l' >= numstatuses = [] + | otherwise = l' + where + l' = nub $ sort l + numstatuses = length [minBound .. maxBound :: Status] type DisplayExp = String @@ -322,7 +330,7 @@ queryFromOpts d ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq] [(if date2_ then Date2 else Date) $ periodAsDateSpan period_] ++ (if real_ then [Real True] else []) ++ (if empty_ then [Empty True] else []) -- ? - ++ [Or $ map StatusQ clearedstatus_] + ++ [Or $ map StatusQ statuses_] ++ (maybe [] ((:[]) . Depth) depth_) argsq = fst $ parseQuery d (T.pack query_) @@ -334,7 +342,7 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery flagsq [(if date2_ then Date2 else Date) $ periodAsDateSpan period_] ++ (if real_ then [Real True] else []) ++ (if empty_ then [Empty True] else []) -- ? - ++ [Or $ map StatusQ clearedstatus_] + ++ [Or $ map StatusQ statuses_] ++ (maybe [] ((:[]) . Depth) depth_) tests_queryFromOpts :: [Test] diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 5e1863dc0..3cd042743 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -181,7 +181,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} mdepth = depth_ ropts togglefilters = case concat [ - uiShowClearedStatus $ clearedstatus_ ropts + uiShowStatus $ statuses_ ropts ,if real_ ropts then ["real"] else [] ] of [] -> str "" diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 42f671e07..a2fd2c2eb 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -178,7 +178,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} where togglefilters = case concat [ - uiShowClearedStatus $ clearedstatus_ ropts + uiShowStatus $ statuses_ ropts ,if real_ ropts then ["real"] else [] ,if empty_ ropts then [] else ["nonzero"] ] of diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 0e05a3269..65ad028fd 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -78,7 +78,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} where togglefilters = case concat [ - uiShowClearedStatus $ clearedstatus_ ropts + uiShowStatus $ statuses_ ropts ,if real_ ropts then ["real"] else [] ,if empty_ ropts then [] else ["nonzero"] ] of diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 2f23abb22..8327010ce 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -120,7 +120,7 @@ resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=rop ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{ accountlistmode_=ALTree ,empty_=True - ,clearedstatus_=[] + ,statuses_=[] ,real_=False ,query_="" --,period_=PeriodAll diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index a5ca9d771..b1323165f 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -28,7 +28,7 @@ runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess -- ui -uiShowClearedStatus = map showstatus . sort +uiShowStatus = map showstatus . sort where showstatus Cleared = "cleared" showstatus Pending = "pending"