Hello community,
here is the log from the commit of package ghc-regex-applicative for
openSUSE:Factory checked in at 2020-09-07 21:22:12
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-regex-applicative (Old)
and /work/SRC/openSUSE:Factory/.ghc-regex-applicative.new.3399 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-regex-applicative"
Mon Sep 7 21:22:12 2020 rev:9 rq:831222 version:0.3.4
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-regex-applicative/ghc-regex-applicative.changes
2019-12-27 13:56:28.488748362 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-regex-applicative.new.3399/ghc-regex-applicative.changes
2020-09-07 21:22:16.205020254 +0200
@@ -1,0 +2,11 @@
+Tue Sep 1 14:41:27 UTC 2020 - [email protected]
+
+- Update regex-applicative to version 0.3.4.
+ 0.3.4
+ -----
+
+ * Let the user provide a custom `uncons` function (add
+ `find{First,Longest,Shortest}PrefixWithUncons`)
+ * Add `Filtrable` and `Monoid` instances for `RE`
+
+-------------------------------------------------------------------
Old:
----
regex-applicative-0.3.3.1.tar.gz
New:
----
regex-applicative-0.3.4.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-regex-applicative.spec ++++++
--- /var/tmp/diff_new_pack.JssoXz/_old 2020-09-07 21:22:19.525021777 +0200
+++ /var/tmp/diff_new_pack.JssoXz/_new 2020-09-07 21:22:19.529021779 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-regex-applicative
#
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name regex-applicative
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.3.3.1
+Version: 0.3.4
Release: 0
Summary: Regex-based parsing with applicative interface
License: MIT
@@ -27,6 +27,7 @@
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-containers-devel
+BuildRequires: ghc-filtrable-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-transformers-devel
%if %{with tests}
@@ -52,7 +53,7 @@
files.
%prep
-%setup -q -n %{pkg_name}-%{version}
+%autosetup -n %{pkg_name}-%{version}
%build
%ghc_lib_build
++++++ regex-applicative-0.3.3.1.tar.gz -> regex-applicative-0.3.4.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/CHANGES.md
new/regex-applicative-0.3.4/CHANGES.md
--- old/regex-applicative-0.3.3.1/CHANGES.md 2019-08-18 22:57:42.000000000
+0200
+++ new/regex-applicative-0.3.4/CHANGES.md 2020-07-24 11:43:05.000000000
+0200
@@ -1,6 +1,13 @@
Changes
=======
+0.3.4
+-----
+
+* Let the user provide a custom `uncons` function (add
+ `find{First,Longest,Shortest}PrefixWithUncons`)
+* Add `Filtrable` and `Monoid` instances for `RE`
+
0.3.3.1
-------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/README.md
new/regex-applicative-0.3.4/README.md
--- old/regex-applicative-0.3.3.1/README.md 2013-08-06 23:30:46.000000000
+0200
+++ new/regex-applicative-0.3.4/README.md 2020-01-31 22:46:54.000000000
+0100
@@ -1,41 +1,64 @@
regex-applicative
=================
-*regex-applicative* is aimed to be an efficient and easy to use parsing
combinator
-library for Haskell based on regular expressions.
+*regex-applicative* is a parsing combinator library for Haskell based on
regular
+expressions.
-Perl programmers often use regular expressions for parsing, even if it is not
-an appropriate tool for the job, because Perl has so good support for regexps.
+Example
+-------
-The opposite seems to be valid about Haskell programmers -- they use parsing
-combinators (which recognize context-free or even context-sensitive grammars),
-even when the language is actually regular!
+``` haskell
+import Text.Regex.Applicative
-Hopefully, this library will improve the situation.
+data Protocol = HTTP | FTP deriving Show
-Installation
-------------
-Install this library using `cabal-install` tool:
+protocol :: RE Char Protocol
+protocol = HTTP <$ string "http" <|> FTP <$ string "ftp"
- cabal update
- cabal install regex-applicative
+type Host = String
+type Location = String
+data URL = URL Protocol Host Location deriving Show
+
+host :: RE Char Host
+host = many $ psym $ (/= '/')
+
+url :: RE Char URL
+url = URL <$> protocol <* string "://" <*> host <* sym '/' <*> many anySym
+
+main = print $ "http://stackoverflow.com/questions"; =~ url
+```
Documentation
-------------
-The [API reference][haddock] is available from Hackage.
-To get started, see some [examples][examples] on the wiki.
+See the [API reference][haddock].
+
+Performance
+-----------
+
+For common tasks, this package is several times slower than monadic
+parser combinator libraries like parsec. However, this library has a roughly
+linear complexity, whereas monadic parser combinators have exponential
+worst-time complexity (see [here](https://swtch.com/~rsc/regexp/regexp1.html)).
+
+Some tips to make your regex run faster:
+
+1. If you don't care about the result of the whole regex or its part, only
+ whether it matches or not, mark it with `void` or `<$`. Recognition is
faster
+ than parsing.
+1. If you apply the same regex to multiple strings, partially apply it like so:
+
+ ```
+ let matcher = match my_regex
+ in map matcher my_strings
+ ```
-Other resources
----------------
+ This way the compiled regex is stored in the `matcher` value and shared
among
+ the strings.
-* [This package on Hackage][hackage]
-* [Issue tracker][issues]
-* [Repository][github]
+GHC support
+-----------
+Only GHC versions >= 8.0 are supported, although older versions may work too.
-[examples]: https://github.com/feuerbach/regex-applicative/wiki/Examples
[haddock]:
http://hackage.haskell.org/packages/archive/regex-applicative/latest/doc/html/Text-Regex-Applicative.html
-[hackage]: http://hackage.haskell.org/package/regex-applicative
-[issues]: https://github.com/feuerbach/regex-applicative/issues
-[github]: https://github.com/feuerbach/regex-applicative
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Compile.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/Compile.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Compile.hs
2015-07-03 13:03:30.000000000 +0200
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/Compile.hs
2020-07-24 11:37:31.000000000 +0200
@@ -1,12 +1,13 @@
{-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -fno-do-lambda-eta-expansion #-}
module Text.Regex.Applicative.Compile (compile) where
+import Control.Monad ((<=<))
import Control.Monad.Trans.State
-import Text.Regex.Applicative.Types
-import Control.Applicative
+import Data.Foldable
import Data.Maybe
+import Data.Monoid (Any (..))
import qualified Data.IntMap as IntMap
+import Text.Regex.Applicative.Types
compile :: RE s a -> (a -> [Thread s r]) -> [Thread s r]
compile e k = compile2 e (SingleCont k)
@@ -30,15 +31,6 @@
SingleCont a -> a
EmptyNonEmpty _ a -> a
--- The whole point of this module is this function, compile2, which needs to be
--- compiled with -fno-do-lambda-eta-expansion for efficiency.
---
--- Since this option would make other code perform worse, we place this
--- function in a separate module and make sure it's not inlined.
---
--- The point of "-fno-do-lambda-eta-expansion" is to make sure the tree is
--- "compiled" only once.
---
-- compile2 function takes two continuations: one when the match is empty and
-- one when the match is non-empty. See the "Rep" case for the reason.
compile2 :: RE s a -> Cont (a -> [Thread s r]) -> [Thread s r]
@@ -68,6 +60,7 @@
in \k -> a1 k ++ a2 k
Fail -> const []
Fmap f n -> let a = compile2 n in \k -> a $ fmap (. f) k
+ CatMaybes n -> let a = compile2 n in \k -> a $ (<=< toList) <$> k
-- This is actually the point where we use the difference between
-- continuations. For the inner RE the empty continuation is a
-- "failing" one in order to avoid non-termination.
@@ -78,11 +71,13 @@
(a $ EmptyNonEmpty (\_ -> []) (\v -> let b' = f b v in
threads b' (SingleCont $ nonEmptyCont k)))
(emptyCont k b)
in threads b
- Void n -> let a = compile2_ n in \k -> a $ fmap ($ ()) k
+ Void n
+ | hasCatMaybes n -> compile2 n . fmap (. \ _ -> ())
+ | otherwise -> compile2_ n . fmap ($ ())
data FSMState
= SAccept
- | STransition ThreadId
+ | STransition !ThreadId
type FSMMap s = IntMap.IntMap (s -> Bool, [FSMState])
@@ -103,6 +98,7 @@
Alt n1 n2 -> (++) <$> go n1 k <*> go n2 k
Fail -> return []
Fmap _ n -> go n k
+ CatMaybes _ -> error "mkNFA CatMaybes"
Rep g _ _ n ->
let entries = findEntries n
cont = combine g entries k
@@ -118,6 +114,9 @@
-- just to use 'go'
evalState (go e []) IntMap.empty
+hasCatMaybes :: RE s a -> Bool
+hasCatMaybes = getAny . foldMapPostorder (Any . \ case CatMaybes _ -> True; _
-> False)
+
compile2_ :: RE s a -> Cont [Thread s r] -> [Thread s r]
compile2_ e =
let (entries, fsmap) = mkNFA e
@@ -131,6 +130,7 @@
in \k -> concatMap (mkThread (emptyCont k) (nonEmptyCont k)) entries
+combine :: Greediness -> [a] -> [a] -> [a]
combine g continue stop =
case g of
Greedy -> continue ++ stop
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Interface.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/Interface.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Interface.hs
2015-12-27 09:32:10.000000000 +0100
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/Interface.hs
2020-07-24 11:43:05.000000000 +0200
@@ -1,34 +1,13 @@
{-# LANGUAGE TypeFamilies, GADTs, TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Regex.Applicative.Interface where
import Control.Applicative hiding (empty)
-import qualified Control.Applicative
import Control.Arrow
-import Data.Traversable
-import Data.String
+import Control.Monad (guard)
+import qualified Data.List as List
import Data.Maybe
import Text.Regex.Applicative.Types
import Text.Regex.Applicative.Object
-instance Functor (RE s) where
- fmap f x = Fmap f x
- f <$ x = pure f <* x
-
-instance Applicative (RE s) where
- pure x = const x <$> Eps
- a1 <*> a2 = App a1 a2
- a *> b = pure (const id) <*> Void a <*> b
- a <* b = pure const <*> a <*> Void b
-
-instance Alternative (RE s) where
- a1 <|> a2 = Alt a1 a2
- empty = Fail
- many a = reverse <$> Rep Greedy (flip (:)) [] a
- some a = (:) <$> a <*> many a
-
-instance (char ~ Char, string ~ String) => IsString (RE char string) where
- fromString = string
-
-- | 'RE' is a profunctor. This is its contravariant map.
--
-- (A dependency on the @profunctors@ package doesn't seem justified.)
@@ -40,44 +19,15 @@
Alt r1 r2 -> Alt (comap f r1) (comap f r2)
App r1 r2 -> App (comap f r1) (comap f r2)
Fmap g r -> Fmap g (comap f r)
+ CatMaybes r -> CatMaybes (comap f r)
Fail -> Fail
Rep gr fn a r -> Rep gr fn a (comap f r)
Void r -> Void (comap f r)
--- | Match and return a single symbol which satisfies the predicate
-psym :: (s -> Bool) -> RE s s
-psym p = msym (\s -> if p s then Just s else Nothing)
-
--- | Like 'psym', but allows to return a computed value instead of the
--- original symbol
-msym :: (s -> Maybe a) -> RE s a
-msym p = Symbol (error "Not numbered symbol") p
-
--- | Match and return the given symbol
-sym :: Eq s => s -> RE s s
-sym s = psym (s ==)
-
-- | Match and return any single symbol
anySym :: RE s s
anySym = msym Just
--- | Match and return the given sequence of symbols.
---
--- Note that there is an 'IsString' instance for regular expression, so
--- if you enable the @OverloadedStrings@ language extension, you can write
--- @string \"foo\"@ simply as @\"foo\"@.
---
--- Example:
---
--- >{-# LANGUAGE OverloadedStrings #-}
--- >import Text.Regex.Applicative
--- >
--- >number = "one" *> pure 1 <|> "two" *> pure 2
--- >
--- >main = print $ "two" =~ number
-string :: Eq a => [a] -> RE a [a]
-string = traverse sym
-
-- | Match zero or more instances of the given expression, which are combined
using
-- the given folding function.
--
@@ -111,6 +61,8 @@
withMatched b
withMatched Fail = Fail
withMatched (Fmap f x) = (f *** id) <$> withMatched x
+withMatched (CatMaybes x) = CatMaybes $
+ (\ (as, s) -> flip (,) s <$> as) <$> withMatched x
withMatched (Rep gr f a0 x) =
Rep gr (\(a, s) (x, t) -> (f a x, s ++ t)) (a0, []) (withMatched x)
-- N.B.: this ruins the Void optimization
@@ -147,6 +99,8 @@
--
-- If match is found, the rest of the input is also returned.
--
+-- See also 'findFirstPrefixWithUncons', of which this is a special case.
+--
-- Examples:
--
-- >Text.Regex.Applicative> findFirstPrefix ("a" <|> "ab") "abc"
@@ -156,24 +110,20 @@
-- >Text.Regex.Applicative> findFirstPrefix "bc" "abc"
-- >Nothing
findFirstPrefix :: RE s a -> [s] -> Maybe (a, [s])
-findFirstPrefix re str = go (compile re) str Nothing
- where
+findFirstPrefix = findFirstPrefixWithUncons List.uncons
+
+-- | Find the first prefix, with the given @uncons@ function.
+--
+-- @since 0.3.4
+findFirstPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe
(a, ss)
+findFirstPrefixWithUncons = findPrefixWith' (walk emptyObject . threads)
+ where
walk obj [] = (obj, Nothing)
walk obj (t:ts) =
case getResult t of
Just r -> (obj, Just r)
Nothing -> walk (addThread t obj) ts
- go obj str resOld =
- case walk emptyObject $ threads obj of
- (obj', resThis) ->
- let res = ((flip (,) str) <$> resThis) <|> resOld
- in
- case str of
- _ | failed obj' -> res
- [] -> res
- (s:ss) -> go (step s obj') ss res
-
-- | Find the longest string prefix which is matched by the regular expression.
--
-- Submatches are still determined using left bias and greediness, so this is
@@ -181,6 +131,8 @@
--
-- If match is found, the rest of the input is also returned.
--
+-- See also 'findLongestPrefixWithUncons', of which this is a special case.
+--
-- Examples:
--
-- >Text.Regex.Applicative Data.Char> let keyword = "if"
@@ -191,28 +143,49 @@
-- >Text.Regex.Applicative Data.Char> findLongestPrefix lexeme "iffoo"
-- >Just (Right "iffoo","")
findLongestPrefix :: RE s a -> [s] -> Maybe (a, [s])
-findLongestPrefix re str = go (compile re) str Nothing
- where
- go obj str resOld =
- let res = (fmap (flip (,) str) $ listToMaybe $ results obj) <|> resOld
- in
- case str of
- _ | failed obj -> res
- [] -> res
- (s:ss) -> go (step s obj) ss res
+findLongestPrefix = findLongestPrefixWithUncons List.uncons
+
+-- | Find the longest prefix, with the given @uncons@ function.
+--
+-- @since 0.3.4
+findLongestPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe
(a, ss)
+findLongestPrefixWithUncons = findPrefixWith' ((,) <*> listToMaybe . results)
+
+findPrefixWith'
+ :: (ReObject s a -> (ReObject s a, Maybe a))
+ -- ^ Given the regex object, compute the regex object to feed the next input
value into, and
+ -- the result, if any.
+ -> (ss -> Maybe (s, ss)) -- ^ @uncons@
+ -> RE s a -> ss -> Maybe (a, ss)
+findPrefixWith' walk uncons = \ re -> go (compile re) Nothing
+ where
+ go obj resOld ss = case walk obj of
+ (obj', resThis) ->
+ let res = flip (,) ss <$> resThis <|> resOld
+ in
+ case uncons ss of
+ _ | failed obj' -> res
+ Nothing -> res
+ Just (s, ss) -> go (step s obj') res ss
-- | Find the shortest prefix (analogous to 'findLongestPrefix')
+--
+-- See also 'findShortestPrefixWithUncons', of which this is a special case.
findShortestPrefix :: RE s a -> [s] -> Maybe (a, [s])
-findShortestPrefix re str = go (compile re) str
- where
- go obj str =
- case results obj of
- r : _ -> Just (r, str)
- _ | failed obj -> Nothing
- _ ->
- case str of
- [] -> Nothing
- s:ss -> go (step s obj) ss
+findShortestPrefix = findShortestPrefixWithUncons List.uncons
+
+-- | Find the shortest prefix (analogous to 'findLongestPrefix'), with the
given @uncons@ function.
+--
+-- @since 0.3.4
+findShortestPrefixWithUncons :: (ss -> Maybe (s, ss)) -> RE s a -> ss -> Maybe
(a, ss)
+findShortestPrefixWithUncons uncons = go . compile
+ where
+ go obj ss = case results obj of
+ r:_ -> Just (r, ss)
+ _ -> do
+ guard (not (failed obj))
+ (s, ss) <- uncons ss
+ go (step s obj) ss
-- | Find the leftmost substring that is matched by the regular expression.
-- Otherwise behaves like 'findFirstPrefix'. Returns the result together with
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Object.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/Object.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Object.hs
2015-05-30 18:38:42.000000000 +0200
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/Object.hs
2020-07-24 11:37:31.000000000 +0200
@@ -34,7 +34,6 @@
import Data.Maybe
import Data.Foldable as F
import Control.Monad.Trans.State
-import Control.Applicative hiding (empty)
-- | The state of the engine is represented as a \"regex object\" of type
-- @'ReObject' s r@, where @s@ is the type of symbols and @r@ is the
@@ -116,19 +115,9 @@
renumber
renumber :: RE s a -> RE s a
-renumber e = flip evalState (ThreadId 1) $ go e
- where
- go :: RE s a -> State ThreadId (RE s a)
- go e =
- case e of
- Eps -> return Eps
- Symbol _ p -> Symbol <$> fresh <*> pure p
- Alt a1 a2 -> Alt <$> go a1 <*> go a2
- App a1 a2 -> App <$> go a1 <*> go a2
- Fail -> return Fail
- Fmap f a -> Fmap f <$> go a
- Rep g f b a -> Rep g f b <$> go a
- Void a -> Void <$> go a
+renumber =
+ flip evalState (ThreadId 1) .
+ traversePostorder (\ case Symbol _ p -> flip Symbol p <$> fresh; a -> pure
a)
fresh :: State ThreadId ThreadId
fresh = do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Reference.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/Reference.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Reference.hs
2015-07-03 13:09:24.000000000 +0200
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/Reference.hs
2020-07-24 11:37:31.000000000 +0200
@@ -58,6 +58,7 @@
Alt a1 a2 -> re2monad a1 <|> re2monad a2
App a1 a2 -> re2monad a1 <*> re2monad a2
Fmap f a -> fmap f $ re2monad a
+ CatMaybes a -> maybe empty pure =<< re2monad a
Rep g f b a -> rep b
where
am = re2monad a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/StateQueue.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/StateQueue.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/StateQueue.hs
2015-05-30 17:28:32.000000000 +0200
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/StateQueue.hs
2020-01-31 22:46:54.000000000 +0100
@@ -1,5 +1,6 @@
-- | This internal module is exposed only for testing and benchmarking. You
-- don't need to import it.
+{-# LANGUAGE RecordWildCards #-}
module Text.Regex.Applicative.StateQueue
( StateQueue
, empty
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Types.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative/Types.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative/Types.hs
2015-07-03 13:02:36.000000000 +0200
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative/Types.hs 2020-07-24
11:43:05.000000000 +0200
@@ -1,12 +1,17 @@
{-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -fno-do-lambda-eta-expansion -fno-warn-unused-imports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
module Text.Regex.Applicative.Types where
import Control.Applicative
--- The above import is needed for haddock to properly generate links to
--- Applicative methods. But it's not actually used in the code, hence
--- -fno-warn-unused-imports.
-
+import Control.Monad ((<=<))
+import Data.Filtrable (Filtrable (..))
+import Data.Functor.Identity (Identity (..))
+import Data.String
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+#endif
newtype ThreadId = ThreadId Int
@@ -31,8 +36,8 @@
-- | Type of regular expressions that recognize symbols of type @s@ and
-- produce a result of type @a@.
--
--- Regular expressions can be built using 'Functor', 'Applicative' and
--- 'Alternative' instances in the following natural way:
+-- Regular expressions can be built using 'Functor', 'Applicative',
+-- 'Alternative', and 'Filtrable' instances in the following natural way:
--
-- * @f@ '<$>' @ra@ matches iff @ra@ matches, and its return value is the
result
-- of applying @f@ to the return value of @ra@.
@@ -55,12 +60,23 @@
--
-- * 'some' @ra@ matches concatenation of one or more strings matched by @ra@
-- and returns the list of @ra@'s return values on those strings.
+--
+-- * 'catMaybes' @ram@ matches iff @ram@ matches and produces 'Just _'.
+--
+-- * @ra@ '<>' @rb@ matches @ra@ followed by @rb@. The return value is @a <>
b@,
+-- where @a@ and @b@ are the return values of @ra@ and @rb@ respectively.
+-- (See
<https://github.com/feuerbach/regex-applicative/issues/37#issue-499781703>
+-- for an example usage.)
+--
+-- * 'mempty' matches the empty string (i.e. it does not consume any symbols),
+-- and its return value is the 'mempty' value of type @a@.
data RE s a where
Eps :: RE s ()
Symbol :: ThreadId -> (s -> Maybe a) -> RE s a
Alt :: RE s a -> RE s a -> RE s a
App :: RE s (a -> b) -> RE s a -> RE s b
Fmap :: (a -> b) -> RE s a -> RE s b
+ CatMaybes :: RE s (Maybe a) -> RE s a
Fail :: RE s a
Rep :: Greediness -- repetition may be greedy or not
-> (b -> a -> b) -- folding function (like in foldl)
@@ -69,3 +85,88 @@
-> RE s a
-> RE s b
Void :: RE s a -> RE s ()
+
+-- | Traverse each (reflexive, transitive) subexpression of a 'RE',
depth-first and post-order.
+traversePostorder :: forall s a m . Monad m => (forall a . RE s a -> m (RE s
a)) -> RE s a -> m (RE s a)
+traversePostorder f = go
+ where
+ go :: forall a . RE s a -> m (RE s a)
+ go = f <=< \ case
+ Eps -> pure Eps
+ Symbol i p -> pure (Symbol i p)
+ Alt a b -> Alt <$> go a <*> go b
+ App a b -> App <$> go a <*> go b
+ Fmap g a -> Fmap g <$> go a
+ CatMaybes a -> CatMaybes <$> go a
+ Fail -> pure Fail
+ Rep greed g b a -> Rep greed g b <$> go a
+ Void a -> Void <$> go a
+
+-- | Fold each (reflexive, transitive) subexpression of a 'RE', depth-first
and post-order.
+foldMapPostorder :: Monoid b => (forall a . RE s a -> b) -> RE s a -> b
+foldMapPostorder f = fst . traversePostorder ((,) <$> f <*> id)
+
+-- | Map each (reflexive, transitive) subexpression of a 'RE'.
+mapRE :: (forall a . RE s a -> RE s a) -> RE s a -> RE s a
+mapRE f = runIdentity . traversePostorder (Identity . f)
+
+instance Functor (RE s) where
+ fmap f x = Fmap f x
+ f <$ x = pure f <* x
+
+instance Applicative (RE s) where
+ pure x = const x <$> Eps
+ a1 <*> a2 = App a1 a2
+ a *> b = pure (const id) <*> Void a <*> b
+ a <* b = pure const <*> a <*> Void b
+
+instance Alternative (RE s) where
+ a1 <|> a2 = Alt a1 a2
+ empty = Fail
+ many a = reverse <$> Rep Greedy (flip (:)) [] a
+ some a = (:) <$> a <*> many a
+
+-- | @since 0.3.4
+instance Filtrable (RE s) where
+ catMaybes = CatMaybes
+
+instance (char ~ Char, string ~ String) => IsString (RE char string) where
+ fromString = string
+
+-- | @since 0.3.4
+instance Semigroup a => Semigroup (RE s a) where
+ x <> y = (<>) <$> x <*> y
+
+-- | @since 0.3.4
+instance Monoid a => Monoid (RE s a) where
+ mempty = pure mempty
+
+-- | Match and return the given sequence of symbols.
+--
+-- Note that there is an 'IsString' instance for regular expression, so
+-- if you enable the @OverloadedStrings@ language extension, you can write
+-- @string \"foo\"@ simply as @\"foo\"@.
+--
+-- Example:
+--
+-- >{-# LANGUAGE OverloadedStrings #-}
+-- >import Text.Regex.Applicative
+-- >
+-- >number = "one" *> pure 1 <|> "two" *> pure 2
+-- >
+-- >main = print $ "two" =~ number
+string :: Eq a => [a] -> RE a [a]
+string = traverse sym
+
+-- | Match and return a single symbol which satisfies the predicate
+psym :: (s -> Bool) -> RE s s
+psym p = msym (\s -> if p s then Just s else Nothing)
+
+-- | Like 'psym', but allows to return a computed value instead of the
+-- original symbol
+msym :: (s -> Maybe a) -> RE s a
+msym p = Symbol (error "Not numbered symbol") p
+
+-- | Match and return the given symbol
+sym :: Eq s => s -> RE s s
+sym s = psym (s ==)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/Text/Regex/Applicative.hs
new/regex-applicative-0.3.4/Text/Regex/Applicative.hs
--- old/regex-applicative-0.3.3.1/Text/Regex/Applicative.hs 2015-12-27
09:32:10.000000000 +0100
+++ new/regex-applicative-0.3.4/Text/Regex/Applicative.hs 2020-07-24
11:43:05.000000000 +0200
@@ -32,9 +32,37 @@
, findFirstInfix
, findLongestInfix
, findShortestInfix
+ -- * Custom uncons function
+ -- $uncons
+ , findFirstPrefixWithUncons
+ , findLongestPrefixWithUncons
+ , findShortestPrefixWithUncons
, module Control.Applicative
)
where
import Text.Regex.Applicative.Types
import Text.Regex.Applicative.Interface
import Control.Applicative
+
+{- $uncons
+The following functions take an argument that splits the input into the first
symbol and
+the remaining input (if the input is non-empty).
+
+It is useful, for example, for feeding a @Text@ to a regex matcher:
+
+>>> findFirstPrefixWithUncons Text.uncons (many (sym 'a')) "aaa"
+Just ("aaa", "")
+
+For another example, feeding input symbols annotated with source positions
into a matcher,
+preserving the positions in the remaining input so the location of a lexical
error can be
+recovered:
+
+@
+data AList a b = AList { annotation :: a, stripAnnotation :: Maybe (b, AList a
b) }
+
+findLongestPrefixAnnotated :: RE s a -> AList b s -> Maybe (a, AList b s)
+fondLongestPrefixAnnotated = findLongestPrefixWithUncons stripAnnotation
+@
+
+The use of the other functions taking an @uncons@ argument is exactly
analogous.
+-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/benchmark/benchmark.hs
new/regex-applicative-0.3.4/benchmark/benchmark.hs
--- old/regex-applicative-0.3.3.1/benchmark/benchmark.hs 2017-12-25
17:43:46.000000000 +0100
+++ new/regex-applicative-0.3.4/benchmark/benchmark.hs 2020-07-24
11:38:16.000000000 +0200
@@ -1,11 +1,58 @@
+{-# LANGUAGE FlexibleInstances, TypeApplications, RankNTypes, CPP #-}
import Data.List
import Data.Traversable
import Data.Maybe
+import Data.Void
+import Control.Monad
import Criterion.Main
import Text.Regex.Applicative
+import qualified Text.Parser.Combinators as PC
+import qualified Text.Parser.Char as PC
+import Control.DeepSeq
+import qualified Text.Parsec as Parsec
+import qualified Text.Megaparsec as Megaparsec
+import qualified Text.Megaparsec.Parsers as MP
+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
+import qualified Data.ByteString.Char8 as BS8
-regex = sequenceA (replicate 500 $ sym 'a' <|> pure 'b') <* sequenceA
(replicate 500 $ sym 'a')
+parser1 :: PC.CharParsing f => f [String]
+parser1 = many $
+ PC.try (PC.string "foo") <|>
+ PC.try (PC.string "bar") <|>
+ PC.string "baz"
-main = defaultMain [bench "aaaaa" $ whnf (match regex) $ replicate 800 'a']
+str :: String
+str = concat $ replicate 10 "foobarfoobarbaz"
+
+benchmarkParser
+ :: NFData a
+ => (forall f . (PC.CharParsing f) => f a)
+ -> [Benchmark]
+benchmarkParser parser =
+ [ bench "regex-applicative" $ nf (match parser) str
+ , bench "parsec" $ nf (Parsec.parse parser "-") str
+ , bench "megaparsec" $ nf (Megaparsec.parseMaybe @Void (MP.unParsecT
parser)) str
+ , bench "attoparsec" $ nf (Attoparsec.parseOnly parser) (BS8.pack str)
+ ]
+
+main = defaultMain $
+ [ bgroup "parsing" (benchmarkParser parser1)
+ , bgroup "recognizing" (benchmarkParser (void parser1))
+ ]
+
+-- instances
+instance PC.Parsing (RE c) where
+ try = id
+ (<?>) = const
+ unexpected _ = empty
+ notFollowedBy = error "RE: notFollowedBy"
+ eof = error "RE: eof"
+instance PC.CharParsing (RE Char) where
+ satisfy = psym
+ char = sym
+ anyChar = anySym
+ string = string
+instance NFData Parsec.ParseError where
+ rnf = flip seq ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/regex-applicative.cabal
new/regex-applicative-0.3.4/regex-applicative.cabal
--- old/regex-applicative-0.3.3.1/regex-applicative.cabal 2019-08-18
22:56:36.000000000 +0200
+++ new/regex-applicative-0.3.4/regex-applicative.cabal 2020-07-24
11:43:05.000000000 +0200
@@ -1,5 +1,5 @@
Name: regex-applicative
-Version: 0.3.3.1
+Version: 0.3.4
Synopsis: Regex-based parsing with applicative interface
Description:
regex-applicative is a Haskell library for parsing using regular
expressions.
@@ -13,6 +13,12 @@
Build-type: Simple
Extra-source-files: README.md CREDITS.md CHANGES.md
Cabal-version: >=1.10
+Tested-With:
+ GHC ==8.0.2 ||
+ ==8.2.2 ||
+ ==8.4.4 ||
+ ==8.6.5 ||
+ ==8.8.2
Source-repository head
type: git
@@ -20,7 +26,9 @@
Library
Default-language: Haskell2010
+ Default-extensions: LambdaCase
Build-depends: base < 5,
+ filtrable >= 0.1.3,
containers,
transformers
Exposed-modules: Text.Regex.Applicative
@@ -32,9 +40,8 @@
Text.Regex.Applicative.Types
Text.Regex.Applicative.Compile
GHC-Options: -Wall
+ -Werror=incomplete-patterns
-fno-warn-name-shadowing
- -fno-warn-missing-signatures
- -fno-warn-orphans
Test-Suite test-regex-applicative
type: exitcode-stdio-1.0
@@ -48,6 +55,7 @@
Default-language: Haskell2010
Build-depends: base < 5,
containers,
+ filtrable >= 0.1.3,
transformers,
smallcheck >= 1.0,
tasty,
@@ -62,4 +70,11 @@
build-depends: base <5
, criterion
, regex-applicative
+ , parsers
+ , deepseq
+ , parsec
+ , attoparsec
+ , megaparsec
+ , parsers-megaparsec
+ , bytestring
default-language: Haskell2010
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/regex-applicative-0.3.3.1/tests/test.hs
new/regex-applicative-0.3.4/tests/test.hs
--- old/regex-applicative-0.3.3.1/tests/test.hs 2017-12-25 16:55:08.000000000
+0100
+++ new/regex-applicative-0.3.4/tests/test.hs 2020-07-24 11:37:31.000000000
+0200
@@ -3,6 +3,7 @@
import Text.Regex.Applicative.Reference
import Control.Applicative
import Control.Monad
+import Data.Filtrable
import Data.Traversable
import Data.Maybe
import Text.Printf
@@ -69,6 +70,8 @@
re9 = many (sym 'a' <|> empty) <* sym 'b'
re10 = few (sym 'a' <|> empty) <* sym 'b'
+re11 = (\ a b -> a <$ guard (a == b)) <$> anySym <*?> anySym
+
prop re f s =
let fs = map f s in
reference re fs == (fs =~ re)
@@ -88,14 +91,15 @@
tests = testGroup "Tests"
[ testGroup "Engine tests"
- [ t "re1" 10 $ prop re1 a
- , t "re2" 10 $ prop re2 ab
- , t "re3" 10 $ prop re3 ab
- , t "re4" 10 $ prop re4 ab
- , t "re5" 10 $ prop re5 a
- , t "re6" 10 $ prop re6 a
- , t "re7" 7 $ prop re7 abc
- , t "re8" 7 $ prop re8 abc
+ [ t "re1" 10 $ prop re1 a
+ , t "re2" 10 $ prop re2 ab
+ , t "re3" 10 $ prop re3 ab
+ , t "re4" 10 $ prop re4 ab
+ , t "re5" 10 $ prop re5 a
+ , t "re6" 10 $ prop re6 a
+ , t "re7" 7 $ prop re7 abc
+ , t "re8" 7 $ prop re8 abc
+ , t "re11" 7 $ prop re11 abc
]
, testGroup "Recognition vs parsing"
[ t "re1" 10 $ testRecognitionAgainstParsing re1 a
@@ -108,6 +112,7 @@
, t "re8" 7 $ testRecognitionAgainstParsing re8 abc
, t "re8" 10 $ testRecognitionAgainstParsing re9 ab
, t "re8" 10 $ testRecognitionAgainstParsing re10 ab
+ , t "re11" 7 $ testRecognitionAgainstParsing re11 abc
]
, testProperty "withMatched" prop_withMatched
, testGroup "Tests for matching functions"
