lib/Hcompta/Filter/Read.hs

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