lib/Hcompta/Filter/Read.hs

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