{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module RegExChar.RegExOptsChar(
MatchSpan,
RegExOptsChar,
toZeroIndexedArray,
(=~)
) where
import qualified Data.Array.IArray
import qualified Data.Default
import qualified RegExChar.ExtendedRegExChar as ExtendedRegExChar
import qualified RegExDot.CompilationOptions
import qualified RegExDot.ConsumptionBounds
import qualified RegExDot.DataSpan
import qualified RegExDot.DataSpanTree
import qualified RegExDot.ExecutionOptions
import qualified RegExDot.RegEx
import qualified RegExDot.RegExOpts
import qualified RegExDot.Result
import qualified RegExDot.Tree
import qualified Text.Regex.Base.RegexLike as RegexLike
import Text.Regex.Base.Context()
import qualified ToolShed.Data.List
import qualified ToolShed.Options
infix 4 =~
type RegExOptsChar = RegExDot.RegExOpts.RegExOpts ExtendedRegExChar.ExtendedRegExChar
hasNonCapturingTopLevelAlternatives :: RegExOptsChar -> Bool
hasNonCapturingTopLevelAlternatives = ExtendedRegExChar.hasNonCapturingTopLevelAlternatives . RegExDot.RegExOpts.regEx
complyStrictlyWithPosix :: RegExOptsChar -> Bool
complyStrictlyWithPosix = RegExDot.CompilationOptions.complyStrictlyWithPosix . RegExDot.RegExOpts.compilationOptions
instance RegexLike.RegexOptions RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions where
blankCompOpt = ToolShed.Options.blankValue
blankExecOpt = ToolShed.Options.blankValue
defaultCompOpt = Data.Default.def
defaultExecOpt = Data.Default.def
setExecOpts e r = r { RegExDot.RegExOpts.executionOptions = e }
getExecOpts = RegExDot.RegExOpts.executionOptions
instance RegexLike.RegexMaker RegExOptsChar RegExDot.CompilationOptions.CompilationOptions RegExDot.ExecutionOptions.ExecutionOptions String where
makeRegexOpts c e source = RegExDot.RegExOpts.MkRegExOpts {
RegExDot.RegExOpts.compilationOptions = c,
RegExDot.RegExOpts.executionOptions = e,
RegExDot.RegExOpts.regEx = read source
}
type MatchSpan = (RegexLike.MatchOffset, RegexLike.MatchLength)
type MatchDataSpan = (ExtendedRegExChar.InputData, MatchSpan)
toMatchDataSpanList
:: Bool
-> RegExDot.ConsumptionBounds.DataLength
-> RegExDot.RegEx.MatchList Char
-> [MatchDataSpan]
toMatchDataSpanList _ offset [] = [RegExDot.DataSpan.empty offset]
toMatchDataSpanList strictPosixCompliance _ matchList = RegExDot.DataSpanTree.extractCaptureGroups strictPosixCompliance . return . RegExDot.Tree.Node . return $ RegExDot.DataSpanTree.toTreeList matchList
exciseNonCapturingTopLevelAlternatives :: RegExOptsChar -> [MatchDataSpan] -> [MatchDataSpan]
exciseNonCapturingTopLevelAlternatives regExOptsChar
| hasNonCapturingTopLevelAlternatives regExOptsChar = ToolShed.Data.List.excise 1
| otherwise = id
toZeroIndexedArray :: [e] -> Data.Array.IArray.Array Int e
toZeroIndexedArray l = Data.Array.IArray.listArray (0, pred $ length l) l
matchUntilFailure
:: RegExOptsChar
-> ExtendedRegExChar.InputData
-> [RegExDot.RegEx.MatchList Char]
matchUntilFailure regExOptsChar inputData = shiftOffsets 0 $ matchUntilFailure' inputData where
matchUntilFailure' :: ExtendedRegExChar.InputData -> [RegExDot.RegEx.MatchList Char]
matchUntilFailure' unmatchedInputData = case unmatchedInputData ExtendedRegExChar.+~ regExOptsChar of
(_, Just matchList, maybeSternAnchorResult) -> matchList : if null (RegExDot.RegEx.extractDataFromMatchList matchList) then [] else matchUntilFailure' (RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult)
_ -> []
shiftOffsets :: RegExDot.ConsumptionBounds.DataLength -> [RegExDot.RegEx.MatchList Char] -> [RegExDot.RegEx.MatchList Char]
shiftOffsets offset (matchList : matchLists) = let
shiftedMatchList :: RegExDot.RegEx.MatchList Char
shiftedMatchList = RegExDot.RegEx.shiftMatchList offset matchList
in shiftedMatchList : shiftOffsets (RegExDot.DataSpan.after . last . RegExDot.DataSpanTree.flattenTreeList 0 $ RegExDot.DataSpanTree.toTreeList shiftedMatchList) matchLists
shiftOffsets _ _ = []
instance RegexLike.RegexLike RegExOptsChar ExtendedRegExChar.InputData where
matchAll regExOptsChar = map (toZeroIndexedArray . map snd . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar
matchAllText regExOptsChar = map (toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (complyStrictlyWithPosix regExOptsChar) 0) . matchUntilFailure regExOptsChar
matchOnce regExOptsChar inputData = (
toZeroIndexedArray . map snd . exciseNonCapturingTopLevelAlternatives regExOptsChar . toMatchDataSpanList (
complyStrictlyWithPosix regExOptsChar
) (
RegExDot.RegEx.externalMatchLength $ RegExDot.Result.getPreMatch extendedRegExResult
)
) `fmap` RegExDot.Result.getMatchList extendedRegExResult where
extendedRegExResult :: RegExDot.RegEx.Result Char
extendedRegExResult = inputData ExtendedRegExChar.+~ regExOptsChar
matchOnceText regExOptsChar inputData = case inputData ExtendedRegExChar.+~ regExOptsChar of
(maybeBowAnchorResult, Just matchList, maybeSternAnchorResult) -> Just (
RegExDot.RegEx.extractDataFromMatch' maybeBowAnchorResult,
toZeroIndexedArray . exciseNonCapturingTopLevelAlternatives regExOptsChar $ toMatchDataSpanList (
complyStrictlyWithPosix regExOptsChar
) (
RegExDot.RegEx.externalMatchLength maybeBowAnchorResult
) matchList,
RegExDot.RegEx.extractDataFromMatch' maybeSternAnchorResult
)
_ -> Nothing
matchTest = flip (ExtendedRegExChar.=~)
(=~) :: RegexLike.RegexContext RegExOptsChar ExtendedRegExChar.InputData target
=> ExtendedRegExChar.InputData
-> String
-> target
inputData =~ s = (RegexLike.makeRegex s :: RegExOptsChar) `RegexLike.match` inputData