{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-binds #-}
{-# LANGUAGE NoImplicitPrelude, UndecidableInstances, FlexibleInstances, FlexibleContexts, BangPatterns #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes, UnicodeSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif

-- | A usable regular expressions library on top of pcre-light.
module Text.Regex.PCRE.Heavy (
  -- * Matching
  (=~)
, (≈)
, scan
, scanO
, scanRanges
, scanRangesO
  -- * Replacement
, RegexReplacement
, sub
, subO
, gsub
, gsubO
  -- * Splitting
, split
, splitO
  -- * QuasiQuoter
, re
, mkRegexQQ
  -- * Building regexes
, escape
  -- * Types and stuff from pcre-light
, Regex
, PCREOption
, PCRE.compileM
  -- * Advanced raw stuff
, rawMatch
, rawSub
) where

import           Prelude.Compat
import           Language.Haskell.TH hiding (match)
import           Language.Haskell.TH.Quote
import           Language.Haskell.TH.Syntax
import qualified Text.Regex.PCRE.Light as PCRE
import           Text.Regex.PCRE.Light.Base
import           Data.Maybe (isJust, fromMaybe)
import           Data.List (unfoldr, mapAccumL)
import qualified Data.List.NonEmpty as NE
import           Data.String.Conversions
import           Data.String.Conversions.Monomorphic
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Internal as BS
import           System.IO.Unsafe (unsafePerformIO)
import           Foreign (withForeignPtr, allocaBytes, nullPtr, plusPtr, peekElemOff)

-- $
-- >>> :set -XQuasiQuotes -XFlexibleContexts -XOverloadedStrings
-- >>> :m + Text.Regex.PCRE.Heavy
-- >>> import qualified Text.Regex.PCRE.Light as PCRE

substr ∷ SBS → (Int, Int) → SBS
substr :: SBS -> (Int, Int) -> SBS
substr SBS
s (Int
f, Int
t) = Int -> SBS -> SBS
BS.take (Int
t forall a. Num a => a -> a -> a
- Int
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SBS -> SBS
BS.drop Int
f forall a b. (a -> b) -> a -> b
$ SBS
s

behead ∷ NE.NonEmpty a → (a, [a])
behead :: forall a. NonEmpty a -> (a, [a])
behead NonEmpty a
l = (forall a. NonEmpty a -> a
NE.head NonEmpty a
l, forall a. NonEmpty a -> [a]
NE.tail NonEmpty a
l)

reMatch ∷ ConvertibleStrings a SBS ⇒ Regex → a → Bool
reMatch :: forall a. ConvertibleStrings a SBS => Regex -> a -> Bool
reMatch Regex
r a
s = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> SBS -> [PCREExecOption] -> Maybe [SBS]
PCRE.match Regex
r (forall a b. ConvertibleStrings a b => a -> b
cs a
s) []

-- | Checks whether a string matches a regex.
--
-- >>> "https://val.packett.cool" =~ [re|^http.*|]
-- True
(=~), (≈) ∷ ConvertibleStrings a SBS ⇒ a → Regex → Bool
=~ :: forall a. ConvertibleStrings a SBS => a -> Regex -> Bool
(=~) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ConvertibleStrings a SBS => Regex -> a -> Bool
reMatch

-- | Same as =~.
≈ :: forall a. ConvertibleStrings a SBS => a -> Regex -> Bool
(≈) = forall a. ConvertibleStrings a SBS => a -> Regex -> Bool
(=~)

-- | Does raw PCRE matching (you probably shouldn't use this directly).
--
-- >>> rawMatch [re|\w{2}|] "a a ab abc ba" 0 []
-- Just [(4,6)]
-- >>> rawMatch [re|\w{2}|] "a a ab abc ba" 6 []
-- Just [(7,9)]
-- >>> rawMatch [re|(\w)(\w)|] "a a ab abc ba" 0 []
-- Just [(4,6),(4,5),(5,6)]
rawMatch ∷ Regex → SBS → Int → [PCREExecOption] → Maybe [(Int, Int)]
rawMatch :: Regex -> SBS -> Int -> [PCREExecOption] -> Maybe [(Int, Int)]
rawMatch r :: Regex
r@(Regex ForeignPtr PCRE
pcreFp SBS
_) SBS
s Int
offset [PCREExecOption]
opts = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PCRE
pcreFp forall a b. (a -> b) -> a -> b
$ \Ptr PCRE
pcrePtr → do
    let nCapt :: Int
nCapt = Regex -> Int
PCRE.captureCount Regex
r
        ovecSize :: Int
ovecSize = (Int
nCapt forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Int
3
        ovecBytes :: Int
ovecBytes = Int
ovecSize forall a. Num a => a -> a -> a
* Int
size_of_cint
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ovecBytes forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ovec → do
      let (ForeignPtr Word8
strFp, Int
off, Int
len) = SBS -> (ForeignPtr Word8, Int, Int)
BS.toForeignPtr SBS
s
      forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
strFp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
strPtr → do
        CInt
results ← Ptr PCRE
-> Ptr PCRE
-> Ptr Word8
-> CInt
-> CInt
-> PCREExecOption
-> Ptr CInt
-> CInt
-> IO CInt
c_pcre_exec Ptr PCRE
pcrePtr forall a. Ptr a
nullPtr (Ptr Word8
strPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)
                               ([PCREExecOption] -> PCREExecOption
combineExecOptions [PCREExecOption]
opts) Ptr CInt
ovec (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ovecSize)
        if CInt
results forall a. Ord a => a -> a -> Bool
< CInt
0 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else
          let loop :: CInt -> Int -> [(a, b)] -> IO (Maybe [(a, b)])
loop CInt
n Int
o [(a, b)]
acc =
                if CInt
n forall a. Eq a => a -> a -> Bool
== CInt
results then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [(a, b)]
acc
                else do
                  CInt
i ← forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec forall a b. (a -> b) -> a -> b
$! Int
o
                  CInt
j ← forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CInt
ovec (Int
o forall a. Num a => a -> a -> a
+ Int
1)
                  CInt -> Int -> [(a, b)] -> IO (Maybe [(a, b)])
loop (CInt
n forall a. Num a => a -> a -> a
+ CInt
1) (Int
o forall a. Num a => a -> a -> a
+ Int
2) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
j) forall a. a -> [a] -> [a]
: [(a, b)]
acc)
          in forall {a} {b}.
(Num a, Num b) =>
CInt -> Int -> [(a, b)] -> IO (Maybe [(a, b)])
loop CInt
0 Int
0 []

nextMatch ∷ Regex → [PCREExecOption] → SBS → Int → Maybe (NE.NonEmpty (Int, Int), Int)
nextMatch :: Regex
-> [PCREExecOption]
-> SBS
-> Int
-> Maybe (NonEmpty (Int, Int), Int)
nextMatch Regex
r [PCREExecOption]
opts SBS
str Int
offset =
  Regex -> SBS -> Int -> [PCREExecOption] -> Maybe [(Int, Int)]
rawMatch Regex
r SBS
str Int
offset [PCREExecOption]
opts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \NonEmpty (Int, Int)
ms → forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Int, Int)
ms, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd NonEmpty (Int, Int)
ms)

-- | Searches the string for all matches of a given regex.
--
-- >>> scan [re|\s*entry (\d+) (\w+)\s*&?|] (" entry 1 hello  &entry 2 hi" :: String)
-- [(" entry 1 hello  &",["1","hello"]),("entry 2 hi",["2","hi"])]
--
-- It is lazy! If you only need the first match, just apply 'head' (or
-- 'headMay' from the "safe" library) -- no extra work will be performed!
--
-- >>> head $ scan [re|\s*entry (\d+) (\w+)\s*&?|] (" entry 1 hello  &entry 2 hi" :: String)
-- (" entry 1 hello  &",["1","hello"])
scan ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ Regex → a → [(a, [a])]
scan :: forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> a -> [(a, [a])]
scan Regex
r a
s = forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> [PCREExecOption] -> a -> [(a, [a])]
scanO Regex
r [] a
s

-- | Exactly like 'scan', but passes runtime options to PCRE.
scanO ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ Regex → [PCREExecOption] → a → [(a, [a])]
scanO :: forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> [PCREExecOption] -> a -> [(a, [a])]
scanO Regex
r [PCREExecOption]
opts a
s = forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> (a, [a])
behead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBS -> (Int, Int) -> SBS
substr SBS
str) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Regex
-> [PCREExecOption]
-> SBS
-> Int
-> Maybe (NonEmpty (Int, Int), Int)
nextMatch Regex
r [PCREExecOption]
opts SBS
str) Int
0
  where str :: SBS
str = forall a. ConvertibleStrings a SBS => a -> SBS
toSBS a
s

-- | Searches the string for all matches of a given regex, like 'scan', but
-- returns positions inside of the string.
--
-- >>> scanRanges [re|\s*entry (\d+) (\w+)\s*&?|] (" entry 1 hello  &entry 2 hi" :: String)
-- [((0,17),[(7,8),(9,14)]),((17,27),[(23,24),(25,27)])]
--
-- And just like 'scan', it's lazy.
scanRanges ∷ ConvertibleStrings a SBS ⇒ Regex → a → [((Int, Int), [(Int, Int)])]
scanRanges :: forall a.
ConvertibleStrings a SBS =>
Regex -> a -> [((Int, Int), [(Int, Int)])]
scanRanges Regex
r a
s = forall a.
ConvertibleStrings a SBS =>
Regex -> [PCREExecOption] -> a -> [((Int, Int), [(Int, Int)])]
scanRangesO Regex
r [] a
s

-- | Exactly like 'scanRanges', but passes runtime options to PCRE.
scanRangesO ∷ ConvertibleStrings a SBS ⇒ Regex → [PCREExecOption] → a → [((Int, Int), [(Int, Int)])]
scanRangesO :: forall a.
ConvertibleStrings a SBS =>
Regex -> [PCREExecOption] -> a -> [((Int, Int), [(Int, Int)])]
scanRangesO Regex
r [PCREExecOption]
opts a
s = forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> (a, [a])
behead forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Regex
-> [PCREExecOption]
-> SBS
-> Int
-> Maybe (NonEmpty (Int, Int), Int)
nextMatch Regex
r [PCREExecOption]
opts SBS
str) Int
0
  where str :: SBS
