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