{-# 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


-- | warapper on 'compileSearchReplace_' that will generate an error
-- if any compilation errors are found
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

-- | compile a SearchReplace template generating errors if the RE or
-- the template are not well formed -- all capture references being checked
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

-- | compile 'SearcgReplace' from two strings containing the RE
-- and the replacement template
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.=~)