str = forall a. ConvertibleStrings a SBS => a -> SBS
toSBS a
s

-- | Class of types that can serve as the replacement argument in the
-- 'sub' family of functions.
class RegexReplacement a where
  performReplacement ∷ SBS → [SBS] → a → SBS

-- | A replacement string.
instance {-# OVERLAPPABLE #-} ConvertibleStrings a SBS ⇒ RegexReplacement a where
  performReplacement :: SBS -> [SBS] -> a -> SBS
performReplacement SBS
_ [SBS]
_ a
to = forall a b. ConvertibleStrings a b => a -> b
cs a
to

-- | A function mapping the matched string and groups to a replacement string.
instance (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ RegexReplacement (a → [a] → a) where
  performReplacement :: SBS -> [SBS] -> (a -> [a] -> a) -> SBS
performReplacement SBS
from [SBS]
groups a -> [a] -> a
replacer = forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ a -> [a] -> a
replacer (forall a b. ConvertibleStrings a b => a -> b
cs SBS
from) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. ConvertibleStrings a b => a -> b
cs [SBS]
groups)

-- | A function mapping the matched string to a replacement string.
instance (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ RegexReplacement (a → a) where
  performReplacement :: SBS -> [SBS] -> (a -> a) -> SBS
performReplacement SBS
from [SBS]
_ a -> a
replacer = forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ a -> a
replacer (forall a b. ConvertibleStrings a b => a -> b
cs SBS
from)

-- | A function mapping the matched groups to a replacement string.
instance (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ RegexReplacement ([a] → a) where
  performReplacement :: SBS -> [SBS] -> ([a] -> a) -> SBS
performReplacement SBS
_ [SBS]
groups [a] -> a
replacer = forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ [a] -> a
replacer (forall a b. (a -> b) -> [a] -> [b]
map forall a b. ConvertibleStrings a b => a -> b
cs [SBS]
groups)

rawSub ∷ RegexReplacement r ⇒ Regex → r → SBS → Int → [PCREExecOption] → Maybe (SBS, Int)
rawSub :: forall r.
RegexReplacement r =>
Regex -> r -> SBS -> Int -> [PCREExecOption] -> Maybe (SBS, Int)
rawSub Regex
r r
t SBS
s Int
offset [PCREExecOption]
opts =
  case Regex -> SBS -> Int -> [PCREExecOption] -> Maybe [(Int, Int)]
rawMatch Regex
r SBS
s Int
offset [PCREExecOption]
opts of
    Just ((Int
begin, Int
end):[(Int, Int)]
groups) →
      let replacement :: SBS
replacement = forall a. RegexReplacement a => SBS -> [SBS] -> a -> SBS
performReplacement (SBS -> (Int, Int) -> SBS
substr SBS
s (Int
begin, Int
end)) (forall a b. (a -> b) -> [a] -> [b]
map (SBS -> (Int, Int) -> SBS
substr SBS
s) [(Int, Int)]
groups) r
t in
      forall a. a -> Maybe a
Just ([SBS] -> SBS
BS.concat [ SBS -> (Int, Int) -> SBS
substr SBS
s (Int
0, Int
begin)
                      , SBS
replacement
                      , SBS -> (Int, Int) -> SBS
substr SBS
s (Int
end, SBS -> Int
BS.length SBS
s)], Int
begin forall a. Num a => a -> a -> a
+ SBS -> Int
BS.length SBS
replacement)
    Maybe [(Int, Int)]
_ → forall a. Maybe a
Nothing

-- | Replaces the first occurence of a given regex.
--
-- >>> sub [re|thing|] "world" "Hello, thing thing" :: String
-- "Hello, world thing"
--
-- >>> sub [re|a|] "b" "c" :: String
-- "c"
--
-- >>> sub [re|bad|] "xxxbad" "this is bad, right?" :: String
-- "this is xxxbad, right?"
--
-- You can use functions!
-- A function of ConvertibleStrings SBS gets the full match.
-- A function of [ConvertibleStrings SBS] gets the groups.
-- A function of ConvertibleStrings SBS → [ConvertibleStrings SBS] gets both.
--
-- >>> sub [re|%(\d+)(\w+)|] (\(d:w:_) -> "{" ++ d ++ " of " ++ w ++ "}" :: String) "Hello, %20thing" :: String
-- "Hello, {20 of thing}"
sub ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS, RegexReplacement r) ⇒ Regex → r → a → a
sub :: forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> r -> a -> a
sub Regex
r r
t a
s = forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> [PCREExecOption] -> r -> a -> a
subO Regex
r [] r
t a
s

-- | Exactly like 'sub', but passes runtime options to PCRE.
subO ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS, RegexReplacement r) ⇒ Regex → [PCREExecOption] → r → a → a
subO :: forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> [PCREExecOption] -> r -> a -> a
subO Regex
r [PCREExecOption]
opts r
t a
s = forall a. a -> Maybe a -> a
fromMaybe a
s forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r.
RegexReplacement r =>
Regex -> r -> SBS -> Int -> [PCREExecOption] -> Maybe (SBS, Int)
rawSub Regex
r r
t (forall a b. ConvertibleStrings a b => a -> b
cs a
s) Int
0 [PCREExecOption]
opts

-- | Replaces all occurences of a given regex.
--
-- See 'sub' for more documentation.
--
-- >>> gsub [re|thing|] "world" "Hello, thing thing" :: String
-- "Hello, world world"
--
-- >>> gsub [re||] "" "Hello, world" :: String
-- "Hello, world"
--
-- https://codeberg.org/valpackett/pcre-heavy/issues/2
-- >>> gsub [re|good|] "bad" "goodgoodgood" :: String
-- "badbadbad"
--
-- >>> gsub [re|bad|] "xxxbad" "this is bad, right? bad" :: String
-- "this is xxxbad, right? xxxbad"
--
-- >>> gsub [re|a|] "" "aaa" :: String
-- ""
gsub ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS, RegexReplacement r) ⇒ Regex → r → a → a
gsub :: forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> r -> a -> a
gsub Regex
r r
t a
s = forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> [PCREExecOption] -> r -> a -> a
gsubO Regex
r [] r
t a
s

