\begin{code}
module Text.RE.ZeInternals.Types.SearchReplace
  ( SearchReplace(..)
  ) where

\end{code}

\begin{code}
-- | contains a compiled RE and replacement template
data SearchReplace re s =
  SearchReplace
    { SearchReplace re s -> re
getSearch   :: !re    -- ^ the RE to match a string to replace
    , SearchReplace re s -> s
getTemplate :: !s     -- ^ the replacement template with ${cap}
                            -- used to identify a capture (by number or
                            -- name if one was given) and '$$' being
                            -- used to escape a single '$'
    }
  deriving (Int -> SearchReplace re s -> ShowS
[SearchReplace re s] -> ShowS
SearchReplace re s -> String
(Int -> SearchReplace re s -> ShowS)
-> (SearchReplace re s -> String)
-> ([SearchReplace re s] -> ShowS)
-> Show (SearchReplace re s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall re s.
(Show re, Show s) =>
Int -> SearchReplace re s -> ShowS
forall re s. (Show re, Show s) => [SearchReplace re s] -> ShowS
forall re s. (Show re, Show s) => SearchReplace re s -> String
showList :: [SearchReplace re s] -> ShowS
$cshowList :: forall re s. (Show re, Show s) => [SearchReplace re s] -> ShowS
show :: SearchReplace re s -> String
$cshow :: forall re s. (Show re, Show s) => SearchReplace re s -> String
showsPrec :: Int -> SearchReplace re s -> ShowS
$cshowsPrec :: forall re s.
(Show re, Show s) =>
Int -> SearchReplace re s -> ShowS
Show)
\end{code}

\begin{code}
instance Functor (SearchReplace re) where
  fmap :: (a -> b) -> SearchReplace re a -> SearchReplace re b
fmap a -> b
f (SearchReplace re
re a
x) = re -> b -> SearchReplace re b
forall re s. re -> s -> SearchReplace re s
SearchReplace re
re (a -> b
f a
x)
\end{code}