lib/Hcompta/Model/Filter/Read.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE NamedFieldPuns #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5 module Hcompta.Model.Filter.Read where
   6
   7 import           Prelude hiding (filter)
   8 import           Control.Applicative ((<$>), (<*))
   9 import           Control.Exception (assert)
  10 import           Control.Monad (liftM)
  11 -- import           Control.Monad.Trans.Except (ExceptT(..), throwE)
  12 import qualified Data.Char
  13 import           Data.Data
  14 import qualified Data.Foldable
  15 import           Data.Functor.Identity (Identity)
  16 import           Data.Maybe (catMaybes)
  17 import qualified Data.Time.Clock     as Time
  18 import qualified Text.Parsec.Expr as R
  19 import qualified Text.Parsec as R hiding
  20                   ( char
  21                   , anyChar
  22                   , crlf
  23                   , newline
  24                   , noneOf
  25                   , oneOf
  26                   , satisfy
  27                   , space
  28                   , spaces
  29                   , string
  30                   )
  31 -- import qualified Text.Parsec.Expr as R
  32 import           Text.Parsec (Stream, ParsecT, (<|>), (<?>))
  33 import           Data.String (fromString)
  34 import qualified Data.Text as Text
  35 import           Data.Text (Text)
  36 import           Data.Typeable ()
  37
  38 import qualified Hcompta.Lib.Regex as Regex
  39 -- import           Hcompta.Lib.Regex (Regex)
  40 import qualified Hcompta.Model.Account as Account
  41 import qualified Hcompta.Model.Date as Date
  42 import           Hcompta.Model.Date (Date)
  43 import qualified Hcompta.Model.Date.Read as Date.Read
  44 import qualified Hcompta.Model.Filter as Filter
  45 import           Hcompta.Model.Filter
  46 import qualified Hcompta.Lib.Parsec as R
  47
  48 -- * Parsers' types
  49
  50 -- ** Type 'Context'
  51
  52 data Context
  53  =   Context
  54  { context_date :: Date
  55  } deriving (Data, Eq, Show, Typeable)
  56
  57 context :: Context
  58 context =
  59         Context
  60          { context_date = Date.nil
  61          }
  62
  63 -- ** Type 'Error'
  64
  65 data Error
  66  =   Error_Unknown
  67  |   Error_Test_Date         Date.Read.Error
  68  deriving (Show)
  69
  70 -- * Read
  71
  72 read ::
  73  ( Stream s (R.Error_State Error Identity) Char
  74  , Show t
  75  )
  76  => ParsecT s Context (R.Error_State Error Identity) (Test_Bool t)
  77  -> s -> IO (Either [R.Error Error] (Test_Bool t))
  78 read t s = do
  79         context_date <- Time.getCurrentTime
  80         return $
  81                 R.runParser_with_Error t context{context_date} "" s
  82
  83 -- ** Read 'Test_Text'
  84 test_text
  85  :: (Stream s m Char, Monad r)
  86  => ParsecT s u m (String -> r Test_Text)
  87 test_text =
  88         R.choice_try
  89          [ R.char '~' >> return (\s -> Regex.of_StringM s >>= (return . Test_Text_Regex))
  90          , R.char '=' >> return (\s -> return (Test_Text_Exact $ Text.pack s))
  91          ,               return (\s -> return (Test_Text_Exact $ Text.pack s))
  92          ]
  93
  94 test_text_operator
  95  :: Stream s m Char
  96  => ParsecT s u m String
  97 test_text_operator =
  98         R.choice_try
  99          [ R.string "="
 100          , R.string "~"
 101          ]
 102
 103 -- ** Read 'Test_Ord'
 104 test_ord
 105  :: (Stream s m Char, Ord o)
 106  => ParsecT s u m (o -> Test_Ord o)
 107 test_ord =
 108         R.choice_try
 109          [ R.string "="  >> return Test_Ord_Eq
 110          , R.string "<=" >> return Test_Ord_Le
 111          , R.string ">=" >> return Test_Ord_Ge
 112          , R.string "<"  >> return Test_Ord_Lt
 113          , R.string ">"  >> return Test_Ord_Gt
 114          ]
 115
 116 test_ord_operator
 117  :: Stream s m Char
 118  => ParsecT s u m String
 119 test_ord_operator =
 120         R.choice_try
 121          [ R.string "="
 122          , R.string "<="
 123          , R.string ">="
 124          , R.string "<"
 125          , R.string ">"
 126          ]
 127
 128 -- ** Read 'Test_Num_Abs'
 129 test_num_abs
 130  :: (Stream s m Char, Num n)
 131  => ParsecT s u m (Test_Ord n -> m (Either (Test_Ord n) (Test_Num_Abs n)))
 132 test_num_abs =
 133         R.choice_try
 134          [ R.char '+' >> return (return . Right . Test_Num_Abs)
 135          , return (return . Left)
 136          ]
 137
 138 text :: Stream s m Char => String -> ParsecT s Context m Text
 139 text none_of =
 140         fromString <$>
 141         R.choice_try
 142          [ borders inside
 143          , R.many $ R.noneOf ("() " ++ none_of)
 144          ]
 145         where
 146                 borders = R.between (R.char '(') (R.char ')')
 147                 inside = liftM concat $ R.many (R.choice_try [borders preserve_inside, R.many1 $ R.noneOf "()"])
 148                 preserve_inside = inside >>= (\x -> return $ '(':(x++')':[]))
 149
 150 -- ** Read 'Test_Bool'
 151
 152 test_bool
 153  :: (Stream s m Char)
 154  => [ParsecT s u m (ParsecT s u m t)]
 155  -> ParsecT s u m (Test_Bool t)
 156 test_bool terms =
 157         R.buildExpressionParser
 158          test_bool_operators
 159          (test_bool_term terms)
 160         <?> "test_bool"
 161
 162 test_bool_operators
 163  :: Stream s m Char
 164  => R.OperatorTable s u m (Filter.Test_Bool t)
 165 test_bool_operators =
 166         [ [ prefix "- "   Filter.Not
 167           , prefix "not " Filter.Not
 168           ]
 169         , [ binary " & "   Filter.And                     R.AssocLeft
 170           , binary " and " Filter.And                     R.AssocLeft
 171           , binary " - "   (flip Filter.And . Filter.Not) R.AssocLeft
 172           , binary " but " (flip Filter.And . Filter.Not) R.AssocLeft
 173           ]
 174         , [ binary " + "  Filter.Or R.AssocLeft
 175           , binary " or " Filter.Or R.AssocLeft
 176           ]
 177         ]
 178         where
 179                 binary  name fun assoc = R.Infix  (test_bool_operator name >> return fun) assoc
 180                 prefix  name fun       = R.Prefix (test_bool_operator name >> return fun)
 181                 -- postfix name fun       = Text.Parsec.Expr.Postfix (test_bool_operator name >> return fun)
 182
 183 test_bool_operator
 184  :: Stream s m Char
 185  => String -> ParsecT s u m ()
 186 test_bool_operator name =
 187         lexeme $ R.try $
 188                 (R.string name
 189                 >> R.notFollowedBy test_bool_operator_letter
 190                 <?> ("end of " ++ show name))
 191
 192 test_bool_operator_letter
 193  :: Stream s m Char => ParsecT s u m Char
 194 test_bool_operator_letter =
 195         R.oneOf ['+', '-', '&']
 196
 197 test_bool_term
 198  :: Stream s m Char
 199  => [ParsecT s u m (ParsecT s u m t)]
 200  ->  ParsecT s u m (Test_Bool t)
 201 test_bool_term terms = do
 202         R.choice_try
 203          ( (R.lookAhead (R.try (R.spaces >> R.char '('))
 204                 >> (return $ parens $
 205                         Data.Foldable.foldr Filter.And Filter.Any <$>
 206                         R.many (R.try (R.spaces >> expr)) ))
 207          : map ((Filter.Bool <$>) <$>) terms
 208          ) <* R.spaces <?> "boolean-expression"
 209         >>= id
 210         where
 211                 expr =
 212                         R.lookAhead (R.try R.anyToken)
 213                         >> R.notFollowedBy (R.char ')')
 214                         >> test_bool terms
 215
 216 lexeme
 217  :: Stream s m Char
 218  => ParsecT s u m a
 219  -> ParsecT s u m a
 220 lexeme p = p <* R.spaces
 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 -- ** Read Account.'Account.Name'
 247 account_name :: Stream s m Char => ParsecT s u m Account.Name
 248 account_name = do
 249         fromString <$> do
 250         R.many1 $ R.try account_name_char
 251         where
 252                 account_name_char :: Stream s m Char => ParsecT s u m Char
 253                 account_name_char = do
 254                         c <- R.anyChar
 255                         case c of
 256                          -- _ | c == comment_begin -> R.parserZero
 257                          -- _ | c == account_section_sep -> R.parserZero
 258                          _ | R.is_space_horizontal c -> do
 259                                 _ <- R.notFollowedBy $ R.space_horizontal
 260                                 return c <* (R.lookAhead $ R.try $
 261                                  ( R.try (R.char account_section_sep)
 262                                  <|> account_name_char
 263                                  ))
 264                          _ | not (Data.Char.isSpace c) -> return c
 265                          _ -> R.parserZero
 266
 267 -- ** Read 'Test_Account_Section'
 268 test_account_section
 269  :: (Stream s m Char)
 270  => (String -> ParsecT s u m Test_Text)
 271  -> ParsecT s u m Test_Account_Section
 272 test_account_section make_test_text = do
 273         R.choice_try
 274          [ R.char '*'
 275                  <* R.lookAhead account_section_end
 276                  >> return Test_Account_Section_Any
 277          , R.many1 (R.satisfy (\c -> c /= account_section_sep && not (Data.Char.isSpace c)))
 278                  >>= (liftM Test_Account_Section_Text . make_test_text)
 279          , R.lookAhead account_section_end
 280                  >> R.many (R.try (R.char account_section_sep >> R.lookAhead (R.try account_section_end)))
 281                  >> return Test_Account_Section_Many
 282          ]
 283         where
 284                 account_section_end =
 285                         R.choice_try
 286                          [ R.char account_section_sep >> return ()
 287                          , R.space_horizontal >> return ()
 288                          , R.eof
 289                          ]
 290
 291 -- ** Read 'Test_Account'
 292 account_section_sep :: Char
 293 account_section_sep = ':'
 294
 295 test_account
 296  :: Stream s m Char
 297  => ParsecT s u m Test_Account
 298 test_account = do
 299         R.notFollowedBy $ R.space_horizontal
 300         make_test_text <- test_text
 301         R.many1_separated (test_account_section make_test_text) $
 302                 R.char account_section_sep
 303
 304 -- ** Read 'Test_Date'
 305 test_date
 306  :: (Stream s (R.Error_State Error m) Char, Monad m)
 307  => ParsecT s Context (R.Error_State Error m) (Test_Bool Test_Date)
 308 test_date = do
 309         R.choice_try
 310          [ R.char '=' >>
 311                 (return $ read_date_pattern)
 312          , test_ord >>= \tst ->
 313                 return $ do
 314                         ctx <- R.getState
 315                         let (year, _, _) = Date.gregorian $ context_date ctx
 316                         Date.Read.date Error_Test_Date (Just year)
 317                         >>= return . Bool . Test_Date_UTC . tst
 318          ] >>= id
 319         where
 320                 read_date_pattern
 321                  :: (Stream s (R.Error_State e m) Char, Monad m)
 322                  => ParsecT s u (R.Error_State e m) (Test_Bool Test_Date)
 323                 read_date_pattern = (do
 324                         let read2 = R.try (R.count 2 R.digit) <|> R.count 1 R.digit
 325                         n0 <- read_range $ R.many1 R.digit
 326                         n1 <- R.option Nothing $ R.try $ do
 327                                 _  <- R.char '/'
 328                                 Just <$> read_range read2
 329                         n2 <- R.option Nothing $ R.try $ do
 330                                 _ <- R.char '/'
 331                                 Just <$> read_range read2
 332                         let (year, month, dom) =
 333                                 case (n1, n2) of
 334                                  (Nothing, Nothing) ->
 335                                         ( test_range_all
 336                                         , of_digits <$> n0
 337                                         , test_range_all )
 338                                  (Just d1, Nothing) ->
 339                                         ( test_range_all
 340                                         , of_digits <$> n0
 341                                         , of_digits <$> d1 )
 342                                  (Nothing, Just _d2) -> assert False undefined
 343                                  (Just d1, Just d2) ->
 344                                         ( R.integer_of_digits 10 <$> n0
 345                                         , of_digits <$> d1
 346                                         , of_digits <$> d2 )
 347                         (hour, minute, second) <-
 348                                 R.option (test_range_all, test_range_all, test_range_all) $ R.try $ do
 349                                         R.skipMany1 $ R.space_horizontal
 350                                         hour <- read_range read2
 351                                         sep <- Date.Read.hour_separator
 352                                         minute <- read_range read2
 353                                         second <- R.option test_range_all $ R.try $ do
 354                                                 _ <- R.char sep
 355                                                 read_range $ R.many1 R.digit
 356                                         -- tz <- R.option Time.utc $ R.try $ do
 357                                         --      R.skipMany $ R.space_horizontal
 358                                         --      Date.Read.time_zone
 359                                         return
 360                                          ( of_digits <$> hour
 361                                          , of_digits <$> minute
 362                                          , of_digits <$> second
 363                                          )
 364                         return $
 365                                 foldr And Any $
 366                                 catMaybes $
 367                                  [ just_when_bounded Test_Date_Year   year
 368                                  , just_when_bounded Test_Date_Month  month
 369                                  , just_when_bounded Test_Date_DoM    dom
 370                                  , just_when_bounded Test_Date_Hour   hour
 371                                  , just_when_bounded Test_Date_Minute minute
 372                                  , just_when_bounded Test_Date_Second second
 373                                  ]
 374                         ) <?> "date-filter"
 375                         where
 376                                 of_digits :: Num n => [Char] -> n
 377                                 of_digits = fromInteger . R.integer_of_digits 10
 378                                 just_when_bounded f x =
 379                                         case x of
 380                                          Test_Range_In Nothing Nothing -> Nothing
 381                                          _ -> Just $ Bool $ f x
 382
 383 read_range :: Stream s m Char
 384  => ParsecT s u m a
 385  -> ParsecT s u m (Test_Range a)
 386 read_range read_digits = do
 387         a0 <- R.choice_try
 388                  [ R.char '*' >> return Nothing
 389                  , Just <$> read_digits
 390                  ]
 391         R.choice_try
 392          [ R.char '-' >>
 393                 (Test_Range_In a0 <$> R.choice_try
 394                  [ R.char '*' >> return Nothing
 395                  , Just <$> read_digits
 396                  ])
 397          , return $ maybe test_range_all Test_Range_Eq a0
 398          ]
 399
 400 test_date_operator
 401  :: Stream s m Char
 402  => ParsecT s u m String
 403 test_date_operator =
 404         test_ord_operator
 405
 406 -- ** Read 'Test_Tag'
 407 tag_name_sep :: Char
 408 tag_name_sep = ':'
 409
 410 test_tag_name
 411  :: Stream s m Char
 412  => ParsecT s u m Test_Tag
 413 test_tag_name = do
 414         make_test_text <- test_text
 415         R.choice_try
 416          [ R.char '*'
 417                  <* R.lookAhead test_tag_name_end
 418                  >> return (Test_Tag_Name Test_Text_Any)
 419          , R.many1 (R.notFollowedBy (R.try test_tag_name_end) >> R.anyChar)
 420                  >>= (liftM Test_Tag_Name . make_test_text)
 421          ]
 422         where
 423                 test_tag_name_end =
 424                         R.choice_try
 425                          [ test_text_operator >> return ()
 426                          , R.space_horizontal >> return ()
 427                          , R.eof
 428                          ]
 429 test_tag_value
 430  :: Stream s m Char
 431  => ParsecT s u m Test_Tag
 432 test_tag_value = do
 433         make_test_text <- test_text
 434         R.choice_try
 435          [ R.char '*'
 436                  <* R.lookAhead test_tag_value_end
 437                  >> return (Test_Tag_Value Test_Text_Any)
 438          , R.many1 (R.notFollowedBy (R.try test_tag_value_end) >> R.anyChar)
 439                  >>= (liftM Test_Tag_Value . make_test_text)
 440          ]
 441         where
 442                 test_tag_value_end =
 443                         R.choice_try
 444                          [ R.space_horizontal >> return ()
 445                          , R.eof
 446                          ]
 447
 448 test_tag
 449  :: Stream s m Char
 450  => ParsecT s u m (Test_Bool Test_Tag)
 451 test_tag = do
 452         n <- test_tag_name
 453         R.choice_try
 454          [ R.lookAhead (R.try $ test_tag_operator)
 455                  >> And (Bool n) . Bool <$> test_tag_value
 456          , return $ Bool n
 457          ]
 458
 459 test_tag_operator
 460  :: Stream s m Char
 461  => ParsecT s u m String
 462 test_tag_operator =
 463         test_text_operator
 464
 465 -- ** Read 'Test_Posting'
 466 test_posting
 467  :: (Stream s m Char, Filter.Posting t)
 468  => ParsecT s Context m (Test_Bool (Test_Posting t))
 469 test_posting =
 470         Data.Foldable.foldr Filter.And Filter.Any <$>
 471         do R.many $
 472                 R.spaces
 473                 >> R.lookAhead R.anyToken
 474                 >> test_bool test_posting_terms
 475
 476 test_posting_terms
 477  :: (Stream s m Char, Filter.Posting t)
 478  => [ParsecT s Context m (ParsecT s Context m (Test_Posting t))]
 479 test_posting_terms =
 480         [ return
 481                 ( Filter.Test_Posting_Account
 482                 <$> test_account )
 483         ]
 484
 485 -- ** Read 'Test_Transaction'
 486 test_transaction
 487  :: (Stream s (R.Error_State Error m) Char, Monad m, Filter.Transaction t)
 488  => ParsecT s Context (R.Error_State Error m) (Test_Bool (Test_Transaction t))
 489 test_transaction =
 490         Data.Foldable.foldr Filter.And Filter.Any <$>
 491         do R.many $
 492                 R.spaces
 493                 >> R.lookAhead R.anyToken
 494                 >> test_bool test_transaction_terms
 495
 496 test_transaction_terms
 497  :: (Stream s (R.Error_State Error m) Char, Filter.Transaction t, Monad m)
 498  => [ParsecT s Context (R.Error_State Error m)
 499     (ParsecT s Context (R.Error_State Error m) (Test_Transaction t))]
 500 test_transaction_terms =
 501         -- , jump [ "account","acct" ] comp_text test_account
 502         -- , jump [ "amount", "amt" ] comp_num parseFilterAmount
 503         -- , jump [ "atag" ] comp_text parseFilterATag
 504         -- , jump [ "balance", "bal" ] comp_num parseFilterBalance
 505         -- , jump [ "code" ] comp_text parseFilterCode
 506         [ jump [ "date" ] test_date_operator
 507                 (Filter.Test_Transaction_Date <$> test_date)
 508         , jump [ "tag" ] test_tag_operator
 509                 (Filter.Test_Transaction_Tag <$> test_tag)
 510         -- , jump [ "date2", "edate" ] (R.char '=') parseFilterDate2
 511         -- , jump [ "depth" ] comp_num parseFilterDepth
 512         -- , jump [ "description","descr","desc" ] comp_text parseFilterDesc
 513         -- , jump [ "real" ] (R.char '=') parseFilterReal
 514         -- , jump [ "status" ] (R.char '=') parseFilterStatus
 515         -- , jump [ "sym" ] comp_text parseFilterSym
 516         -- , R.lookAhead comp_num >> return parseFilterAmount
 517         , return
 518                 ( Filter.Test_Transaction_Posting
 519                 . Filter.Test_Posting_Account
 520                 <$> test_account )
 521         ]
 522         where
 523                 jump :: Stream s m Char
 524                  => [String]
 525                  -> ParsecT s u m b
 526                  -> a
 527                  -> ParsecT s u m a
 528                 jump prefixes next r =
 529                         R.choice_try
 530                          (map (\s -> R.string s >> return r) prefixes)
 531                          <* R.lookAhead (R.try next)
 532
 533 -- ** Read 'Test_Balance'
 534 test_balance
 535  :: (Stream s m Char, Filter.Balance t)
 536  => ParsecT s Context m (Test_Bool (Test_Balance t))
 537 test_balance =
 538         Data.Foldable.foldr Filter.And Filter.Any <$>
 539         do R.many $
 540                 R.spaces
 541                 >> R.lookAhead R.anyToken
 542                 >> test_bool test_balance_terms
 543
 544 test_balance_terms
 545  :: (Stream s m Char, Filter.Balance t)
 546  => [ParsecT s Context m (ParsecT s Context m (Test_Balance t))]
 547 test_balance_terms =
 548         [ return
 549                 ( Filter.Test_Balance_Account
 550                 <$> test_account )
 551         ]
 552
 553 {-
 554
 555 account :: Stream s m Char => ParsecT s Context m Filter
 556 account = do
 557         o <- R.optionMaybe comp_text
 558         liftM (Filter.Account $ fromMaybe Comp_Text_Exact o)
 559          (liftM (accountNameComponents) $ string (" \t"++"+-&"))
 560
 561 parseFilterAmount :: Stream s m Char => ParsecT s Context m Filter
 562 parseFilterAmount = do
 563         Filter.Amount
 564          <$> comp_num
 565          <*> comp_num_abs
 566          <*> amount
 567
 568 parseFilterATag :: Stream s m Char => ParsecT s Context m Filter
 569 parseFilterATag = do
 570         c <- comp_text
 571         liftM (uncurry (ATag c))
 572          parseTag
 573
 574 --parseFilterCode :: Stream s m Char => ParsecT s Context m Filter
 575 --parseFilterCode = do
 576 --      string "code="
 577 --      liftM Code $
 578 --       try (do {
 579                 --              choice
 580                 --               [ inparen
 581                 --               , R.many nonspace
 582                 --               ]
 583                 --              return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
 584                 --       })
 585
 586 parseFilterBalance :: Stream s m Char => ParsecT s Context m Filter
 587 parseFilterBalance = do
 588         nc <- comp_num
 589         absc <- comp_num_abs
 590         a <- parseAmount Nothing
 591         return $ Bal (nc, absc) a
 592
 593 parseFilterDate :: Stream s m Char => ParsecT s Context m Filter
 594 parseFilterDate = do
 595         R.char '='
 596         ctx <- getState
 597         liftM Date $
 598          periodexprdatespan (qCtxDay ctx)
 599
 600 parseFilterDate2 :: Stream s m Char => ParsecT s Context m Filter
 601 parseFilterDate2 = do
 602         R.char '='
 603         ctx <- getState
 604         liftM Date2 $
 605          periodexprdatespan (qCtxDay ctx)
 606
 607 parseFilterDesc :: Stream s m Char => ParsecT s Context m Filter
 608 parseFilterDesc = do
 609         c <- comp_text
 610         liftM (Desc c)
 611          (string "")
 612
 613 parseFilterDepth :: Stream s m Char => ParsecT s Context m Filter
 614 parseFilterDepth = do
 615         c <- comp_num
 616         liftM (Depth c . fromIntegral) $
 617          parseDecimal
 618
 619 parseFilterReal :: Stream s m Char => ParsecT s Context m Filter
 620 parseFilterReal = do
 621         R.char '='
 622         liftM Real bool
 623
 624 -- | Read the boolean value part of a "status:" query, allowing "*" as
 625 -- another way to spell True, similar to the journal file format.
 626 parseFilterStatus :: Stream s m Char => ParsecT s Context m Filter
 627 parseFilterStatus = do
 628         R.char '='
 629         liftM Status $
 630          try (R.char '*' >> return True) <|> bool
 631
 632 --parseFilterSym :: Stream s m Char => ParsecT s Context m Filter
 633 --parseFilterSym = do
 634 --      string "cur="
 635 --      liftM Sym
 636 --       commoditysymbol
 637
 638 parseFilterTag :: Stream s m Char => ParsecT s Context m Filter
 639 parseFilterTag = do
 640         c <- comp_text
 641         liftM (uncurry (Tag c))
 642          parseTag
 643 -}