-- | Exactly like 'gsub', but passes runtime options to PCRE.
gsubO ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS, RegexReplacement r) ⇒ Regex → [PCREExecOption] → r → a → a
gsubO :: forall a r.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS,
 RegexReplacement r) =>
Regex -> [PCREExecOption] -> r -> a -> a
gsubO Regex
r [PCREExecOption]
opts r
t a
s = forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ Int -> SBS -> SBS
loop Int
0 SBS
str
  where str :: SBS
str = forall a. ConvertibleStrings a SBS => a -> SBS
toSBS a
s
        loop :: Int -> SBS -> SBS
loop Int
offset SBS
acc
          | Int
offset forall a. Ord a => a -> a -> Bool
>= Int
l = SBS
acc
          | Bool
otherwise = case forall r.
RegexReplacement r =>
Regex -> r -> SBS -> Int -> [PCREExecOption] -> Maybe (SBS, Int)
rawSub Regex
r r
t SBS
acc Int
offset [PCREExecOption]
opts of
            Just (SBS
result, Int
newOffset) →
              if Int
newOffset forall a. Eq a => a -> a -> Bool
== Int
offset Bool -> Bool -> Bool
&& Int
l forall a. Eq a => a -> a -> Bool
== SBS -> Int
BS.length SBS
result
              then SBS
