matchers 0.14.0.2 → 0.16.0.0
raw patch · 5 files changed
+202/−207 lines, 5 filesdep +prednote
Dependencies added: prednote
Files
- Text/Matchers.hs +39/−199
- Text/Matchers/Times.hs +139/−0
- current-versions.txt +10/−3
- matchers.cabal +3/−1
- minimum-versions.txt +11/−4
Text/Matchers.hs view
@@ -1,67 +1,44 @@ module Text.Matchers- ( Matcher(..)- , CaseSensitive(..)+ ( CaseSensitive(..) , pcre , within , exact- , CompUTC(..)- , descUTC- , compUTCtoCmp- , date+ , anyTime+ , time ) where -import Control.Applicative ((<$>), (<*>), (<*), (<$), optional, (<|>))-import Control.Monad (replicateM, mzero)-import Data.Fixed (Pico)-import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack, toCaseFold, isInfixOf)-import Text.Parsec (many, satisfy) import qualified Text.Parsec as P-import Text.Parsec.Text (Parser) import qualified Data.Time as Time+import Text.Matchers.Times (dateTime) import Text.Matchers.Pcre as PCRE+import qualified Data.Prednote.Pdct as R 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- }- 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.+-- | Uses the PCRE regular expression engine. pcre :: CaseSensitive -> Text -- ^ Pattern - -> Either Text Matcher- -- ^ The Matcher if the pattern is good; if the pattern is bad,+ -> Either Text (R.Pdct Text)+ -- ^ The Pdct if the pattern is good; if the pattern is bad, -- returns an error message. pcre c t = case PCRE.compile (c == Insensitive) t of Left e -> Left . pack $ e Right r ->- let sDesc = pack "Perl-compatible regular expression"- mrDesc = pack $ "matches the PCRE pattern \""+ let mrDesc = pack $ "matches the PCRE pattern \"" ++ unpack t ++ "\"" ++ descSensitive c mr = maybe False id . PCRE.exec r- in return $ Matcher sDesc mrDesc mr+ in return $ R.operand mrDesc mr -- | Matcher that succeeds if the pattern text is found anywhere -- within the subject.@@ -71,20 +48,18 @@ -> Text -- ^ The pattern - -> Matcher-within cs t = Matcher sDesc mrDesc mr+ -> R.Pdct Text+within cs t = R.operand 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+exact :: CaseSensitive -> Text -> R.Pdct Text+exact cs t = R.operand mrDesc mr where- sDesc = pack "exact" mrDesc = pack $ "matches the text \"" ++ unpack t ++ "\"" ++ descSensitive cs mr = txtMatch (==) cs t@@ -100,168 +75,33 @@ 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----------------------------------------------------------------- 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+-- | Matches any valid time.+anyTime :: R.Pdct Text+anyTime = R.operand mrDesc mr 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-+ mrDesc = pack "any valid time"+ mr x = case P.parse dateTime "" x of+ Left _ -> False+ Right _ -> True -dateTime :: Parser Time.UTCTime-dateTime =- f <$> pDate <* many (satisfy white) <*> optional timeWithZone+-- | If the given ordering is @r@, the given time is @t@, and the+-- time of the subject is @s@, the Pdct returns @compare s t == r@.+-- Always returns False if the subject is not a valid time.+time+ :: Ordering+ -- ^ @r@+ -> Time.UTCTime+ -- ^ @t@+ -> R.Pdct Text+time ord ti = R.operand mrDesc mr where- f d mayTwithZ = Time.zonedTimeToUTC zt+ mrDesc = pack $ "subject time is " ++ d ++ " " ++ show ti 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 -> (<=)+ d = case ord of+ EQ -> "equal to"+ LT -> "less than"+ GT -> "greater than"+ mr x = case P.parse dateTime "" x of+ Left _ -> False+ Right g -> compare g ti == ord
+ Text/Matchers/Times.hs view
@@ -0,0 +1,139 @@+-- | Time parsers.+--+-- "Text.Matchers" allows you to perform matching based on times.+-- Times are parsed using the parsers in this module.+module Text.Matchers.Times where++import Data.Fixed+import Data.Maybe+import Control.Applicative+import Control.Monad+import qualified Data.Time as Time+import Text.Parsec (satisfy)+import qualified Text.Parsec as P+import Text.Parsec.Text (Parser)++-- | A four-digit year.+year :: Parser Integer+year = read <$> replicateM 4 P.digit++-- | A two-digit month (exactly 2 digits.)+month :: Parser Int+month = read <$> replicateM 2 P.digit++-- | A two-digit day (exactly 2 digits.)+day :: Parser Int+day = read <$> replicateM 2 P.digit++-- | A valid Gregorian day, in YYYY-MM-DD format. Each separator+-- may be a hyphen or a slash. Fails if the day is not valid.+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++-- | Date separator (slash or hyphen).+dateSep :: Char -> Bool+dateSep c = c == '/' || c == '-'++digit :: Char -> Bool+digit c = c >= '0' && c <= '9'++colon :: Char -> Bool+colon = (== ':')++-- | Two digits for the hour (exactly two digits). Must be between+-- 0 and 23.+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+++-- | Two digits for the minutes (exactly two digits). Must be+-- between 0 and 59.+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++-- | Two digits for seconds (exactly two digits). Must be between 0+-- and 59; there are no leap seconds.+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++-- | Hours and minutes, separated by colons, with optional seconds.+time :: Parser Time.TimeOfDay+time = f <$> hours <*> minutes <*> optional seconds+ where+ f h m ms = Time.TimeOfDay h m (fromMaybe 0 ms)++-- | Time zone sign, plus or minus.+tzSign :: Parser (Int -> Int)+tzSign = (id <$ satisfy plus) <|> (negate <$ satisfy minus)+ where+ plus = (== '+')+ minus = (== '-')++-- | Time zone offset, exactly 4 digits.+tzNumber :: Parser Int+tzNumber = read <$> replicateM 4 (satisfy digit)++-- | Time zone; that is, sign and offset. Both the sign and offset+-- are required. The number of minutes may not exceed 840.+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 "")++-- | Space or tab.+white :: Char -> Bool+white c = c == ' ' || c == '\t'++-- | Time of day, with optional time zone.+timeWithZone :: Parser (Time.TimeOfDay, Maybe Time.TimeZone)+timeWithZone =+ (,) <$> time <* many (satisfy white) <*> optional timeZone+++-- | Day, followed by optional whitespace, followed by optional time+-- with zone.+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)+
current-versions.txt view
@@ -1,7 +1,7 @@ This package was tested to work with these dependency versions and compiler version. These are the default versions fetched by cabal install.-Tested as of: 2014-02-24 14:31:52.614543 UTC+Tested as of: 2014-03-01 20:03:17.979027 UTC Path to compiler: ghc-7.6.3 Compiler description: 7.6.3 @@ -32,10 +32,17 @@ time-1.4.0.1 unix-2.6.0.1 -/home/massysett/matchers/sunlight-20584/db:- matchers-0.14.0.2+/home/massysett/matchers/sunlight-23118/db:+ contravariant-0.4.4+ matchers-0.16.0.0 mtl-2.1.2 parsec-3.1.5+ prednote-0.20.0.0+ rainbow-0.6.0.4+ split-0.2.2+ tagged-0.7+ terminfo-0.4.0.0 text-1.1.0.0 transformers-0.3.0.0+ transformers-compat-0.1.1.1
matchers.cabal view
@@ -1,5 +1,5 @@ Name: matchers-Version: 0.14.0.2+Version: 0.16.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -28,6 +28,7 @@ base >=4.5.0.0 && < 5 , bytestring >=0.9.2.1 , parsec >= 3.1.2+ , prednote >= 0.20.0.0 , text >=0.11.2.0 , time >=1.4 @@ -36,6 +37,7 @@ Text.Matchers , Text.Matchers.Pcre , Text.Matchers.Pcre.Base+ , Text.Matchers.Times extra-libraries: pcre
minimum-versions.txt view
@@ -1,11 +1,11 @@ This package was tested to work with these dependency versions and compiler version. These are the minimum versions given in the .cabal file.-Tested as of: 2014-02-24 14:31:52.614543 UTC+Tested as of: 2014-03-01 20:03:17.979027 UTC Path to compiler: ghc-7.4.1 Compiler description: 7.4.1 -/var/lib/ghc/package.conf.d:+/opt/ghc/7.4.1/lib/ghc-7.4.1/package.conf.d: Cabal-1.14.0 array-0.4.0.0 base-4.5.0.0@@ -33,10 +33,17 @@ time-1.4 unix-2.5.1.0 -/home/massysett/matchers/sunlight-20584/db:- matchers-0.14.0.2+/home/massysett/matchers/sunlight-23118/db:+ contravariant-0.4.4+ matchers-0.16.0.0 mtl-2.1.2 parsec-3.1.2+ prednote-0.20.0.0+ rainbow-0.6.0.4+ split-0.2.2+ tagged-0.7+ terminfo-0.4.0.0 text-0.11.2.0 transformers-0.3.0.0+ transformers-compat-0.1.1.1