lib/Hcompta/Filter/Read.hs

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