acc
              else Int -> SBS -> SBS
loop Int
newOffset SBS
result
            Maybe (SBS, Int)
_ → SBS
acc
          where l :: Int
l = SBS -> Int
BS.length SBS
acc

-- | Splits the string using the given regex.
--
-- Is lazy.
--
-- >>> split [re|%(begin|next|end)%|] ("%begin%hello%next%world%end%" :: String)
-- ["","hello","world",""]
--
-- >>> split [re|%(begin|next|end)%|] ("" :: String)
-- [""]
split ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ Regex → a → [a]
split :: forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> a -> [a]
split Regex
r a
s = forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> [PCREExecOption] -> a -> [a]
splitO Regex
r [] a
s

-- | Exactly like 'split', but passes runtime options to PCRE.
splitO ∷ (ConvertibleStrings SBS a, ConvertibleStrings a SBS) ⇒ Regex → [PCREExecOption] → a → [a]
splitO :: forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> [PCREExecOption] -> a -> [a]
splitO Regex
r [PCREExecOption]
opts a
s = forall a b. (a -> b) -> [a] -> [b]
map forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {b}.
Foldable t =>
((Int, Int) -> b) -> t (Int, Int) -> [b]
map' (SBS -> (Int, Int) -> SBS
substr SBS
str) [(Int, Int)]
partRanges
  where map' :: ((Int, Int) -> b) -> t (Int, Int) -> [b]
map' (Int, Int) -> b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> b
f) [(Int, Int) -> b
f (Int
lastL, SBS -> Int
BS.length SBS
str)] -- avoiding the snoc operation
        (Int
lastL, [(Int, Int)]
partRanges) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a} {b} {a}. a -> (b, a) -> (a, (a, b))
invRange Int
0 [(Int, Int)]
ranges
        invRange :: a -> (b, a) -> (a, (a, b))
invRange a
acc (b
xl, a
xr) = (a
xr, (a
acc, b
xl))
        ranges :: [(Int, Int)]
