diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,12 @@ Changes ======= +0.3 +--- +* Add a new module, `Text.Regex.Applicative.Common`, which contains some + commonly used regexps (by Aleksey Khudyakov) +* Improve the test suite + 0.2.1 ----- * Add the `withMatched` function diff --git a/Text/Regex/Applicative/Common.hs b/Text/Regex/Applicative/Common.hs new file mode 100644 --- /dev/null +++ b/Text/Regex/Applicative/Common.hs @@ -0,0 +1,40 @@ +-- | +-- Collection of commonly used regular expressions. +module Text.Regex.Applicative.Common ( + -- * Digits + digit + , hexDigit + -- * Numbers + , signed + , decimal + , hexadecimal + ) where + +import Data.Char +import Text.Regex.Applicative + + +-- | Decimal digit, i.e. @\'0\'@..@\'9\'@ +digit :: Num a => RE Char a +digit = fromIntegral . digitToInt <$> psym isDigit + +-- | Hexadecimal digit +-- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@. +hexDigit :: Num a => RE Char a +hexDigit = fromIntegral . digitToInt <$> psym isHexDigit + +-- | Add optional sign +signed :: Num a => RE Char a -> RE Char a +signed p = sign <*> p + where + sign = id <$ sym '+' + <|> negate <$ sym '-' + <|> pure id + +-- | Parse decimal number without sign. +decimal :: Num a => RE Char a +decimal = foldl (\d i -> d*10 + i) 0 <$> some digit + +-- | Parse decimal number without sign. +hexadecimal :: Num a => RE Char a +hexadecimal = foldl (\d i -> d*16 + i) 0 <$> some hexDigit diff --git a/regex-applicative.cabal b/regex-applicative.cabal --- a/regex-applicative.cabal +++ b/regex-applicative.cabal @@ -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.1 +Version: 0.3 -- A short (one-line) description of the package. Synopsis: Regex-based parsing with applicative interface @@ -47,7 +47,7 @@ Extra-source-files: README.md CREDITS.md test.hs CHANGES.md -- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.6 +Cabal-version: >=1.10 Source-repository head type: git @@ -56,9 +56,10 @@ Source-repository this type: git location: git://github.com/feuerbach/regex-applicative.git - tag: v0.2.1 + tag: v0.3 Library + Default-language: Haskell2010 -- Packages needed in order to build this package. Build-depends: base < 5, containers, @@ -68,6 +69,7 @@ -- Modules exported by the library. Exposed-modules: Text.Regex.Applicative Text.Regex.Applicative.Object + Text.Regex.Applicative.Common -- Modules not exported by this package. Other-modules: Text.Regex.Applicative.Interface @@ -83,3 +85,16 @@ -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-orphans + +Test-Suite test-regex-applicative + type: exitcode-stdio-1.0 + main-is: test.hs + Default-language: Haskell2010 + Build-depends: base < 5, + containers, + transformers, + smallcheck >= 1.0, + HUnit, + test-framework, + test-framework-smallcheck, + test-framework-hunit diff --git a/test.hs b/test.hs --- a/test.hs +++ b/test.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses #-} import Text.Regex.Applicative import Text.Regex.Applicative.Reference import Control.Applicative @@ -6,26 +7,25 @@ import Data.Maybe import Text.Printf +import Test.HUnit import Test.SmallCheck import Test.SmallCheck.Series import Test.Framework import Test.Framework.Providers.SmallCheck +import Test.Framework.Providers.HUnit -- Small alphabets as SmallCheck's series newtype A = A { a :: Char } deriving Show -instance Serial A where +instance Monad m => Serial m A where series = cons0 $ A 'a' - coseries = error "No coseries, sorry" newtype AB = AB { ab :: Char } deriving Show -instance Serial AB where +instance Monad m => Serial m AB where series = cons0 (AB 'a') \/ cons0 (AB 'b') - coseries = error "No coseries, sorry" newtype ABC = ABC { abc :: Char } deriving Show -instance Serial ABC where +instance Monad m => Serial m ABC where series = cons0 (ABC 'a') \/ cons0 (ABC 'b') \/ cons0 (ABC 'c') - coseries = error "No coseries, sorry" re1 = let one = pure 1 <* sym 'a' @@ -109,8 +109,74 @@ , 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 = withDepth n . testProperty name + u name real ideal = testCase name (assertEqual "" real ideal) main = defaultMain tests