slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: rename Query's Status constructor to StatusQ

Browse Source
This commit is contained in:
Simon Michael 2017-06-15 16:52:58 -07:00
parent eb42ea04e5
commit 430c49154a
5 changed files with 24 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
bin/hledger-check.hs
View File

@ -228,9 +228,9 @@ inAssertion account = inAssertion'
fixupJournal :: Opts -> H.Journal -> IO (H.Journal, [(H.AccountName, H.MixedAmount)]) fixupJournal :: Opts -> H.Journal -> IO (H.Journal, [(H.AccountName, H.MixedAmount)])
fixupJournal opts j = do fixupJournal opts j = do
today <- H.getCurrentDay today <- H.getCurrentDay
let j' = (if cleared opts then H.filterJournalTransactions (H.Status H.Cleared) else id) let j' = (if cleared opts then H.filterJournalTransactions (H.StatusQ H.Cleared) else id)
. (if pending opts then H.filterJournalTransactions (H.Status H.Pending) else id) . (if pending opts then H.filterJournalTransactions (H.StatusQ H.Pending) else id)
. (if unmarked opts then H.filterJournalTransactions (H.Status H.Unmarked) else id) . (if unmarked opts then H.filterJournalTransactions (H.StatusQ H.Unmarked) else id)
. (if real opts then H.filterJournalTransactions (H.Real True) else id) . (if real opts then H.filterJournalTransactions (H.Real True) else id)
$ H.journalApplyAliases (aliases opts) j $ H.journalApplyAliases (aliases opts) j
let starting = case begin opts of let starting = case begin opts of

4
hledger-lib/Hledger/Data/Types.hs
View File

