-- | Very simple wrapper around PCRE.  Just kind of exports what we needs.
module Text.Regex.PCRE.Simple
    ( CompileOptions
    , optionUtf8
    , optionMultiline

    , ExecOptions

    , I.Regex
    , compile
    , replaceAll
    ) where

import           Data.Bifunctor         (first, second)
import           Data.Bits              ((.|.))
import qualified Data.Text              as T
import qualified Data.Text.Lazy         as TL
import qualified Data.Text.Lazy.Builder as TLB
import           System.IO.Unsafe       (unsafePerformIO)
import qualified Text.Regex.PCRE.Text   as I

newtype CompileOptions = CompileOptions I.CompOption

instance Semigroup CompileOptions where
    CompileOptions CompOption
x <> :: CompileOptions -> CompileOptions -> CompileOptions
<> CompileOptions CompOption
y = CompOption -> CompileOptions
CompileOptions (CompOption
x CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|. CompOption
y)

instance Monoid CompileOptions where
    mempty :: CompileOptions
mempty = CompOption -> CompileOptions
CompileOptions CompOption
I.compBlank

optionUtf8 :: CompileOptions
optionUtf8 :: CompileOptions
optionUtf8 = CompOption -> CompileOptions
CompileOptions CompOption
I.compUTF8

optionMultiline :: CompileOptions
optionMultiline :: CompileOptions
optionMultiline = CompOption -> CompileOptions
CompileOptions CompOption
I.compMultiline

newtype ExecOptions = ExecOptions I.ExecOption

instance Semigroup ExecOptions where
    ExecOptions ExecOption
x <> :: ExecOptions -> ExecOptions -> ExecOptions
<> ExecOptions ExecOption
y = ExecOption -> ExecOptions
ExecOptions (ExecOption
x ExecOption -> ExecOption -> ExecOption
forall a. Bits a => a -> a -> a
.|. ExecOption
y)

instance Monoid ExecOptions where
    mempty :: ExecOptions
mempty = ExecOption -> ExecOptions
ExecOptions ExecOption
I.execBlank

compile :: CompileOptions -> ExecOptions -> T.Text -> Either String I.Regex
compile :: CompileOptions -> ExecOptions -> Text -> Either String Regex
compile (CompileOptions CompOption
compOption) (ExecOptions ExecOption
execOption) = ((MatchOffset, String) -> String)
-> Either (MatchOffset, String) Regex -> Either String Regex
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MatchOffset, String) -> String
forall a b. (a, b) -> b
snd (Either (MatchOffset, String) Regex -> Either String Regex)
-> (Text -> Either (MatchOffset, String) Regex)
-> Text
-> Either String Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    IO (Either (MatchOffset, String) Regex)
-> Either (MatchOffset, String) Regex
forall a. IO a -> a
unsafePerformIO (IO (Either (MatchOffset, String) Regex)
 -> Either (MatchOffset, String) Regex)
-> (Text -> IO (Either (MatchOffset, String) Regex))
-> Text
-> Either (MatchOffset, String) Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompOption
-> ExecOption -> Text -> IO (Either (MatchOffset, String) Regex)
I.compile CompOption
compOption ExecOption
execOption

replaceAll :: I.Regex -> T.Text -> T.Text -> Either String T.Text
replaceAll :: Regex -> Text -> Text -> Either String Text
replaceAll Regex
regex Text
replacement =
    (Builder -> Text) -> Either String Builder -> Either String Text
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText) (Either String Builder -> Either String Text)
-> (Text -> Either String Builder) -> Text -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either String Builder) -> Either String Builder
forall a. IO a -> a
unsafePerformIO (IO (Either String Builder) -> Either String Builder)
-> (Text -> IO (Either String Builder))
-> Text
-> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text -> IO (Either String Builder)
go Builder
forall a. Monoid a => a
mempty
  where
    go :: Builder -> Text -> IO (Either String Builder)
go Builder
acc Text
text = do
        Either WrapError (Maybe (Text, Text, Text, [Text]))
match <- Regex
-> Text -> IO (Either WrapError (Maybe (Text, Text, Text, [Text])))
I.regexec Regex
regex Text
text
        case Either WrapError (Maybe (Text, Text, Text, [Text]))
match of
            Left WrapError
err -> Either String Builder -> IO (Either String Builder)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> IO (Either String Builder))
-> (String -> Either String Builder)
-> String
-> IO (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Builder
forall a b. a -> Either a b
Left (String -> IO (Either String Builder))
-> String -> IO (Either String Builder)
forall a b. (a -> b) -> a -> b
$ WrapError -> String
forall a. Show a => a -> String
show WrapError
err
            Right Maybe (Text, Text, Text, [Text])
Nothing -> Either String Builder -> IO (Either String Builder)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> IO (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> IO (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall a b. b -> Either a b
Right (Builder -> IO (Either String Builder))
-> Builder -> IO (Either String Builder)
forall a b. (a -> b) -> a -> b
$ Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
text
            Right (Just (Text
pre, Text
_, Text
post, [Text]
_)) ->
                Builder -> Text -> IO (Either String Builder)
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
pre Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
replacement) Text
post