{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE OverloadedStrings          #-}

module Text.RE.ZeInternals.AddCaptureNames where

import qualified Data.ByteString.Char8         as B
import qualified Data.ByteString.Lazy.Char8    as LBS
import           Data.Dynamic
import           Data.Maybe
import qualified Data.Sequence                 as S
import qualified Data.Text                     as T
import qualified Data.Text.Lazy                as TL
import           Prelude.Compat
import           Text.RE.ZeInternals.Types.CaptureID
import           Text.RE.ZeInternals.Types.Match
import           Text.RE.ZeInternals.Types.Matches
import           Unsafe.Coerce


-- | a convenience function used by the API modules to insert
-- capture names extracted from the parsed RE into the (*=~) result
addCaptureNamesToMatches :: CaptureNames -> Matches a -> Matches a
addCaptureNamesToMatches :: CaptureNames -> Matches a -> Matches a
addCaptureNamesToMatches CaptureNames
cnms Matches a
mtchs =
  Matches a
mtchs { allMatches :: [Match a]
allMatches = (Match a -> Match a) -> [Match a] -> [Match a]
forall a b. (a -> b) -> [a] -> [b]
map (CaptureNames -> Match a -> Match a
forall a. CaptureNames -> Match a -> Match a
addCaptureNamesToMatch CaptureNames
cnms) ([Match a] -> [Match a]) -> [Match a] -> [Match a]
forall a b. (a -> b) -> a -> b
$ Matches a -> [Match a]
forall a. Matches a -> [Match a]
allMatches Matches a
mtchs }

-- | a convenience function used by the API modules to insert
-- capture names extracted from the parsed RE into the (?=~) result
addCaptureNamesToMatch :: CaptureNames -> Match a -> Match a
addCaptureNamesToMatch :: CaptureNames -> Match a -> Match a
addCaptureNamesToMatch CaptureNames
cnms Match a
mtch = Match a
mtch { captureNames :: CaptureNames
captureNames = CaptureNames
cnms }

-- | a hairy dynamically-typed function used with the legacy (=~) and (=~~)
-- to see if it can/should add the capture names extracted from the RE
-- into the polymorphic result of the operator (it does for any Match
-- or Matches type, provided it is parameterised over a recognised type).
-- The test suite is all over this one, testing all of these cases.
addCaptureNames :: Typeable a => CaptureNames -> a -> a
addCaptureNames :: CaptureNames -> a -> a
addCaptureNames CaptureNames
cnms a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes
    [ a -> String -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( String
forall a. a
proxy :: String         )
    , a -> String -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( String
forall a. a
proxy :: String         )
    , a -> ByteString -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( ByteString
forall a. a
proxy :: B.ByteString   )
    , a -> ByteString -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( ByteString
forall a. a
proxy :: B.ByteString   )
    , a -> ByteString -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( ByteString
forall a. a
proxy :: LBS.ByteString )
    , a -> ByteString -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( ByteString
forall a. a
proxy :: LBS.ByteString )
    , a -> Text -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( Text
forall a. a
proxy :: T.Text         )
    , a -> Text -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( Text
forall a. a
proxy :: T.Text         )
    , a -> Text -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( Text
forall a. a
proxy :: TL.Text        )
    , a -> Text -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( Text
forall a. a
proxy :: TL.Text        )
    , a -> Seq Char -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_match   a
x ( Seq Char
forall a. a
proxy :: S.Seq Char     )
    , a -> Seq Char -> Maybe a
forall t r. Typeable t => r -> t -> Maybe r
test_matches a
x ( Seq Char
forall a. a
proxy :: S.Seq Char     )
    ]
  where
    test_match :: Typeable t => r -> t -> Maybe r
    test_match :: r -> t -> Maybe r
test_match r
r t
t = r -> t -> Maybe (Match t) -> Maybe r
forall r' t'. r' -> t' -> Maybe (Match t') -> Maybe r'
f r
r t
t (Maybe (Match t) -> Maybe r) -> Maybe (Match t) -> Maybe r
forall a b. (a -> b) -> a -> b
$ CaptureNames -> Match t -> Match t
forall a. CaptureNames -> Match a -> Match a
addCaptureNamesToMatch CaptureNames
cnms (Match t -> Match t) -> Maybe (Match t) -> Maybe (Match t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic -> Maybe (Match t)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn
      where
        f :: r' -> t' -> Maybe (Match t') -> Maybe r'
        f :: r' -> t' -> Maybe (Match t') -> Maybe r'
f r'
_ t'
_ = Maybe (Match t') -> Maybe r'
forall a b. a -> b
unsafeCoerce

    test_matches :: Typeable t => r -> t -> Maybe r
    test_matches :: r -> t -> Maybe r
test_matches r
r t
t = r -> t -> Maybe (Matches t) -> Maybe r
forall r' t'. r' -> t' -> Maybe (Matches t') -> Maybe r'
f r
r t
t (Maybe (Matches t) -> Maybe r) -> Maybe (Matches t) -> Maybe r
forall a b. (a -> b) -> a -> b
$ CaptureNames -> Matches t -> Matches t
forall a. CaptureNames -> Matches a -> Matches a
addCaptureNamesToMatches CaptureNames
cnms (Matches t -> Matches t) -> Maybe (Matches t) -> Maybe (Matches t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic -> Maybe (Matches t)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn
      where
        f :: r' -> t' -> Maybe (Matches t') -> Maybe r'
        f :: r' -> t' -> Maybe (Matches t') -> Maybe r'
f r'
_ t'
_ = Maybe (Matches t') -> Maybe r'
forall a b. a -> b
unsafeCoerce

    dyn :: Dynamic
    dyn :: Dynamic
dyn = a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
x

    proxy :: a
    proxy :: a
proxy = String -> a
forall a. HasCallStack => String -> a
error String
"addCaptureNames"