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)"
pcre
:: CaseSensitive
-> Text
-> Either Text (R.Predbox Text)
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
within
:: CaseSensitive
-> Text
-> 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
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
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
time
:: Ordering
-> Time.UTCTime
-> 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)