{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Text.RE.ZeInternals.SearchReplace
( unsafeCompileSearchReplace_
, compileSearchReplace_
, compileSearchAndReplace_
) where
import Control.Monad.Fail
import qualified Data.HashMap.Strict as HMS
import Prelude.Compat hiding (fail)
import Text.RE.ZeInternals.NamedCaptures
import Text.RE.ZeInternals.Replace
import Text.RE.ZeInternals.Types.Capture
import Text.RE.ZeInternals.Types.CaptureID
import Text.RE.ZeInternals.Types.Matches
import Text.RE.ZeInternals.Types.Poss
import Text.RE.ZeInternals.Types.SearchReplace
import qualified Text.Regex.TDFA as TDFA
unsafeCompileSearchReplace_ :: (String->s)
-> (String->Either String re)
-> String
-> SearchReplace re s
unsafeCompileSearchReplace_ :: (String -> s)
-> (String -> Either String re) -> String -> SearchReplace re s
unsafeCompileSearchReplace_ String -> s
pk String -> Either String re
cf = (String -> SearchReplace re s)
-> (SearchReplace re s -> SearchReplace re s)
-> Poss (SearchReplace re s)
-> SearchReplace re s
forall b a. (String -> b) -> (a -> b) -> Poss a -> b
poss String -> SearchReplace re s
forall a. String -> a
err SearchReplace re s -> SearchReplace re s
forall a. a -> a
id (Poss (SearchReplace re s) -> SearchReplace re s)
-> (String -> Poss (SearchReplace re s))
-> String
-> SearchReplace re s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> s)
-> (String -> Either String re)
-> String
-> Poss (SearchReplace re s)
forall (m :: * -> *) s re.
(Monad m, MonadFail m, Functor m) =>
(String -> s)
-> (String -> Either String re) -> String -> m (SearchReplace re s)
compileSearchReplace_ String -> s
pk String -> Either String re
cf
where
err :: String -> a
err String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"unsafeCompileSearchReplace_: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
compileSearchReplace_ :: (Monad m,MonadFail m,Functor m)
=> (String->s)
-> (String->Either String re)
-> String
-> m (SearchReplace re s)
compileSearchReplace_ :: (String -> s)
-> (String -> Either String re) -> String -> m (SearchReplace re s)
compileSearchReplace_ String -> s
pack String -> Either String re
compile_re String
sr_tpl = (String -> m (SearchReplace re s))
-> (SearchReplace re s -> m (SearchReplace re s))
-> Poss (SearchReplace re s)
-> m (SearchReplace re s)
forall b a. (String -> b) -> (a -> b) -> Poss a -> b
poss String -> m (SearchReplace re s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SearchReplace re s -> m (SearchReplace re s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Poss (SearchReplace re s) -> m (SearchReplace re s))
-> Poss (SearchReplace re s) -> m (SearchReplace re s)
forall a b. (a -> b) -> a -> b
$ do
case Matches String -> [Capture String]
forall a. Matches a -> [Capture a]
mainCaptures (Matches String -> [Capture String])
-> Matches String -> [Capture String]
forall a b. (a -> b) -> a -> b
$ String
sr_tpl String -> String -> Matches String
$=~ String
"///" of
[Capture String
cap] ->
(String -> s)
-> (String -> Either String re)
-> String
-> String
-> Poss (SearchReplace re s)
forall (m :: * -> *) s re.
(Monad m, MonadFail m, Functor m) =>
(String -> s)
-> (String -> Either String re)
-> String
-> String
-> m (SearchReplace re s)
compileSearchAndReplace_ String -> s
pack String -> Either String re
compile_re
(Capture String -> String
forall a. Extract a => Capture a -> a
capturePrefix Capture String
cap) (Capture String -> String
forall a. Extract a => Capture a -> a
captureSuffix Capture String
cap)
[Capture String]
_ -> String -> Poss (SearchReplace re s)
forall a. String -> Poss a
Eek (String -> Poss (SearchReplace re s))
-> String -> Poss (SearchReplace re s)
forall a b. (a -> b) -> a -> b
$ String
"bad search-replace template syntax: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sr_tpl
compileSearchAndReplace_ :: (Monad m,MonadFail m,Functor m)
=> (String->s)
-> (String->Either String re)
-> String
-> String
-> m (SearchReplace re s)
compileSearchAndReplace_ :: (String -> s)
-> (String -> Either String re)
-> String
-> String
-> m (SearchReplace re s)
compileSearchAndReplace_ String -> s
pack String -> Either String re
compile_re String
re_s String
tpl = (String -> m (SearchReplace re s))
-> (SearchReplace re s -> m (SearchReplace re s))
-> Either String (SearchReplace re s)
-> m (SearchReplace re s)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m (SearchReplace re s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SearchReplace re s -> m (SearchReplace re s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (SearchReplace re s) -> m (SearchReplace re s))
-> Either String (SearchReplace re s) -> m (SearchReplace re s)
forall a b. (a -> b) -> a -> b
$ do
re
re <- String -> Either String re
compile_re String
re_s
((Int
n,CaptureNames
cnms),String
_) <- String -> Either String ((Int, CaptureNames), String)
extractNamedCaptures String
re_s
(CaptureID -> Either String ()) -> [CaptureID] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> CaptureNames -> CaptureID -> Either String ()
check Int
n CaptureNames
cnms) ([CaptureID] -> Either String ())
-> [CaptureID] -> Either String ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> String -> [CaptureID]
forall a.
(Replace a, RegexContext Regex a (Matches a),
RegexMaker Regex CompOption ExecOption String) =>
(a -> String) -> a -> [CaptureID]
templateCaptures String -> String
forall a. a -> a
id String
tpl
SearchReplace re s -> Either String (SearchReplace re s)
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchReplace re s -> Either String (SearchReplace re s))
-> SearchReplace re s -> Either String (SearchReplace re s)
forall a b. (a -> b) -> a -> b
$ re -> s -> SearchReplace re s
forall re s. re -> s -> SearchReplace re s
SearchReplace re
re (s -> SearchReplace re s) -> s -> SearchReplace re s
forall a b. (a -> b) -> a -> b
$ String -> s
pack String
tpl
where
check :: Int -> CaptureNames -> CaptureID -> Either String ()
check :: Int -> CaptureNames -> CaptureID -> Either String ()
check Int
n CaptureNames
cnms CaptureID
cid = case CaptureID
cid of
IsCaptureOrdinal CaptureOrdinal
co -> Int -> CaptureOrdinal -> Either String ()
check_co Int
n CaptureOrdinal
co
IsCaptureName CaptureName
cn -> CaptureNames -> CaptureName -> Either String ()
forall a. HashMap CaptureName a -> CaptureName -> Either String ()
check_cn CaptureNames
cnms CaptureName
cn
check_co :: Int -> CaptureOrdinal -> Either String ()
check_co Int
n (CaptureOrdinal Int
i) = case Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n of
Bool
True -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"capture ordinal out of range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
check_cn :: HashMap CaptureName a -> CaptureName -> Either String ()
check_cn HashMap CaptureName a
cnms CaptureName
cnm = case CaptureName
cnm CaptureName -> HashMap CaptureName a -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HMS.member` HashMap CaptureName a
cnms of
Bool
True -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"capture name not defined: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Text -> String
forall a. Show a => a -> String
show (CaptureName -> Text
getCaptureName CaptureName
cnm)
($=~) :: String -> String -> Matches String
$=~ :: String -> String -> Matches String
($=~) = String -> String -> Matches String
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
(TDFA.=~)