ranges = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
ConvertibleStrings a SBS =>
Regex -> [PCREExecOption] -> a -> [((Int, Int), [(Int, Int)])]
scanRangesO Regex
r [PCREExecOption]
opts SBS
str
        str :: SBS
str = forall a. ConvertibleStrings a SBS => a -> SBS
toSBS a
s

instance Lift PCREOption where
  -- well, the constructor isn't exported, but at least it implements Read/Show :D
  liftTyped :: forall (m :: * -> *). Quote m => PCREOption -> Code m PCREOption
liftTyped PCREOption
o = let o' :: String
o' = forall a. Show a => a -> String
show PCREOption
o in [|| read o' ∷ PCREOption ||]

quoteExpRegex ∷ [PCREOption] → String → ExpQ
quoteExpRegex :: [PCREOption] -> String -> ExpQ
quoteExpRegex [PCREOption]
opts String
txt = [| PCRE.compile (cs (txt ∷ String)) opts |]
  where !Regex
_ = SBS -> [PCREOption] -> Regex
PCRE.compile (forall a b. ConvertibleStrings a b => a -> b
cs String
txt) [PCREOption]
opts -- check at compile time

-- | Returns a QuasiQuoter like 're', but with given PCRE options.
mkRegexQQ ∷ [PCREOption] → QuasiQuoter
mkRegexQQ :: [PCREOption] -> QuasiQuoter
mkRegexQQ [PCREOption]
opts = QuasiQuoter
  { quoteExp :: String -> ExpQ
quoteExp  = [PCREOption] -> String -> ExpQ
quoteExpRegex [PCREOption]
opts
  , quotePat :: String -> Q Pat
quotePat  = forall a. HasCallStack => a
undefined
  , quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => a
undefined
  , quoteDec :: String -> Q [Dec]
quoteDec  = forall a. HasCallStack => a
undefined }

-- | A QuasiQuoter for regular expressions that does a compile time check.
re ∷ QuasiQuoter
re :: QuasiQuoter
re = [PCREOption] -> QuasiQuoter
mkRegexQQ [PCREOption
utf8]

-- Metacharacters used in PCRE syntax.  Taken from pcrepattern(3) man
-- page.
pcreMetachars ∷ SBS
pcreMetachars :: SBS
pcreMetachars = SBS
"\\^$.[|()?*+{"

-- Start and end quote markers in PCRE syntax.
startQuoteMarker, endQuoteMarker ∷ SBS
startQuoteMarker :: SBS
startQuoteMarker = SBS
"\\Q"
endQuoteMarker :: SBS
endQuoteMarker = SBS
"\\E"

-- | Escapes the regex metacharacters in a string.  In other words,
-- given a string, produces a regex that matches just that string (or
-- case variations of that string, if case-insenstive matching is
-- enabled).
--
-- >>> ("foo*bar"::String) =~ PCRE.compile (escape "foo*bar") []
-- True
escape ∷ (ConvertibleStrings a SBS, ConvertibleStrings SBS a) ⇒ a → a
escape :: forall a.
(ConvertibleStrings a SBS, ConvertibleStrings SBS a) =>
a -> a
escape = forall a b. ConvertibleStrings a b => a -> b
convertString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBS -> SBS
escapeSBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
convertString
  where escapeSBS :: SBS -> SBS
escapeSBS SBS
s
            -- Handle the special case where \Q...\E doesn't work.
            | SBS
endQuoteMarker SBS -> SBS -> Bool
`BS.isInfixOf` SBS
s = (Char -> SBS) -> SBS -> SBS
BS.concatMap Char -> SBS
step SBS
s
            -- Handle the typical case.
            | Bool
otherwise = [SBS] -> SBS
BS.concat [SBS
startQuoteMarker, SBS
s, SBS
endQuoteMarker]
        step :: Char -> SBS
step Char
c
            | Char
c Char -> SBS -> Bool
`BS.elem` SBS
pcreMetachars = String -> SBS
BS.pack [Char
'\\', Char
c]
            | Bool
otherwise = Char -> SBS
BS.singleton Char
c