-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Regex.Impl
-- Copyright   :  (c) Chris Kuklewicz 2006
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Maintainer  :  hvr@gnu.org
-- Stability   :  experimental
-- Portability :  non-portable (Text.Regex.Base needs MPTC+FD)
--
-- Helper functions for defining certain instances of
-- 'RegexContext'. These help when defining instances of 'RegexContext'
-- with repeated types:
--
-- @
-- instance (RegexLike regex source) => RegexContext regex source source where
-- @
--
-- runs into overlapping restrictions. To avoid this I have each backend
-- define, for its own @Regex@ type:
--
-- @
-- instance RegexContext Regex String String where
--   match = polymatch
--   matchM = polymatchM
-- @
--
-- @
-- instance RegexContext Regex ByteString ByteString where
--   match = polymatch
--   matchM = polymatchM
-- @
--
-- @
-- instance RegexContext Regex Text Text where
--   match = polymatch
--   matchM = polymatchM
-- @
-------------------------------------------------------------------------------

module Text.Regex.Base.Impl(polymatch,polymatchM) where

import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))

import Text.Regex.Base
import Data.Array((!))

regexFailed :: (MonadFail m) => m b
{-# INLINE regexFailed #-}
regexFailed :: m b
regexFailed =  String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ String
"regex failed to match"

actOn :: (RegexLike r s,MonadFail m) => ((s,MatchText s,s)->t) -> r -> s -> m t
{-# INLINE actOn #-}
actOn :: ((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (s, MatchText s, s) -> t
f r
r s
s = case r -> s -> Maybe (s, MatchText s, s)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText r
r s
s of
    Maybe (s, MatchText s, s)
Nothing -> m t
forall (m :: * -> *) b. MonadFail m => m b
regexFailed
    Just (s, MatchText s, s)
preMApost -> t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return ((s, MatchText s, s) -> t
f (s, MatchText s, s)
preMApost)

polymatch :: (RegexLike a b) => a -> b -> b
{-# INLINE polymatch #-}
polymatch :: a -> b -> b
polymatch a
r b
s = case a -> b -> Maybe (b, MatchText b, b)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText a
r b
s of
    Maybe (b, MatchText b, b)
Nothing -> b
forall source. Extract source => source
empty
    Just (b
_, MatchText b
ma, b
_) -> (b, (MatchOffset, MatchOffset)) -> b
forall a b. (a, b) -> a
fst (MatchText b
ma MatchText b -> MatchOffset -> (b, (MatchOffset, MatchOffset))
forall i e. Ix i => Array i e -> i -> e
! MatchOffset
0)

polymatchM :: (RegexLike a b,MonadFail m) => a -> b -> m b
{-# INLINE polymatchM #-}
polymatchM :: a -> b -> m b
polymatchM =  ((b, MatchText b, b) -> b) -> a -> b -> m b
forall r s (m :: * -> *) t.
(RegexLike r s, MonadFail m) =>
((s, MatchText s, s) -> t) -> r -> s -> m t
actOn (\ (b
_, MatchText b
ma, b
_) -> (b, (MatchOffset, MatchOffset)) -> b
forall a b. (a, b) -> a
fst (MatchText b
ma MatchText b -> MatchOffset -> (b, (MatchOffset, MatchOffset))
forall i e. Ix i => Array i e -> i -> e
! MatchOffset
0))