\begin{code}
\end{code}
\begin{code}
module Text.RE.ZeInternals.Types.Match
( Match(..)
, noMatch
, emptyMatchArray
, matched
, matchedText
, matchCapture
, matchCaptures
, (!$$)
, captureText
, (!$$?)
, captureTextMaybe
, (!$)
, capture
, (!$?)
, captureMaybe
, convertMatchText
) where
\end{code}
\begin{code}
import Data.Array
import Data.Maybe
import Data.Typeable
import Text.RE.ZeInternals.Types.Capture
import Text.RE.ZeInternals.Types.CaptureID
import Text.Regex.Base
infixl 9 !$, !$$
\end{code}
\begin{code}
data Match a =
Match
{ matchSource :: !a
, captureNames :: !CaptureNames
, matchArray :: !(Array CaptureOrdinal (Capture a))
}
deriving (Show,Eq,Typeable)
\end{code}
\begin{code}
noMatch :: a -> Match a
noMatch t = Match t noCaptureNames emptyMatchArray
emptyMatchArray :: Array CaptureOrdinal (Capture a)
emptyMatchArray = listArray (CaptureOrdinal 0,CaptureOrdinal $ 1) []
\end{code}
\begin{code}
instance Functor Match where
fmap f Match{..} =
Match
{ matchSource = f matchSource
, captureNames = captureNames
, matchArray = fmap (fmap f) matchArray
}
\end{code}
\begin{code}
matched :: Match a -> Bool
matched = isJust . matchCapture
matchedText :: Match a -> Maybe a
matchedText = fmap capturedText . matchCapture
matchCapture :: Match a -> Maybe (Capture a)
matchCapture = fmap fst . matchCaptures
matchCaptures :: Match a -> Maybe (Capture a,[Capture a])
matchCaptures Match{..} = case rangeSize (bounds matchArray) == 0 of
True -> Nothing
False -> Just (matchArray!0,drop 1 $ elems matchArray)
(!$$) :: Match a -> CaptureID -> a
(!$$) = flip captureText
captureText :: CaptureID -> Match a -> a
captureText cid mtch = capturedText $ capture cid mtch
(!$$?) :: Match a -> CaptureID -> Maybe a
(!$$?) = flip captureTextMaybe
captureTextMaybe :: CaptureID -> Match a -> Maybe a
captureTextMaybe cid mtch = do
cap <- mtch !$? cid
case hasCaptured cap of
True -> Just $ capturedText cap
False -> Nothing
(!$) :: Match a -> CaptureID -> Capture a
(!$) = flip capture
capture :: CaptureID -> Match a -> Capture a
capture cid mtch = fromMaybe oops $ mtch !$? cid
where
oops = error $ "capture: out of bounds (" ++ show cid ++ ")"
(!$?) :: Match a -> CaptureID -> Maybe (Capture a)
(!$?) = flip captureMaybe
captureMaybe :: CaptureID -> Match a -> Maybe (Capture a)
captureMaybe cid mtch@Match{..} = do
i <- lookupCaptureID cid mtch
cap <- case bounds matchArray `inRange` i of
True -> Just $ matchArray ! i
False -> Nothing
case hasCaptured cap of
True -> Just cap
False -> Nothing
lookupCaptureID :: CaptureID -> Match a -> Maybe CaptureOrdinal
lookupCaptureID cid Match{..} =
either (const Nothing) Just $ findCaptureID cid captureNames
\end{code}
\begin{code}
instance
( RegexContext regex source (AllTextSubmatches (Array Int) (source,(Int,Int)))
, RegexLike regex source
) =>
RegexContext regex source (Match source) where
match r s = convertMatchText s $ getAllTextSubmatches $ match r s
matchM r s = do
y <- matchM r s
return $ convertMatchText s $ getAllTextSubmatches y
\end{code}
\begin{code}
convertMatchText :: source -> MatchText source -> Match source
convertMatchText hay arr =
Match
{ matchSource = hay
, captureNames = noCaptureNames
, matchArray =
ixmap (CaptureOrdinal lo,CaptureOrdinal hi) getCaptureOrdinal $
fmap f arr
}
where
(lo,hi) = bounds arr
f (ndl,(off,len)) =
Capture
{ captureSource = hay
, capturedText = ndl
, captureOffset = off
, captureLength = len
}
\end{code}