regex-applicative 0.2 → 0.2.1

raw patch · 8 files changed

+45/−10 lines, 8 files

Files

• CHANGES.md +6/−0
• Text/Regex/Applicative.hs +1/−0
• Text/Regex/Applicative/Compile.hs +3/−1
• Text/Regex/Applicative/Interface.hs +22/−6
• Text/Regex/Applicative/Object.hs +1/−0
• Text/Regex/Applicative/Types.hs +2/−1
• regex-applicative.cabal +2/−2
• test.hs +8/−0

@@ -1,6 +1,12 @@ Changes ======= +0.2.1+-----+* Add the `withMatched` function+* Make matching functions a bit more lax+* Fix a bug in the `empty` method+ 0.2 --- * Infix matching functions

@@ -20,6 +20,7 @@     , reFoldl     , Greediness(..)     , few+    , withMatched     , match     , (=~)     , findFirstPrefix

@@ -44,7 +44,7 @@ compile2 :: RE s a -> Cont (a -> [Thread s r]) -> [Thread s r] compile2 e =     case e of-        Eps -> \k -> emptyCont k $ error "empty"+        Eps -> \k -> emptyCont k ()         Symbol i p -> \k -> [t $ nonEmptyCont k] where           -- t :: (a -> [Thread s r]) -> Thread s r           t k = Thread i $ \s ->@@ -64,6 +64,7 @@             let a1 = compile2 n1                 a2 = compile2 n2             in \k -> a1 k ++ a2 k+        Fail -> const []         Fmap f n -> let a = compile2 n in \k -> a $ fmap (. f) k         -- This is actually the point where we use the difference between         -- continuations. For the inner RE the empty continuation is a@@ -98,6 +99,7 @@             return [STransition i]         App n1 n2 -> go n1 =<< go n2 k         Alt n1 n2 -> (++) <$> go n1 k <*> go n2 k+        Fail -> return []         Fmap _ n -> go n k         Rep g _ _ n ->             let entries = findEntries n

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Regex.Applicative.Interface where import Control.Applicative hiding (empty)@@ -22,7 +22,7 @@  instance Alternative (RE s) where     a1 <|> a2 = Alt a1 a2-    empty = Eps+    empty = Fail     many a = reverse <$> Rep Greedy (flip (:)) [] a     some a = (:) <$> a <*> many a @@ -80,6 +80,22 @@ few :: RE s a -> RE s [a] few a = reverse <$> Rep NonGreedy (flip (:)) [] a +-- | Return matched symbols as part of the return value+withMatched :: RE s a -> RE s (a, [s])+withMatched Eps = flip (,) [] <$> Eps+withMatched x@(Symbol _ _) = (id &&& pure) <$> x+withMatched (Alt a b) = withMatched a <|> withMatched b+withMatched (App a b) =+    (\(f, s) (x, t) -> (f x, s ++ t)) <$>+        withMatched a <*>+        withMatched b+withMatched Fail = Fail+withMatched (Fmap f x) = (f *** id) <$> 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+withMatched (Void x) = (const () *** id) <$> withMatched x+ -- | @s =~ a = match a s@ (=~) :: [s] -> RE s a -> Maybe a (=~) = flip match@@ -134,8 +150,8 @@                 let res = ((flip (,) str) <$> resThis) <|> resOld                 in                     case str of-                        [] -> res                         _ | failed obj' -> res+                        [] -> res                         (s:ss) -> go (step s obj') ss res  -- | Find the longest string prefix which is matched by the regular expression.@@ -161,8 +177,8 @@         let res = (fmap (flip (,) str) $ listToMaybe $ results obj) <|> resOld         in             case str of-                [] -> res                 _ | failed obj -> res+                [] -> res                 (s:ss) -> go (step s obj) ss res  -- | Find the shortest prefix (analogous to 'findLongestPrefix')@@ -172,10 +188,10 @@     go obj str =         case results obj of             r : _ -> Just (r, str)-            [] ->+            _ | failed obj -> Nothing+            _ ->                 case str of                     [] -> Nothing-                    _ | failed obj -> Nothing                     s:ss -> go (step s obj) ss  -- | Find the leftmost substring that is matched by the regular expression.

@@ -125,6 +125,7 @@             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

@@ -56,11 +56,12 @@ -- * 'some' @ra@ matches concatenation of one or more strings matched by @ra@ -- and returns the list of @ra@'s return values on those strings. data RE s a where-    Eps :: RE s a+    Eps :: RE s ()     Symbol :: ThreadId -> (s -> Bool) -> RE s s     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+    Fail :: RE s a     Rep :: Greediness    -- repetition may be greedy or not         -> (b -> a -> b) -- folding function (like in foldl)         -> b             -- the value for zero matches, and also the initial value

@@ -9,7 +9,7 @@ -- standards guiding when and how versions should be incremented.  -- DO NOT FORGET TO UPDATE THE GIT TAG BELOW!!!-Version:             0.2+Version:             0.2.1  -- A short (one-line) description of the package. Synopsis:            Regex-based parsing with applicative interface@@ -56,7 +56,7 @@ Source-repository this   type:     git   location: git://github.com/feuerbach/regex-applicative.git-  tag:      v0.2+  tag:      v0.2.1  Library   -- Packages needed in order to build this package.

@@ -72,6 +72,13 @@     let fs = map f s in     reference re fs == (fs =~ re) +prop_withMatched =+    let re = withMatched $ many (string "a" <|> string "ba")+    in \str ->+        case map ab str =~ re of+            Nothing -> True+            Just (x, y) -> concat x == y+ -- Because we have 2 slightly different algorithms for recognition and parsing, -- we test that they agree testRecognitionAgainstParsing re f s =@@ -101,6 +108,7 @@        , t "re8" 10 $ testRecognitionAgainstParsing re9 ab        , t "re8" 10 $ testRecognitionAgainstParsing re10 ab        ]+    , testProperty "withMatched" prop_withMatched     ]     where     t name n = withDepth n . testProperty name