regex-applicative 0.3.0.1 → 0.3.0.2
raw patch · 5 files changed
+274/−187 lines, 5 filesdep +regex-applicative
Dependencies added: regex-applicative
Files
- CHANGES.md +5/−0
- Text/Regex/Applicative/Reference.hs +77/−0
- regex-applicative.cabal +10/−5
- test.hs +0/−182
- tests/test.hs +182/−0
CHANGES.md view
@@ -1,6 +1,11 @@ Changes ======= +0.3.0.2+-------++Fix the test suite+ 0.3.0.1 -------
+ Text/Regex/Applicative/Reference.hs view
@@ -0,0 +1,77 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Regex.Applicative.Reference+-- Copyright : (c) Roman Cheplyaka+-- License : MIT+--+-- Maintainer: Roman Cheplyaka <roma@ro-che.info>+-- Stability : experimental+--+-- Reference implementation (using backtracking).+--+-- This is exposed for testing purposes only!+--------------------------------------------------------------------++{-# LANGUAGE GADTs #-}+module Text.Regex.Applicative.Reference (reference) where+import Prelude hiding (getChar)+import Text.Regex.Applicative.Types+import Control.Applicative+import Control.Monad+++-- A simple parsing monad+newtype P s a = P { unP :: [s] -> [(a, [s])] }++instance Monad (P s) where+ return x = P $ \s -> [(x, s)]+ (P a) >>= k = P $ \s ->+ a s >>= \(x,s) -> unP (k x) s++instance Functor (P s) where+ fmap = liftM++instance Applicative (P s) where+ (<*>) = ap+ pure = return++instance Alternative (P s) where+ empty = P $ const []+ P a1 <|> P a2 = P $ \s ->+ a1 s ++ a2 s++getChar :: P s s+getChar = P $ \s ->+ case s of+ [] -> []+ c:cs -> [(c,cs)]++re2monad :: RE s a -> P s a+re2monad r =+ case r of+ Eps -> return $ error "eps"+ Symbol _ p -> do+ c <- getChar+ if p c then return c else empty+ Alt a1 a2 -> re2monad a1 <|> re2monad a2+ App a1 a2 -> re2monad a1 <*> re2monad a2+ Fmap f a -> fmap f $ re2monad a+ Rep g f b a -> rep b+ where+ am = re2monad a+ rep b = combine (do a <- am; rep $ f b a) (return b)+ combine a b = case g of Greedy -> a <|> b; NonGreedy -> b <|> a+ Void a -> re2monad a >> return ()+ Fail -> empty++runP :: P s a -> [s] -> Maybe a+runP m s = case filter (null . snd) $ unP m s of+ (r, _) : _ -> Just r+ _ -> Nothing++-- | 'reference' @r@ @s@ should give the same results as @s@ '=~' @r@.+--+-- However, this is not very efficient implementation and is supposed to be+-- used for testing only.+reference :: RE s a -> [s] -> Maybe a+reference r s = runP (re2monad r) s
regex-applicative.cabal view
@@ -9,7 +9,7 @@ -- standards guiding when and how versions should be incremented. -- DO NOT FORGET TO UPDATE THE GIT TAG BELOW!!!-Version: 0.3.0.1+Version: 0.3.0.2 -- A short (one-line) description of the package. Synopsis: Regex-based parsing with applicative interface@@ -44,7 +44,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README.md CREDITS.md test.hs CHANGES.md+Extra-source-files: README.md CREDITS.md CHANGES.md -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.10@@ -56,7 +56,7 @@ Source-repository this type: git location: git://github.com/feuerbach/regex-applicative.git- tag: v0.3.0.1+ tag: v0.3.0.2 Library Default-language: Haskell2010@@ -70,6 +70,7 @@ Exposed-modules: Text.Regex.Applicative Text.Regex.Applicative.Object Text.Regex.Applicative.Common+ Text.Regex.Applicative.Reference -- Modules not exported by this package. Other-modules: Text.Regex.Applicative.Interface@@ -88,7 +89,10 @@ Test-Suite test-regex-applicative type: exitcode-stdio-1.0- main-is: test.hs+ hs-source-dirs:+ tests+ main-is:+ test.hs GHC-Options: -threaded Default-language: Haskell2010 Build-depends: base < 5,@@ -98,4 +102,5 @@ HUnit, tasty, tasty-smallcheck,- tasty-hunit+ tasty-hunit,+ regex-applicative
− test.hs
@@ -1,182 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses #-}-import Text.Regex.Applicative-import Text.Regex.Applicative.Reference-import Control.Applicative-import Control.Monad-import Data.Traversable-import Data.Maybe-import Text.Printf--import Test.HUnit-import Test.SmallCheck-import Test.SmallCheck.Series-import Test.Tasty-import Test.Tasty.SmallCheck-import Test.Tasty.HUnit---- Small alphabets as SmallCheck's series-newtype A = A { a :: Char } deriving Show-instance Monad m => Serial m A where- series = cons0 $ A 'a'--newtype AB = AB { ab :: Char } deriving Show-instance Monad m => Serial m AB where- series = cons0 (AB 'a') \/ cons0 (AB 'b')--newtype ABC = ABC { abc :: Char } deriving Show-instance Monad m => Serial m ABC where- series = cons0 (ABC 'a') \/ cons0 (ABC 'b') \/ cons0 (ABC 'c')--re1 =- let one = pure 1 <* sym 'a'- two = pure 2 <* sym 'a' <* sym 'a'- in (,) <$> (one <|> two) <*> (two <|> one)--re2 = sequenceA $- [ pure 1 <* sym 'a' <* sym 'a' <|>- pure 2 <* sym 'a'- , pure 3 <* sym 'b'- , pure 4 <* sym 'b' <|>- pure 5 <* sym 'a' ]--re3 = sequenceA $- [ pure 0 <|> pure 1- , pure 1 <* sym 'a' <* sym 'a' <|>- pure 2 <* sym 'a'- , pure 3 <* sym 'b' <|> pure 6- , fmap (+1) $- pure 4 <* sym 'b' <|>- pure 7 <|>- pure 5 <* sym 'a' ]--re4 = sym 'a' *> many (sym 'b') <* sym 'a'--re5 = (sym 'a' <|> sym 'a' *> sym 'a') *> many (sym 'a')--re6 = many (pure 3 <* sym 'a' <* sym 'a' <* sym 'a' <|> pure 1 <* sym 'a')---- Regular expression from the weighted regexp paper.-re7 =- let many_A_or_B = many (sym 'a' <|> sym 'b')- in (,) <$>- many ((,,,) <$> many_A_or_B <*> sym 'c' <*> many_A_or_B <*> sym 'c') <*>- many_A_or_B--re8 = (,) <$> many (sym 'a' <|> sym 'b') <*> many (sym 'b' <|> sym 'c')---- NB: we don't test these against the reference impl, 'cause it will loop!-re9 = many (sym 'a' <|> empty) <* sym 'b'-re10 = few (sym 'a' <|> empty) <* sym 'b'--prop re f s =- 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 =- let fs = map f s in- isJust (fs =~ re) == isJust (fs =~ (re *> pure ()))--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- ]- , testGroup "Recognition vs parsing"- [ t "re1" 10 $ testRecognitionAgainstParsing re1 a- , t "re2" 10 $ testRecognitionAgainstParsing re2 ab- , t "re3" 10 $ testRecognitionAgainstParsing re3 ab- , t "re4" 10 $ testRecognitionAgainstParsing re4 ab- , t "re5" 10 $ testRecognitionAgainstParsing re5 a- , t "re6" 10 $ testRecognitionAgainstParsing re6 a- , t "re7" 7 $ testRecognitionAgainstParsing re7 abc- , t "re8" 7 $ testRecognitionAgainstParsing re8 abc- , t "re8" 10 $ testRecognitionAgainstParsing re9 ab- , t "re8" 10 $ testRecognitionAgainstParsing re10 ab- ]- , testProperty "withMatched" prop_withMatched- , testGroup "Tests for matching functions"- [ testGroup "findFirstPrefix"- [ u "t1"- (findFirstPrefix ("a" <|> "ab") "abc")- (Just ("a","bc"))- , u "t2"- (findFirstPrefix ("ab" <|> "a") "abc")- (Just ("ab","c"))- , u "t3"- (findFirstPrefix "bc" "abc")- Nothing- ]- , testGroup "findFirstInfix"- [ u "t1"- (findFirstInfix ("a" <|> "ab") "tabc")- (Just ("t", "a","bc"))- , u "t2"- (findFirstInfix ("ab" <|> "a") "tabc")- (Just ("t", "ab","c"))- ]- , testGroup "findLongestPrefix"- [ u "t1"- (findLongestPrefix ("a" <|> "ab") "abc")- (Just ("ab","c"))- , u "t2"- (findLongestPrefix ("ab" <|> "a") "abc")- (Just ("ab","c"))- , u "t3"- (findLongestPrefix "bc" "abc")- Nothing- ]- , testGroup "findLongestInfix"- [ u "t1"- (findLongestInfix ("a" <|> "ab") "tabc")- (Just ("t", "ab","c"))- , u "t2"- (findLongestInfix ("ab" <|> "a") "tabc")- (Just ("t", "ab","c"))- , u "t3"- (findLongestInfix "bc" "tabc")- (Just ("ta", "bc",""))- ]- , testGroup "findShortestPrefix"- [ u "t1"- (findShortestPrefix ("a" <|> "ab") "abc")- (Just ("a","bc"))- , u "t2"- (findShortestPrefix ("ab" <|> "a") "abc")- (Just ("a","bc"))- , u "t3"- (findShortestPrefix "bc" "abc")- Nothing- ]- , testGroup "findShortestInfix"- [ u "t1"- (findShortestInfix ("a" <|> "ab") "tabc")- (Just ("t", "a","bc"))- , u "t2"- (findShortestInfix ("ab" <|> "a") "tabc")- (Just ("t", "a","bc"))- , u "t3"- (findShortestInfix "bc" "tabc")- (Just ("ta", "bc",""))- ]- ]- ]- where- t name n = localOption (SmallCheckDepth n) . testProperty name- u name real ideal = testCase name (assertEqual "" real ideal)--main = defaultMain tests
+ tests/test.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses #-}+import Text.Regex.Applicative+import Text.Regex.Applicative.Reference+import Control.Applicative+import Control.Monad+import Data.Traversable+import Data.Maybe+import Text.Printf++import Test.HUnit+import Test.SmallCheck+import Test.SmallCheck.Series+import Test.Tasty+import Test.Tasty.SmallCheck+import Test.Tasty.HUnit++-- Small alphabets as SmallCheck's series+newtype A = A { a :: Char } deriving Show+instance Monad m => Serial m A where+ series = cons0 $ A 'a'++newtype AB = AB { ab :: Char } deriving Show+instance Monad m => Serial m AB where+ series = cons0 (AB 'a') \/ cons0 (AB 'b')++newtype ABC = ABC { abc :: Char } deriving Show+instance Monad m => Serial m ABC where+ series = cons0 (ABC 'a') \/ cons0 (ABC 'b') \/ cons0 (ABC 'c')++re1 =+ let one = pure 1 <* sym 'a'+ two = pure 2 <* sym 'a' <* sym 'a'+ in (,) <$> (one <|> two) <*> (two <|> one)++re2 = sequenceA $+ [ pure 1 <* sym 'a' <* sym 'a' <|>+ pure 2 <* sym 'a'+ , pure 3 <* sym 'b'+ , pure 4 <* sym 'b' <|>+ pure 5 <* sym 'a' ]++re3 = sequenceA $+ [ pure 0 <|> pure 1+ , pure 1 <* sym 'a' <* sym 'a' <|>+ pure 2 <* sym 'a'+ , pure 3 <* sym 'b' <|> pure 6+ , fmap (+1) $+ pure 4 <* sym 'b' <|>+ pure 7 <|>+ pure 5 <* sym 'a' ]++re4 = sym 'a' *> many (sym 'b') <* sym 'a'++re5 = (sym 'a' <|> sym 'a' *> sym 'a') *> many (sym 'a')++re6 = many (pure 3 <* sym 'a' <* sym 'a' <* sym 'a' <|> pure 1 <* sym 'a')++-- Regular expression from the weighted regexp paper.+re7 =+ let many_A_or_B = many (sym 'a' <|> sym 'b')+ in (,) <$>+ many ((,,,) <$> many_A_or_B <*> sym 'c' <*> many_A_or_B <*> sym 'c') <*>+ many_A_or_B++re8 = (,) <$> many (sym 'a' <|> sym 'b') <*> many (sym 'b' <|> sym 'c')++-- NB: we don't test these against the reference impl, 'cause it will loop!+re9 = many (sym 'a' <|> empty) <* sym 'b'+re10 = few (sym 'a' <|> empty) <* sym 'b'++prop re f s =+ 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 =+ let fs = map f s in+ isJust (fs =~ re) == isJust (fs =~ (re *> pure ()))++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+ ]+ , testGroup "Recognition vs parsing"+ [ t "re1" 10 $ testRecognitionAgainstParsing re1 a+ , t "re2" 10 $ testRecognitionAgainstParsing re2 ab+ , t "re3" 10 $ testRecognitionAgainstParsing re3 ab+ , t "re4" 10 $ testRecognitionAgainstParsing re4 ab+ , t "re5" 10 $ testRecognitionAgainstParsing re5 a+ , t "re6" 10 $ testRecognitionAgainstParsing re6 a+ , t "re7" 7 $ testRecognitionAgainstParsing re7 abc+ , t "re8" 7 $ testRecognitionAgainstParsing re8 abc+ , t "re8" 10 $ testRecognitionAgainstParsing re9 ab+ , t "re8" 10 $ testRecognitionAgainstParsing re10 ab+ ]+ , testProperty "withMatched" prop_withMatched+ , testGroup "Tests for matching functions"+ [ testGroup "findFirstPrefix"+ [ u "t1"+ (findFirstPrefix ("a" <|> "ab") "abc")+ (Just ("a","bc"))+ , u "t2"+ (findFirstPrefix ("ab" <|> "a") "abc")+ (Just ("ab","c"))+ , u "t3"+ (findFirstPrefix "bc" "abc")+ Nothing+ ]+ , testGroup "findFirstInfix"+ [ u "t1"+ (findFirstInfix ("a" <|> "ab") "tabc")+ (Just ("t", "a","bc"))+ , u "t2"+ (findFirstInfix ("ab" <|> "a") "tabc")+ (Just ("t", "ab","c"))+ ]+ , testGroup "findLongestPrefix"+ [ u "t1"+ (findLongestPrefix ("a" <|> "ab") "abc")+ (Just ("ab","c"))+ , u "t2"+ (findLongestPrefix ("ab" <|> "a") "abc")+ (Just ("ab","c"))+ , u "t3"+ (findLongestPrefix "bc" "abc")+ Nothing+ ]+ , testGroup "findLongestInfix"+ [ u "t1"+ (findLongestInfix ("a" <|> "ab") "tabc")+ (Just ("t", "ab","c"))+ , u "t2"+ (findLongestInfix ("ab" <|> "a") "tabc")+ (Just ("t", "ab","c"))+ , u "t3"+ (findLongestInfix "bc" "tabc")+ (Just ("ta", "bc",""))+ ]+ , testGroup "findShortestPrefix"+ [ u "t1"+ (findShortestPrefix ("a" <|> "ab") "abc")+ (Just ("a","bc"))+ , u "t2"+ (findShortestPrefix ("ab" <|> "a") "abc")+ (Just ("a","bc"))+ , u "t3"+ (findShortestPrefix "bc" "abc")+ Nothing+ ]+ , testGroup "findShortestInfix"+ [ u "t1"+ (findShortestInfix ("a" <|> "ab") "tabc")+ (Just ("t", "a","bc"))+ , u "t2"+ (findShortestInfix ("ab" <|> "a") "tabc")+ (Just ("t", "a","bc"))+ , u "t3"+ (findShortestInfix "bc" "tabc")+ (Just ("ta", "bc",""))+ ]+ ]+ ]+ where+ t name n = localOption (SmallCheckDepth n) . testProperty name+ u name real ideal = testCase name (assertEqual "" real ideal)++main = defaultMain tests