diff --git a/Text/Matchers.hs b/Text/Matchers.hs deleted file mode 100644 --- a/Text/Matchers.hs +++ /dev/null @@ -1,102 +0,0 @@ -module Text.Matchers - ( CaseSensitive(..) - , pcre - , within - , exact - , anyTime - , time - ) where - -import Data.Text (Text, pack, unpack, toCaseFold, isInfixOf) -import qualified Text.Parsec as P -import qualified Data.Time as Time -import Text.Matchers.Times (dateTime) -import Text.Matchers.Pcre as PCRE -import qualified Data.Prednote.Predbox as R - -data CaseSensitive = Sensitive | Insensitive deriving (Eq, Ord, Show) - -descSensitive :: CaseSensitive -> String -descSensitive c = case c of - Sensitive -> " (case sensitive)" - Insensitive -> " (case insensitive)" - --- | Uses the PCRE regular expression engine. -pcre - :: CaseSensitive - - -> Text - -- ^ Pattern - - -> Either Text (R.Predbox Text) - -- ^ The Predbox 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 mrDesc = pack $ "matches the PCRE pattern \"" - ++ unpack t ++ "\"" ++ descSensitive c - mr = maybe False id . PCRE.exec r - in return $ R.predicate mrDesc mr - --- | Matcher that succeeds if the pattern text is found anywhere --- within the subject. -within - :: CaseSensitive - - -> Text - -- ^ The pattern - - -> R.Predbox Text -within cs t = R.predicate mrDesc mr - where - 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 -> R.Predbox Text -exact cs t = R.predicate mrDesc mr - where - 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 - --- | Matches any valid time. -anyTime :: R.Predbox Text -anyTime = R.predicate mrDesc mr - where - mrDesc = pack "any valid time" - mr x = case P.parse dateTime "" x of - Left _ -> False - Right _ -> True - --- | If the given ordering is @r@, the given time is @t@, and the --- time of the subject is @s@, the Predbox returns @compare s t == r@. --- Always returns False if the subject is not a valid time. -time - :: Ordering - -- ^ @r@ - -> Time.UTCTime - -- ^ @t@ - -> R.Predbox Text -time ord ti = R.compareByMaybe desc (pack "time") mr ord - where - desc = pack . show $ ti - mr x = case P.parse dateTime "" x of - Left _ -> Nothing - Right g -> Just $ (g `compare` ti) - diff --git a/Text/Matchers/Pcre.hs b/Text/Matchers/Pcre.hs deleted file mode 100644 --- a/Text/Matchers/Pcre.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -module Text.Matchers.Pcre - ( B.Caseless - , B.Regex - , B.reCaseless - , B.rePattern - , compile - , exec - ) where - -import qualified Text.Matchers.Pcre.Base as B -import qualified Data.Text as X -import System.IO.Unsafe (unsafePerformIO) - -compile - :: B.Caseless - -> X.Text - -> Either String B.Regex -compile cl x = unsafePerformIO $ B.compile cl x - -exec - :: B.Regex - -> X.Text - -> Maybe Bool -exec r x = unsafePerformIO $ B.exec r x - diff --git a/Text/Matchers/Pcre/Base.hsc b/Text/Matchers/Pcre/Base.hsc deleted file mode 100644 --- a/Text/Matchers/Pcre/Base.hsc +++ /dev/null @@ -1,135 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} - -module Text.Matchers.Pcre.Base - ( caseless - , PCRE - , PCRE_Extra - , c_free - , c_pcre_compile - , c_pcre_exec - , Caseless - , pcre_compile - , pcre_exec - , Regex - , reCaseless - , rePattern - , 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 -#include - -caseless :: CInt -caseless = #const PCRE_CASELESS - -data PCRE - -instance Show PCRE where - show _ = "PCRE" - -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 PCRE) - -foreign import ccall unsafe "pcre.h pcre_exec" - c_pcre_exec - :: Ptr PCRE - -- ^ Regex - -> Ptr PCRE_Extra - -- ^ Result of study - -> 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. - -type Caseless = Bool - -pcre_compile - :: Caseless - -> Text - -- ^ Pattern - -> IO (Either String (Ptr PCRE)) - -- ^ 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 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 PCRE -> 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 - -data Regex = Regex - { reCaseless :: Caseless - , rePattern :: Text - , _rePtr :: ForeignPtr PCRE - } deriving Show - -compile :: Caseless -> Text -> IO (Either String Regex) -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 $ Regex cl pat fp - -exec :: Regex -> Text -> IO (Maybe Bool) -exec (Regex _ _ fp) s = withForeignPtr fp $ \p -> pcre_exec p s diff --git a/Text/Matchers/Times.hs b/Text/Matchers/Times.hs deleted file mode 100644 --- a/Text/Matchers/Times.hs +++ /dev/null @@ -1,139 +0,0 @@ --- | 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) - diff --git a/current-versions.txt b/current-versions.txt --- a/current-versions.txt +++ b/current-versions.txt @@ -1,48 +1,50 @@ 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-03-02 02:11:53.267528 UTC -Path to compiler: ghc-7.6.3 -Compiler description: 7.6.3 +Tested as of: 2014-07-17 02:09:19.042404 UTC +Path to compiler: ghc-7.8.3 +Compiler description: 7.8.3 -/opt/ghc-7.6.3/lib/ghc-7.6.3/package.conf.d: - Cabal-1.16.0 - array-0.4.0.1 - base-4.6.0.1 +/opt/ghc/7.8.3/lib/ghc-7.8.3/package.conf.d: + Cabal-1.18.1.3 + array-0.5.0.0 + base-4.7.0.1 bin-package-db-0.0.0.0 - binary-0.5.1.1 - bytestring-0.10.0.2 - containers-0.5.0.0 - deepseq-1.3.0.1 - directory-1.2.0.1 - filepath-1.3.0.1 - (ghc-7.6.3) - ghc-prim-0.3.0.0 - (haskell2010-1.1.1.0) - (haskell98-2.0.0.2) - hoopl-3.9.0.0 - hpc-0.6.0.0 - integer-gmp-0.5.0.0 - old-locale-1.0.0.5 - old-time-1.1.0.1 - pretty-1.1.1.0 - process-1.1.0.2 + binary-0.7.1.0 rts-1.0 - template-haskell-2.8.0.0 - time-1.4.0.1 - unix-2.6.0.1 + bytestring-0.10.4.0 + containers-0.5.5.1 + deepseq-1.3.0.2 + directory-1.2.1.0 + filepath-1.3.0.2 + (ghc-7.8.3) + ghc-prim-0.3.1.0 + haskeline-0.7.1.2 + (haskell2010-1.1.2.0) + (haskell98-2.0.0.3) + hoopl-3.10.0.1 + hpc-0.6.0.1 + integer-gmp-0.5.1.0 + old-locale-1.0.0.6 + old-time-1.1.0.2 + pretty-1.1.1.1 + process-1.2.0.0 + template-haskell-2.9.0.0 + terminfo-0.4.0.0 + time-1.4.2 + transformers-0.3.0.0 + unix-2.7.0.1 + xhtml-3000.2.1 -/home/massysett/matchers/sunlight-26440/db: - contravariant-0.4.4 - matchers-0.18.0.0 - mtl-2.1.2 +/home/massysett/matchers/sunlight-7904/db: + contravariant-0.6 + matchers-0.20.0.0 + mtl-2.2.1 parsec-3.1.5 - prednote-0.22.0.0 - rainbow-0.6.0.4 + prednote-0.24.0.0 + rainbow-0.14.0.2 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 + text-1.1.1.3 + transformers-0.4.1.0 + transformers-compat-0.3.3.4 diff --git a/lib/Matchers.hs b/lib/Matchers.hs new file mode 100644 --- /dev/null +++ b/lib/Matchers.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} +module Matchers + ( CaseSensitive(..) + , pcre + , within + , exact + , anyTime + , time + ) where + +import Data.Text (Text, pack, toCaseFold, isInfixOf) +import qualified Text.Parsec as P +import qualified Data.Time as Time +import Matchers.Times (dateTime) +import Matchers.Pcre as PCRE +import qualified Prednote as R +import qualified Prednote.Comparisons as R +import Matchers.Types +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 st dyn pd + where + st = "matches the PCRE regular expression " + <> txt <> " - " <> s + s = case cs of + Sensitive -> "case sensitive" + Insensitive -> "case insensitive" + dyn x = "text " <> pack (show x) <> " - " <> st + 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 + -- ^ Static label + -> CaseSensitive + -> Text + -- ^ Pattern + -> R.Pred Text +txtMatch f lbl c p = R.predicate st dyn pd + where + st = lbl <> " - " <> cs + (cs, flipCase) = case c of + Sensitive -> ("case sensitive", id) + Insensitive -> ("case insensitive", toCaseFold) + dyn txt = "text " <> pack (show txt) <> " - " <> st + pd t = f pat txt + where + txt = flipCase t + pat = flipCase p + + +-- | Matches any valid time. +anyTime :: R.Pred Text +anyTime = R.predicate st dyn pd + where + st = "is any valid date or time" + dyn x = "text " <> pack (show x) <> " - " <> st + pd x = case P.parse dateTime "" x of + Left _ -> False + Right _ -> True + +-- | If the given ordering is @r@, the given time is @t@, and the +-- time of the subject is @s@, the Predbox returns @compare s t == r@. +-- Always returns False if the subject is not a valid time. +time + :: Time.UTCTime + -- ^ @t@ + -> Ordering + -- ^ @r@ + -> R.Pred Text +time ti ord = R.compareByMaybe "time" descRhs descLhs cmp ord + where + descRhs = pack . show $ ti + descLhs = pack . show + cmp x = case P.parse dateTime "" x of + Left _ -> Nothing + Right g -> Just $ (g `compare` ti) + diff --git a/lib/Matchers/Pcre.hs b/lib/Matchers/Pcre.hs new file mode 100644 --- /dev/null +++ b/lib/Matchers/Pcre.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE Trustworthy #-} +module Matchers.Pcre + ( B.PCRE + , compile + , exec + ) where + +import qualified Matchers.Pcre.Base as B +import qualified Data.Text as X +import System.IO.Unsafe (unsafePerformIO) +import Matchers.Types + +compile + :: 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 + diff --git a/lib/Matchers/Pcre/Base.hsc b/lib/Matchers/Pcre/Base.hsc new file mode 100644 --- /dev/null +++ b/lib/Matchers/Pcre/Base.hsc @@ -0,0 +1,123 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module Matchers.Pcre.Base + ( 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 +import Matchers.Types + +#include +#include + +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 diff --git a/lib/Matchers/Times.hs b/lib/Matchers/Times.hs new file mode 100644 --- /dev/null +++ b/lib/Matchers/Times.hs @@ -0,0 +1,139 @@ +-- | Time parsers. +-- +-- "Matchers" allows you to perform matching based on times. +-- Times are parsed using the parsers in this module. +module 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) + diff --git a/lib/Matchers/Types.hs b/lib/Matchers/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Matchers/Types.hs @@ -0,0 +1,5 @@ +module Matchers.Types where + +data CaseSensitive = Sensitive | Insensitive + deriving (Eq, Ord, Show) + diff --git a/matchers.cabal b/matchers.cabal --- a/matchers.cabal +++ b/matchers.cabal @@ -1,5 +1,5 @@ Name: matchers -Version: 0.18.0.0 +Version: 0.20.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3 @@ -26,19 +26,21 @@ Library Build-depends: base >=4.5.0.0 && < 5 - , bytestring >=0.9.2.1 - , parsec >= 3.1.2 - , prednote >= 0.22.0.0 - , text >=0.11.2.0 - , time >=1.4 + , bytestring >=0.9.2.1 && < 0.11 + , parsec >= 3.1.2 && < 3.2 + , text >=0.11.2.0 && < 1.2 + , time >=1.4 && < 1.5 + , prednote >= 0.24.0.0 && < 0.25 Exposed-modules: - Text.Matchers - , Text.Matchers.Pcre - , Text.Matchers.Pcre.Base - , Text.Matchers.Times + Matchers + , Matchers.Pcre + , Matchers.Pcre.Base + , Matchers.Times + , Matchers.Types extra-libraries: pcre ghc-options: -Wall + hs-source-dirs: lib diff --git a/minimum-versions.txt b/minimum-versions.txt --- a/minimum-versions.txt +++ b/minimum-versions.txt @@ -1,7 +1,7 @@ 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-03-02 02:11:53.267528 UTC +Tested as of: 2014-07-17 02:09:19.042404 UTC Path to compiler: ghc-7.4.1 Compiler description: 7.4.1 @@ -33,17 +33,17 @@ time-1.4 unix-2.5.1.0 -/home/massysett/matchers/sunlight-26440/db: - contravariant-0.4.4 - matchers-0.18.0.0 - mtl-2.1.2 +/home/massysett/matchers/sunlight-7904/db: + contravariant-0.6 + matchers-0.20.0.0 + mtl-2.2.1 parsec-3.1.2 - prednote-0.22.0.0 - rainbow-0.6.0.4 + prednote-0.24.0.0 + rainbow-0.14.0.2 split-0.2.2 - tagged-0.7 + tagged-0.7.2 terminfo-0.4.0.0 text-0.11.2.0 - transformers-0.3.0.0 - transformers-compat-0.1.1.1 + transformers-0.4.1.0 + transformers-compat-0.3.3.4 diff --git a/sunlight-test.hs b/sunlight-test.hs --- a/sunlight-test.hs +++ b/sunlight-test.hs @@ -8,7 +8,7 @@ { tiDescription = Nothing , tiCabal = "cabal" , tiLowest = ghc "7.4.1" - , tiDefault = [ ghc "7.4.1", ghc "7.6.3" ] + , tiDefault = [ ghc "7.4.1", ghc "7.6.3", ghc "7.8.3" ] , tiTest = [] }