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         ]