{-# LANGUAGE TemplateHaskell, BangPatterns, OverloadedStrings #-}
module NgxExport.Tools.PCRE (
matchRegex
,SubPasteF
,subRegex
,subRegexWith
,gsubRegex
,gsubRegexWith
) where
import NgxExport
import NgxExport.Tools.Combinators
import NgxExport.Tools.SimpleService
import qualified Data.HashMap.Strict as HM
import Data.HashMap.Strict (HashMap)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.IORef
import Text.Regex.PCRE.Light
import Text.Regex.PCRE.Heavy
import Control.Exception (Exception, throwIO)
import Control.Arrow
import System.IO.Unsafe
type InputRegexes = [(ByteString, ByteString, ByteString)]
type Regexes = HashMap ByteString Regex
newtype MatchRegexError = MatchRegexError String
instance Exception MatchRegexError
instance Show MatchRegexError where
show :: MatchRegexError -> [Char]
show (MatchRegexError [Char]
s) = [Char]
"PCRE ERROR: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
regexes :: IORef Regexes
regexes :: IORef Regexes
regexes = IO (IORef Regexes) -> IORef Regexes
forall a. IO a -> a
unsafePerformIO (IO (IORef Regexes) -> IORef Regexes)
-> IO (IORef Regexes) -> IORef Regexes
forall a b. (a -> b) -> a -> b
$ Regexes -> IO (IORef Regexes)
forall a. a -> IO (IORef a)
newIORef Regexes
forall k v. HashMap k v
HM.empty
{-# NOINLINE regexes #-}
declareRegexes :: InputRegexes -> NgxExportService
declareRegexes :: InputRegexes -> NgxExportService
declareRegexes = InputRegexes -> NgxExportService
forall a. a -> NgxExportService
voidService
ngxExportSimpleServiceTyped 'declareRegexes ''InputRegexes SingleShotService
compileRegexes :: ByteString -> IO L.ByteString
compileRegexes :: ByteString -> IO ByteString
compileRegexes = IO () -> ByteString -> IO ByteString
forall a b. IO a -> b -> IO ByteString
voidHandler' (IO () -> ByteString -> IO ByteString)
-> IO () -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
!InputRegexes
inputRegexes <- Maybe InputRegexes -> InputRegexes
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InputRegexes -> InputRegexes)
-> IO (Maybe InputRegexes) -> IO InputRegexes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Maybe InputRegexes) -> IO (Maybe InputRegexes)
forall a. IORef a -> IO a
readIORef IORef (Maybe InputRegexes)
storage_InputRegexes_declareRegexes
let !compiledRegexes :: Regexes
compiledRegexes =
(Regexes -> (ByteString, ByteString, ByteString) -> Regexes)
-> Regexes -> InputRegexes -> Regexes
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Regexes
a (!ByteString
k, !ByteString
v, !ByteString
m) -> let !r :: Regex
r = ByteString -> [PCREOption] -> Regex
compile ByteString
v ([PCREOption] -> Regex) -> [PCREOption] -> Regex
forall a b. (a -> b) -> a -> b
$ [Char] -> [PCREOption]
mods ([Char] -> [PCREOption]) -> [Char] -> [PCREOption]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
C8.unpack ByteString
m
!hm :: Regexes
hm = ByteString -> Regex -> Regexes -> Regexes
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ByteString
k Regex
r Regexes
a
in Regexes
hm
) Regexes
forall k v. HashMap k v
HM.empty InputRegexes
inputRegexes
IORef Regexes -> Regexes -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Regexes
regexes Regexes
compiledRegexes
where md :: Char -> Maybe PCREOption
md Char
'i' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
caseless
md Char
's' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
dotall
md Char
'm' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
multiline
md Char
_ = Maybe PCREOption
forall a. Maybe a
Nothing
mods :: [Char] -> [PCREOption]
mods = (NonEmpty PCREOption -> PCREOption)
-> [NonEmpty PCREOption] -> [PCREOption]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty PCREOption -> PCREOption
forall a. NonEmpty a -> a
NE.head ([NonEmpty PCREOption] -> [PCREOption])
-> ([Char] -> [NonEmpty PCREOption]) -> [Char] -> [PCREOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PCREOption] -> [NonEmpty PCREOption]
forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group ([PCREOption] -> [NonEmpty PCREOption])
-> ([Char] -> [PCREOption]) -> [Char] -> [NonEmpty PCREOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PCREOption] -> [PCREOption]
forall a. Ord a => [a] -> [a]
sort ([PCREOption] -> [PCREOption])
-> ([Char] -> [PCREOption]) -> [Char] -> [PCREOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe PCREOption) -> [Char] -> [PCREOption]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe PCREOption
md
ngxExportServiceHook 'compileRegexes
type InputSubs = [(ByteString, ByteString)]
type Subs = HashMap ByteString ByteString
substitutions :: IORef Subs
substitutions :: IORef Subs
substitutions = IO (IORef Subs) -> IORef Subs
forall a. IO a -> a
unsafePerformIO (IO (IORef Subs) -> IORef Subs) -> IO (IORef Subs) -> IORef Subs
forall a b. (a -> b) -> a -> b
$ Subs -> IO (IORef Subs)
forall a. a -> IO (IORef a)
newIORef Subs
forall k v. HashMap k v
HM.empty
{-# NOINLINE substitutions #-}
mapSubs :: InputSubs -> NgxExportService
mapSubs :: InputSubs -> NgxExportService
mapSubs = (InputSubs -> IO ByteString) -> InputSubs -> NgxExportService
forall a. (a -> IO ByteString) -> a -> NgxExportService
ignitionService ((InputSubs -> IO ByteString) -> InputSubs -> NgxExportService)
-> (InputSubs -> IO ByteString) -> InputSubs -> NgxExportService
forall a b. (a -> b) -> a -> b
$ IO () -> IO ByteString
forall a. IO a -> IO ByteString
voidHandler (IO () -> IO ByteString)
-> (InputSubs -> IO ()) -> InputSubs -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
IORef Subs -> Subs -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Subs
substitutions (Subs -> IO ()) -> (InputSubs -> Subs) -> InputSubs -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subs -> (ByteString, ByteString) -> Subs)
-> Subs -> InputSubs -> Subs
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Subs
a (ByteString
k, ByteString
v) -> ByteString -> ByteString -> Subs -> Subs
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ByteString
k ByteString
v Subs
a) Subs
forall k v. HashMap k v
HM.empty
ngxExportSimpleServiceTyped 'mapSubs ''InputSubs SingleShotService
type RegexF = Regex -> ByteString -> IO ByteString
rtRegex :: RegexF -> ByteString -> IO L.ByteString
rtRegex :: RegexF -> ByteString -> IO ByteString
rtRegex RegexF
f = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
L.fromStrict (IO ByteString -> IO ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> IO ByteString)
-> (ByteString, ByteString) -> IO ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> IO ByteString
doRtRegex ((ByteString, ByteString) -> IO ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second HasCallStack => ByteString -> ByteString
ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|')
where doRtRegex :: ByteString -> ByteString -> IO ByteString
doRtRegex ByteString
k ByteString
v = do
Regexes
rgxs <- IORef Regexes -> IO Regexes
forall a. IORef a -> IO a
readIORef IORef Regexes
regexes
case ByteString -> Regexes -> Maybe Regex
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k Regexes
rgxs of
Maybe Regex
Nothing -> MatchRegexError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (MatchRegexError -> IO ByteString)
-> MatchRegexError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchRegexError
MatchRegexError ([Char] -> MatchRegexError) -> [Char] -> MatchRegexError
forall a b. (a -> b) -> a -> b
$
[Char]
"Regex " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
C8.unpack ByteString
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" was not found"
Just Regex
r -> RegexF
f Regex
r ByteString
v
doMatchRegex :: RegexF
doMatchRegex :: RegexF
doMatchRegex Regex
r ByteString
v = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
case Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
r ByteString
v [] of
Just (ByteString
_ : ByteString
c1 : [ByteString]
_) -> ByteString
c1
Just (ByteString
c0 : [ByteString]
_) -> ByteString
c0
Maybe [ByteString]
_ -> ByteString
""
matchRegex
:: ByteString
-> IO L.ByteString
matchRegex :: ByteString -> IO ByteString
matchRegex = RegexF -> ByteString -> IO ByteString
rtRegex RegexF
doMatchRegex
ngxExportIOYY 'matchRegex
type SubPasteF =
ByteString
-> [ByteString]
-> ByteString
type SubF = Regex -> SubPasteF -> ByteString -> ByteString
doSubRegex :: SubF -> Maybe SubPasteF -> RegexF
doSubRegex :: SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
f Maybe SubPasteF
p Regex
r ByteString
v =
case Maybe SubPasteF
p of
Maybe SubPasteF
Nothing -> do
let (ByteString
k, ByteString
v') = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second HasCallStack => ByteString -> ByteString
ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') ByteString
v
Subs
subs <- IORef Subs -> IO Subs
forall a. IORef a -> IO a
readIORef IORef Subs
substitutions
case ByteString -> Subs -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k Subs
subs of
Maybe ByteString
Nothing -> MatchRegexError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (MatchRegexError -> IO ByteString)
-> MatchRegexError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> MatchRegexError
MatchRegexError ([Char] -> MatchRegexError) -> [Char] -> MatchRegexError
forall a b. (a -> b) -> a -> b
$
[Char]
"Substitution " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
C8.unpack ByteString
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" was not found"
Just ByteString
s -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF
f Regex
r (SubPasteF
forall a b. a -> b -> a
const SubPasteF -> (ByteString -> ByteString) -> SubPasteF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
s) ByteString
v'
Just SubPasteF
paste -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF
f Regex
r SubPasteF
paste ByteString
v
subRegex
:: ByteString
-> IO L.ByteString
subRegex :: ByteString -> IO ByteString
subRegex = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> RegexF -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
RegexReplacement r) =>
Regex -> r -> a -> a
sub Maybe SubPasteF
forall a. Maybe a
Nothing
ngxExportIOYY 'subRegex
subRegexWith
:: SubPasteF
-> ByteString
-> IO L.ByteString
subRegexWith :: SubPasteF -> ByteString -> IO ByteString
subRegexWith = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> (SubPasteF -> RegexF)
-> SubPasteF
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
RegexReplacement r) =>
Regex -> r -> a -> a
sub (Maybe SubPasteF -> RegexF)
-> (SubPasteF -> Maybe SubPasteF) -> SubPasteF -> RegexF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPasteF -> Maybe SubPasteF
forall a. a -> Maybe a
Just
gsubRegex
:: ByteString
-> IO L.ByteString
gsubRegex :: ByteString -> IO ByteString
gsubRegex = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> RegexF -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
RegexReplacement r) =>
Regex -> r -> a -> a
gsub Maybe SubPasteF
forall a. Maybe a
Nothing
ngxExportIOYY 'gsubRegex
gsubRegexWith
:: SubPasteF
-> ByteString
-> IO L.ByteString
gsubRegexWith :: SubPasteF -> ByteString -> IO ByteString
gsubRegexWith = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> (SubPasteF -> RegexF)
-> SubPasteF
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
RegexReplacement r) =>
Regex -> r -> a -> a
gsub (Maybe SubPasteF -> RegexF)
-> (SubPasteF -> Maybe SubPasteF) -> SubPasteF -> RegexF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPasteF -> Maybe SubPasteF
forall a. a -> Maybe a
Just