]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Filter/Read.hs
Ajout : syntax/ledger.vim : ledgerChart.
[comptalang.git] / lib / Hcompta / Filter / Read.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE NamedFieldPuns #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5 {-# LANGUAGE TupleSections #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module Hcompta.Filter.Read where
8
9 import Control.Applicative ((<$>), (<*))
10 import Control.Exception (assert)
11 import Control.Monad (Monad(..), liftM, join, when, (=<<), (>=>), void, forM)
12 -- import Control.Monad.Trans.Except (ExceptT(..), throwE)
13 import Data.Bool
14 import Data.Char
15 import Data.Data
16 import Data.Either (Either(..))
17 import Data.Eq (Eq(..))
18 import qualified Data.Foldable
19 import Data.Foldable (Foldable(..))
20 import Data.Functor (Functor(..))
21 import Data.Functor.Identity (Identity)
22 import Data.List ((++), concat, head, map, reverse, tail)
23 -- import Data.List.NonEmpty (NonEmpty(..))
24 -- import qualified Data.List.NonEmpty as NonEmpty
25 import Data.Maybe (Maybe(..), catMaybes, maybe)
26 import Data.Ord (Ord(..))
27 import Data.String (String, fromString)
28 import Data.Text (Text)
29 import qualified Data.Text as Text
30 import qualified Data.Time.Clock as Time
31 import Data.Tuple (snd)
32 import Data.Typeable ()
33 import Prelude (($), (.), Integer, IO, Num(..), undefined)
34 import qualified Text.Parsec.Expr as R
35 import qualified Text.Parsec as R hiding
36 ( char
37 , anyChar
38 , crlf
39 , newline
40 , noneOf
41 , oneOf
42 , satisfy
43 , space
44 , spaces
45 , string
46 )
47 -- import qualified Text.Parsec.Expr as R
48 import Text.Parsec (Stream, ParsecT, (<|>), (<?>))
49 import Text.Show (Show(..))
50
51 import qualified Hcompta.Account.Read as Account.Read
52 import Hcompta.Amount (Amount)
53 import qualified Hcompta.Amount as Amount
54 import qualified Hcompta.Amount.Read as Amount.Read
55 import qualified Hcompta.Amount.Unit as Unit
56 import Hcompta.Date (Date)
57 import qualified Hcompta.Date as Date
58 import qualified Hcompta.Date.Read as Date.Read
59 import qualified Hcompta.Filter as Filter
60 import Hcompta.Filter hiding (Amount)
61 import Hcompta.Lib.Interval (Interval)
62 import qualified Hcompta.Lib.Interval as Interval
63 import qualified Hcompta.Lib.Parsec as R
64 -- import Hcompta.Lib.Regex (Regex)
65 import qualified Hcompta.Lib.Regex as Regex
66
67 -- * Parsers' types
68
69 -- ** Type 'Context'
70
71 data Context
72 = Context
73 { context_date :: Date
74 } deriving (Data, Eq, Show, Typeable)
75
76 context :: Context
77 context =
78 Context
79 { context_date = Date.nil
80 }
81
82 -- ** Type 'Error'
83
84 data Error
85 = Error_Unknown
86 | Error_Filter_Date Date.Read.Error
87 | Error_Filter_Date_Interval (Integer, Integer)
88 deriving (Show)
89
90 -- * Read
91
92 read ::
93 ( Stream s (R.Error_State Error Identity) Char
94 , Show t
95 )
96 => ParsecT s Context (R.Error_State Error Identity) (Filter_Bool t)
97 -> s -> IO (Either [R.Error Error] (Filter_Bool t))
98 read t s = do
99 context_date <- Time.getCurrentTime
100 return $
101 R.runParser_with_Error t context{context_date} "" s
102
103 -- ** Read 'Filter_Text'
104 filter_text
105 :: (Stream s m Char, Monad r)
106 => ParsecT s u m (String -> r Filter_Text)
107 filter_text =
108 R.choice_try
109 [ R.char '~' >> return (Regex.of_StringM >=> (return . Filter_Text_Regex))
110 , R.char '=' >> return (\s -> return (Filter_Text_Exact $ Text.pack s))
111 , return (\s -> return (Filter_Text_Exact $ Text.pack s))
112 ]
113
114 filter_text_operator
115 :: Stream s m Char
116 => ParsecT s u m String
117 filter_text_operator =
118 R.choice_try
119 [ R.string "="
120 , R.string "~"
121 ]
122
123 -- ** Read 'Filter_Ord'
124 filter_ord
125 :: (Stream s m Char, Ord o)
126 => ParsecT s u m (o -> Filter_Ord o)
127 filter_ord =
128 R.choice_try
129 [ R.string "=" >> return (Filter_Ord Eq)
130 , R.string "<=" >> return (Filter_Ord Le) -- NOTE: before "<"
131 , R.string ">=" >> return (Filter_Ord Ge) -- NOTE: before ">"
132 , R.string "<" >> return (Filter_Ord Lt)
133 , R.string ">" >> return (Filter_Ord Gt)
134 ]
135
136 filter_ord_operator
137 :: Stream s m Char
138 => ParsecT s u m String
139 filter_ord_operator =
140 R.choice_try
141 [ R.string "="
142 , R.string "<="
143 , R.string ">="
144 , R.string "<"
145 , R.string ">"
146 ]
147
148 -- ** Read 'Filter_Num_Abs'
149 filter_num_abs
150 :: (Stream s m Char, Num n)
151 => ParsecT s u m (Filter_Ord n -> m (Either (Filter_Ord n) (Filter_Num_Abs n)))
152 filter_num_abs =
153 R.choice_try
154 [ R.char '+' >> return (return . Right . Filter_Num_Abs)
155 , return (return . Left)
156 ]
157
158 text :: Stream s m Char => String -> ParsecT s Context m Text
159 text none_of =
160 fromString <$>
161 R.choice_try
162 [ borders inside
163 , R.many $ R.noneOf ("() " ++ none_of)
164 ]
165 where
166 borders = R.between (R.char '(') (R.char ')')
167 inside = liftM concat $ R.many (R.choice_try [borders preserve_inside, R.many1 $ R.noneOf "()"])
168 preserve_inside = inside >>= (\x -> return $ '(':(x++[')']))
169
170 -- ** Read 'Filter_Bool'
171
172 filter_bool
173 :: (Stream s m Char)
174 => [ParsecT s u m (ParsecT s u m (Filter_Bool t))]
175 -> ParsecT s u m (Filter_Bool t)
176 filter_bool terms =
177 R.buildExpressionParser
178 filter_bool_operators
179 (filter_bool_term terms)
180 <?> "filter_bool"
181
182 filter_bool_operators
183 :: Stream s m Char
184 => R.OperatorTable s u m (Filter.Filter_Bool t)
185 filter_bool_operators =
186 [ [ prefix "- " Filter.Not
187 ]
188 , [ binary " & " Filter.And R.AssocLeft
189 ]
190 , [ binary " + " Filter.Or R.AssocLeft
191 , binary " - " (\x -> Filter.And x . Filter.Not) R.AssocLeft
192 ]
193 ]
194 where
195 binary name fun = R.Infix (filter_bool_operator name >> return fun)
196 prefix name fun = R.Prefix (filter_bool_operator name >> return fun)
197 -- postfix name fun = Text.Parsec.Expr.Postfix (filter_bool_operator name >> return fun)
198
199 filter_bool_operator
200 :: Stream s m Char
201 => String -> ParsecT s u m ()
202 filter_bool_operator name =
203 R.try $
204 (R.string name
205 >> R.notFollowedBy filter_bool_operator_letter
206 -- <* R.spaces
207 <?> name)
208
209 filter_bool_operator_letter
210 :: Stream s m Char => ParsecT s u m Char
211 filter_bool_operator_letter =
212 R.oneOf ['-', '&', '+']
213
214 filter_bool_term
215 :: Stream s m Char
216 => [ParsecT s u m (ParsecT s u m (Filter_Bool t))]
217 -> ParsecT s u m (Filter_Bool t)
218 filter_bool_term terms = (do
219 join $ R.choice_try
220 ( (R.lookAhead (R.try (R.spaces >> R.char '('))
221 >> (return $ parens $
222 Data.Foldable.foldr Filter.And Filter.Any <$>
223 R.many (R.try (R.spaces >> expr)) ))
224 : terms
225 ) <* R.spaces) <?> "boolean-term"
226 where
227 expr =
228 R.lookAhead (R.try R.anyToken)
229 >> R.notFollowedBy (R.char ')')
230 >> filter_bool terms
231
232 parens
233 :: Stream s m Char
234 => ParsecT s u m a
235 -> ParsecT s u m a
236 parens =
237 R.between
238 (R.spaces >> R.char '(')
239 (R.spaces >> R.char ')')
240
241 bool :: Stream s m Char => ParsecT s u m Bool
242 bool = do
243 R.choice_try
244 [ R.choice_try
245 [ R.string "1"
246 , R.string "true"
247 , R.string "t"
248 ] >> return True
249 , R.choice_try
250 [ R.string "0"
251 , R.string "false"
252 , R.string "f"
253 ] >> return False
254 ]
255
256 jump :: Stream s m Char
257 => [String]
258 -> ParsecT s u m b
259 -> a
260 -> ParsecT s u m a
261 jump prefixes next r =
262 R.choice_try (map (\s -> R.string s >> return r) prefixes)
263 <* R.lookAhead (R.try next)
264
265 -- ** Read 'Filter_Account'
266 -- | Return the 'Filter_Posting_Type' and stripped 'Account' of the given 'Account'.
267 account_posting_type :: [String] -> (Filter_Posting_Type, [String])
268 account_posting_type acct =
269 maybe
270 (Filter_Posting_Type_Any, acct)
271 (Filter_Posting_Type_Exact Posting_Type_Virtual,) $ do
272 case acct of
273 [] -> Nothing
274 [('[':n)] ->
275 case reverse n of
276 "]" -> Just $ []
277 ']':rs -> Just $ [reverse rs]
278 _ -> Nothing
279 ('[':fn):ns ->
280 let rs = reverse ns in
281 case reverse $ Data.List.head rs of
282 ']':ln -> Just $ fn : reverse (reverse ln : Data.List.tail rs)
283 _ -> Nothing
284 _ -> Nothing
285
286 filter_account
287 :: Stream s m Char
288 => ParsecT s u m (Filter_Posting_Type, Filter_Account)
289 filter_account = do
290 R.notFollowedBy $ R.space_horizontal
291 Filter_Ord o () <-
292 R.option (Filter_Ord Eq ()) $ R.try $
293 (\f -> f ()) <$> filter_ord
294 (Filter_Path o <$>) <$> account
295 where
296 account :: Stream s m Char => ParsecT s u m (Filter_Posting_Type, [Filter_Path_Section])
297 account = do
298 (pt, strings) <-
299 account_posting_type <$>
300 R.many1_separated
301 (R.many (R.satisfy (\c -> c /= Account.Read.section_sep && not (Data.Char.isSpace c))))
302 (R.char Account.Read.section_sep)
303 sections <- forM strings $ \s ->
304 case s of
305 "" -> return Filter_Path_Section_Many
306 "*" -> return Filter_Path_Section_Any
307 '~':t -> Filter_Path_Section_Text . Filter_Text_Regex <$> Regex.of_StringM t
308 t -> return $ Filter_Path_Section_Text $ Filter_Text_Exact $ Text.pack t
309 return (pt, if null sections then [Filter_Path_Section_Many] else sections)
310
311 -- ** Read 'Filter_Amount'
312 filter_amount
313 :: Stream s m Char
314 => ParsecT s u m (Filter_Amount Amount)
315 filter_amount = do
316 R.notFollowedBy $ R.space_horizontal
317 R.choice_try
318 [ filter_ord
319 >>= \tst -> do
320 amt <- Amount.Read.amount
321 return $ And
322 (Bool $ Filter_Amount_Section_Quantity (tst $ Amount.quantity amt))
323 (case Unit.text $ Amount.unit amt of
324 unit | Text.null unit -> Any
325 unit -> Bool $ Filter_Amount_Section_Unit (Filter_Unit (Filter_Text_Exact unit)))
326 , filter_text
327 >>= \tst -> do
328 unit <- Amount.Read.unit >>= tst . Text.unpack . Unit.text
329 return $ Bool $ Filter_Amount_Section_Unit (Filter_Unit unit)
330 ]
331
332 filter_amount_operator
333 :: Stream s m Char
334 => ParsecT s u m String
335 filter_amount_operator =
336 R.choice_try
337 [ filter_ord_operator
338 , filter_text_operator
339 ]
340
341 -- ** Read 'Filter_Date'
342 filter_date
343 :: (Stream s (R.Error_State Error m) Char, Monad m)
344 => ParsecT s Context (R.Error_State Error m) (Filter_Bool Filter_Date)
345 filter_date = do
346 join $ R.choice_try
347 [ R.char '=' >>
348 (return $ read_date_pattern)
349 , filter_ord >>= \tst ->
350 return $ do
351 ctx <- R.getState
352 let (year, _, _) = Date.gregorian $ context_date ctx
353 liftM (Bool . Filter_Date_UTC . tst) $
354 Date.Read.date Error_Filter_Date (Just year)
355 ]
356 where
357 read_date_pattern
358 :: (Stream s (R.Error_State Error m) Char, Monad m)
359 => ParsecT s u (R.Error_State Error m) (Filter_Bool Filter_Date)
360 read_date_pattern = (do
361 let read2 = of_digits <$> (R.try (R.count 2 R.digit) <|> R.count 1 R.digit)
362 n0 <- read_interval Error_Filter_Date_Interval $ of_digits <$> R.many1 R.digit
363 n1 <- R.option Nothing $ R.try $ do
364 _ <- R.char '/'
365 Just <$> read_interval Error_Filter_Date_Interval read2
366 n2 <- R.option Nothing $ R.try $ do
367 _ <- R.char '/'
368 Just <$> read_interval Error_Filter_Date_Interval read2
369 let (year, month, dom) =
370 case (n1, n2) of
371 (Nothing, Nothing) ->
372 ( Interval.unlimited
373 , n0
374 , Interval.unlimited )
375 (Just d1, Nothing) ->
376 ( Interval.unlimited
377 , n0
378 , d1 )
379 (Nothing, Just _d2) -> assert False undefined
380 (Just d1, Just d2) ->
381 ( n0
382 , d1
383 , d2 )
384 (hour, minute, second) <-
385 R.option (Interval.unlimited, Interval.unlimited, Interval.unlimited) $ R.try $ do
386 _ <- R.char '_'
387 hour <- read_interval Error_Filter_Date_Interval read2
388 sep <- Date.Read.hour_separator
389 minute <- read_interval Error_Filter_Date_Interval read2
390 second <- R.option Interval.unlimited $ R.try $ do
391 _ <- R.char sep
392 read_interval Error_Filter_Date_Interval $ of_digits <$> R.many1 R.digit
393 -- tz <- R.option Time.utc $ R.try $ do
394 -- -- R.skipMany $ R.space_horizontal
395 -- Date.Read.time_zone
396 return
397 ( hour
398 , minute
399 , second
400 )
401 return $
402 foldr And Any $
403 catMaybes $
404 [ just_when_limited (Filter_Date_Year . Filter_Interval_In) year
405 , just_when_limited (Filter_Date_Month . Filter_Interval_In) (Interval.fmap_unsafe (fmap fromInteger) month)
406 , just_when_limited (Filter_Date_DoM . Filter_Interval_In) (Interval.fmap_unsafe (fmap fromInteger) dom)
407 , just_when_limited (Filter_Date_Hour . Filter_Interval_In) (Interval.fmap_unsafe (fmap fromInteger) hour)
408 , just_when_limited (Filter_Date_Minute . Filter_Interval_In) (Interval.fmap_unsafe (fmap fromInteger) minute)
409 , just_when_limited (Filter_Date_Second . Filter_Interval_In) (Interval.fmap_unsafe (fmap fromInteger) second)
410 ]
411 ) <?> "date-filter"
412 where
413 of_digits :: Num n => [Char] -> n
414 of_digits = fromInteger . R.integer_of_digits 10
415 just_when_limited f x =
416 if x == Interval.unlimited
417 then Nothing
418 else Just $ Bool $ f x
419
420 read_interval
421 :: (Stream s (R.Error_State e m) Char, Monad m, Ord x)
422 => ((x, x) -> e)
423 -> ParsecT s u (R.Error_State e m) x
424 -> ParsecT s u (R.Error_State e m) (Interval (Interval.Unlimitable x))
425 read_interval err read_digits = do
426 l <- R.choice_try
427 [ R.string ".." >> return Interval.Unlimited_low
428 , Interval.Limited <$> read_digits
429 ]
430 R.choice_try
431 [ when (l /= Interval.Unlimited_low)
432 (void $ R.string "..") >> do
433 h <- R.choice_try
434 [ Interval.Limited <$> read_digits
435 , return Interval.Unlimited_high
436 ]
437 case (Interval.<=..<=) l h of
438 Nothing -> R.fail_with "interval" (err $ (Interval.limited l, Interval.limited h))
439 Just i -> return i
440 , return $
441 case l of
442 Interval.Limited _ -> Interval.point l
443 _ -> Interval.unlimited
444 ]
445
446 filter_date_operator
447 :: Stream s m Char
448 => ParsecT s u m String
449 filter_date_operator =
450 filter_ord_operator
451
452 -- ** Read 'Filter_Description'
453 filter_description
454 :: Stream s m Char
455 => ParsecT s u m Filter_Text
456 filter_description = (do
457 make_filter_text <- filter_text
458 R.between (R.char '"') (R.char '"') $
459 make_filter_text =<< (R.many $ R.try $ R.satisfy (/= '"'))
460 ) <?> "description"
461
462 filter_description_operator
463 :: Stream s m Char
464 => ParsecT s u m String
465 filter_description_operator =
466 filter_text_operator
467
468 -- ** Read 'Filter_Tag'
469
470 filter_tag
471 :: Stream s m Char
472 => ParsecT s u m Filter_Tag
473 filter_tag = do
474 R.notFollowedBy $ R.space_horizontal
475 Filter_Ord o () <- (\f -> f ()) <$> filter_ord
476 filter_tag_value <-
477 R.choice_try
478 [ R.char '^' >> return Filter_Tag_Value_First
479 , R.char '$' >> return Filter_Tag_Value_Last
480 , return Filter_Tag_Value_Any
481 ]
482 strings <-
483 R.many1_separated
484 (R.many (R.satisfy (\c -> c /= Account.Read.section_sep && not (Data.Char.isSpace c))))
485 (R.char Account.Read.section_sep)
486 sections <- forM strings $ \s ->
487 case s of
488 "" -> return Filter_Path_Section_Many
489 "*" -> return Filter_Path_Section_Any
490 '~':t -> Filter_Path_Section_Text . Filter_Text_Regex <$> Regex.of_StringM t
491 t -> return $ Filter_Path_Section_Text $ Filter_Text_Exact $ Text.pack t
492 case reverse sections of
493 [] -> R.parserZero
494 [p] -> return $ Bool $ Filter_Tag_Path $ Filter_Path o [p]
495 value:rev_path ->
496 return $ And
497 (Bool $ Filter_Tag_Path $ Filter_Path o $ reverse rev_path)
498 (Bool $ Filter_Tag_Value $ filter_tag_value $
499 case value of
500 Filter_Path_Section_Any -> Filter_Text_Any
501 Filter_Path_Section_Many -> Filter_Text_Any
502 Filter_Path_Section_Text ft -> ft
503 )
504
505 filter_tag_operator
506 :: Stream s m Char
507 => ParsecT s u m String
508 filter_tag_operator = do
509 void filter_ord_operator
510 R.choice_try
511 [ R.string "^"
512 , R.string "$"
513 , R.string ""
514 ]
515
516 -- ** Read 'Filter_Posting'
517 filter_posting ::
518 ( Stream s m Char
519 , Filter.Posting p
520 , Posting_Amount p ~ Amount
521 )
522 => ParsecT s Context m (Filter_Bool (Filter_Posting p))
523 filter_posting =
524 Data.Foldable.foldr Filter.And Filter.Any <$>
525 do R.many $
526 R.spaces
527 >> R.lookAhead R.anyToken
528 >> filter_bool filter_posting_terms
529
530 filter_posting_terms ::
531 ( Stream s m Char
532 , Filter.Posting p
533 , Posting_Amount p ~ Amount
534 )
535 => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_Posting p)))]
536 filter_posting_terms =
537 [ jump [ "a", "amount" ] filter_amount_operator
538 ((Bool . Filter.Filter_Posting_Amount) <$> filter_amount)
539 , return $ liftM
540 (\(pt, a) ->
541 And
542 (Bool $ Filter_Posting_Account a)
543 (Bool $ Filter_Posting_Type pt)
544 ) filter_account
545 ]
546
547 -- ** Read 'Filter_Transaction'
548 filter_transaction ::
549 ( Stream s (R.Error_State Error m) Char
550 , Monad m
551 , Filter.Transaction t
552 , Posting_Amount (Transaction_Posting t) ~ Amount
553 ) => ParsecT s Context (R.Error_State Error m)
554 (Filter_Bool (Filter_Transaction t))
555 filter_transaction =
556 glue_posting . Data.Foldable.foldr Filter.And Filter.Any <$>
557 do R.many $
558 R.spaces
559 >> R.lookAhead R.anyToken
560 >> filter_bool filter_transaction_terms
561 where
562 glue_posting
563 :: Transaction t
564 => Filter_Bool (Filter_Transaction t)
565 -> Filter_Bool (Filter_Transaction t)
566 glue_posting fb =
567 case fb of
568 Any -> Any
569 Bool p -> Bool p
570 (Or b0 b1) -> Or (glue_posting b0) (glue_posting b1)
571 (Not b) ->
572 case glue_posting b of
573 Bool (Filter_Transaction_Posting p) ->
574 Bool $ Filter_Transaction_Posting $ Not p
575 bb -> Not bb
576 (And b0 b1) ->
577 case (glue_posting b0, glue_posting b1) of
578 ( Bool (Filter_Transaction_Posting p0),
579 Bool (Filter_Transaction_Posting p1)
580 ) -> Bool $ Filter_Transaction_Posting $ And p0 p1
581 (Bool (Filter_Transaction_Posting p0), Any) ->
582 Bool $ Filter_Transaction_Posting $ p0
583 (Any, Bool (Filter_Transaction_Posting p1)) ->
584 Bool $ Filter_Transaction_Posting $ p1
585 (b0', b1') -> And b0' b1'
586
587 filter_transaction_terms ::
588 ( Stream s (R.Error_State Error m) Char
589 , Filter.Transaction t
590 , Monad m
591 , Posting_Amount (Transaction_Posting t) ~ Amount
592 )
593 => [ParsecT s Context (R.Error_State Error m)
594 (ParsecT s Context (R.Error_State Error m)
595 (Filter_Bool (Filter_Transaction t)))]
596 filter_transaction_terms =
597 -- , jump [ "atag" ] comp_text parseFilterATag
598 -- , jump [ "code" ] comp_text parseFilterCode
599 [ jump [ "date", "d" ] filter_date_operator
600 (Bool . Filter.Filter_Transaction_Date <$> filter_date)
601 , jump [ "tag", "T" ] filter_tag_operator
602 (Bool . Filter.Filter_Transaction_Tag <$> filter_tag)
603 , jump [ "debit", "D" ] filter_amount_operator
604 (( Bool
605 . Filter_Transaction_Posting
606 . Bool
607 . Filter_Posting_Positive
608 ) <$> filter_amount)
609 , jump [ "credit", "C" ] filter_amount_operator
610 (( Bool
611 . Filter_Transaction_Posting
612 . Bool
613 . Filter_Posting_Negative
614 ) <$> filter_amount)
615 , jump [ "wording", "W" ] filter_description_operator
616 (Bool . Filter.Filter_Transaction_Description <$> filter_description)
617 -- , jump [ "date2", "edate" ] (R.char '=') parseFilterDate2
618 -- , jump [ "real" ] (R.char '=') parseFilterReal
619 -- , jump [ "status" ] (R.char '=') parseFilterStatus
620 -- , jump [ "sym" ] comp_text parseFilterSym
621 -- , R.lookAhead comp_num >> return parseFilterAmount
622 , return $ liftM
623 (\(pt, a) ->
624 Bool $
625 Filter_Transaction_Posting $
626 And (Bool $ Filter_Posting_Account a)
627 (Bool $ Filter_Posting_Type pt)
628 ) filter_account
629 ]
630
631 -- ** Read 'Filter_Balance'
632 filter_balance
633 :: (Stream s m Char, Filter.Balance t, Balance_Amount t ~ Amount)
634 => ParsecT s Context m (Filter_Bool (Filter_Balance t))
635 filter_balance =
636 Data.Foldable.foldr Filter.And Filter.Any <$>
637 do R.many $
638 R.spaces
639 >> R.lookAhead R.anyToken
640 >> filter_bool filter_balance_terms
641
642 filter_balance_terms
643 :: (Stream s m Char, Filter.Balance t, Balance_Amount t ~ Amount)
644 => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_Balance t)))]
645 filter_balance_terms =
646 [ jump [ "RD", "debit" ] filter_amount_operator
647 ( Bool . Filter_Balance_Positive
648 <$> filter_amount )
649 , jump [ "RC", "credit" ] filter_amount_operator
650 ( Bool . Filter_Balance_Negative
651 <$> filter_amount )
652 , jump [ "RB", "balance" ] filter_amount_operator
653 ( Bool . Filter_Balance_Amount
654 <$> filter_amount )
655 , return
656 ( Bool . Filter_Balance_Account . snd
657 <$> filter_account )
658 ]
659
660 -- ** Read 'Filter_GL'
661 filter_gl
662 :: (Stream s m Char, Filter.GL t, GL_Amount t ~ Amount)
663 => ParsecT s Context m (Filter_Bool (Filter_GL t))
664 filter_gl =
665 Data.Foldable.foldr Filter.And Filter.Any <$>
666 do R.many $
667 R.spaces
668 >> R.lookAhead R.anyToken
669 >> filter_bool filter_gl_terms
670
671 filter_gl_terms
672 :: (Stream s m Char, Filter.GL t, GL_Amount t ~ Amount)
673 => [ParsecT s Context m (ParsecT s Context m (Filter_Bool (Filter_GL t)))]
674 filter_gl_terms =
675 [ jump [ "D", "debit" ] filter_amount_operator
676 ( Bool . Filter_GL_Amount_Positive
677 <$> filter_amount )
678 , jump [ "C", "credit" ] filter_amount_operator
679 ( Bool . Filter_GL_Amount_Negative
680 <$> filter_amount )
681 , jump [ "B", "balance" ] filter_amount_operator
682 ( Bool . Filter_GL_Amount_Balance
683 <$> filter_amount )
684 , jump [ "RD", "running-debit" ] filter_amount_operator
685 ( Bool . Filter_GL_Sum_Positive
686 <$> filter_amount )
687 , jump [ "RC", "running-credit" ] filter_amount_operator
688 ( Bool . Filter_GL_Sum_Negative
689 <$> filter_amount )
690 , jump [ "RB", "running-balance" ] filter_amount_operator
691 ( Bool . Filter_GL_Sum_Balance
692 <$> filter_amount )
693 , return
694 ( Bool . Filter_GL_Account . snd
695 <$> filter_account )
696 ]