1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# 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 cnms mtchs =
mtchs { allMatches = map (addCaptureNamesToMatch cnms) $ allMatches 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 cnms mtch = mtch { 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 cnms x = fromMaybe x $ listToMaybe $ catMaybes
[ test_match x ( proxy :: String )
, test_matches x ( proxy :: String )
, test_match x ( proxy :: B.ByteString )
, test_matches x ( proxy :: B.ByteString )
, test_match x ( proxy :: LBS.ByteString )
, test_matches x ( proxy :: LBS.ByteString )
, test_match x ( proxy :: T.Text )
, test_matches x ( proxy :: T.Text )
, test_match x ( proxy :: TL.Text )
, test_matches x ( proxy :: TL.Text )
, test_match x ( proxy :: S.Seq Char )
, test_matches x ( proxy :: S.Seq Char )
]
where
test_match :: Typeable t => r -> t -> Maybe r
test_match r t = f r t $ addCaptureNamesToMatch cnms <$> fromDynamic dyn
where
f :: r' -> t' -> Maybe (Match t') -> Maybe r'
f _ _ = unsafeCoerce
test_matches :: Typeable t => r -> t -> Maybe r
test_matches r t = f r t $ addCaptureNamesToMatches cnms <$> fromDynamic dyn
where
f :: r' -> t' -> Maybe (Matches t') -> Maybe r'
f _ _ = unsafeCoerce
dyn :: Dynamic
dyn = toDyn x
proxy :: a
proxy = error "addCaptureNames"
|