@ -182,10 +182,6 @@ type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value.
-- | The status of a transaction or posting, recorded with a status mark -- | The status of a transaction or posting, recorded with a status mark
-- (nothing, !, or *). What these mean is ultimately user defined. -- (nothing, !, or *). What these mean is ultimately user defined.
-- Calling the unmarked state "Unmarked" creates some ambiguity
-- but is traditional in Ledger/hledger so we keep it (#564).
-- Calling the type "Cleared..." might also be confusing, just Status
-- would be better but that's currently used as a Query constructor.
data ClearedStatus = Unmarked | Pending | Cleared data ClearedStatus = Unmarked | Pending | Cleared
deriving (Eq,Ord,Typeable,Data,Generic) deriving (Eq,Ord,Typeable,Data,Generic)

34
hledger-lib/Hledger/Query.hs
View File

@ -79,7 +79,7 @@ data Query = Any -- ^ always match
| Acct Regexp -- ^ match postings whose account matches this regexp | Acct Regexp -- ^ match postings whose account matches this regexp
| Date DateSpan -- ^ match if primary date in this date span | Date DateSpan -- ^ match if primary date in this date span
| Date2 DateSpan -- ^ match if secondary date in this date span | Date2 DateSpan -- ^ match if secondary date in this date span
| Status ClearedStatus -- ^ match txns/postings with this status | StatusQ ClearedStatus -- ^ match txns/postings with this status
| Real Bool -- ^ match if "realness" (involves a real non-virtual account ?) has this value | 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 | 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 | Sym Regexp -- ^ match if the entire commodity symbol is matched by this regexp
@ -104,7 +104,7 @@ instance Show Query where
show (Acct r) = "Acct " ++ show r show (Acct r) = "Acct " ++ show r
show (Date ds) = "Date (" ++ show ds ++ ")" show (Date ds) = "Date (" ++ show ds ++ ")"
show (Date2 ds) = "Date2 (" ++ show ds ++ ")" show (Date2 ds) = "Date2 (" ++ show ds ++ ")"
show (Status b) = "Status " ++ show b show (StatusQ b) = "StatusQ " ++ show b
show (Real b) = "Real " ++ show b show (Real b) = "Real " ++ show b
show (Amt ord qty) = "Amt " ++ show ord ++ " " ++ show qty show (Amt ord qty) = "Amt " ++ show ord ++ " " ++ show qty
show (Sym r) = "Sym " ++ show r show (Sym r) = "Sym " ++ show r
@ -270,7 +270,7 @@ parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
Right (_,span) -> Left $ Date span Right (_,span) -> Left $ Date span
parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
Right st -> Left $ Status st Right st -> Left $ StatusQ st
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s
@ -290,11 +290,11 @@ tests_parseQueryTerm = [
"a" `gives` (Left $ Acct "a") "a" `gives` (Left $ Acct "a")
"acct:expenses:autres d\233penses" `gives` (Left $ Acct "expenses:autres d\233penses") "acct:expenses:autres d\233penses" `gives` (Left $ Acct "expenses:autres d\233penses")
"not:desc:a b" `gives` (Left $ Not $ Desc "a b") "not:desc:a b" `gives` (Left $ Not $ Desc "a b")
"status:1" `gives` (Left $ Status Cleared) "status:1" `gives` (Left $ StatusQ Cleared)
"status:*" `gives` (Left $ Status Cleared) "status:*" `gives` (Left $ StatusQ Cleared)
"status:!" `gives` (Left $ Status Pending) "status:!" `gives` (Left $ StatusQ Pending)
"status:0" `gives` (Left $ Status Unmarked) "status:0" `gives` (Left $ StatusQ Unmarked)
"status:" `gives` (Left $ Status Unmarked) "status:" `gives` (Left $ StatusQ Unmarked)
"real:1" `gives` (Left $ Real True) "real:1" `gives` (Left $ Real True)
"date:2008" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) "date:2008" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01"))
"date:from 2012/5/17" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) "date:from 2012/5/17" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing)
@ -433,7 +433,7 @@ tests_filterQuery = [
let (q,p) `gives` r = assertEqual "" r (filterQuery p q) let (q,p) `gives` r = assertEqual "" r (filterQuery p q)
(Any, queryIsDepth) `gives` Any (Any, queryIsDepth) `gives` Any
(Depth 1, queryIsDepth) `gives` Depth 1 (Depth 1, queryIsDepth) `gives` Depth 1
(And [And [Status Cleared,Depth 1]], not . queryIsDepth) `gives` Status Cleared (And [And [StatusQ Cleared,Depth 1]], not . queryIsDepth) `gives` StatusQ Cleared
-- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])] -- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])]
] ]
@ -480,7 +480,7 @@ queryIsReal (Real _) = True
queryIsReal _ = False queryIsReal _ = False
queryIsStatus :: Query -> Bool queryIsStatus :: Query -> Bool
queryIsStatus (Status _) = True queryIsStatus (StatusQ _) = True
queryIsStatus _ = False queryIsStatus _ = False
queryIsEmpty :: Query -> Bool queryIsEmpty :: Query -> Bool
@ -675,7 +675,7 @@ matchesPosting (Acct r) p = matchesPosting p || matchesPosting (originalPosting
where matchesPosting p = regexMatchesCI r $ T.unpack $ paccount p -- XXX pack where matchesPosting p = regexMatchesCI r $ T.unpack $ paccount p -- XXX pack
matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date span) p = span `spanContainsDate` postingDate p
matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
matchesPosting (Status s) p = postingStatus p == s matchesPosting (StatusQ s) p = postingStatus p == s
matchesPosting (Real v) p = v == isReal p matchesPosting (Real v) p = v == isReal p
matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
@ -692,15 +692,15 @@ tests_matchesPosting = [
"matchesPosting" ~: do "matchesPosting" ~: do
-- matching posting status.. -- matching posting status..
assertBool "positive match on cleared posting status" $ assertBool "positive match on cleared posting status" $
(Status Cleared) `matchesPosting` nullposting{pstatus=Cleared} (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
assertBool "negative match on cleared posting status" $ assertBool "negative match on cleared posting status" $
not $ (Not $ Status Cleared) `matchesPosting` nullposting{pstatus=Cleared} not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
assertBool "positive match on unmarked posting status" $ assertBool "positive match on unmarked posting status" $
(Status Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
assertBool "negative match on unmarked posting status" $ assertBool "negative match on unmarked posting status" $
not $ (Not $ Status Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
assertBool "positive match on true posting status acquired from transaction" $ assertBool "positive match on true posting status acquired from transaction" $
(Status Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}}
assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
@ -732,7 +732,7 @@ matchesTransaction (Desc r) t = regexMatchesCI r $ T.unpack $ tdescription t
matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date span) t = spanContainsDate span $ tdate t
matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t
matchesTransaction (Status s) t = tstatus t == s matchesTransaction (StatusQ s) t = tstatus t == s
matchesTransaction (Real v) t = v == hasRealPostings t matchesTransaction (Real v) t = v == hasRealPostings t
matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t
matchesTransaction (Empty _) _ = True matchesTransaction (Empty _) _ = True

4
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -266,8 +266,8 @@ tests_postingsReport = [
(Any, samplejournal) `gives` 11 (Any, samplejournal) `gives` 11
-- register --depth just clips account names -- register --depth just clips account names
(Depth 2, samplejournal) `gives` 11 (Depth 2, samplejournal) `gives` 11
(And [Depth 1, Status Cleared, Acct "expenses"], samplejournal) `gives` 2 (And [Depth 1, StatusQ Cleared, Acct "expenses"], samplejournal) `gives` 2
(And [And [Depth 1, Status Cleared], Acct "expenses"], samplejournal) `gives` 2 (And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2
-- with query and/or command-line options -- with query and/or command-line options
assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal) assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)

4
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -322,7 +322,7 @@ queryFromOpts d ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_] [(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
++ (if real_ then [Real True] else []) ++ (if real_ then [Real True] else [])
++ (if empty_ then [Empty True] else []) -- ? ++ (if empty_ then [Empty True] else []) -- ?
++ [Or $ map Status clearedstatus_] ++ [Or $ map StatusQ clearedstatus_]
++ (maybe [] ((:[]) . Depth) depth_) ++ (maybe [] ((:[]) . Depth) depth_)
argsq = fst $ parseQuery d (T.pack query_) argsq = fst $ parseQuery d (T.pack query_)
@ -334,7 +334,7 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery flagsq
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_] [(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
++ (if real_ then [Real True] else []) ++ (if real_ then [Real True] else [])
++ (if empty_ then [Empty True] else []) -- ? ++ (if empty_ then [Empty True] else []) -- ?
++ [Or $ map Status clearedstatus_] ++ [Or $ map StatusQ clearedstatus_]
++ (maybe [] ((:[]) . Depth) depth_) ++ (maybe [] ((:[]) . Depth) depth_)
tests_queryFromOpts :: [Test] tests_queryFromOpts :: [Test]