module Yi.Regex
( SearchOption(..), makeSearchOptsM
, SearchExp(..), searchString, searchRegex, emptySearch
, emptyRegex
, regexEscapeString
, reversePattern
, module Text.Regex.TDFA
) where
import Data.Binary
import GHC.Generics (Generic)
import Text.Regex.TDFA
import Text.Regex.TDFA.Pattern
import Control.Applicative
import Lens.Micro.Platform
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, Generic)
instance Binary 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 ((.) . searchOpt) id
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,rest) = (rev pattern, rest)
where rev (PConcat l) = PConcat (reverse (map rev l))
rev (PCarat dp) = PDollar dp
rev (PDollar dp) = PCarat dp
rev (PEscape dp '<') = PEscape dp '>'
rev (PEscape dp '>') = PEscape dp '<'
rev (PGroup a x) = PGroup a (rev x)
rev (POr l) = POr (map rev l)
rev (PQuest x) = PQuest (rev x)
rev (PPlus x) = PPlus (rev x)
rev (PStar b x) = PStar b (rev x)
rev (PBound i m x) = PBound i m (rev x)
rev (PNonCapture x) = PNonCapture (rev x)
rev (PNonEmpty x) = PNonEmpty (rev x)
rev x = x
emptySearch :: SearchExp
emptySearch = SearchExp "" emptyRegex emptyRegex []
emptyRegex :: Regex
Just emptyRegex = makeRegexOptsM defaultCompOpt defaultExecOpt "[[:empty:]]"