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