module Yi.Regex
(
SearchOption(..), makeSearchOptsM,
SearchExp(..), searchString, searchRegex, emptySearch,
emptyRegex,
regexEscapeString,
module Text.Regex.TDFA,
)
where
import Data.Binary
import Data.DeriveTH
import Data.Generics.Uniplate
import Text.Regex.TDFA
import Text.Regex.TDFA.Pattern
import Control.Applicative
import Text.Regex.TDFA.ReadRegex(parseRegex)
import Text.Regex.TDFA.TDFA(patternToRegex)
import Yi.Buffer.Basic (Direction(..))
data SearchExp = SearchExp { seInput :: String
, seCompiled :: Regex
, seBackCompiled :: Regex
, seOptions :: [SearchOption]
}
searchString :: SearchExp -> String
searchString = seInput
searchRegex :: Direction -> SearchExp -> Regex
searchRegex Forward = seCompiled
searchRegex Backward = seBackCompiled
data SearchOption
= IgnoreCase
| NoNewLine
| QuoteRegex
deriving Eq
$(derive makeBinary ''SearchOption)
searchOpt :: SearchOption -> CompOption -> CompOption
searchOpt IgnoreCase = \o->o{caseSensitive = False}
searchOpt NoNewLine = \o->o{multiline = False}
searchOpt QuoteRegex = id
makeSearchOptsM :: [SearchOption] -> String -> Either String SearchExp
makeSearchOptsM opts re = (\p->SearchExp { seInput = re
, seCompiled = compile p
, seBackCompiled = compile $ reversePattern p
, seOptions = opts
}) <$> pattern
where searchOpts = foldr (.) id . map searchOpt
compile source = patternToRegex source (searchOpts opts defaultCompOpt) defaultExecOpt
pattern = if QuoteRegex `elem` opts
then Right (literalPattern re)
else mapLeft show (parseRegex re)
instance Binary SearchExp where
get = do re <- get
opts <- get
return $ case makeSearchOptsM opts re of
Left err -> error err
Right se -> se
put (SearchExp { seInput = re,
seOptions = opts, .. }) = do put re
put opts
mapLeft :: (t1 -> a) -> Either t1 t -> Either a t
mapLeft _ (Right a) = Right a
mapLeft f (Left a) = Left (f a)
regexEscapeString :: String -> String
regexEscapeString source = showPattern . literalPattern' $ source
literalPattern :: (Num t) => String -> (Pattern, (t, DoPa))
literalPattern source = (literalPattern' source, (0,DoPa 0))
literalPattern' :: String -> Pattern
literalPattern' = PConcat . map (PChar (DoPa 0))
reversePattern :: (Pattern, (t, DoPa)) -> (Pattern, (t, DoPa))
reversePattern (pattern,(gi,DoPa maxDoPa)) = (transform (rev) pattern, (gi,DoPa maxDoPa))
where rev (PConcat l) = PConcat (reverse l)
rev (PCarat x) = PDollar x
rev (PDollar x) = PCarat x
rev (PEscape {getDoPa = dp, getPatternChar = '<'}) = PEscape {getDoPa = dp, getPatternChar = '>'}
rev (PEscape {getDoPa = dp, getPatternChar = '>'}) = PEscape {getDoPa = dp, getPatternChar = '<'}
rev x = x
instance Uniplate Pattern where
uniplate = \pat ->
case pat of
PGroup x p -> ([p], \[z] ->PGroup x z)
POr ps -> (ps, POr)
PConcat ps -> (ps, PConcat)
PQuest p ->([p], \[z] -> PQuest z)
PPlus p ->([p], \[z] -> PPlus z)
PStar x p -> ([p], \[z] ->PStar x z)
PBound w x p -> ([p], \[z] ->PBound w x z)
PNonCapture p ->([p], \[z] -> PNonCapture z)
PNonEmpty p ->([p], \[z] -> PNonEmpty z)
p ->([],\[]->p)
emptySearch :: SearchExp
emptySearch = SearchExp "" emptyRegex emptyRegex []
emptyRegex :: Regex
Just emptyRegex = makeRegexOptsM defaultCompOpt defaultExecOpt "[[:empty:]]"