matchers 0.6.0.0 → 0.24.0.0
raw patch · 7 files changed
Files
- LICENSE +1/−1
- README.md +19/−0
- Text/Matchers.hs +0/−352
- lib/Matchers.hs +66/−0
- lib/Matchers/Pcre.hs +24/−0
- lib/Matchers/Pcre/Base.hsc +127/−0
- matchers.cabal +18/−13
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011-2013 Omari Norman.+Copyright (c) 2011-2015 Omari Norman. All rights reserved. Redistribution and use in source and binary forms, with or without
+ README.md view
@@ -0,0 +1,19 @@+# matchers++This package contains helpers for performing text matches using+regular expressions as well as simpler matching that sees if a+particular substring exists within a larger string.++It was written mostly for use with+[Penny](http://www.github.com/massysett/penny) so it doesn't have much+of a stable API.++It uses the pcre C library, so make sure you have that installed.++## Test results++[](https://travis-ci.org/massysett/matchers)++The link above takes you to the archive of Travis build results. If+you have trouble building matchers, look there, as it will show you+what dependencies were successfully used in past builds.
− Text/Matchers.hs
@@ -1,352 +0,0 @@-module Text.Matchers- ( Matcher(..)- , CaseSensitive(..)- , tdfa- , pcre- , within- , exact- , CompUTC(..)- , descUTC- , compUTCtoCmp- , date- ) where--import Control.Applicative ((<$>), (<*>), (<*), (<$), optional, (<|>))-import Control.Monad (replicateM, mzero)-import Control.Monad.Exception.Synchronous- ( Exceptional (Exception, Success))-import qualified Data.ByteString as BS-import Data.Fixed (Pico)-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack, unpack, toCaseFold, isInfixOf)-import Data.Text.Encoding (encodeUtf8)-import qualified Text.Regex.TDFA as TDFA-import qualified Text.Regex.Base.RegexLike as RL-import qualified Text.Regex.PCRE.Light as PCRE-import Text.Parsec (many, satisfy)-import qualified Text.Parsec as P-import Text.Parsec.Text (Parser)-import qualified Data.Time as Time--data CaseSensitive = Sensitive | Insensitive deriving (Eq, Ord, Show)--data Matcher = Matcher- { shortDesc :: Text- -- ^ Short description of this matcher, e.g. @PCRE@ or @Exact@.-- , matchDesc :: Text- -- ^ Description of a successful match, e.g.- -- @Matches the PCRE pattern abc@, or- -- @a valid date with optional time@.-- , match :: Text -> Bool- -- ^ Function to carry out the match- }---- | Uses the regular expression matcher from the regex-tdfa--- package. This is a POSIX extended regular expression. It should--- work correctly with Unicode.-tdfa- :: CaseSensitive-- -> Text- -- ^ The pattern-- -> Exceptional Text Matcher- -- ^ The Matcher if the pattern is good; if the pattern is bad,- -- returns an error message. The error message has a trailing- -- newline.--tdfa c t = case tdfaPrim c (unpack t) of- Exception e -> Exception $ pack e- Success f ->- let sDesc = pack "POSIX-like regular expression (TDFA)"- mrDesc = pack $ "matches the POSIX regular expression \""- ++ unpack t ++ "\"" ++ descSensitive c- mr = f . unpack- in return $ Matcher sDesc mrDesc mr--descSensitive :: CaseSensitive -> String-descSensitive c = case c of- Sensitive -> " (case sensitive)"- Insensitive -> " (case insensitive)"---- | Uses the PCRE regular expression engine. Currently the pcre-light--- package is used, as it has a simpler interface than the--- regex-pcre-builtin. It should work correctly with Unicode.-pcre- :: CaseSensitive-- -> Text- -- ^ Pattern-- -> Exceptional Text Matcher- -- ^ The Matcher if the pattern is good; if the pattern is bad,- -- returns an error message.--pcre c t = case pcrePrim c (encodeUtf8 t) of- Exception e -> Exception $ pack e- Success f ->- let sDesc = pack "Perl-compatible regular expression"- mrDesc = pack $ "matches the PCRE pattern \""- ++ unpack t ++ "\"" ++ descSensitive c- mr = f . encodeUtf8- in return $ Matcher sDesc mrDesc mr---- | Matcher that succeeds if the pattern text is found anywhere--- within the subject.-within- :: CaseSensitive-- -> Text- -- ^ The pattern-- -> Matcher-within cs t = Matcher sDesc mrDesc mr- where- sDesc = pack "within"- mrDesc = pack $ "contains the text \"" ++ unpack t- ++ "\"" ++ descSensitive cs- mr = txtMatch isInfixOf cs t---- | Matcher that succeeds if the pattern text exactly matches the--- subject (with case sensitivity as appropriate.)-exact :: CaseSensitive -> Text -> Matcher-exact cs t = Matcher sDesc mrDesc mr- where- sDesc = pack "exact"- mrDesc = pack $ "matches the text \"" ++ unpack t- ++ "\"" ++ descSensitive cs- mr = txtMatch (==) cs t--txtMatch :: (Text -> Text -> Bool)- -> CaseSensitive- -> Text- -> Text -> Bool-txtMatch f c p t = pat `f` txt where- txt = flipCase t- pat = flipCase p- flipCase = case c of- Sensitive -> id- Insensitive -> toCaseFold---- | Matcher that succeeds if the subject represents a valid date with--- an optional time.-date- :: Maybe (CompUTC, Time.UTCTime)- -- ^ If Nothing, any valid date and time will succeed as a match;- -- the matcher will return False if the subject is not a valid- -- date. If Just, the subject must be a valid date and must fit- -- within the range indicated.- -> Matcher-date mayPair = Matcher (pack "date") md mr- where- md = case mayPair of- Nothing -> pack "any valid date with optional time"- Just (c, t) -> pack $ "valid date and optional time, "- ++ descUTC c t- mr x = fromMaybe False $ do- subjDT <- case P.parse dateTime "" x of- Left _ -> mzero- Right g -> return g- case mayPair of- Nothing -> return True- Just (c, t) ->- let cmp = compUTCtoCmp c- in return $ subjDT `cmp` t----------------------------------------------------------------- StrErr monad----------------------------------------------------------------- | This monad exists because using the mtl Monad instance of (Either--- String) causes problems due to orphan instances.------ See http://www.haskell.org/pipermail/haskell-cafe/2011-December/098079.html--data StrErr a = Good a- | Bad String- deriving (Show, Eq)--instance Monad StrErr where- return = Good- (Good a) >>= f = f a- (Bad s) >>= _ = Bad s- fail s = Bad s----------------------------------------------------------------- TDFA primitives---------------------------------------------------------------tdfaPrim- :: CaseSensitive -> String -> Exceptional String (String -> Bool)-tdfaPrim c regexStr = case RL.makeRegexOptsM comp exec regexStr of- (Bad s) -> Exception s- (Good rx) -> return (RL.matchTest rx)- where- comp = RL.defaultCompOpt { TDFA.caseSensitive = case c of- Sensitive -> True- Insensitive -> False- , TDFA.newSyntax = True- , TDFA.lastStarGreedy = True }- exec = RL.defaultExecOpt { TDFA.captureGroups = False }----------------------------------------------------------------- PCRE primitives---------------------------------------------------------------pcrePrim :: CaseSensitive- -> BS.ByteString- -> Exceptional String (BS.ByteString -> Bool)-pcrePrim c bs = let- u8 = [PCRE.utf8]- opts = case c of- Sensitive -> u8- Insensitive -> PCRE.caseless:u8 in- case PCRE.compileM bs opts of- (Left err) -> Exception err- (Right rx) -> Success $ \s ->- case PCRE.match rx s [] of- (Just _) -> True- Nothing -> False----------------------------------------------------------------- Date parsers--------------------------------------------------------------year :: Parser Integer-year = read <$> replicateM 4 P.digit--month :: Parser Int-month = read <$> replicateM 2 P.digit--day :: Parser Int-day = read <$> replicateM 2 P.digit--pDate :: Parser Time.Day-pDate = p >>= failOnErr- where- p = Time.fromGregorianValid- <$> year <* satisfy dateSep- <*> month <* satisfy dateSep- <*> day- failOnErr = maybe (fail "could not parse date") return--dateSep :: Char -> Bool-dateSep c = c == '/' || c == '-'--digit :: Char -> Bool-digit c = c >= '0' && c <= '9'--colon :: Char -> Bool-colon = (== ':')--hours :: Parser Int-hours = p >>= (maybe (fail "could not parse hours") return)- where- p = f <$> satisfy digit <*> satisfy digit- f d1 d2 =- let r = read [d1,d2]- in if r < 0 || r > 23- then Nothing- else Just r---minutes :: Parser Int-minutes = p >>= maybe (fail "could not parse minutes") return- where- p = f <$ satisfy colon <*> satisfy digit <*> satisfy digit- f d1 d2 =- let r = read [d1, d2]- in if r < 0 || r > 59- then Nothing- else Just r--seconds :: Parser Pico-seconds = p >>= maybe (fail "could not parse seconds") return- where- p = f <$ satisfy colon <*> satisfy digit <*> satisfy digit- f d1 d2 =- let r = read [d1, d2] :: Int- in if r < 0 || r > 59- then Nothing- else Just . fromIntegral $ r--time :: Parser Time.TimeOfDay-time = f <$> hours <*> minutes <*> optional seconds- where- f h m ms = Time.TimeOfDay h m (fromMaybe 0 ms)--tzSign :: Parser (Int -> Int)-tzSign = (id <$ satisfy plus) <|> (negate <$ satisfy minus)- where- plus = (== '+')- minus = (== '-')--tzNumber :: Parser Int-tzNumber = read <$> replicateM 4 (satisfy digit)--timeZone :: Parser Time.TimeZone-timeZone = p >>= maybe (fail "could not parse time zone") return- where- p = f <$> tzSign <*> tzNumber- f s = minsToOffset . s- minsToOffset m = if abs m > 840- then Nothing- else Just (Time.TimeZone m False "")--white :: Char -> Bool-white c = c == ' ' || c == '\t'--timeWithZone :: Parser (Time.TimeOfDay, Maybe Time.TimeZone)-timeWithZone =- (,) <$> time <* many (satisfy white) <*> optional timeZone---dateTime :: Parser Time.UTCTime-dateTime =- f <$> pDate <* many (satisfy white) <*> optional timeWithZone- where- f d mayTwithZ = Time.zonedTimeToUTC zt- where- zt = Time.ZonedTime lt tz- lt = Time.LocalTime d tod- (tod, tz) = case mayTwithZ of- Nothing -> (Time.midnight, Time.utc)- Just (t, mayZ) -> case mayZ of- Nothing -> (t, Time.utc)- Just z -> (t, z)----------------------------------------------------------------- Other date things---------------------------------------------------------------data CompUTC- = UAfter- | UOnOrAfter- | UExactly- | UBefore- | UOnOrBefore- deriving (Eq, Show, Ord)--descUTC :: CompUTC -> Time.UTCTime -> String-descUTC c u = "date is " ++ co ++ " " ++ dt- where- co = case c of- UAfter -> "after"- UOnOrAfter -> "on or after"- UExactly -> "on"- UBefore -> "before"- UOnOrBefore -> "on or before"- dt = show dy ++ " " ++ hs ++ ":" ++ ms ++ ":" ++ ss ++ " UTC"- Time.UTCTime dy difft = u- Time.TimeOfDay h m s = Time.timeToTimeOfDay difft- (hs, ms, ss) = (show h, show m, show (round s :: Int))--compUTCtoCmp :: Ord a => CompUTC -> a -> a -> Bool-compUTCtoCmp c = case c of- UAfter -> (>)- UOnOrAfter -> (>=)- UExactly -> (==)- UBefore -> (<)- UOnOrBefore -> (<=)-
+ lib/Matchers.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+module Matchers+ ( CaseSensitive(..)+ , pcre+ , within+ , exact+ ) where++import Data.Text (Text, pack, toCaseFold, isInfixOf)+import Matchers.Pcre as PCRE+import qualified Prednote as R+import Data.Monoid++pcre+ :: CaseSensitive+ -> Text+ -- ^ Pattern+ -> Either String (R.Pred Text)+pcre cs txt = fmap f $ compile cs txt+ where+ f pc = R.predicate cond pd+ where+ cond = "matches the PCRE regular expression "+ <> (pack . show $ txt) <> ", " <> s+ s = case cs of+ Sensitive -> "case sensitive"+ Insensitive -> "case insensitive"+ pd x = case exec pc x of+ Nothing -> False+ Just b -> b++within+ :: CaseSensitive+ -> Text+ -- ^ Pattern+ -> R.Pred Text+within cs txt = txtMatch isInfixOf st cs txt+ where+ st = "contains the text " <> pack (show txt)++exact+ :: CaseSensitive+ -> Text+ -> R.Pred Text+exact cs txt = txtMatch (==) st cs txt+ where+ st = "exactly matches the text " <> pack (show txt)++txtMatch+ :: (Text -> Text -> Bool)+ -> Text+ -- ^ Condition description+ -> CaseSensitive+ -> Text+ -- ^ Pattern+ -> R.Pred Text+txtMatch f lbl c p = R.predicate cond pd+ where+ cond = lbl <> ", " <> cs+ (cs, flipCase) = case c of+ Sensitive -> ("case sensitive", id)+ Insensitive -> ("case insensitive", toCaseFold)+ pd t = f pat txt+ where+ txt = flipCase t+ pat = flipCase p
+ lib/Matchers/Pcre.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE Trustworthy #-}+module Matchers.Pcre+ ( B.CaseSensitive(..)+ , B.PCRE+ , compile+ , exec+ ) where++import qualified Matchers.Pcre.Base as B+import qualified Data.Text as X+import System.IO.Unsafe (unsafePerformIO)++compile+ :: B.CaseSensitive+ -> X.Text+ -> Either String B.PCRE+compile cl x = unsafePerformIO $ B.compile cl x++exec+ :: B.PCRE+ -> X.Text+ -> Maybe Bool+exec r x = unsafePerformIO $ B.exec r x+
+ lib/Matchers/Pcre/Base.hsc view
@@ -0,0 +1,127 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}++module Matchers.Pcre.Base+ ( CaseSensitive(..)+ , PCRE+ , compile+ , exec+ ) where++import Foreign.Storable+import Foreign.C+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.ForeignPtr.Safe+import Foreign.Ptr+import Data.ByteString+import Data.Text+import Data.Text.Encoding+++#include <pcre.h>+#include <stdlib.h>++data CaseSensitive = Sensitive | Insensitive+ deriving (Eq, Ord, Show)++caseless :: CInt+caseless = #const PCRE_CASELESS++data PCREData++instance Show PCREData where+ show _ = "PCREData"++data PCRE_Extra++instance Show PCRE_Extra where+ show _ = "PCRE_Extra"++foreign import ccall unsafe "stdlib.h &free"+ c_free :: FunPtr (Ptr a -> IO ())++foreign import ccall unsafe "pcre.h pcre_compile"+ c_pcre_compile+ :: CString+ -- ^ Pattern+ -> CInt+ -- ^ Options+ -> Ptr CString+ -- ^ OUT error message+ -> Ptr CInt+ -- ^ OUT Error offset+ -> Ptr CUChar+ -- ^ Pointer to character table. Use NULL for default.+ -> IO (Ptr PCREData)++foreign import ccall unsafe "pcre.h pcre_exec"+ c_pcre_exec+ :: Ptr PCREData+ -- ^ Regex++ -> Ptr PCRE_Extra+ -- ^ Result of study. Just pass NULL if you did not study the+ -- pattern.++ -> CString+ -- ^ Subject+ -> CInt+ -- ^ Length of subject string. (Apparently it does not have to be+ -- null terminated?)+ -> CInt+ -- ^ Start at this offset in the subject string.+ -> CInt+ -- ^ Options+ -> Ptr CInt+ -- ^ OUT Output vector. Information about matching substrings is+ -- stored in this array.+ -> CInt+ -- ^ Output vector size+ -> IO CInt+ -- ^ One more than the highest numbered pair that has been set.++pcre_compile+ :: CaseSensitive+ -> Text+ -- ^ Pattern+ -> IO (Either String (Ptr PCREData))+ -- ^ Errors are indicated with a Left with the error message.+pcre_compile cl pat+ = useAsCString (encodeUtf8 pat) $ \patC ->+ alloca $ \ptrMsg ->+ alloca $ \ptrOffset -> do+ let cOpt = if cl == Insensitive then caseless else 0+ ptrPcre <- c_pcre_compile patC cOpt ptrMsg ptrOffset nullPtr+ if ptrPcre == nullPtr+ then do+ ptrErr <- peek ptrMsg+ msg <- peekCAString ptrErr+ return . Left $ msg+ else return . Right $ ptrPcre+ + +pcre_exec :: Ptr PCREData -> Text -> IO (Maybe Bool)+pcre_exec ptr txt+ = useAsCStringLen (encodeUtf8 txt) $ \(ptrSubj, len) ->+ allocaArray 30 $ \array -> do+ r <- c_pcre_exec ptr nullPtr ptrSubj (fromIntegral len)+ 0 0 array 30+ return $ case () of+ _ | r == (-1) -> Just False+ | r < (-1) -> Nothing+ | otherwise -> Just True+ +newtype PCRE = PCRE (ForeignPtr PCREData)+ deriving Show++compile :: CaseSensitive -> Text -> IO (Either String PCRE)+compile cl pat = do+ ei <- pcre_compile cl pat+ case ei of+ Left e -> return . Left $ e+ Right ptr -> do+ fp <- newForeignPtr c_free ptr+ return . Right $ PCRE fp++exec :: PCRE -> Text -> IO (Maybe Bool)+exec (PCRE fp) s = withForeignPtr fp $ \p -> pcre_exec p s
matchers.cabal view
@@ -1,9 +1,9 @@ Name: matchers-Version: 0.6.0.0+Version: 0.24.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3-Copyright: 2012-2013 Omari Norman.+Copyright: 2011-2015 Omari Norman. author: Omari Norman maintainer: omari@smileystation.com stability: Experimental@@ -12,8 +12,13 @@ Category: Console License-File: LICENSE synopsis: Text matchers+extra-source-files:+ README.md description: Helpers for performing text matches.+ For more information, please see the Github homepage at+ .+ <http://www.github.com/massysett/matchers> source-repository head type: git@@ -21,18 +26,18 @@ Library Build-depends:- base ==4.*- , bytestring ==0.10.*- , explicit-exception ==0.1.*- , parsec >= 3.1.2 && < 3.2- , pcre-light ==0.4.*- , regex-base ==0.93.*- , regex-tdfa ==1.1.*- , text ==0.11.*- , time ==1.4.*+ base >=4.5.0.0 && < 5+ , bytestring >=0.9.2.1 && < 0.11+ , text >=0.11.2.0 && < 1.3+ , prednote >= 0.28.0.0 && < 0.29 Exposed-modules:- Text.Matchers+ Matchers+ , Matchers.Pcre+ , Matchers.Pcre.Base - ghc-options: -Wall+ extra-libraries: pcre++ ghc-options: -Wall+ hs-source-dirs: lib