    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveGeneric #-}

    -- Copyright (c) Jean-Philippe Bernardy 2008
    module Yi.Regex
      ( SearchOption(..), makeSearchOptsM
      , SearchExp(..), searchString, searchRegex, emptySearch
      , emptyRegex
      , regexEscapeString
      , reversePattern
      , module Text.Regex.TDFA
      ) where

    import Data.Bifunctor (first)
    import Data.Binary
    import GHC.Generics (Generic)
    import Yi.Buffer.Basic (Direction(..))

    import Text.Regex.TDFA ( Regex, CompOption(..), caseSensitive, multiline
                           , defaultCompOpt, defaultExecOpt, makeRegexOptsM
                           , matchOnceText, makeRegex, RegexLike(matchAll)
                           , AllTextSubmatches(..), (=~))
    import Text.Regex.TDFA.Pattern (Pattern(..), DoPa(..), showPattern)
    import Text.Regex.TDFA.ReadRegex(parseRegex)
    import Text.Regex.TDFA.TDFA(patternToRegex)

    -- input string, regexexp, backward regex.
    data SearchExp = SearchExp
        { SearchExp -> String
    seInput        :: String
        , SearchExp -> Regex
    seCompiled     :: Regex
        , SearchExp -> Regex
    seBackCompiled :: Regex
        , SearchExp -> [SearchOption]
    seOptions      :: [SearchOption]
        }

    searchString :: SearchExp -> String
    searchString :: SearchExp -> String
    searchString = SearchExp -> String
    seInput

    searchRegex :: Direction -> SearchExp -> Regex
    searchRegex :: Direction -> SearchExp -> Regex
    searchRegex Direction
    Forward = SearchExp -> Regex
    seCompiled
    searchRegex Direction
    Backward = SearchExp -> Regex
    seBackCompiled

    --
    -- What would be interesting would be to implement our own general
    -- mechanism to allow users to supply a regex function of any kind, and
    -- search with that. This removes the restriction on strings be valid
    -- under regex(3).
    --

    data SearchOption
        = IgnoreCase   -- ^ Compile for matching that ignores char case
        | NoNewLine    -- ^ Compile for newline-insensitive matching
        | QuoteRegex   -- ^ Treat the input not as a regex but as a literal string to search for.
        deriving (SearchOption -> SearchOption -> Bool
    (SearchOption -> SearchOption -> Bool)
    -> (SearchOption -> SearchOption -> Bool) -> Eq SearchOption
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SearchOption -> SearchOption -> Bool
    == :: SearchOption -> SearchOption -> Bool
    $c/= :: SearchOption -> SearchOption -> Bool
    /= :: SearchOption -> SearchOption -> Bool
    Eq, (forall x. SearchOption -> Rep SearchOption x)
    -> (forall x. Rep SearchOption x -> SearchOption)
    -> Generic SearchOption
    forall x. Rep SearchOption x -> SearchOption
    forall x. SearchOption -> Rep SearchOption x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. SearchOption -> Rep SearchOption x
    from :: forall x. SearchOption -> Rep SearchOption x
    $cto :: forall x. Rep SearchOption x -> SearchOption
    to :: forall x. Rep SearchOption x -> SearchOption
    Generic)

    instance Binary SearchOption

    searchOpt :: SearchOption -> CompOption -> CompOption
    searchOpt :: SearchOption -> CompOption -> CompOption
    searchOpt SearchOption
    IgnoreCase = \CompOption
    o->CompOption
    o{caseSensitive = False}
    searchOpt SearchOption
    NoNewLine = \CompOption
    o->CompOption
    o{multiline = False}
    searchOpt SearchOption
    QuoteRegex = CompOption -> CompOption
    forall a. a -> a
    id

    makeSearchOptsM :: [SearchOption] -> String -> Either String SearchExp
    makeSearchOptsM :: [SearchOption] -> String -> Either String SearchExp
    makeSearchOptsM [SearchOption]
    opts String
    re = (\(Pattern, (GroupIndex, DoPa))
    p->SearchExp { seInput :: String
    seInput        = String
    re
                                             , seCompiled :: Regex
    seCompiled     = (Pattern, (GroupIndex, DoPa)) -> Regex
    compile (Pattern, (GroupIndex, DoPa))
    p
                                             , seBackCompiled :: Regex
    seBackCompiled = (Pattern, (GroupIndex, DoPa)) -> Regex
    compile ((Pattern, (GroupIndex, DoPa)) -> Regex)
    -> (Pattern, (GroupIndex, DoPa)) -> Regex
    forall a b. (a -> b) -> a -> b
    $ (Pattern, (GroupIndex, DoPa)) -> (Pattern, (GroupIndex, DoPa))
    forall t. (Pattern, (t, DoPa)) -> (Pattern, (t, DoPa))
    reversePattern (Pattern, (GroupIndex, DoPa))
    p
                                             , seOptions :: [SearchOption]
    seOptions      = [SearchOption]
    opts
                                             }) ((Pattern, (GroupIndex, DoPa)) -> SearchExp)
    -> Either String (Pattern, (GroupIndex, DoPa))
    -> Either String SearchExp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Either String (Pattern, (GroupIndex, DoPa))
    pattern
        where searchOpts :: [SearchOption] -> CompOption -> CompOption
    searchOpts = (SearchOption
     -> (CompOption -> CompOption) -> CompOption -> CompOption)
    -> (CompOption -> CompOption)
    -> [SearchOption]
    -> CompOption
    -> CompOption
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((CompOption -> CompOption)
    -> (CompOption -> CompOption) -> CompOption -> CompOption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ((CompOption -> CompOption)
     -> (CompOption -> CompOption) -> CompOption -> CompOption)
    -> (SearchOption -> CompOption -> CompOption)
    -> SearchOption
    -> (CompOption -> CompOption)
    -> CompOption
    -> CompOption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SearchOption -> CompOption -> CompOption
    searchOpt) CompOption -> CompOption
    forall a. a -> a
    id
              compile :: (Pattern, (GroupIndex, DoPa)) -> Regex
    compile (Pattern, (GroupIndex, DoPa))
    source = (Pattern, (GroupIndex, DoPa)) -> CompOption -> ExecOption -> Regex
    patternToRegex (Pattern, (GroupIndex, DoPa))
    source ([SearchOption] -> CompOption -> CompOption
    searchOpts [SearchOption]
    opts CompOption
    forall regex compOpt execOpt.
    RegexOptions regex compOpt execOpt =>
    compOpt
    defaultCompOpt) ExecOption
    forall regex compOpt execOpt.
    RegexOptions regex compOpt execOpt =>
    execOpt
    defaultExecOpt
              pattern :: Either String (Pattern, (GroupIndex, DoPa))
    pattern = if SearchOption
    QuoteRegex SearchOption -> [SearchOption] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [SearchOption]
    opts
                              then (Pattern, (GroupIndex, DoPa))
    -> Either String (Pattern, (GroupIndex, DoPa))
    forall a b. b -> Either a b
    Right (String -> (Pattern, (GroupIndex, DoPa))
    forall t. Num t => String -> (Pattern, (t, DoPa))
    literalPattern String
    re)
                              else (ParseError -> String)
    -> Either ParseError (Pattern, (GroupIndex, DoPa))
    -> Either String (Pattern, (GroupIndex, DoPa))
    forall a b c. (a -> b) -> Either a c -> Either b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ParseError -> String
    forall a. Show a => a -> String
    show (String -> Either ParseError (Pattern, (GroupIndex, DoPa))
    parseRegex String
    re)

    instance Binary SearchExp where
      get :: Get SearchExp
    get = do re   <- Get String
    forall t. Binary t => Get t
    get
               opts <- get
               return $ case makeSearchOptsM opts re of
                          Left String
    err -> String -> SearchExp
    forall a. HasCallStack => String -> a
    error String
    err
                          Right SearchExp
    se -> SearchExp
    se
      put :: SearchExp -> Put
    put (SearchExp { seInput :: SearchExp -> String
    seInput   = String
    re,
                       seOptions :: SearchExp -> [SearchOption]
    seOptions = [SearchOption]
    opts, Regex
    seCompiled :: SearchExp -> Regex
    seBackCompiled :: SearchExp -> Regex
    seCompiled :: Regex
    seBackCompiled :: Regex
    .. }) = do String -> Put
    forall t. Binary t => t -> Put
    put String
    re
                                                    [SearchOption] -> Put
    forall t. Binary t => t -> Put
    put [SearchOption]
    opts

    -- | Return an escaped (for parseRegex use) version of the string.
    regexEscapeString :: String -> String
    regexEscapeString :: String -> String
    regexEscapeString String
    source = Pattern -> String
    showPattern (Pattern -> String) -> (String -> Pattern) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Pattern
    literalPattern' (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    source

    -- | Return a pattern that matches its argument.
    literalPattern :: (Num t) => String -> (Pattern, (t, DoPa))
    literalPattern :: forall t. Num t => String -> (Pattern, (t, DoPa))
    literalPattern String
    source = (String -> Pattern
    literalPattern' String
    source, (t
    0,GroupIndex -> DoPa
    DoPa GroupIndex
    0))

    literalPattern' :: String -> Pattern
    literalPattern' :: String -> Pattern
    literalPattern' = [Pattern] -> Pattern
    PConcat ([Pattern] -> Pattern)
    -> (String -> [Pattern]) -> String -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Pattern) -> String -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map (DoPa -> Char -> Pattern
    PChar (GroupIndex -> DoPa
    DoPa GroupIndex
    0))

    -- | Reverse a pattern. Note that the submatches will be reversed as well.
    reversePattern :: (Pattern, (t, DoPa)) -> (Pattern, (t, DoPa))
    reversePattern :: forall t. (Pattern, (t, DoPa)) -> (Pattern, (t, DoPa))
    reversePattern (Pattern
    pattern,(t, DoPa)
    rest) = (Pattern -> Pattern
    rev Pattern
    pattern, (t, DoPa)
    rest)
        where rev :: Pattern -> Pattern
    rev (PConcat [Pattern]
    l)      = [Pattern] -> Pattern
    PConcat ([Pattern] -> [Pattern]
    forall a. [a] -> [a]
    reverse ((Pattern -> Pattern) -> [Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map Pattern -> Pattern
    rev [Pattern]
    l))
              rev (PCarat  DoPa
    dp)     = DoPa -> Pattern
    PDollar DoPa
    dp
              rev (PDollar DoPa
    dp)     = DoPa -> Pattern
    PCarat  DoPa
    dp
              rev (PEscape DoPa
    dp Char
    '<') = DoPa -> Char -> Pattern
    PEscape DoPa
    dp Char
    '>'
              rev (PEscape DoPa
    dp Char
    '>') = DoPa -> Char -> Pattern
    PEscape DoPa
    dp Char
    '<'
              rev (PGroup Maybe GroupIndex
    a Pattern
    x)     = Maybe GroupIndex -> Pattern -> Pattern
    PGroup Maybe GroupIndex
    a (Pattern -> Pattern
    rev Pattern
    x)
              rev (POr [Pattern]
    l)          = [Pattern] -> Pattern
    POr ((Pattern -> Pattern) -> [Pattern] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map Pattern -> Pattern
    rev [Pattern]
    l)
              rev (PQuest Pattern
    x)       = Pattern -> Pattern
    PQuest (Pattern -> Pattern
    rev Pattern
    x)
              rev (PPlus Pattern
    x)        = Pattern -> Pattern
    PPlus (Pattern -> Pattern
    rev Pattern
    x)
              rev (PStar Bool
    b Pattern
    x)      = Bool -> Pattern -> Pattern
    PStar Bool
    b (Pattern -> Pattern
    rev Pattern
    x)
              rev (PBound GroupIndex
    i Maybe GroupIndex
    m Pattern
    x)   = GroupIndex -> Maybe GroupIndex -> Pattern -> Pattern
    PBound GroupIndex
    i Maybe GroupIndex
    m (Pattern -> Pattern
    rev Pattern
    x)
              rev (PNonCapture Pattern
    x)  = Pattern -> Pattern
    PNonCapture (Pattern -> Pattern
    rev Pattern
    x)
              rev (PNonEmpty Pattern
    x)    = Pattern -> Pattern
    PNonEmpty (Pattern -> Pattern
    rev Pattern
    x)
              rev Pattern
    x = Pattern
    x

    {-
    Chris K Commentary:

    I have one DIRE WARNING and one suggestion.

    The DIRE WARNING is against using the reversed Pattern to find captured subexpressions.
    It will work perfectly to find the longest match but give nonsense for captures.  In
    particular matching text "abc" with "(.)*" forward returns the 1st capture as "c".
    Searching "cba" with the reverse of "(.)*", which is identical, returns the 1st capture as "a".

    Enough changes to the matching engine could allow for the reversed search on the
    reversed text to return the same captures as the the forward search on the forward
    text.  Rather than that tricky complexity, if you need the substring captures you
    can use the reversed pattern to find a whole match and then run the forward pattern
    on that substring.

    The one suggestion is that the DoPa are irrelevant to the matching — they are there to
    allow a person to understand how the output of each stage of the regex-tdfa code relates
    to the input pattern.

    -}

    emptySearch :: SearchExp
    emptySearch :: SearchExp
    emptySearch = String -> Regex -> Regex -> [SearchOption] -> SearchExp
    SearchExp String
    "" Regex
    emptyRegex Regex
    emptyRegex []

    -- | The regular expression that matches nothing.
    emptyRegex :: Regex
    Just Regex
    emptyRegex = CompOption -> ExecOption -> String -> Maybe Regex
    forall regex compOpt execOpt source (m :: * -> *).
    (RegexMaker regex compOpt execOpt source, MonadFail m) =>
    compOpt -> execOpt -> source -> m regex
    forall (m :: * -> *).
    MonadFail m =>
    CompOption -> ExecOption -> String -> m Regex
    makeRegexOptsM CompOption
    forall regex compOpt execOpt.
    RegexOptions regex compOpt execOpt =>
    compOpt
    defaultCompOpt ExecOption
    forall regex compOpt execOpt.
    RegexOptions regex compOpt execOpt =>
    execOpt
    defaultExecOpt String
    "[[:empty:]]"