diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -53,9 +53,13 @@     ☒  2017-03-13 v0.6.0.0 [Split out PCRE](https://github.com/iconnect/regex/milestone/7) -    ☒  2017-03-13 v0.6.0.1 [Fix .travis.yml release-stack scriptRE](https://github.com/iconnect/regex/milestone/7) +    ☒  2017-03-13 v0.6.0.1 [Fix .travis.yml release-stack script](https://github.com/iconnect/regex/issues/67) -    ☐  2017-03-20 v1.0.0.0 [First stable release](https://github.com/iconnect/regex/milestone/3) +    ☒  2017-03-15 v0.7.0.0 [Better organization of API](https://github.com/iconnect/regex/milestone/8) + +    ☐  2017-03-17 v0.8.0.0 [Add type-safe replacement templates and use TemplateHaskellQuotes](https://github.com/iconnect/regex/milestone/9) + +    ☐  2017-03-31 v1.0.0.0 [First stable release](https://github.com/iconnect/regex/milestone/3)     ☐  2017-08-31 v2.0.0.0 [Fast text replacement with benchmarks](https://github.com/iconnect/regex/milestone/4) diff --git a/Text/RE.hs b/Text/RE.hs --- a/Text/RE.hs +++ b/Text/RE.hs @@ -45,54 +45,10 @@ , hasCaptured , capturePrefix , captureSuffix - -- * IsRegex - , IsRegex(..) -- * Options - , Options_(..) - , IsOption(..) - , MacroID(..) - , Macros - , emptyMacros , SimpleRegexOptions(..) -- * CaptureID - , CaptureID(..) - , CaptureNames - , noCaptureNames - , CaptureName(..) - , CaptureOrdinal(..) - , findCaptureID - -- * Edit - , Edits(..) - , Edit(..) - , LineEdit(..) - , applyEdits - , applyEdit - , applyLineEdit - -- * LineNo - , LineNo(..) - , firstLine - , getLineNo - , lineNo - -- * Parsers - , parseInteger - , parseHex - , parseDouble - , parseString - , parseSimpleString - , parseDate - , parseSlashesDate - , parseTimeOfDay - , parseTimeZone - , parseDateTime - , parseDateTime8601 - , parseDateTimeCLF - , parseShortMonth - , shortMonthArray - , IPV4Address - , parseIPv4Address - , Severity(..) - , parseSeverity - , severityKeywords + , CaptureID -- * Replace , Replace(..) , ReplaceMethods(..) @@ -110,34 +66,14 @@ , replaceCapturesM , expandMacros , expandMacros' - -- * Tools - -- ** Grep - , Line(..) - , grep - , grepLines - , GrepScript - , grepScript - , linesMatched - -- ** Lex - , alex - , alex' - -- ** Sed - , SedScript - , sed - , sed' ) where -import Text.RE.Capture -import Text.RE.CaptureID -import Text.RE.Edit -import Text.RE.IsRegex -import Text.RE.LineNo -import Text.RE.Options -import Text.RE.Parsers -import Text.RE.Replace -import Text.RE.Tools.Grep -import Text.RE.Tools.Lex -import Text.RE.Tools.Sed +import Text.RE.Types.Capture +import Text.RE.Types.CaptureID +import Text.RE.Types.Match +import Text.RE.Types.Matches +import Text.RE.Types.Options +import Text.RE.Types.Replace -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/Capture.lhs b/Text/RE/Capture.lhs deleted file mode 100644 --- a/Text/RE/Capture.lhs +++ /dev/null @@ -1,292 +0,0 @@ -\begin{code} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE DeriveDataTypeable #-} -\end{code} - -\begin{code} -module Text.RE.Capture - ( Matches(..) - , Match(..) - , Capture(..) - , noMatch - , emptyMatchArray - -- Matches functions - , anyMatches - , countMatches - , matches - , mainCaptures - -- Match functions - , matched - , matchedText - , matchCapture - , matchCaptures - , (!$$) - , captureText - , (!$$?) - , captureTextMaybe - , (!$) - , capture - , (!$?) - , captureMaybe - -- Capture functions - , hasCaptured - , capturePrefix - , captureSuffix - ) where -\end{code} - -\begin{code} -import Data.Array -import Data.Maybe -import Data.Typeable -import Text.Regex.Base -import Text.RE.CaptureID - -infixl 9 !$, !$$ -\end{code} - - - -\begin{code} --- | the result type to use when every match is needed, not just the --- first match of the RE against the source -data Matches a = - Matches - { matchesSource :: !a -- ^ the source text being matched - , allMatches :: ![Match a] -- ^ all captures found, left to right - } - deriving (Show,Eq,Typeable) -\end{code} - -\begin{code} --- | the result of matching a RE to a text once, listing the text that --- was matched and the named captures in the RE and all of the substrings --- matched, with the text captured by the whole RE; a complete failure --- to match will be represented with an empty array (with bounds (0,-1)) -data Match a = - Match - { matchSource :: !a -- ^ the whole source text - , captureNames :: !CaptureNames -- ^ the RE's capture names - , matchArray :: !(Array CaptureOrdinal (Capture a)) - -- ^ 0..n-1 captures, - -- starting with the - -- text matched by the - -- whole RE - } - deriving (Show,Eq,Typeable) -\end{code} - -\begin{code} --- | the matching of a single sub-expression against part of the source --- text -data Capture a = - Capture - { captureSource :: !a -- ^ the whole text that was searched - , capturedText :: !a -- ^ the text that was matched - , captureOffset :: !Int -- ^ the number of characters preceding the - -- match with -1 used if no text was captured - -- by the RE (not even the empty string) - , captureLength :: !Int -- ^ the number of chacter in the captured - -- sub-string - } - deriving (Show,Eq) -\end{code} - -\begin{code} --- | Construct a Match that does not match anything. -noMatch :: a -> Match a -noMatch t = Match t noCaptureNames emptyMatchArray - --- | an empty array of Capture -emptyMatchArray :: Array CaptureOrdinal (Capture a) -emptyMatchArray = listArray (CaptureOrdinal 0,CaptureOrdinal $ -1) [] -\end{code} - -\begin{code} -instance Functor Matches where - fmap f Matches{..} = - Matches - { matchesSource = f matchesSource - , allMatches = map (fmap f) allMatches - } - -instance Functor Match where - fmap f Match{..} = - Match - { matchSource = f matchSource - , captureNames = captureNames - , matchArray = fmap (fmap f) matchArray - } - -instance Functor Capture where - fmap f c@Capture{..} = - c - { captureSource = f captureSource - , capturedText = f capturedText - } -\end{code} - -\begin{code} --- | tests whether the RE matched the source text at all -anyMatches :: Matches a -> Bool -anyMatches = not . null . allMatches - --- | count the matches -countMatches :: Matches a -> Int -countMatches = length . allMatches - -matches :: Matches a -> [a] -matches = map capturedText . mainCaptures - --- | extract the main capture from each match -mainCaptures :: Matches a -> [Capture a] -mainCaptures ac = [ capture c0 cs | cs<-allMatches ac ] - where - c0 = IsCaptureOrdinal $ CaptureOrdinal 0 -\end{code} - - - -\begin{code} --- | tests whether the RE matched the source text at all -matched :: Match a -> Bool -matched = isJust . matchCapture - --- | tests whether the RE matched the source text at all -matchedText :: Match a -> Maybe a -matchedText = fmap capturedText . matchCapture - --- | the top-level capture if the source text matched the RE, --- Nothing otherwise -matchCapture :: Match a -> Maybe (Capture a) -matchCapture = fmap fst . matchCaptures - --- | the top-level capture and the sub captures if the text matched --- the RE, Nothing otherwise -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) - --- | an alternative for captureText -(!$$) :: Match a -> CaptureID -> a -(!$$) = flip captureText - --- | look up the text of the nth capture, 0 being the match of the whole --- RE against the source text, 1, the first bracketed sub-expression to --- be matched and so on -captureText :: CaptureID -> Match a -> a -captureText cid mtch = capturedText $ capture cid mtch - --- | an alternative for captureTextMaybe -(!$$?) :: Match a -> CaptureID -> Maybe a -(!$$?) = flip captureTextMaybe - --- | look up the text of the nth capture (0 being the match of the --- whole), returning Nothing if the Match doesn't contain the capture -captureTextMaybe :: CaptureID -> Match a -> Maybe a -captureTextMaybe cid mtch = do - cap <- mtch !$? cid - case hasCaptured cap of - True -> Just $ capturedText cap - False -> Nothing - --- | an alternative for capture -(!$) :: Match a -> CaptureID -> Capture a -(!$) = flip capture - --- | look up the nth capture, 0 being the match of the whole RE against --- the source text, 1, the first bracketed sub-expression to be matched --- and so on -capture :: CaptureID -> Match a -> Capture a -capture cid mtch = fromMaybe oops $ mtch !$? cid - where - oops = error $ "capture: out of bounds (" ++ show cid ++ ")" - --- | an alternative for capture captureMaybe -(!$?) :: Match a -> CaptureID -> Maybe (Capture a) -(!$?) = flip captureMaybe - --- | look up the nth capture, 0 being the match of the whole RE against --- the source text, 1, the first bracketed sub-expression to be matched --- and so on, returning Nothing if there is no such capture, or if the --- capture failed to capture anything (being in a failed alternate) -captureMaybe :: CaptureID -> Match a -> Maybe (Capture a) -captureMaybe cid mtch@Match{..} = do - cap <- case bounds matchArray `inRange` CaptureOrdinal i of - True -> Just $ matchArray ! CaptureOrdinal i - False -> Nothing - case hasCaptured cap of - True -> Just cap - False -> Nothing - where - i = lookupCaptureID cid mtch - -lookupCaptureID :: CaptureID -> Match a -> Int -lookupCaptureID cid Match{..} = findCaptureID cid captureNames -\end{code} - - -\begin{code} --- | test if the capture has matched any text -hasCaptured :: Capture a -> Bool -hasCaptured = (>=0) . captureOffset - --- | returns the text preceding the match -capturePrefix :: Extract a => Capture a -> a -capturePrefix Capture{..} = before captureOffset captureSource - --- | returns the text after the match -captureSuffix :: Extract a => Capture a -> a -captureSuffix Capture{..} = after (captureOffset+captureLength) captureSource -\end{code} - - -\begin{code} --- | for matching just the first RE against the source text -instance - ( RegexContext regex source (AllTextSubmatches (Array Int) (source,(Int,Int))) - , RegexLike regex source - ) => - RegexContext regex source (Match source) where - match r s = cvt s $ getAllTextSubmatches $ match r s - matchM r s = do - y <- matchM r s - return $ cvt s $ getAllTextSubmatches y - --- | for matching all REs against the source text -instance - ( RegexContext regex source [MatchText source] - , RegexLike regex source - ) => - RegexContext regex source (Matches source) where - match r s = Matches s $ map (cvt s) $ match r s - matchM r s = do - y <- matchM r s - return $ Matches s $ map (cvt s) y -\end{code} - -\begin{code} -cvt :: source -> MatchText source -> Match source -cvt 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} diff --git a/Text/RE/CaptureID.hs b/Text/RE/CaptureID.hs deleted file mode 100644 --- a/Text/RE/CaptureID.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Text.RE.CaptureID where - -import Data.Ix -import Data.Hashable -import qualified Data.HashMap.Strict as HMS -import Data.Maybe -import qualified Data.Text as T - - --- | CaptureID identifies captures, either by number --- (e.g., [cp|1|]) or name (e.g., [cp|foo|]). -data CaptureID - = IsCaptureOrdinal CaptureOrdinal - | IsCaptureName CaptureName - deriving (Show,Ord,Eq) - --- | the dictionary for named captures stored in compiled regular --- expressions associates -type CaptureNames = HMS.HashMap CaptureName CaptureOrdinal - --- | an empty 'CaptureNames' dictionary -noCaptureNames :: CaptureNames -noCaptureNames = HMS.empty - --- | a 'CaptureName' is just the text of the name -newtype CaptureName = CaptureName { getCaptureName :: T.Text } - deriving (Show,Ord,Eq) - -instance Hashable CaptureName where - hashWithSalt i = hashWithSalt i . getCaptureName - --- | a 'CaptureOrdinal' is just the number of the capture, starting --- with 0 for the whole of the text matched, then in leftmost, --- outermost -newtype CaptureOrdinal = CaptureOrdinal { getCaptureOrdinal :: Int } - deriving (Show,Ord,Eq,Enum,Ix,Num) - --- | look up a 'CaptureID' in the 'CaptureNames' dictionary -findCaptureID :: CaptureID -> CaptureNames -> Int -findCaptureID (IsCaptureOrdinal o) _ = getCaptureOrdinal o -findCaptureID (IsCaptureName n) hms = - getCaptureOrdinal $ fromMaybe oops $ HMS.lookup n hms - where - oops = error $ unlines $ - ("lookupCaptureID: " ++ T.unpack t ++ " not found in:") : - [ " "++T.unpack (getCaptureName nm) | nm <- HMS.keys hms ] - t = getCaptureName n diff --git a/Text/RE/Edit.lhs b/Text/RE/Edit.lhs deleted file mode 100644 --- a/Text/RE/Edit.lhs +++ /dev/null @@ -1,96 +0,0 @@ -\begin{code} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - -module Text.RE.Edit - ( LineNo - , Edits(..) - , Edit(..) - , LineEdit(..) - , applyEdits - , applyEdit - , applyLineEdit - ) where - -import Data.Maybe -import Prelude.Compat -import Text.RE.Capture -import Text.RE.IsRegex -import Text.RE.LineNo -import Text.RE.Replace - - -data Edits m re s - = Select [(re,Edit m s)] - | Pipe [(re,Edit m s)] - -data Edit m s - = Template s - | Function Context (LineNo->Match s->Location->Capture s->m (Maybe s)) - | LineEdit (LineNo->Matches s->m (LineEdit s)) - -data LineEdit s - = NoEdit - | ReplaceWith s - | Delete - deriving (Show) - -applyEdits :: (IsRegex re s,Monad m,Functor m) - => LineNo - -> Edits m re s - -> s - -> m s -applyEdits lno ez0 s0 = case ez0 of - Select ez -> select_edit_scripts lno ez s0 - Pipe ez -> pipe_edit_scripts lno ez s0 - -applyEdit :: (IsRegex re s,Monad m,Functor m) - => (s->s) - -> LineNo - -> re - -> Edit m s - -> s - -> m (Maybe s) -applyEdit anl lno re edit s = - case allMatches acs of - [] -> return Nothing - _ -> fmap Just $ case edit of - Template tpl -> return $ anl $ replaceAll tpl acs - Function ctx f -> anl <$> replaceAllCapturesM replaceMethods ctx (f lno) acs - LineEdit g -> fromMaybe s' . applyLineEdit anl <$> g lno acs - where - s' = anl s - acs = matchMany re s - -applyLineEdit :: Monoid s => (s->s) -> LineEdit s -> Maybe s -applyLineEdit _ NoEdit = Nothing -applyLineEdit anl (ReplaceWith s) = Just $ anl s -applyLineEdit _ Delete = Just $ mempty - -select_edit_scripts :: (IsRegex re s,Monad m,Functor m) - => LineNo - -> [(re,Edit m s)] - -> s - -> m s -select_edit_scripts lno ps0 s = select ps0 - where - select [] = return $ appendNewlineE s - select ((re,es):ps) = - applyEdit appendNewlineE lno re es s >>= maybe (select ps) return - -pipe_edit_scripts :: (IsRegex re s,Monad m,Functor m) - => LineNo - -> [(re,Edit m s)] - -> s - -> m s -pipe_edit_scripts lno ez s0 = - appendNewlineE <$> foldr f (return s0) ez - where - f (re,es) act = do - s <- act - fromMaybe s <$> applyEdit id lno re es s -\end{code} diff --git a/Text/RE/Internal/AddCaptureNames.hs b/Text/RE/Internal/AddCaptureNames.hs --- a/Text/RE/Internal/AddCaptureNames.hs +++ b/Text/RE/Internal/AddCaptureNames.hs @@ -15,6 +15,7 @@ import qualified Data.Text.Lazy as TL import Prelude.Compat import Text.RE +import Text.RE.Types.CaptureID import Unsafe.Coerce diff --git a/Text/RE/Internal/NamedCaptures.lhs b/Text/RE/Internal/NamedCaptures.lhs --- a/Text/RE/Internal/NamedCaptures.lhs +++ b/Text/RE/Internal/NamedCaptures.lhs @@ -27,6 +27,8 @@ import Text.RE.Internal.PreludeMacros import Text.RE.Internal.QQ import Text.RE.TestBench +import Text.RE.Tools.Lex +import Text.RE.Types.CaptureID import Text.Regex.TDFA diff --git a/Text/RE/Internal/PreludeMacros.hs b/Text/RE/Internal/PreludeMacros.hs --- a/Text/RE/Internal/PreludeMacros.hs +++ b/Text/RE/Internal/PreludeMacros.hs @@ -8,7 +8,7 @@ #endif module Text.RE.Internal.PreludeMacros - ( RegexType(..) + ( RegexType , WithCaptures(..) , MacroDescriptor(..) , RegexSource(..) @@ -30,8 +30,8 @@ import qualified Data.Text as T import Data.Time import Prelude.Compat -import Text.RE.Options -import Text.RE.Parsers +import Text.RE.Types.Options +import Text.RE.TestBench.Parsers import Text.RE.TestBench @@ -266,17 +266,18 @@ -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -string_macro (PCRE _) _ _ = Nothing -string_macro rty@(TDFA _) env pm = - Just $ run_tests rty (fmap T.unpack . parseString) samples env pm - MacroDescriptor - { _md_source = "\"(?:[^\"\\]+|\\\\[\\\"])*\"" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseString" - , _md_description = "a double-quote string, with simple \\ escapes for \\s and \"s" - } +string_macro rty env pm + | isPCRE rty = Nothing + | otherwise = + Just $ run_tests rty (fmap T.unpack . parseString) samples env pm + MacroDescriptor + { _md_source = "\"(?:[^\"\\]+|\\\\[\\\"])*\"" + , _md_samples = map fst samples + , _md_counter_samples = counter_samples + , _md_test_results = [] + , _md_parser = Just "parseString" + , _md_description = "a double-quote string, with simple \\ escapes for \\s and \"s" + } where samples :: [(String,String)] samples = @@ -788,9 +789,9 @@ , "ALERT" ] - re = case rty of - PCRE _ -> re_pcre - TDFA _ -> re_tdfa + re = if isPCRE rty + then re_pcre + else re_tdfa re_tdfa = bracketedRegexSource $ intercalate "|" $ diff --git a/Text/RE/IsRegex.lhs b/Text/RE/IsRegex.lhs deleted file mode 100644 --- a/Text/RE/IsRegex.lhs +++ /dev/null @@ -1,17 +0,0 @@ -\begin{code} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - -module Text.RE.IsRegex where - -import Text.RE.Capture -import Text.RE.Replace -\end{code} - - -\begin{code} -class Replace s => IsRegex re s where - matchOnce :: re -> s -> Match s - matchMany :: re -> s -> Matches s - regexSource :: re -> String -\end{code} diff --git a/Text/RE/LineNo.hs b/Text/RE/LineNo.hs deleted file mode 100644 --- a/Text/RE/LineNo.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Text.RE.LineNo where - - -newtype LineNo = - ZeroBasedLineNo { getZeroBasedLineNo :: Int } - deriving (Show,Enum) - - -firstLine :: LineNo -firstLine = ZeroBasedLineNo 0 - -getLineNo :: LineNo -> Int -getLineNo = (+1) . getZeroBasedLineNo - -lineNo :: Int -> LineNo -lineNo = ZeroBasedLineNo . (\x->x-1) diff --git a/Text/RE/Options.lhs b/Text/RE/Options.lhs deleted file mode 100644 --- a/Text/RE/Options.lhs +++ /dev/null @@ -1,69 +0,0 @@ -\begin{code} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FunctionalDependencies #-} - -module Text.RE.Options where - -import Data.Hashable -import qualified Data.HashMap.Strict as HM -import Data.String -import Language.Haskell.TH -import Language.Haskell.TH.Syntax -\end{code} - -\begin{code} -data Options_ r c e = - Options - { optionsMacs :: !(Macros r) - , optionsComp :: !c - , optionsExec :: !e - } - deriving (Show) -\end{code} - -\begin{code} -class IsOption o r c e | - e -> r, c -> e , e -> c, r -> c, c -> r, r -> e where - makeOptions :: o -> Options_ r c e -\end{code} - -\begin{code} -newtype MacroID = - MacroID { getMacroID :: String } - deriving (IsString,Ord,Eq,Show) -\end{code} - -\begin{code} -instance Hashable MacroID where - hashWithSalt i = hashWithSalt i . getMacroID -\end{code} - -\begin{code} -type Macros r = HM.HashMap MacroID r -\end{code} - -\begin{code} -emptyMacros :: Macros r -emptyMacros = HM.empty -\end{code} - -\begin{code} -data SimpleRegexOptions - = MultilineSensitive - | MultilineInsensitive - | BlockSensitive - | BlockInsensitive - deriving (Bounded,Enum,Eq,Ord,Show) -\end{code} - -\begin{code} -instance Lift SimpleRegexOptions where - lift sro = case sro of - MultilineSensitive -> conE 'MultilineSensitive - MultilineInsensitive -> conE 'MultilineInsensitive - BlockSensitive -> conE 'BlockSensitive - BlockInsensitive -> conE 'BlockInsensitive -\end{code} diff --git a/Text/RE/Parsers.hs b/Text/RE/Parsers.hs deleted file mode 100644 --- a/Text/RE/Parsers.hs +++ /dev/null @@ -1,166 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -{-# LANGUAGE OverloadedStrings #-} - -module Text.RE.Parsers - ( parseInteger - , parseHex - , parseDouble - , parseString - , parseSimpleString - , parseDate - , parseSlashesDate - , parseTimeOfDay - , parseTimeZone - , parseDateTime - , parseDateTime8601 - , parseDateTimeCLF - , parseShortMonth - , shortMonthArray - , IPV4Address - , parseIPv4Address - , Severity(..) - , parseSeverity - , severityKeywords - ) where - -import Data.Array -import qualified Data.HashMap.Strict as HM -import Data.Maybe -import qualified Data.Text as T -import Data.Time -import qualified Data.Time.Locale.Compat as LC -import Data.Word -import Text.Printf -import Text.Read -import Text.RE.Replace - - -parseInteger :: Replace a => a -> Maybe Int -parseInteger = readMaybe . unpackE - -parseHex :: Replace a => a -> Maybe Int -parseHex = readMaybe . ("0x"++) . unpackE - -parseDouble :: Replace a => a -> Maybe Double -parseDouble = readMaybe . unpackE - -parseString :: Replace a => a -> Maybe T.Text -parseString = readMaybe . unpackE - -parseSimpleString :: Replace a => a -> Maybe T.Text -parseSimpleString = Just . T.dropEnd 1 . T.drop 1 . textifyE - -date_templates, time_templates, timezone_templates, - date_time_8601_templates, date_time_templates :: [String] -date_templates = ["%F"] -time_templates = ["%H:%M:%S","%H:%M:%S%Q","%H:%M"] -timezone_templates = ["Z","%z"] -date_time_8601_templates = - [ printf "%sT%s%s" dt tm tz - | dt <- date_templates - , tm <- time_templates - , tz <- timezone_templates - ] -date_time_templates = - [ printf "%s%c%s%s" dt sc tm tz - | dt <- date_templates - , sc <- ['T',' '] - , tm <- time_templates - , tz <- timezone_templates ++ [" UTC",""] - ] - -parseDate :: Replace a => a -> Maybe Day -parseDate = parse_time date_templates - -parseSlashesDate :: Replace a => a -> Maybe Day -parseSlashesDate = parse_time ["%Y/%m/%d"] - -parseTimeOfDay :: Replace a => a -> Maybe TimeOfDay -parseTimeOfDay = parse_time time_templates - -parseTimeZone :: Replace a => a -> Maybe TimeZone -parseTimeZone = parse_time timezone_templates - -parseDateTime :: Replace a => a -> Maybe UTCTime -parseDateTime = parse_time date_time_templates - -parseDateTime8601 :: Replace a => a -> Maybe UTCTime -parseDateTime8601 = parse_time date_time_8601_templates - -parseDateTimeCLF :: Replace a => a -> Maybe UTCTime -parseDateTimeCLF = parse_time ["%d/%b/%Y:%H:%M:%S %z"] - -parseShortMonth :: Replace a => a -> Maybe Int -parseShortMonth = flip HM.lookup short_month_hm . unpackE - -parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t -parse_time tpls = prs . unpackE - where - prs s = listToMaybe $ catMaybes - [ parseTime LC.defaultTimeLocale fmt s - | fmt<-tpls - ] - -short_month_hm :: HM.HashMap String Int -short_month_hm = HM.fromList [ (T.unpack $ shortMonthArray!i,i) | i<-[1..12] ] - -shortMonthArray :: Array Int T.Text -shortMonthArray = listArray (1,12) $ - T.words "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" - -type IPV4Address = (Word8,Word8,Word8,Word8) - -parseIPv4Address :: Replace a => a -> Maybe IPV4Address -parseIPv4Address = prs . words_by (=='.') . unpackE - where - prs [a_s,b_s,c_s,d_s] = do - a <- readMaybe a_s - b <- readMaybe b_s - c <- readMaybe c_s - d <- readMaybe d_s - case all is_o [a,b,c,d] of - True -> Just (toEnum a,toEnum b,toEnum c,toEnum d) - False -> Nothing - prs _ = Nothing - - is_o x = 0 <= x && x <= 255 - -data Severity - = Emerg - | Alert - | Crit - | Err - | Warning - | Notice - | Info - | Debug - deriving (Bounded,Enum,Ord,Eq,Show) - -parseSeverity :: Replace a => a -> Maybe Severity -parseSeverity = flip HM.lookup severity_hm . textifyE - -severity_hm :: HM.HashMap T.Text Severity -severity_hm = HM.fromList - [ (kw,pri) - | pri<-[minBound..maxBound] - , let (kw0,kws) = severityKeywords pri - , kw <- kw0:kws - ] - -severityKeywords :: Severity -> (T.Text,[T.Text]) -severityKeywords pri = case pri of - Emerg -> (,) "emerg" ["panic"] - Alert -> (,) "alert" [] - Crit -> (,) "crit" [] - Err -> (,) "err" ["error"] - Warning -> (,) "warning" ["warn"] - Notice -> (,) "notice" [] - Info -> (,) "info" [] - Debug -> (,) "debug" [] - -words_by :: (Char->Bool) -> String -> [String] -words_by f s = case dropWhile f s of - "" -> [] - s' -> w : words_by f s'' - where - (w, s'') = break f s' diff --git a/Text/RE/Replace.lhs b/Text/RE/Replace.lhs deleted file mode 100644 --- a/Text/RE/Replace.lhs +++ /dev/null @@ -1,453 +0,0 @@ -\begin{code} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} - -module Text.RE.Replace - ( Replace(..) - , ReplaceMethods(..) - , replaceMethods - , Context(..) - , Location(..) - , isTopLocation - , replace - , replaceAll - , replaceAllCaptures - , replaceAllCaptures_ - , replaceAllCapturesM - , replaceCaptures - , replaceCaptures_ - , replaceCapturesM - , expandMacros - , expandMacros' - ) where - -import Control.Applicative -import Data.Array -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Char -import qualified Data.Foldable as F -import Data.Functor.Identity -import qualified Data.HashMap.Strict as HM -import Data.Maybe -import Data.Monoid -import qualified Data.Sequence as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Lazy as LT -import Prelude.Compat -import Text.Heredoc -import Text.RE.Capture -import Text.RE.CaptureID -import Text.RE.Options -import Text.Read -import Text.Regex.TDFA -import Text.Regex.TDFA.Text() -import Text.Regex.TDFA.Text.Lazy() -\end{code} - -\begin{code} --- | Replace provides the missing methods needed to replace the matched --- text; lengthE is the minimum implementation -class (Extract a,Monoid a) => Replace a where - -- | length function for a - lengthE :: a -> Int - -- | inject String into a - packE :: String -> a - -- | project a onto a String - unpackE :: a -> String - -- | inject into Text - textifyE :: a -> T.Text - -- | project Text onto a - detextifyE :: T.Text -> a - -- | append a newline - appendNewlineE :: a -> a - -- | apply a substitution function to a Capture - substE :: (a->a) -> Capture a -> a - -- | convert a template containing $0, $1, etc., in the first - -- argument, into a 'phi' replacement function for use with - -- replaceAllCaptures and replaceCaptures - parseTemplateE :: a -> Match a -> Location -> Capture a -> Maybe a - - textifyE = T.pack . unpackE - detextifyE = packE . T.unpack - appendNewlineE = (<> packE "\n") - - substE f m@Capture{..} = - capturePrefix m <> f capturedText <> captureSuffix m -\end{code} - -\begin{code} --- | a selction of the Replace methods can be encapsulated with ReplaceMethods --- for the higher-order replacement functions -data ReplaceMethods a = - ReplaceMethods - { methodLength :: a -> Int - , methodSubst :: (a->a) -> Capture a -> a - } - --- | replaceMethods encapsulates ReplaceMethods a from a Replace a context -replaceMethods :: Replace a => ReplaceMethods a -replaceMethods = - ReplaceMethods - { methodLength = lengthE - , methodSubst = substE - } -\end{code} - -\begin{code} --- | @Context@ specifies which contexts the substitutions should be applied -data Context - = TOP -- ^ substitutions should be applied to the top-level only, - -- the text that matched the whole RE - | SUB -- ^ substitutions should only be applied to the text - -- captured by bracketed sub-REs - | ALL -- ^ the substitution function should be applied to all - -- captures, the top level and the sub-expression captures - deriving (Show) - --- | the @Location@ information passed into the substitution function --- specifies which sub-expression is being substituted -data Location = - Location - { locationMatch :: Int - -- ^ the zero-based, i-th string to be matched, - -- when matching all strings, zero when only the - -- first string is being matched - , locationCapture :: CaptureOrdinal - -- ^ 0, when matching the top-level string - -- matched by the whole RE, 1 for the top-most, - -- left-most redex captured by bracketed - -- sub-REs, etc. - } - deriving (Show) -\end{code} - -\begin{code} --- | True iff the location references a complete match --- (i.e., not a bracketed capture) -isTopLocation :: Location -> Bool -isTopLocation = (==0) . locationCapture -\end{code} - -\begin{code} --- | replace all with a template, $0 for whole text, $1 for first --- capture, etc. -replaceAll :: Replace a - => a - -> Matches a - -> a -replaceAll tpl ac = replaceAllCaptures TOP (parseTemplateE tpl) ac -\end{code} - -\begin{code} --- | substitutes using a function that takes the full Match --- context and returns the same replacement text as the _phi_phi --- context. -replaceAllCaptures :: Replace a - => Context - -> (Match a->Location->Capture a->Maybe a) - -> Matches a - -> a -\end{code} - -\begin{code} -replaceAllCaptures = replaceAllCaptures_ replaceMethods -\end{code} - -\begin{code} --- | replaceAllCaptures_ is like like replaceAllCaptures but takes the --- Replace methods through the ReplaceMethods argument -replaceAllCaptures_ :: Extract a - => ReplaceMethods a - -> Context - -> (Match a->Location->Capture a->Maybe a) - -> Matches a - -> a -replaceAllCaptures_ s ctx phi ac = - runIdentity $ replaceAllCapturesM s ctx (lift_phi phi) ac -\end{code} - -\begin{code} --- | replaceAllCapturesM is just a monadically generalised version of --- replaceAllCaptures_ -replaceAllCapturesM :: (Extract a,Monad m) - => ReplaceMethods a - -> Context - -> (Match a->Location->Capture a->m (Maybe a)) - -> Matches a - -> m a -replaceAllCapturesM r ctx phi_ Matches{..} = - replaceCapturesM r ALL phi $ Match matchesSource cnms arr - where - phi _ (Location _ i) = case arr_c!i of - Just caps -> phi_ caps . uncurry Location $ arr_i ! i - Nothing -> const $ return Nothing - - arr_c = listArray bds $ - concat $ - [ repl (rangeSize $ bounds $ matchArray cs) cs - | cs <- allMatches - ] - - arr_i = listArray bds j_ks - - arr = listArray bds $ - [ arr_ ! k - | arr_ <- map matchArray allMatches - , k <- indices arr_ - ] - - bds = (0,CaptureOrdinal $ length j_ks-1) - - j_ks = - [ (j,k) - | (j,arr_) <- zip [0..] $ map matchArray allMatches - , k <- indices arr_ - ] - - repl 0 _ = [] - repl n x = case ctx of - TOP -> Just x : replicate (n-1) Nothing - SUB -> Nothing : replicate (n-1) (Just x) - ALL -> replicate n $ Just x - - cnms = fromMaybe noCaptureNames $ listToMaybe $ map captureNames allMatches -\end{code} - -\begin{code} --- | replace with a template containing $0 for whole text, --- $1 for first capture, etc. -replace :: Replace a - => Match a - -> a - -> a -replace c tpl = replaceCaptures TOP (parseTemplateE tpl) c -\end{code} - -\begin{code} --- | substitutes using a function that takes the full Match --- context and returns the same replacement text as the _phi_phi --- context. -replaceCaptures :: Replace a - => Context - -> (Match a->Location->Capture a->Maybe a) - -> Match a - -> a -replaceCaptures = replaceCaptures_ replaceMethods -\end{code} - -\begin{code} --- | replaceCaptures_ is like replaceCaptures but takes the Replace methods --- through the ReplaceMethods argument -replaceCaptures_ :: Extract a - => ReplaceMethods a - -> Context - -> (Match a->Location->Capture a->Maybe a) - -> Match a - -> a -replaceCaptures_ s ctx phi caps = - runIdentity $ replaceCapturesM s ctx (lift_phi phi) caps -\end{code} - -\begin{code} --- | replaceCapturesM is just a monadically generalised version of --- replaceCaptures_ -replaceCapturesM :: (Monad m,Extract a) - => ReplaceMethods a - -> Context - -> (Match a->Location->Capture a->m (Maybe a)) - -> Match a - -> m a -replaceCapturesM ReplaceMethods{..} ctx phi_ caps@Match{..} = do - (hay',_) <- foldr sc (return (matchSource,[])) $ - zip [0..] $ elems matchArray - return hay' - where - sc (i,cap0) act = do - (hay,ds) <- act - let ndl = capturedText cap - cap = adj hay ds cap0 - mb <- phi i cap - case mb of - Nothing -> return (hay,ds) - Just ndl' -> - return - ( methodSubst (const ndl') cap - , (captureOffset cap,len'-len) : ds - ) - where - len' = methodLength ndl' - len = methodLength ndl - - adj hay ds cap = - Capture - { captureSource = hay - , capturedText = before len $ after off0 hay - , captureOffset = off0 - , captureLength = len - } - where - len = len0 + sum - [ delta - | (off,delta) <- ds - , off < off0 + len0 - ] - len0 = captureLength cap - off0 = captureOffset cap - - phi i cap = case ctx of - TOP | i/=0 -> return Nothing - SUB | i==0 ->return Nothing - _ -> - case not $ hasCaptured cap of - True -> return Nothing - False -> phi_ caps (Location 0 i) cap -\end{code} - -\begin{code} --- the Replace instances - -instance Replace [Char] where - lengthE = length - packE = id - unpackE = id - textifyE = T.pack - detextifyE = T.unpack - appendNewlineE = (<>"\n") - parseTemplateE = parseTemplateE' id - -instance Replace B.ByteString where - lengthE = B.length - packE = B.pack - unpackE = B.unpack - textifyE = TE.decodeUtf8 - detextifyE = TE.encodeUtf8 - appendNewlineE = (<>"\n") - parseTemplateE = parseTemplateE' B.unpack - -instance Replace LBS.ByteString where - lengthE = fromEnum . LBS.length - packE = LBS.pack - unpackE = LBS.unpack - textifyE = TE.decodeUtf8 . LBS.toStrict - detextifyE = LBS.fromStrict . TE.encodeUtf8 - appendNewlineE = (<>"\n") - parseTemplateE = parseTemplateE' LBS.unpack - -instance Replace (S.Seq Char) where - lengthE = S.length - packE = S.fromList - unpackE = F.toList - parseTemplateE = parseTemplateE' F.toList - -instance Replace T.Text where - lengthE = T.length - packE = T.pack - unpackE = T.unpack - textifyE = id - detextifyE = id - appendNewlineE = (<>"\n") - parseTemplateE = parseTemplateE' T.unpack - -instance Replace LT.Text where - lengthE = fromEnum . LT.length - packE = LT.pack - unpackE = LT.unpack - textifyE = LT.toStrict - detextifyE = LT.fromStrict - appendNewlineE = (<>"\n") - parseTemplateE = parseTemplateE' LT.unpack -\end{code} - -\begin{code} --- | expand all of the @{..} macros in the RE in the argument String --- according to the Macros argument, preprocessing the RE String --- according to the Mode argument (used internally) -expandMacros :: (r->String) -> Macros r -> String -> String -expandMacros x_src hm s = - case HM.null hm of - True -> s - False -> expandMacros' (fmap x_src . flip HM.lookup hm) s -\end{code} - -\begin{code} --- | expand the @{..} macos in the argument string using the given --- function -expandMacros' :: (MacroID->Maybe String) -> String -> String -expandMacros' lu = fixpoint e_m - where - e_m re_s = replaceAllCaptures TOP phi $ re_s $=~ [here|@(@|\{([^{}]+)\})|] - where - phi mtch _ cap = case txt == "@@" of - True -> Just "@" - False -> Just $ fromMaybe txt $ lu ide - where - txt = capturedText cap - ide = MacroID $ capturedText $ capture c2 mtch - c2 = IsCaptureOrdinal $ CaptureOrdinal 2 -\end{code} - -\begin{code} -lift_phi :: Monad m - => (Match a->Location->Capture a->Maybe a) - -> (Match a->Location->Capture a->m (Maybe a)) -lift_phi phi_ = phi - where - phi caps' loc' cap' = return $ phi_ caps' loc' cap' -\end{code} - -\begin{code} -parseTemplateE' :: ( Replace a - , RegexContext Regex a (Matches a) - , RegexMaker Regex CompOption ExecOption String - ) - => (a->String) - -> a - -> Match a - -> Location - -> Capture a - -> Maybe a -parseTemplateE' unpack tpl mtch _ _ = - Just $ replaceAllCaptures TOP phi $ - tpl $=~ [here|\$(\$|[0-9]|\{([^{}]+)\})|] - where - phi t_mtch _ _ = case t_mtch !$? c2 of - Just cap -> case readMaybe stg of - Nothing -> this $ IsCaptureName $ CaptureName $ T.pack stg - Just cn -> this $ IsCaptureOrdinal $ CaptureOrdinal cn - where - stg = unpack $ capturedText cap - Nothing -> case s == "$" of - True -> Just t - False -> this $ IsCaptureOrdinal $ CaptureOrdinal $ read s - where - s = unpack t - t = capturedText $ capture c1 t_mtch - - this cid = capturedText <$> mtch !$? cid - - c1 = IsCaptureOrdinal $ CaptureOrdinal 1 - c2 = IsCaptureOrdinal $ CaptureOrdinal 2 -\end{code} - -\begin{code} -fixpoint :: (Eq a) => (a->a) -> a -> a -fixpoint f = chk . iterate f - where - chk (x:x':_) | x==x' = x - chk xs = chk $ tail xs -\end{code} - -\begin{code} -($=~) :: ( RegexContext Regex source target - , RegexMaker Regex CompOption ExecOption String - ) - => source -> String -> target -($=~) = (=~) - -\end{code} diff --git a/Text/RE/TDFA.hs b/Text/RE/TDFA.hs --- a/Text/RE/TDFA.hs +++ b/Text/RE/TDFA.hs @@ -43,6 +43,7 @@ import Text.RE.TDFA.String() import Text.RE.TDFA.Text() import Text.RE.TDFA.Text.Lazy() +import Text.RE.Types.IsRegex -- | find all matches in text diff --git a/Text/RE/TDFA/ByteString.hs b/Text/RE/TDFA/ByteString.hs --- a/Text/RE/TDFA/ByteString.hs +++ b/Text/RE/TDFA/ByteString.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE B.ByteString where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TDFA/ByteString/Lazy.hs b/Text/RE/TDFA/ByteString/Lazy.hs --- a/Text/RE/TDFA/ByteString/Lazy.hs +++ b/Text/RE/TDFA/ByteString/Lazy.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE LBS.ByteString where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TDFA/RE.hs b/Text/RE/TDFA/RE.hs --- a/Text/RE/TDFA/RE.hs +++ b/Text/RE/TDFA/RE.hs @@ -42,6 +42,8 @@ , preludeSource , unpackSimpleRegexOptions , compileRegex + , compileRegexWith + , compileRegexWithOptions , escape , escapeREString ) where @@ -56,6 +58,8 @@ import Text.RE.Internal.PreludeMacros import Text.RE.Internal.QQ import Text.RE.TestBench +import Text.RE.Types.CaptureID +import Text.RE.Types.Options import Text.Regex.TDFA @@ -83,7 +87,7 @@ regexType :: RegexType regexType = - TDFA $ \txt env md -> txt =~ mdRegexSource regexType ExclCaptures env md + mkTDFA $ \txt env md -> txt =~ mdRegexSource regexType ExclCaptures env md data RE = RE @@ -156,14 +160,20 @@ BlockSensitive -> (,) False True BlockInsensitive -> (,) False False -compileRegex :: ( IsOption o RE CompOption ExecOption - , Functor m - , Monad m - ) - => o - -> String - -> m RE -compileRegex = compileRegex_ . makeOptions +compileRegex :: (Functor m,Monad m) => String -> m RE +compileRegex = compileRegexWithOptions () + +compileRegexWith :: (Functor m,Monad m) => SimpleRegexOptions -> String -> m RE +compileRegexWith = compileRegexWithOptions + +compileRegexWithOptions :: ( IsOption o RE CompOption ExecOption + , Functor m + , Monad m + ) + => o + -> String + -> m RE +compileRegexWithOptions = compileRegex_ . makeOptions compileRegex_ :: (Functor m,Monad m) => Options diff --git a/Text/RE/TDFA/Sequence.hs b/Text/RE/TDFA/Sequence.hs --- a/Text/RE/TDFA/Sequence.hs +++ b/Text/RE/TDFA/Sequence.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE (S.Seq Char) where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TDFA/String.hs b/Text/RE/TDFA/String.hs --- a/Text/RE/TDFA/String.hs +++ b/Text/RE/TDFA/String.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE String where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TDFA/Text.hs b/Text/RE/TDFA/Text.hs --- a/Text/RE/TDFA/Text.hs +++ b/Text/RE/TDFA/Text.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE T.Text where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TDFA/Text/Lazy.hs b/Text/RE/TDFA/Text/Lazy.hs --- a/Text/RE/TDFA/Text/Lazy.hs +++ b/Text/RE/TDFA/Text/Lazy.hs @@ -31,6 +31,7 @@ import Data.Typeable import Text.Regex.Base import Text.RE +import Text.RE.Types.IsRegex import Text.RE.Internal.AddCaptureNames import Text.RE.TDFA.RE import qualified Text.Regex.TDFA as TDFA @@ -71,9 +72,11 @@ (=~~) bs rex = addCaptureNames (reCaptureNames rex) <$> matchM (reRegex rex) bs instance IsRegex RE TL.Text where - matchOnce = flip (?=~) - matchMany = flip (*=~) - regexSource = reSource + matchOnce = flip (?=~) + matchMany = flip (*=~) + makeRegexWith = \o -> compileRegexWith o . unpackE + makeRegex = compileRegex . unpackE + regexSource = packE . reSource -- $tutorial -- We have a regex tutorial at . These API diff --git a/Text/RE/TestBench.lhs b/Text/RE/TestBench.lhs --- a/Text/RE/TestBench.lhs +++ b/Text/RE/TestBench.lhs @@ -10,7 +10,9 @@ module Text.RE.TestBench ( MacroID(..) - , RegexType(..) + , RegexType + , mkTDFA + , mkPCRE , isTDFA , isPCRE , presentRegexType @@ -43,9 +45,11 @@ import Data.String import Text.Printf import Prelude.Compat -import Text.RE.Capture -import Text.RE.Options -import Text.RE.Replace +import Text.RE.Types.Capture +import Text.RE.Types.Options +import Text.RE.Types.Match +import Text.RE.Types.Matches +import Text.RE.Types.Replace \end{code} Types @@ -70,6 +74,10 @@ isPCRE (TDFA _) = False isPCRE (PCRE _) = True + +mkTDFA, mkPCRE :: TestBenchMatcher -> RegexType +mkTDFA = TDFA +mkPCRE = PCRE presentRegexType :: RegexType -> String presentRegexType (TDFA _) = "TDFA" diff --git a/Text/RE/TestBench/Parsers.hs b/Text/RE/TestBench/Parsers.hs new file mode 100644 --- /dev/null +++ b/Text/RE/TestBench/Parsers.hs @@ -0,0 +1,166 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.RE.TestBench.Parsers + ( parseInteger + , parseHex + , parseDouble + , parseString + , parseSimpleString + , parseDate + , parseSlashesDate + , parseTimeOfDay + , parseTimeZone + , parseDateTime + , parseDateTime8601 + , parseDateTimeCLF + , parseShortMonth + , shortMonthArray + , IPV4Address + , parseIPv4Address + , Severity(..) + , parseSeverity + , severityKeywords + ) where + +import Data.Array +import qualified Data.HashMap.Strict as HM +import Data.Maybe +import qualified Data.Text as T +import Data.Time +import qualified Data.Time.Locale.Compat as LC +import Data.Word +import Text.Printf +import Text.Read +import Text.RE.Types.Replace + + +parseInteger :: Replace a => a -> Maybe Int +parseInteger = readMaybe . unpackE + +parseHex :: Replace a => a -> Maybe Int +parseHex = readMaybe . ("0x"++) . unpackE + +parseDouble :: Replace a => a -> Maybe Double +parseDouble = readMaybe . unpackE + +parseString :: Replace a => a -> Maybe T.Text +parseString = readMaybe . unpackE + +parseSimpleString :: Replace a => a -> Maybe T.Text +parseSimpleString = Just . T.dropEnd 1 . T.drop 1 . textifyE + +date_templates, time_templates, timezone_templates, + date_time_8601_templates, date_time_templates :: [String] +date_templates = ["%F"] +time_templates = ["%H:%M:%S","%H:%M:%S%Q","%H:%M"] +timezone_templates = ["Z","%z"] +date_time_8601_templates = + [ printf "%sT%s%s" dt tm tz + | dt <- date_templates + , tm <- time_templates + , tz <- timezone_templates + ] +date_time_templates = + [ printf "%s%c%s%s" dt sc tm tz + | dt <- date_templates + , sc <- ['T',' '] + , tm <- time_templates + , tz <- timezone_templates ++ [" UTC",""] + ] + +parseDate :: Replace a => a -> Maybe Day +parseDate = parse_time date_templates + +parseSlashesDate :: Replace a => a -> Maybe Day +parseSlashesDate = parse_time ["%Y/%m/%d"] + +parseTimeOfDay :: Replace a => a -> Maybe TimeOfDay +parseTimeOfDay = parse_time time_templates + +parseTimeZone :: Replace a => a -> Maybe TimeZone +parseTimeZone = parse_time timezone_templates + +parseDateTime :: Replace a => a -> Maybe UTCTime +parseDateTime = parse_time date_time_templates + +parseDateTime8601 :: Replace a => a -> Maybe UTCTime +parseDateTime8601 = parse_time date_time_8601_templates + +parseDateTimeCLF :: Replace a => a -> Maybe UTCTime +parseDateTimeCLF = parse_time ["%d/%b/%Y:%H:%M:%S %z"] + +parseShortMonth :: Replace a => a -> Maybe Int +parseShortMonth = flip HM.lookup short_month_hm . unpackE + +parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t +parse_time tpls = prs . unpackE + where + prs s = listToMaybe $ catMaybes + [ parseTime LC.defaultTimeLocale fmt s + | fmt<-tpls + ] + +short_month_hm :: HM.HashMap String Int +short_month_hm = HM.fromList [ (T.unpack $ shortMonthArray!i,i) | i<-[1..12] ] + +shortMonthArray :: Array Int T.Text +shortMonthArray = listArray (1,12) $ + T.words "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" + +type IPV4Address = (Word8,Word8,Word8,Word8) + +parseIPv4Address :: Replace a => a -> Maybe IPV4Address +parseIPv4Address = prs . words_by (=='.') . unpackE + where + prs [a_s,b_s,c_s,d_s] = do + a <- readMaybe a_s + b <- readMaybe b_s + c <- readMaybe c_s + d <- readMaybe d_s + case all is_o [a,b,c,d] of + True -> Just (toEnum a,toEnum b,toEnum c,toEnum d) + False -> Nothing + prs _ = Nothing + + is_o x = 0 <= x && x <= 255 + +data Severity + = Emerg + | Alert + | Crit + | Err + | Warning + | Notice + | Info + | Debug + deriving (Bounded,Enum,Ord,Eq,Show) + +parseSeverity :: Replace a => a -> Maybe Severity +parseSeverity = flip HM.lookup severity_hm . textifyE + +severity_hm :: HM.HashMap T.Text Severity +severity_hm = HM.fromList + [ (kw,pri) + | pri<-[minBound..maxBound] + , let (kw0,kws) = severityKeywords pri + , kw <- kw0:kws + ] + +severityKeywords :: Severity -> (T.Text,[T.Text]) +severityKeywords pri = case pri of + Emerg -> (,) "emerg" ["panic"] + Alert -> (,) "alert" [] + Crit -> (,) "crit" [] + Err -> (,) "err" ["error"] + Warning -> (,) "warning" ["warn"] + Notice -> (,) "notice" [] + Info -> (,) "info" [] + Debug -> (,) "debug" [] + +words_by :: (Char->Bool) -> String -> [String] +words_by f s = case dropWhile f s of + "" -> [] + s' -> w : words_by f s'' + where + (w, s'') = break f s' diff --git a/Text/RE/Tools/Edit.lhs b/Text/RE/Tools/Edit.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Tools/Edit.lhs @@ -0,0 +1,98 @@ +\begin{code} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Text.RE.Tools.Edit + ( LineNo + , Edits(..) + , Edit(..) + , LineEdit(..) + , applyEdits + , applyEdit + , applyLineEdit + ) where + +import Data.Maybe +import Prelude.Compat +import Text.RE.Types.Capture +import Text.RE.Types.Match +import Text.RE.Types.Matches +import Text.RE.Types.IsRegex +import Text.RE.Types.LineNo +import Text.RE.Types.Replace + + +data Edits m re s + = Select [(re,Edit m s)] + | Pipe [(re,Edit m s)] + +data Edit m s + = Template s + | Function Context (LineNo->Match s->Location->Capture s->m (Maybe s)) + | LineEdit (LineNo->Matches s->m (LineEdit s)) + +data LineEdit s + = NoEdit + | ReplaceWith s + | Delete + deriving (Show) + +applyEdits :: (IsRegex re s,Monad m,Functor m) + => LineNo + -> Edits m re s + -> s + -> m s +applyEdits lno ez0 s0 = case ez0 of + Select ez -> select_edit_scripts lno ez s0 + Pipe ez -> pipe_edit_scripts lno ez s0 + +applyEdit :: (IsRegex re s,Monad m,Functor m) + => (s->s) + -> LineNo + -> re + -> Edit m s + -> s + -> m (Maybe s) +applyEdit anl lno re edit s = + case allMatches acs of + [] -> return Nothing + _ -> fmap Just $ case edit of + Template tpl -> return $ anl $ replaceAll tpl acs + Function ctx f -> anl <$> replaceAllCapturesM replaceMethods ctx (f lno) acs + LineEdit g -> fromMaybe s' . applyLineEdit anl <$> g lno acs + where + s' = anl s + acs = matchMany re s + +applyLineEdit :: Monoid s => (s->s) -> LineEdit s -> Maybe s +applyLineEdit _ NoEdit = Nothing +applyLineEdit anl (ReplaceWith s) = Just $ anl s +applyLineEdit _ Delete = Just $ mempty + +select_edit_scripts :: (IsRegex re s,Monad m,Functor m) + => LineNo + -> [(re,Edit m s)] + -> s + -> m s +select_edit_scripts lno ps0 s = select ps0 + where + select [] = return $ appendNewlineE s + select ((re,es):ps) = + applyEdit appendNewlineE lno re es s >>= maybe (select ps) return + +pipe_edit_scripts :: (IsRegex re s,Monad m,Functor m) + => LineNo + -> [(re,Edit m s)] + -> s + -> m s +pipe_edit_scripts lno ez s0 = + appendNewlineE <$> foldr f (return s0) ez + where + f (re,es) act = do + s <- act + fromMaybe s <$> applyEdit id lno re es s +\end{code} diff --git a/Text/RE/Tools/Grep.lhs b/Text/RE/Tools/Grep.lhs --- a/Text/RE/Tools/Grep.lhs +++ b/Text/RE/Tools/Grep.lhs @@ -11,14 +11,17 @@ , GrepScript , grepScript , linesMatched + , module Text.RE + , module Text.RE.Types.IsRegex + , module Text.RE.Types.LineNo ) where import qualified Data.ByteString.Lazy.Char8 as LBS import Prelude.Compat import Text.Printf -import Text.RE.Capture -import Text.RE.IsRegex -import Text.RE.LineNo +import Text.RE +import Text.RE.Types.IsRegex +import Text.RE.Types.LineNo data Line = diff --git a/Text/RE/Tools/Lex.lhs b/Text/RE/Tools/Lex.lhs --- a/Text/RE/Tools/Lex.lhs +++ b/Text/RE/Tools/Lex.lhs @@ -1,12 +1,16 @@ \begin{code} {-# LANGUAGE NoImplicitPrelude #-} -module Text.RE.Tools.Lex where +module Text.RE.Tools.Lex + ( alex + , alex' + , module Text.RE + , module Text.RE.Types.IsRegex + ) where import Prelude.Compat -import Text.RE.Capture -import Text.RE.IsRegex -import Text.RE.Replace +import Text.RE +import Text.RE.Types.IsRegex alex :: IsRegex re s => [(re,Match s->Maybe t)] -> t -> s -> [t] diff --git a/Text/RE/Tools/Sed.lhs b/Text/RE/Tools/Sed.lhs --- a/Text/RE/Tools/Sed.lhs +++ b/Text/RE/Tools/Sed.lhs @@ -11,13 +11,18 @@ ( SedScript , sed , sed' + , module Text.RE + , module Text.RE.Types.IsRegex + , module Text.RE.Tools.Edit + , module Text.RE.Types.LineNo ) where import qualified Data.ByteString.Lazy.Char8 as LBS import Prelude.Compat -import Text.RE.Edit -import Text.RE.LineNo -import Text.RE.IsRegex +import Text.RE +import Text.RE.Tools.Edit +import Text.RE.Types.LineNo +import Text.RE.Types.IsRegex type SedScript re = Edits IO re LBS.ByteString @@ -35,14 +40,14 @@ ] write_file o_fp $ LBS.concat lns' -sed' :: (IsRegex re LBS.ByteString,Monad m,Functor m) - => Edits m re LBS.ByteString - -> LBS.ByteString - -> m LBS.ByteString +sed' :: (IsRegex re a,Monad m,Functor m) + => Edits m re a + -> a + -> m a sed' as lbs = do - LBS.concat <$> sequence + mconcat <$> sequence [ applyEdits lno as s - | (lno,s)<-zip [firstLine..] $ LBS.lines lbs + | (lno,s)<-zip [firstLine..] $ linesE lbs ] read_file :: FilePath -> IO LBS.ByteString diff --git a/Text/RE/Types/Capture.lhs b/Text/RE/Types/Capture.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/Capture.lhs @@ -0,0 +1,61 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +\end{code} + +\begin{code} +module Text.RE.Types.Capture + ( Capture(..) + , hasCaptured + , capturePrefix + , captureSuffix + ) where +\end{code} + +\begin{code} +import Text.Regex.Base +\end{code} + + + +\begin{code} +-- | the matching of a single sub-expression against part of the source +-- text +data Capture a = + Capture + { captureSource :: !a -- ^ the whole text that was searched + , capturedText :: !a -- ^ the text that was matched + , captureOffset :: !Int -- ^ the number of characters preceding the + -- match with -1 used if no text was captured + -- by the RE (not even the empty string) + , captureLength :: !Int -- ^ the number of chacter in the captured + -- sub-string + } + deriving (Show,Eq) +\end{code} + +\begin{code} +instance Functor Capture where + fmap f c@Capture{..} = + c + { captureSource = f captureSource + , capturedText = f capturedText + } +\end{code} + +\begin{code} +-- | test if the capture has matched any text +hasCaptured :: Capture a -> Bool +hasCaptured = (>=0) . captureOffset + +-- | returns the text preceding the match +capturePrefix :: Extract a => Capture a -> a +capturePrefix Capture{..} = before captureOffset captureSource + +-- | returns the text after the match +captureSuffix :: Extract a => Capture a -> a +captureSuffix Capture{..} = after (captureOffset+captureLength) captureSource +\end{code} diff --git a/Text/RE/Types/CaptureID.hs b/Text/RE/Types/CaptureID.hs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/CaptureID.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Text.RE.Types.CaptureID where + +import Data.Ix +import Data.Hashable +import qualified Data.HashMap.Strict as HMS +import Data.Maybe +import qualified Data.Text as T + + +-- | CaptureID identifies captures, either by number +-- (e.g., [cp|1|]) or name (e.g., [cp|foo|]). +data CaptureID + = IsCaptureOrdinal CaptureOrdinal + | IsCaptureName CaptureName + deriving (Show,Ord,Eq) + +-- | the dictionary for named captures stored in compiled regular +-- expressions associates +type CaptureNames = HMS.HashMap CaptureName CaptureOrdinal + +-- | an empty 'CaptureNames' dictionary +noCaptureNames :: CaptureNames +noCaptureNames = HMS.empty + +-- | a 'CaptureName' is just the text of the name +newtype CaptureName = CaptureName { getCaptureName :: T.Text } + deriving (Show,Ord,Eq) + +instance Hashable CaptureName where + hashWithSalt i = hashWithSalt i . getCaptureName + +-- | a 'CaptureOrdinal' is just the number of the capture, starting +-- with 0 for the whole of the text matched, then in leftmost, +-- outermost +newtype CaptureOrdinal = CaptureOrdinal { getCaptureOrdinal :: Int } + deriving (Show,Ord,Eq,Enum,Ix,Num) + +-- | look up a 'CaptureID' in the 'CaptureNames' dictionary +findCaptureID :: CaptureID -> CaptureNames -> Int +findCaptureID (IsCaptureOrdinal o) _ = getCaptureOrdinal o +findCaptureID (IsCaptureName n) hms = + getCaptureOrdinal $ fromMaybe oops $ HMS.lookup n hms + where + oops = error $ unlines $ + ("lookupCaptureID: " ++ T.unpack t ++ " not found in:") : + [ " "++T.unpack (getCaptureName nm) | nm <- HMS.keys hms ] + t = getCaptureName n diff --git a/Text/RE/Types/IsRegex.lhs b/Text/RE/Types/IsRegex.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/IsRegex.lhs @@ -0,0 +1,25 @@ +\begin{code} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Text.RE.Types.IsRegex where + +import Text.RE.Types.Match +import Text.RE.Types.Matches +import Text.RE.Types.Options +import Text.RE.Types.Replace +\end{code} + + +\begin{code} +class Replace s => IsRegex re s where + matchOnce :: re -> s -> Match s + matchMany :: re -> s -> Matches s + makeRegex :: (Functor m,Monad m) => s -> m re + makeRegexWith :: (Functor m,Monad m) => SimpleRegexOptions -> s -> m re + regexSource :: re -> s +\end{code} diff --git a/Text/RE/Types/LineNo.hs b/Text/RE/Types/LineNo.hs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/LineNo.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Text.RE.Types.LineNo where + + +newtype LineNo = + ZeroBasedLineNo { getZeroBasedLineNo :: Int } + deriving (Show,Enum) + + +firstLine :: LineNo +firstLine = ZeroBasedLineNo 0 + +getLineNo :: LineNo -> Int +getLineNo = (+1) . getZeroBasedLineNo + +lineNo :: Int -> LineNo +lineNo = ZeroBasedLineNo . (\x->x-1) diff --git a/Text/RE/Types/Match.lhs b/Text/RE/Types/Match.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/Match.lhs @@ -0,0 +1,193 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +\end{code} + +\begin{code} +module Text.RE.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.Regex.Base +import Text.RE.Types.Capture +import Text.RE.Types.CaptureID + +infixl 9 !$, !$$ +\end{code} + +\begin{code} +-- | the result of matching a RE to a text once, listing the text that +-- was matched and the named captures in the RE and all of the substrings +-- matched, with the text captured by the whole RE; a complete failure +-- to match will be represented with an empty array (with bounds (0,-1)) +data Match a = + Match + { matchSource :: !a -- ^ the whole source text + , captureNames :: !CaptureNames -- ^ the RE's capture names + , matchArray :: !(Array CaptureOrdinal (Capture a)) + -- ^ 0..n-1 captures, + -- starting with the + -- text matched by the + -- whole RE + } + deriving (Show,Eq,Typeable) +\end{code} + +\begin{code} +-- | Construct a Match that does not match anything. +noMatch :: a -> Match a +noMatch t = Match t noCaptureNames emptyMatchArray + +-- | an empty array of Capture +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} +-- | tests whether the RE matched the source text at all +matched :: Match a -> Bool +matched = isJust . matchCapture + +-- | tests whether the RE matched the source text at all +matchedText :: Match a -> Maybe a +matchedText = fmap capturedText . matchCapture + +-- | the top-level capture if the source text matched the RE, +-- Nothing otherwise +matchCapture :: Match a -> Maybe (Capture a) +matchCapture = fmap fst . matchCaptures + +-- | the top-level capture and the sub captures if the text matched +-- the RE, Nothing otherwise +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) + +-- | an alternative for captureText +(!$$) :: Match a -> CaptureID -> a +(!$$) = flip captureText + +-- | look up the text of the nth capture, 0 being the match of the whole +-- RE against the source text, 1, the first bracketed sub-expression to +-- be matched and so on +captureText :: CaptureID -> Match a -> a +captureText cid mtch = capturedText $ capture cid mtch + +-- | an alternative for captureTextMaybe +(!$$?) :: Match a -> CaptureID -> Maybe a +(!$$?) = flip captureTextMaybe + +-- | look up the text of the nth capture (0 being the match of the +-- whole), returning Nothing if the Match doesn't contain the capture +captureTextMaybe :: CaptureID -> Match a -> Maybe a +captureTextMaybe cid mtch = do + cap <- mtch !$? cid + case hasCaptured cap of + True -> Just $ capturedText cap + False -> Nothing + +-- | an alternative for capture +(!$) :: Match a -> CaptureID -> Capture a +(!$) = flip capture + +-- | look up the nth capture, 0 being the match of the whole RE against +-- the source text, 1, the first bracketed sub-expression to be matched +-- and so on +capture :: CaptureID -> Match a -> Capture a +capture cid mtch = fromMaybe oops $ mtch !$? cid + where + oops = error $ "capture: out of bounds (" ++ show cid ++ ")" + +-- | an alternative for capture captureMaybe +(!$?) :: Match a -> CaptureID -> Maybe (Capture a) +(!$?) = flip captureMaybe + +-- | look up the nth capture, 0 being the match of the whole RE against +-- the source text, 1, the first bracketed sub-expression to be matched +-- and so on, returning Nothing if there is no such capture, or if the +-- capture failed to capture anything (being in a failed alternate) +captureMaybe :: CaptureID -> Match a -> Maybe (Capture a) +captureMaybe cid mtch@Match{..} = do + cap <- case bounds matchArray `inRange` CaptureOrdinal i of + True -> Just $ matchArray ! CaptureOrdinal i + False -> Nothing + case hasCaptured cap of + True -> Just cap + False -> Nothing + where + i = lookupCaptureID cid mtch + +lookupCaptureID :: CaptureID -> Match a -> Int +lookupCaptureID cid Match{..} = findCaptureID cid captureNames +\end{code} + + +\begin{code} +-- | for matching just the first RE against the source text +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} +-- | convert a regex-base native MatchText into a regex Match type +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} diff --git a/Text/RE/Types/Matches.lhs b/Text/RE/Types/Matches.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/Matches.lhs @@ -0,0 +1,81 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +\end{code} + +\begin{code} +module Text.RE.Types.Matches + ( Matches(..) + , anyMatches + , countMatches + , matches + , mainCaptures + ) where +\end{code} + +\begin{code} +import Data.Typeable +import Text.Regex.Base +import Text.RE.Types.Capture +import Text.RE.Types.CaptureID +import Text.RE.Types.Match +\end{code} + + + +\begin{code} +-- | the result type to use when every match is needed, not just the +-- first match of the RE against the source +data Matches a = + Matches + { matchesSource :: !a -- ^ the source text being matched + , allMatches :: ![Match a] -- ^ all captures found, left to right + } + deriving (Show,Eq,Typeable) +\end{code} + +\begin{code} +instance Functor Matches where + fmap f Matches{..} = + Matches + { matchesSource = f matchesSource + , allMatches = map (fmap f) allMatches + } +\end{code} + +\begin{code} +-- | tests whether the RE matched the source text at all +anyMatches :: Matches a -> Bool +anyMatches = not . null . allMatches + +-- | count the matches +countMatches :: Matches a -> Int +countMatches = length . allMatches + +-- | list the Matches +matches :: Matches a -> [a] +matches = map capturedText . mainCaptures + +-- | extract the main capture from each match +mainCaptures :: Matches a -> [Capture a] +mainCaptures ac = [ capture c0 cs | cs<-allMatches ac ] + where + c0 = IsCaptureOrdinal $ CaptureOrdinal 0 +\end{code} + + +\begin{code} +-- | for matching all REs against the source text +instance + ( RegexContext regex source [MatchText source] + , RegexLike regex source + ) => + RegexContext regex source (Matches source) where + match r s = Matches s $ map (convertMatchText s) $ match r s + matchM r s = do + y <- matchM r s + return $ Matches s $ map (convertMatchText s) y +\end{code} diff --git a/Text/RE/Types/Options.lhs b/Text/RE/Types/Options.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/Options.lhs @@ -0,0 +1,69 @@ +\begin{code} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} + +module Text.RE.Types.Options where + +import Data.Hashable +import qualified Data.HashMap.Strict as HM +import Data.String +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +\end{code} + +\begin{code} +data Options_ r c e = + Options + { optionsMacs :: !(Macros r) + , optionsComp :: !c + , optionsExec :: !e + } + deriving (Show) +\end{code} + +\begin{code} +class IsOption o r c e | + e -> r, c -> e , e -> c, r -> c, c -> r, r -> e where + makeOptions :: o -> Options_ r c e +\end{code} + +\begin{code} +newtype MacroID = + MacroID { getMacroID :: String } + deriving (IsString,Ord,Eq,Show) +\end{code} + +\begin{code} +instance Hashable MacroID where + hashWithSalt i = hashWithSalt i . getMacroID +\end{code} + +\begin{code} +type Macros r = HM.HashMap MacroID r +\end{code} + +\begin{code} +emptyMacros :: Macros r +emptyMacros = HM.empty +\end{code} + +\begin{code} +data SimpleRegexOptions + = MultilineSensitive + | MultilineInsensitive + | BlockSensitive + | BlockInsensitive + deriving (Bounded,Enum,Eq,Ord,Show) +\end{code} + +\begin{code} +instance Lift SimpleRegexOptions where + lift sro = case sro of + MultilineSensitive -> conE 'MultilineSensitive + MultilineInsensitive -> conE 'MultilineInsensitive + BlockSensitive -> conE 'BlockSensitive + BlockInsensitive -> conE 'BlockInsensitive +\end{code} diff --git a/Text/RE/Types/Replace.lhs b/Text/RE/Types/Replace.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/Types/Replace.lhs @@ -0,0 +1,471 @@ +\begin{code} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module Text.RE.Types.Replace + ( Replace(..) + , ReplaceMethods(..) + , replaceMethods + , Context(..) + , Location(..) + , isTopLocation + , replace + , replaceAll + , replaceAllCaptures + , replaceAllCaptures_ + , replaceAllCapturesM + , replaceCaptures + , replaceCaptures_ + , replaceCapturesM + , expandMacros + , expandMacros' + ) where + +import Control.Applicative +import Data.Array +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Char +import qualified Data.Foldable as F +import Data.Functor.Identity +import qualified Data.HashMap.Strict as HM +import Data.Maybe +import Data.Monoid +import qualified Data.Sequence as S +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as LT +import Prelude.Compat +import Text.Heredoc +import Text.RE.Types.Capture +import Text.RE.Types.CaptureID +import Text.RE.Types.Match +import Text.RE.Types.Matches +import Text.RE.Types.Options +import Text.Read +import Text.Regex.TDFA +import Text.Regex.TDFA.Text() +import Text.Regex.TDFA.Text.Lazy() +\end{code} + +\begin{code} +-- | Replace provides the missing methods needed to replace the matched +-- text; lengthE is the minimum implementation +class (Show a,Eq a,Ord a,Extract a,Monoid a) => Replace a where + -- | length function for a + lengthE :: a -> Int + -- | inject String into a + packE :: String -> a + -- | project a onto a String + unpackE :: a -> String + -- | inject into Text + textifyE :: a -> T.Text + -- | project Text onto a + detextifyE :: T.Text -> a + -- | split into lines + linesE :: a -> [a] + -- | concatenate a list of lines + unlinesE :: [a] -> a + -- | append a newline + appendNewlineE :: a -> a + -- | apply a substitution function to a Capture + substE :: (a->a) -> Capture a -> a + -- | convert a template containing $0, $1, etc., in the first + -- argument, into a 'phi' replacement function for use with + -- replaceAllCaptures and replaceCaptures + parseTemplateE :: a -> Match a -> Location -> Capture a -> Maybe a + + textifyE = T.pack . unpackE + detextifyE = packE . T.unpack + appendNewlineE = (<> packE "\n") + + substE f m@Capture{..} = + capturePrefix m <> f capturedText <> captureSuffix m +\end{code} + +\begin{code} +-- | a selction of the Replace methods can be encapsulated with ReplaceMethods +-- for the higher-order replacement functions +data ReplaceMethods a = + ReplaceMethods + { methodLength :: a -> Int + , methodSubst :: (a->a) -> Capture a -> a + } + +-- | replaceMethods encapsulates ReplaceMethods a from a Replace a context +replaceMethods :: Replace a => ReplaceMethods a +replaceMethods = + ReplaceMethods + { methodLength = lengthE + , methodSubst = substE + } +\end{code} + +\begin{code} +-- | @Context@ specifies which contexts the substitutions should be applied +data Context + = TOP -- ^ substitutions should be applied to the top-level only, + -- the text that matched the whole RE + | SUB -- ^ substitutions should only be applied to the text + -- captured by bracketed sub-REs + | ALL -- ^ the substitution function should be applied to all + -- captures, the top level and the sub-expression captures + deriving (Show) + +-- | the @Location@ information passed into the substitution function +-- specifies which sub-expression is being substituted +data Location = + Location + { locationMatch :: Int + -- ^ the zero-based, i-th string to be matched, + -- when matching all strings, zero when only the + -- first string is being matched + , locationCapture :: CaptureOrdinal + -- ^ 0, when matching the top-level string + -- matched by the whole RE, 1 for the top-most, + -- left-most redex captured by bracketed + -- sub-REs, etc. + } + deriving (Show) +\end{code} + +\begin{code} +-- | True iff the location references a complete match +-- (i.e., not a bracketed capture) +isTopLocation :: Location -> Bool +isTopLocation = (==0) . locationCapture +\end{code} + +\begin{code} +-- | replace all with a template, $0 for whole text, $1 for first +-- capture, etc. +replaceAll :: Replace a + => a + -> Matches a + -> a +replaceAll tpl ac = replaceAllCaptures TOP (parseTemplateE tpl) ac +\end{code} + +\begin{code} +-- | substitutes using a function that takes the full Match +-- context and returns the same replacement text as the _phi_phi +-- context. +replaceAllCaptures :: Replace a + => Context + -> (Match a->Location->Capture a->Maybe a) + -> Matches a + -> a +\end{code} + +\begin{code} +replaceAllCaptures = replaceAllCaptures_ replaceMethods +\end{code} + +\begin{code} +-- | replaceAllCaptures_ is like like replaceAllCaptures but takes the +-- Replace methods through the ReplaceMethods argument +replaceAllCaptures_ :: Extract a + => ReplaceMethods a + -> Context + -> (Match a->Location->Capture a->Maybe a) + -> Matches a + -> a +replaceAllCaptures_ s ctx phi ac = + runIdentity $ replaceAllCapturesM s ctx (lift_phi phi) ac +\end{code} + +\begin{code} +-- | replaceAllCapturesM is just a monadically generalised version of +-- replaceAllCaptures_ +replaceAllCapturesM :: (Extract a,Monad m) + => ReplaceMethods a + -> Context + -> (Match a->Location->Capture a->m (Maybe a)) + -> Matches a + -> m a +replaceAllCapturesM r ctx phi_ Matches{..} = + replaceCapturesM r ALL phi $ Match matchesSource cnms arr + where + phi _ (Location _ i) = case arr_c!i of + Just caps -> phi_ caps . uncurry Location $ arr_i ! i + Nothing -> const $ return Nothing + + arr_c = listArray bds $ + concat $ + [ repl (rangeSize $ bounds $ matchArray cs) cs + | cs <- allMatches + ] + + arr_i = listArray bds j_ks + + arr = listArray bds $ + [ arr_ ! k + | arr_ <- map matchArray allMatches + , k <- indices arr_ + ] + + bds = (0,CaptureOrdinal $ length j_ks-1) + + j_ks = + [ (j,k) + | (j,arr_) <- zip [0..] $ map matchArray allMatches + , k <- indices arr_ + ] + + repl 0 _ = [] + repl n x = case ctx of + TOP -> Just x : replicate (n-1) Nothing + SUB -> Nothing : replicate (n-1) (Just x) + ALL -> replicate n $ Just x + + cnms = fromMaybe noCaptureNames $ listToMaybe $ map captureNames allMatches +\end{code} + +\begin{code} +-- | replace with a template containing $0 for whole text, +-- $1 for first capture, etc. +replace :: Replace a + => Match a + -> a + -> a +replace c tpl = replaceCaptures TOP (parseTemplateE tpl) c +\end{code} + +\begin{code} +-- | substitutes using a function that takes the full Match +-- context and returns the same replacement text as the _phi_phi +-- context. +replaceCaptures :: Replace a + => Context + -> (Match a->Location->Capture a->Maybe a) + -> Match a + -> a +replaceCaptures = replaceCaptures_ replaceMethods +\end{code} + +\begin{code} +-- | replaceCaptures_ is like replaceCaptures but takes the Replace methods +-- through the ReplaceMethods argument +replaceCaptures_ :: Extract a + => ReplaceMethods a + -> Context + -> (Match a->Location->Capture a->Maybe a) + -> Match a + -> a +replaceCaptures_ s ctx phi caps = + runIdentity $ replaceCapturesM s ctx (lift_phi phi) caps +\end{code} + +\begin{code} +-- | replaceCapturesM is just a monadically generalised version of +-- replaceCaptures_ +replaceCapturesM :: (Monad m,Extract a) + => ReplaceMethods a + -> Context + -> (Match a->Location->Capture a->m (Maybe a)) + -> Match a + -> m a +replaceCapturesM ReplaceMethods{..} ctx phi_ caps@Match{..} = do + (hay',_) <- foldr sc (return (matchSource,[])) $ + zip [0..] $ elems matchArray + return hay' + where + sc (i,cap0) act = do + (hay,ds) <- act + let ndl = capturedText cap + cap = adj hay ds cap0 + mb <- phi i cap + case mb of + Nothing -> return (hay,ds) + Just ndl' -> + return + ( methodSubst (const ndl') cap + , (captureOffset cap,len'-len) : ds + ) + where + len' = methodLength ndl' + len = methodLength ndl + + adj hay ds cap = + Capture + { captureSource = hay + , capturedText = before len $ after off0 hay + , captureOffset = off0 + , captureLength = len + } + where + len = len0 + sum + [ delta + | (off,delta) <- ds + , off < off0 + len0 + ] + len0 = captureLength cap + off0 = captureOffset cap + + phi i cap = case ctx of + TOP | i/=0 -> return Nothing + SUB | i==0 ->return Nothing + _ -> + case not $ hasCaptured cap of + True -> return Nothing + False -> phi_ caps (Location 0 i) cap +\end{code} + +\begin{code} +-- the Replace instances + +instance Replace [Char] where + lengthE = length + packE = id + unpackE = id + textifyE = T.pack + detextifyE = T.unpack + linesE = lines + unlinesE = unlines + appendNewlineE = (<>"\n") + parseTemplateE = parseTemplateE' id + +instance Replace B.ByteString where + lengthE = B.length + packE = B.pack + unpackE = B.unpack + textifyE = TE.decodeUtf8 + detextifyE = TE.encodeUtf8 + linesE = B.lines + unlinesE = B.unlines + appendNewlineE = (<>"\n") + parseTemplateE = parseTemplateE' B.unpack + +instance Replace LBS.ByteString where + lengthE = fromEnum . LBS.length + packE = LBS.pack + unpackE = LBS.unpack + textifyE = TE.decodeUtf8 . LBS.toStrict + linesE = LBS.lines + unlinesE = LBS.unlines + detextifyE = LBS.fromStrict . TE.encodeUtf8 + appendNewlineE = (<>"\n") + parseTemplateE = parseTemplateE' LBS.unpack + +instance Replace (S.Seq Char) where + lengthE = S.length + packE = S.fromList + unpackE = F.toList + linesE = map packE . lines . unpackE + unlinesE = packE . unlines . map unpackE + parseTemplateE = parseTemplateE' F.toList + +instance Replace T.Text where + lengthE = T.length + packE = T.pack + unpackE = T.unpack + textifyE = id + detextifyE = id + linesE = T.lines + unlinesE = T.unlines + appendNewlineE = (<>"\n") + parseTemplateE = parseTemplateE' T.unpack + +instance Replace LT.Text where + lengthE = fromEnum . LT.length + packE = LT.pack + unpackE = LT.unpack + textifyE = LT.toStrict + detextifyE = LT.fromStrict + linesE = LT.lines + unlinesE = LT.unlines + appendNewlineE = (<>"\n") + parseTemplateE = parseTemplateE' LT.unpack +\end{code} + +\begin{code} +-- | expand all of the @{..} macros in the RE in the argument String +-- according to the Macros argument, preprocessing the RE String +-- according to the Mode argument (used internally) +expandMacros :: (r->String) -> Macros r -> String -> String +expandMacros x_src hm s = + case HM.null hm of + True -> s + False -> expandMacros' (fmap x_src . flip HM.lookup hm) s +\end{code} + +\begin{code} +-- | expand the @{..} macos in the argument string using the given +-- function +expandMacros' :: (MacroID->Maybe String) -> String -> String +expandMacros' lu = fixpoint e_m + where + e_m re_s = replaceAllCaptures TOP phi $ re_s $=~ [here|@(@|\{([^{}]+)\})|] + where + phi mtch _ cap = case txt == "@@" of + True -> Just "@" + False -> Just $ fromMaybe txt $ lu ide + where + txt = capturedText cap + ide = MacroID $ capturedText $ capture c2 mtch + c2 = IsCaptureOrdinal $ CaptureOrdinal 2 +\end{code} + +\begin{code} +lift_phi :: Monad m + => (Match a->Location->Capture a->Maybe a) + -> (Match a->Location->Capture a->m (Maybe a)) +lift_phi phi_ = phi + where + phi caps' loc' cap' = return $ phi_ caps' loc' cap' +\end{code} + +\begin{code} +parseTemplateE' :: ( Replace a + , RegexContext Regex a (Matches a) + , RegexMaker Regex CompOption ExecOption String + ) + => (a->String) + -> a + -> Match a + -> Location + -> Capture a + -> Maybe a +parseTemplateE' unpack tpl mtch _ _ = + Just $ replaceAllCaptures TOP phi $ + tpl $=~ [here|\$(\$|[0-9]|\{([^{}]+)\})|] + where + phi t_mtch _ _ = case t_mtch !$? c2 of + Just cap -> case readMaybe stg of + Nothing -> this $ IsCaptureName $ CaptureName $ T.pack stg + Just cn -> this $ IsCaptureOrdinal $ CaptureOrdinal cn + where + stg = unpack $ capturedText cap + Nothing -> case s == "$" of + True -> Just t + False -> this $ IsCaptureOrdinal $ CaptureOrdinal $ read s + where + s = unpack t + t = capturedText $ capture c1 t_mtch + + this cid = capturedText <$> mtch !$? cid + + c1 = IsCaptureOrdinal $ CaptureOrdinal 1 + c2 = IsCaptureOrdinal $ CaptureOrdinal 2 +\end{code} + +\begin{code} +fixpoint :: (Eq a) => (a->a) -> a -> a +fixpoint f = chk . iterate f + where + chk (x:x':_) | x==x' = x + chk xs = chk $ tail xs +\end{code} + +\begin{code} +($=~) :: ( RegexContext Regex source target + , RegexMaker Regex CompOption ExecOption String + ) + => source -> String -> target +($=~) = (=~) + +\end{code} diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,12 @@ -*-change-log-*- +0.7.0.0 Chris Dornan 2017-03-15 + * Fix and extend Replace class (#74) + * Better package organisation (#73) + * Generalise sed' in progress (#72) + * compileRegex to take just a string (#68) + * Fix comment reference in Text.RE.PCRE in progress (#66) + 0.6.0.1 Chris Dornan 2017-03-13 * Fix .travis.yml release-stack script (#67) diff --git a/regex.cabal b/regex.cabal --- a/regex.cabal +++ b/regex.cabal @@ -1,5 +1,5 @@ Name: regex -Version: 0.6.0.1 +Version: 0.7.0.0 Synopsis: Toolkit for regex-base Description: A Regular Expression Toolkit for regex-base with Compile-time checking of RE syntax, data types for @@ -31,7 +31,7 @@ Source-Repository this Type: git Location: https://github.com/iconnect/regex.git - Tag: 0.6.0.1 + Tag: 0.7.0.0 @@ -40,19 +40,13 @@ Hs-Source-Dirs: . Exposed-Modules: Text.RE - Text.RE.Capture - Text.RE.CaptureID - Text.RE.Edit Text.RE.Internal.AddCaptureNames Text.RE.Internal.EscapeREString Text.RE.Internal.NamedCaptures Text.RE.Internal.PreludeMacros Text.RE.Internal.QQ - Text.RE.IsRegex - Text.RE.LineNo - Text.RE.Options - Text.RE.Parsers - Text.RE.Replace + Text.RE.Types.IsRegex + Text.RE.Types.Replace Text.RE.TDFA Text.RE.TDFA.ByteString Text.RE.TDFA.ByteString.Lazy @@ -62,9 +56,17 @@ Text.RE.TDFA.Text Text.RE.TDFA.Text.Lazy Text.RE.TestBench + Text.RE.TestBench.Parsers + Text.RE.Tools.Edit Text.RE.Tools.Grep Text.RE.Tools.Lex Text.RE.Tools.Sed + Text.RE.Types.Capture + Text.RE.Types.CaptureID + Text.RE.Types.LineNo + Text.RE.Types.Match + Text.RE.Types.Matches + Text.RE.Types.Options Default-Language: Haskell2010 GHC-Options: