diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -68,6 +68,8 @@     ☒  2017-03-28 v0.10.0.3 [Upgrade to LTS 8.6 and Improve Haddocks for Text.RE.{TDFA,PCRE}](https://github.com/iconnect/regex/milestone/13) +    ☒  2017-03-29 v0.11.0.0 [Simplify the API](https://github.com/iconnect/regex/milestone/14) +     ☐  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 @@ -29,8 +29,8 @@ , matchedText ) where -import Text.RE.Types.Match -import Text.RE.Types.Matches +import Text.RE.ZeInternals.Types.Match +import Text.RE.ZeInternals.Types.Matches -- $tutorial -- @@ -55,7 +55,7 @@ -- -- * "Text.RE.TDFA.ByteString" -- * "Text.RE.TDFA.ByteString.Lazy" --- * "Text.RE.TDFA.RE" +-- * "Text.RE.ZeInternals.TDFA" -- * "Text.RE.TDFA.Sequence" -- * "Text.RE.TDFA.String" -- * "Text.RE.TDFA.Text" @@ -67,7 +67,7 @@ -- -- * Text.RE.PCRE.ByteString -- * Text.RE.PCRE.ByteString.Lazy --- * Text.RE.PCRE.RE +-- * Text.RE.ZeInternals.PCRE -- * Text.RE.PCRE.Sequence -- * Text.RE.PCRE.String -- * Text.RE.PCRE diff --git a/Text/RE/Internal/AddCaptureNames.hs b/Text/RE/Internal/AddCaptureNames.hs deleted file mode 100644 --- a/Text/RE/Internal/AddCaptureNames.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} - -module Text.RE.Internal.AddCaptureNames where - -import qualified Data.ByteString.Lazy.Char8 as LBS -import qualified Data.ByteString.Char8 as B -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 -import Text.RE.Types.CaptureID -import Text.RE.Types.Match -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" diff --git a/Text/RE/Internal/EscapeREString.hs b/Text/RE/Internal/EscapeREString.hs deleted file mode 100644 --- a/Text/RE/Internal/EscapeREString.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Text.RE.Internal.EscapeREString where - --- | Convert a string into a regular expression that will amtch that --- string -escapeREString :: String -> String -escapeREString = foldr esc [] - where - esc c t | isMetaChar c = '\\' : c : t - | otherwise = c : t - --- | returns True iff the charactr is an RE meta character --- ('[', '*', '{', etc.) -isMetaChar :: Char -> Bool -isMetaChar c = case c of - '^' -> True - '\\' -> True - '.' -> True - '|' -> True - '*' -> True - '?' -> True - '+' -> True - '(' -> True - ')' -> True - '[' -> True - ']' -> True - '{' -> True - '}' -> True - '$' -> True - _ -> False diff --git a/Text/RE/Internal/NamedCaptures.lhs b/Text/RE/Internal/NamedCaptures.lhs deleted file mode 100644 --- a/Text/RE/Internal/NamedCaptures.lhs +++ /dev/null @@ -1,230 +0,0 @@ -\begin{code} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.NamedCaptures - ( cp - , extractNamedCaptures - , idFormatTokenREOptions - , Token(..) - , validToken - , formatTokens - , formatTokens' - , formatTokens0 - , scan - ) where - -import Data.Char -import qualified Data.HashMap.Strict as HM -import qualified Data.Text as T -import GHC.Generics -import qualified Language.Haskell.TH as TH -import Language.Haskell.TH.Quote -import Text.RE -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.RE.Types.Match -import Text.Regex.TDFA - - --- | quasi quoter for CaptureID ([cp|0|],[cp|y|], etc.) -cp :: QuasiQuoter -cp = - (qq0 "cp") - { quoteExp = parse_capture - } - --- | extract the CaptureNames from an RE or return an error diagnostic --- if the RE is not well formed; also returs the total number of captures --- in the RE -extractNamedCaptures :: String -> Either String ((Int,CaptureNames),String) -extractNamedCaptures s = Right (analyseTokens tks,formatTokens tks) - where - tks = scan s -\end{code} - - -Token ------ - -\begin{code} --- | our RE scanner returns a list of these tokens -data Token - = ECap (Maybe String) - | PGrp - | PCap - | Bra - | BS Char - | Other Char - deriving (Show,Generic,Eq) - --- | check that a token is well formed -validToken :: Token -> Bool -validToken tkn = case tkn of - ECap mb -> maybe True check_ecap mb - PGrp -> True - PCap -> True - Bra -> True - BS c -> is_dot c - Other c -> is_dot c - where - check_ecap s = not (null s) && all not_br s - is_dot c = c/='\n' - not_br c = not $ c `elem` "{}\n" - -\end{code} - - -Analysing [Token] -> CaptureNames ---------------------------------- - -\begin{code} --- | analyse a token stream, returning the number of captures and the --- 'CaptureNames' -analyseTokens :: [Token] -> (Int,CaptureNames) -analyseTokens tks0 = case count_em 1 tks0 of - (n,as) -> (n-1, HM.fromList as) - where - count_em n [] = (n,[]) - count_em n (tk:tks) = case count_em (n `seq` n+d) tks of - (n',as) -> (n',bd++as) - where - (d,bd) = case tk of - ECap (Just nm) -> (,) 1 [(CaptureName $ T.pack nm,CaptureOrdinal n)] - ECap Nothing -> (,) 1 [] - PGrp -> (,) 0 [] - PCap -> (,) 1 [] - Bra -> (,) 1 [] - BS _ -> (,) 0 [] - Other _ -> (,) 0 [] -\end{code} - - -Scanning Regex Strings ----------------------- - -\begin{code} --- | scan a RE string into a list of RE Token -scan :: String -> [Token] -scan = alex' match al oops - where - al :: [(Regex,Match String->Maybe Token)] - al = - [ mk "\\$\\{([^{}]+)\\}\\(" $ ECap . Just . x_1 - , mk "\\$\\(" $ const $ ECap Nothing - , mk "\\(\\?:" $ const PGrp - , mk "\\(\\?" $ const PCap - , mk "\\(" $ const Bra - , mk "\\\\(.)" $ BS . s2c . x_1 - , mk "(.)" $ Other . s2c . x_1 - ] - - x_1 = captureText $ IsCaptureOrdinal $ CaptureOrdinal 1 - - s2c [c] = c - s2c _ = error "scan:s2c:internal error" - - mk s f = (either error id $ makeRegexM s,Just . f) - - oops = error "reScanner" -\end{code} - - -Parsing captures ----------------- - -\begin{code} -parse_capture :: String -> TH.Q TH.Exp -parse_capture s = case all isDigit s of - True -> [|IsCaptureOrdinal $ CaptureOrdinal $ read s|] - False -> [|IsCaptureName $ CaptureName $ T.pack s|] -\end{code} - - -Formatting [Token] ------------------- - -\begin{code} --- | format [Token] into an RE string -formatTokens :: [Token] -> String -formatTokens = formatTokens' defFormatTokenREOptions - --- | options for the general Token formatter below -data FormatTokenREOptions = - FormatTokenREOptions - { _fto_regex_type :: Maybe RegexType -- ^ Posix, PCRE or indeterminate REs? - , _fto_min_caps :: Bool -- ^ remove captures where possible - , _fto_incl_caps :: Bool -- ^ include the captures in the output - } - deriving (Show) - --- | the default configuration for the Token formatter -defFormatTokenREOptions :: FormatTokenREOptions -defFormatTokenREOptions = - FormatTokenREOptions - { _fto_regex_type = Nothing - , _fto_min_caps = False - , _fto_incl_caps = False - } - --- | a configuration that will preserve the parsed regular expression --- in the output -idFormatTokenREOptions :: FormatTokenREOptions -idFormatTokenREOptions = - FormatTokenREOptions - { _fto_regex_type = Nothing - , _fto_min_caps = False - , _fto_incl_caps = True - } - --- | the general Token formatter, generating REs according to the options -formatTokens' :: FormatTokenREOptions -> [Token] -> String -formatTokens' FormatTokenREOptions{..} = foldr f "" - where - f tk tl = t_s ++ tl - where - t_s = case tk of - ECap mb -> ecap mb - PGrp -> if maybe False isTDFA _fto_regex_type then "(" else "(?:" - PCap -> "(?" - Bra -> bra _fto_min_caps - BS c -> "\\" ++ [c] - Other c -> [c] - - ecap mb = case _fto_incl_caps of - True -> case mb of - Nothing -> "$(" - Just nm -> "${"++nm++"}(" - False -> bra _fto_min_caps - - bra mc = case mc && maybe False isPCRE _fto_regex_type of - True -> "(?:" - False -> "(" -\end{code} - -\begin{code} --- this is a reference of formatTokens defFormatTokenREOptions, --- used for testing the latter -formatTokens0 :: [Token] -> String -formatTokens0 = foldr f "" - where - f tk tl = t_s ++ tl - where - t_s = case tk of - ECap _ -> "(" - PGrp -> "(?:" - PCap -> "(?" - Bra -> "(" - BS c -> "\\" ++ [c] - Other c -> [c] -\end{code} diff --git a/Text/RE/Internal/PreludeMacros.hs b/Text/RE/Internal/PreludeMacros.hs deleted file mode 100644 --- a/Text/RE/Internal/PreludeMacros.hs +++ /dev/null @@ -1,909 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - -module Text.RE.Internal.PreludeMacros - ( RegexType - , WithCaptures(..) - , MacroDescriptor(..) - , RegexSource(..) - , PreludeMacro(..) - , presentPreludeMacro - , preludeMacros - , preludeMacroTable - , preludeMacroSummary - , preludeMacroSources - , preludeMacroSource - , preludeMacroEnv - , preludeMacroDescriptor - ) where - -import Data.Array -import qualified Data.HashMap.Lazy as HML -import Data.List -import Data.Maybe -import qualified Data.Text as T -import Data.Time -import Prelude.Compat -import Text.RE.Types.REOptions -import Text.RE.TestBench.Parsers -import Text.RE.TestBench - - --- | generate the standard prelude Macros used to parse REs -preludeMacros :: (Monad m,Functor m) - => (String->m r) - -> RegexType - -> WithCaptures - -> m (Macros r) -preludeMacros prs rty wc = mkMacros prs rty wc $ preludeMacroEnv rty - --- | format the standard prelude macros in a markdown table -preludeMacroTable :: RegexType -> String -preludeMacroTable rty = formatMacroTable rty $ preludeMacroEnv rty - --- | generate a textual summary of the prelude macros -preludeMacroSummary :: RegexType -> PreludeMacro -> String -preludeMacroSummary rty = - formatMacroSummary rty (preludeMacroEnv rty) . prelude_macro_id - --- | generate a plain text table giving the RE for each macro with all --- macros expanded (to NF) -preludeMacroSources :: RegexType -> String -preludeMacroSources rty = - formatMacroSources rty ExclCaptures $ preludeMacroEnv rty - --- | generate plain text giving theexpanded RE for a single macro -preludeMacroSource :: RegexType -> PreludeMacro -> String -preludeMacroSource rty = - formatMacroSource rty ExclCaptures (preludeMacroEnv rty) . prelude_macro_id - --- | generate the `MacroEnv` for the standard prelude macros -preludeMacroEnv :: RegexType -> MacroEnv -preludeMacroEnv rty = fix $ prelude_macro_env rty - -prelude_macro_env :: RegexType -> MacroEnv -> MacroEnv -prelude_macro_env rty env = HML.fromList $ catMaybes - [ (,) (prelude_macro_id pm) <$> preludeMacroDescriptor rty env pm - | pm<-[minBound..maxBound] - ] - --- | generate the `MacroDescriptor` for a given `PreludeMacro` -preludeMacroDescriptor :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -preludeMacroDescriptor rty env pm = case pm of - PM_nat -> natural_macro rty env pm - PM_hex -> natural_hex_macro rty env pm - PM_int -> integer_macro rty env pm - PM_frac -> decimal_macro rty env pm - PM_string -> string_macro rty env pm - PM_string_simple -> string_simple_macro rty env pm - PM_id -> id_macro rty env pm - PM_id' -> id'_macro rty env pm - PM_id_ -> id__macro rty env pm - PM_date -> date_macro rty env pm - PM_date_slashes -> date_slashes_macro rty env pm - PM_time -> time_macro rty env pm - PM_timezone -> timezone_macro rty env pm - PM_datetime -> datetime_macro rty env pm - PM_datetime_8601 -> datetime_8601_macro rty env pm - PM_datetime_clf -> datetime_clf_macro rty env pm - PM_shortmonth -> shortmonth_macro rty env pm - PM_address_ipv4 -> address_ipv4_macros rty env pm - PM_email_simple -> email_simple_macro rty env pm - PM_url -> url_macro rty env pm - PM_syslog_severity -> syslog_severity_macro rty env pm - --- | an enumeration of all of the prelude macros -data PreludeMacro - -- numbers - = PM_nat - | PM_hex - | PM_int - | PM_frac - -- strings - | PM_string - | PM_string_simple - -- identifiers - | PM_id - | PM_id' - | PM_id_ - -- dates & times - | PM_date - | PM_date_slashes - | PM_time - | PM_timezone - | PM_datetime - | PM_datetime_8601 - | PM_datetime_clf - | PM_shortmonth - -- addresses - | PM_address_ipv4 - | PM_email_simple - | PM_url - -- syslog - | PM_syslog_severity - deriving (Bounded,Enum,Ord,Eq,Show) - --- | naming the macros -presentPreludeMacro :: PreludeMacro -> String -presentPreludeMacro pm = case pm of - PM_id_ -> prelude_prefix++"id-" - _ -> fmt pm - where - fmt = (prelude_prefix++) . map tr . drop 3 . show - - tr '_' = '.' - tr c = c - --- | all prelude macros are prefixed with this -prelude_prefix :: String -prelude_prefix = "%" - -prelude_macro_id :: PreludeMacro -> MacroID -prelude_macro_id = MacroID . presentPreludeMacro - -natural_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -natural_macro rty env pm = Just $ run_tests rty parseInteger samples env pm - MacroDescriptor - { _md_source = "[0-9]+" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseInteger" - , _md_description = "a string of one or more decimal digits" - } - where - samples :: [(String,Int)] - samples = - [ (,) "0" 0 - , (,) "1234567890" 1234567890 - , (,) "00" 0 - , (,) "01" 1 - ] - - counter_samples = - [ "" - , "0A" - , "-1" - ] - -natural_hex_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -natural_hex_macro rty env pm = Just $ run_tests rty parseHex samples env pm - MacroDescriptor - { _md_source = "[0-9a-fA-F]+" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseHex" - , _md_description = "a string of one or more hexadecimal digits" - } - where - samples :: [(String,Int)] - samples = - [ (,) "0" 0x0 - , (,) "12345678" 0x12345678 - , (,) "0abcdef" 0xabcdef - , (,) "0ABCDEF" 0xabcdef - , (,) "00" 0x0 - , (,) "010" 0x10 - ] - - counter_samples = - [ "" - , "0x10" - , "0z" - , "-1a" - ] - -integer_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -integer_macro rty env pm = Just $ run_tests rty parseInteger samples env pm - MacroDescriptor - { _md_source = "-?[0-9]+" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseInteger" - , _md_description = "a decimal integer" - } - where - samples :: [(String,Int)] - samples = - [ (,) "0" 0 - , (,) "1234567890" 1234567890 - , (,) "00" 0 - , (,) "01" 1 - , (,) "-1" $ -1 - , (,) "-0" 0 - ] - - counter_samples = - [ "" - , "0A" - , "+0" - ] - --- | a digit string macro -decimal_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -decimal_macro rty env pm = Just $ run_tests rty parseDouble samples env pm - MacroDescriptor - { _md_source = "-?[0-9]+(?:\\.[0-9]+)?" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseInteger" - , _md_description = "a decimal integer" - } - where - samples :: [(String,Double)] - samples = - [ (,) "0" 0 - , (,) "1234567890" 1234567890 - , (,) "00" 0 - , (,) "01" 1 - , (,) "-1" $ -1 - , (,) "-0" 0 - , (,) "0.1234567890" 0.1234567890 - , (,) "-1.0" $ -1.0 - ] - - counter_samples = - [ "" - , "0A" - , "+0" - , "0." - , ".0" - , "." - , "-" - , "-." - , "-1." - , "-.1" - ] - -string_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -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 = - [ (,) "\"\"" "" - , (,) "\"foo\"" "foo" - , (,) "\"\\\"\"" "\"" - , (,) "\"\\\"\\\"\"" "\"\"" - , (,) "\"\\\"\\\\\\\"\"" "\"\\\"" - , (,) "\"\\\"foo\\\"\"" "\"foo\"" - , (,) "\"\"" "" - ] - - counter_samples = - [ "\"" - , "\"aa" - ] - -string_simple_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -string_simple_macro rty env pm = - Just $ run_tests rty (fmap T.unpack . parseSimpleString) samples env pm - MacroDescriptor - { _md_source = "\"[^\"[:cntrl:]]*\"" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseSimpleString" - , _md_description = "a decimal integer" - } - where - samples :: [(String,String)] - samples = - [ (,) "\"\"" "" - , (,) "\"foo\"" "foo" - , (,) "\"\\\"" "\\" - , (,) "\"\"" "" - ] - - counter_samples = - [ "" - , "\"" - , "\"\\\"\"" - , "\"\\\"\\\"\"" - , "\"\\\"\\\\\\\"\"" - , "\"\\\"foo\\\"\"" - , "\"aa" - ] - -id_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -id_macro rty env pm = - Just $ run_tests rty Just samples env pm - MacroDescriptor - { _md_source = "_*[a-zA-Z][a-zA-Z0-9_]*" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Nothing - , _md_description = "a standard C-style alphanumeric identifier (with _s)" - } - where - samples :: [(String,String)] - samples = - [ f "a" - , f "A" - , f "A1" - , f "a_" - , f "a1_B2" - , f "_abc" - , f "__abc" - ] - where - f s = (s,s) - - counter_samples = - [ "" - , "1" - , "_" - , "__" - , "__1" - , "1a" - , "a'" - ] - -id'_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -id'_macro rty env pm = - Just $ run_tests rty Just samples env pm - MacroDescriptor - { _md_source = "_*[a-zA-Z][a-zA-Z0-9_']*" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Nothing - , _md_description = "a standard Haskell-style alphanumeric identifier (with '_'s and '''s)" - } - where - samples :: [(String,String)] - samples = - [ f "a" - , f "A" - , f "A1" - , f "a_" - , f "a1_B2" - , f "_abc" - , f "__abc" - , f "a'" - , f "_a'" - , f "a'b" - ] - where - f s = (s,s) - - counter_samples = - [ "" - , "1" - , "_" - , "__" - , "__1" - , "1a" - , "'" - , "'a" - , "_'" - , "_1'" - ] - -id__macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -id__macro rty env pm = - Just $ run_tests rty Just samples env pm - MacroDescriptor - { _md_source = "_*[a-zA-Z][a-zA-Z0-9_'-]*" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Nothing - , _md_description = "an identifier with -s" - } - where - samples :: [(String,String)] - samples = - [ f "a" - , f "A" - , f "A1" - , f "a_" - , f "a1_B2" - , f "_abc" - , f "__abc" - , f "a'" - , f "_a'" - , f "a'b" - , f "a-" - , f "a1-B2" - , f "a1-B2-" - ] - where - f s = (s,s) - - counter_samples = - [ "" - , "1" - , "_" - , "__" - , "__1" - , "1a" - , "'" - , "'a" - , "_'" - , "_1'" - ] - -date_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -date_macro rty env pm = - Just $ run_tests rty parseDate samples env pm - MacroDescriptor - { _md_source = "[0-9]{4}-[0-9]{2}-[0-9]{2}" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseDate" - , _md_description = "a YYYY-MM-DD format date" - } - where - samples :: [(String,Day)] - samples = - [ f "2016-12-31" - , f "0001-01-01" - , f "1000-01-01" - ] - where - f s = (s,read s) - - counter_samples = - [ "" - , "2016/01/31" - , "2016-1-31" - , "2016-01-1" - , "2016-001-01" - ] - -date_slashes_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -date_slashes_macro rty env pm = - Just $ run_tests rty parseSlashesDate samples env pm - MacroDescriptor - { _md_source = "[0-9]{4}/[0-9]{2}/[0-9]{2}" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseSlashesDate" - , _md_description = "a YYYY/MM/DD format date" - } - where - samples :: [(String,Day)] - samples = - [ f "2016/12/31" - , f "0001/01/01" - , f "1000/01/01" - ] - where - f s = (s,read $ map tr s) - where - tr '/' = '-' - tr c = c - - counter_samples = - [ "" - , "2016-01-31" - , "2016/1/31" - , "2016/01/1" - , "2016/001/01" - ] - -time_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -time_macro rty env pm = - Just $ run_tests rty parseTimeOfDay samples env pm - MacroDescriptor - { _md_source = "[0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseTimeOfDay" - , _md_description = "a HH:MM:SS[.Q+]" - } - where - samples :: [(String,TimeOfDay)] - samples = - [ f "00:00:00" 00 00 0 - , f "23:59:59" 23 59 59 - , f "00:00:00.1234567890" 00 00 $ 123456789 / 1000000000 - ] - where - f s h m ps = (s,TimeOfDay h m ps) - - counter_samples = - [ "" - , "235959" - , "10:20" - , "A00:00:00" - , "00:00:00A" - , "23:59:59." - ] - -timezone_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -timezone_macro rty env pm = - Just $ run_tests rty parseTimeZone samples env pm - MacroDescriptor - { _md_source = "(?:Z|[+-][0-9]{2}:?[0-9]{2})" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseTimeZone" - , _md_description = "an IOS-8601 TZ specification" - } - where - samples :: [(String,TimeZone)] - samples = - [ f "Z" $ minutesToTimeZone 0 - , f "+00:00" $ minutesToTimeZone 0 - , f "+0000" $ minutesToTimeZone 0 - , f "+0200" $ minutesToTimeZone 120 - , f "-0100" $ minutesToTimeZone $ -60 - ] - where - f = (,) - - counter_samples = - [ "" - , "00" - , "A00:00" - , "UTC" - , "EST" - , " EST" - ] - -datetime_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -datetime_macro rty env pm = Just $ run_tests rty parseDateTime samples env pm - MacroDescriptor - { _md_source = "@{%date}[ T]@{%time}(?:@{%timezone}| UTC)?" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseDateTime" - , _md_description = "ISO-8601 format date and time + simple variants" - } - where - samples :: [(String,UTCTime)] - samples = - [ f "2016-12-31 23:37:22.525343 UTC" "2016-12-31 23:37:22.525343Z" - , f "2016-12-31 23:37:22.525343" "2016-12-31 23:37:22.525343Z" - , f "2016-12-31 23:37:22" "2016-12-31 23:37:22Z" - , f "2016-12-31T23:37:22+0100" "2016-12-31 23:37:22+0100" - , f "2016-12-31T23:37:22-01:00" "2016-12-31 23:37:22-0100" - , f "2016-12-31T23:37:22-23:59" "2016-12-31 23:37:22-2359" - , f "2016-12-31T23:37:22Z" "2016-12-31 23:37:22Z" - ] - where - f :: String -> String -> (String,UTCTime) - f s r_s = (s,read r_s) - - counter_samples = - [ "" - , "2016-12-31 23:37:22.525343 EST" - ] - -datetime_8601_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -datetime_8601_macro rty env pm = - Just $ run_tests rty parseDateTime samples env pm - MacroDescriptor - { _md_source = "@{%date}T@{%time}@{%timezone}" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseDateTime8601" - , _md_description = "YYYY-MM-DDTHH:MM:SS[.Q*](Z|[+-]HHMM) format date and time" - } - where - samples :: [(String,UTCTime)] - samples = - [ f "2016-12-31T23:37:22.343Z" "2016-12-31 23:37:22.343Z" - , f "2016-12-31T23:37:22-0100" "2016-12-31 23:37:22-0100" - , f "2016-12-31T23:37:22+23:59" "2016-12-31 23:37:22+2359" - ] - where - f :: String -> String -> (String,UTCTime) - f s r_s = (s,read r_s) - - counter_samples = - [ "" - , "2016-12-31 23:37:22.525343 EST" - ] - -datetime_clf_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor -datetime_clf_macro rty env pm = - Just $ run_tests rty parseDateTimeCLF samples env pm - MacroDescriptor - { _md_source = re - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseDateTimeCLF" - , _md_description = "Common Log Format date+time: %d/%b/%Y:%H:%M:%S %z" - } - where - samples :: [(String,UTCTime)] - samples = - [ f "10/Oct/2000:13:55:36 -0700" "2000-10-10 13:55:36-0700" - , f "10/Oct/2000:13:55:36 +07:00" "2000-10-10 13:55:36+0700" - ] - where - f :: String -> String -> (String,UTCTime) - f s r_s = (s,read r_s) - - counter_samples = - [ "" - , "2016-12-31T23:37+0100" - , "10/Oct/2000:13:55:36-0700" - , "10/OCT/2000:13:55:36 -0700" - , "10/Oct/2000:13:55 -0700" - , "10/Oct/2000:13:55Z" - ] - - re = RegexSource $ unwords - [ "[0-9]{2}/@{%shortmonth}/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2}" - , "[+-][0-9]{2}:?[0-9]{2}" - ] - -shortmonth_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -shortmonth_macro rty env pm = - Just $ run_tests rty parseShortMonth samples env pm - MacroDescriptor - { _md_source = bracketedRegexSource $ - intercalate "|" $ map T.unpack $ elems shortMonthArray - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseShortMonth" - , _md_description = "three letter month name: Jan-Dec" - } - where - samples :: [(String,Int)] - samples = - [ f "Jan" 1 - , f "Feb" 2 - , f "Dec" 12 - ] - where - f = (,) - - counter_samples = - [ "" - , "jan" - , "DEC" - , "January" - , "01" - , "1" - ] - -address_ipv4_macros :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -address_ipv4_macros rty env pm = - Just $ run_tests rty parseIPv4Address samples env pm - MacroDescriptor - { _md_source = "[0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseSeverity" - , _md_description = "an a.b.c.d IPv4 address" - } - where - samples :: [(String,IPV4Address)] - samples = - [ f "0.0.0.0" ( 0, 0, 0, 0) - , f "123.45.6.78" (123, 45, 6, 78) - , f "9.9.9.9" ( 9, 9, 9, 9) - , f "255.255.255.255" (255,255,255,255) - ] - where - f = (,) - - counter_samples = - [ "" - , "foo" - , "1234.0.0.0" - , "1.2.3" - , "1.2.3." - , "1.2..4" - , "www.example.com" - , "2001:0db8:85a3:0000:0000:8a2e:0370:7334" - ] - -syslog_severity_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -syslog_severity_macro rty env pm = - Just $ run_tests rty parseSeverity samples env pm - MacroDescriptor - { _md_source = re - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Just "parseSeverity" - , _md_description = "syslog severity keyword (debug-emerg)" - } - where - samples :: [(String,Severity)] - samples = - [ f "emerg" Emerg - , f "panic" Emerg - , f "alert" Alert - , f "crit" Crit - , f "err" Err - , f "error" Err - , f "warn" Warning - , f "warning" Warning - , f "notice" Notice - , f "info" Info - , f "debug" Debug - ] - where - f = (,) - - counter_samples = - [ "" - , "Emergency" - , "ALERT" - ] - - re = if isPCRE rty - then re_pcre - else re_tdfa - - re_tdfa = bracketedRegexSource $ - intercalate "|" $ - [ T.unpack kw - | (kw0,kws) <- map severityKeywords [minBound..maxBound] - , kw <- kw0:kws - ] - - re_pcre = bracketedRegexSource $ - intercalate "|" $ - [ T.unpack kw - | (kw0,kws) <- map severityKeywords $ - filter (/=Err) [minBound..maxBound] - , kw <- kw0:kws - ] ++ ["err(?:or)?"] - -email_simple_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -email_simple_macro rty env pm = - Just $ run_tests rty Just samples env pm - MacroDescriptor - { _md_source = "[a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9.-]+" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Nothing - , _md_description = "an email address" - } - where - samples :: [(String,String)] - samples = - [ f "user-name%foo.bar.com@an-example.com" - ] - where - f s = (s,s) - - counter_samples = - [ "" - , "not-an-email-address" - , "@not-an-email-address" - ] --- | see https://mathiasbynens.be/demo/url-regex --- (based on @stephenhay URL) -url_macro :: RegexType - -> MacroEnv - -> PreludeMacro - -> Maybe MacroDescriptor -url_macro rty env pm = - Just $ run_tests rty Just samples env pm - MacroDescriptor - { _md_source = "([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*" - , _md_samples = map fst samples - , _md_counter_samples = counter_samples - , _md_test_results = [] - , _md_parser = Nothing - , _md_description = "a URL" - } - where - samples :: [(String,String)] - samples = - [ f "https://mathiasbynens.be/demo/url-regex" - , f "http://foo.com/blah_blah" - , f "http://foo.com/blah_blah/" - , f "http://foo.com/blah_blah_(wikipedia)" - , f "http://foo.com/blah_blah_(wikipedia)_(again)" - , f "http://www.example.com/wpstyle/?p=364" - , f "HTTPS://foo.bar/?q=Test%20URL-encoded%20stuff" - , f "HTTP://223.255.255.254" - , f "ftp://223.255.255.254" - , f "FTP://223.255.255.254" - ] - where - f s = (s,s) - - counter_samples = - [ "" - , "http://" - , "http://." - , "http://.." - , "http://../" - , "http://?" - , "http://??" - , "http://foo.bar?q=Spaces should be encoded" - , "//" - , "http://##/" - , "http://##" - , "http://##/" - ] - -run_tests :: (Eq a,Show a) - => RegexType - -> (String->Maybe a) - -> [(String,a)] - -> MacroEnv - -> PreludeMacro - -> MacroDescriptor - -> MacroDescriptor -run_tests rty parser vector env = - runTests rty parser vector env . prelude_macro_id - -bracketedRegexSource :: String -> RegexSource -bracketedRegexSource re_s = RegexSource $ "(?:" ++ re_s ++ ")" - -fix :: (a->a) -> a -fix f = f (fix f) diff --git a/Text/RE/Internal/QQ.hs b/Text/RE/Internal/QQ.hs deleted file mode 100644 --- a/Text/RE/Internal/QQ.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module Text.RE.Internal.QQ where - -import Control.Exception -import Data.Typeable -import Language.Haskell.TH.Quote - - --- | used to throw an exception reporting an abuse of a quasi quoter -data QQFailure = - QQFailure - { _qqf_context :: String -- ^ in what context was the quasi quoter used - , _qqf_component :: String -- ^ how was the quasi quoter being abused - } - deriving (Show,Typeable) - -instance Exception QQFailure where - --- | a quasi quoter that can be used in no context (to be extended with --- the appropriate quasi quoter parser) -qq0 :: String -> QuasiQuoter -qq0 ctx = - QuasiQuoter - { quoteExp = const $ throw $ QQFailure ctx "expression" - , quotePat = const $ throw $ QQFailure ctx "pattern" - , quoteType = const $ throw $ QQFailure ctx "type" - , quoteDec = const $ throw $ QQFailure ctx "declaration" - } diff --git a/Text/RE/Internal/SearchReplace.hs b/Text/RE/Internal/SearchReplace.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Text.RE.Internal.SearchReplace - ( unsafeCompileSearchReplace_ - , compileSearchReplace_ - , compileSearchAndReplace_ - ) where - -import qualified Data.HashMap.Strict as HMS -import Prelude.Compat -import Text.RE.Internal.NamedCaptures -import Text.RE.Types.Capture -import Text.RE.Types.CaptureID -import Text.RE.Types.Matches -import Text.RE.Types.Replace -import Text.RE.Types.SearchReplace -import qualified Text.Regex.TDFA as TDFA - - --- | warapper on 'compileSearchReplace_' that will generate an error --- if any compilation errors are found -unsafeCompileSearchReplace_ :: (String->s) - -> (String->Either String re) - -> String - -> SearchReplace re s -unsafeCompileSearchReplace_ pk cf = either err id . compileSearchReplace_ pk cf - where - err msg = error $ "unsafeCompileSearchReplace_: " ++ msg - --- | compile a SearchReplace template generating errors if the RE or --- the template are not well formed -- all capture references being checked -compileSearchReplace_ :: (Monad m,Functor m) - => (String->s) - -> (String->Either String re) - -> String - -> m (SearchReplace re s) -compileSearchReplace_ pack compile_re sr_tpl = either fail return $ do - case mainCaptures $ sr_tpl $=~ "///" of - [cap] -> - compileSearchAndReplace_ pack compile_re - (capturePrefix cap) (captureSuffix cap) - _ -> Left $ "bad search-replace template syntax: " ++ sr_tpl - --- | compile 'SearcgReplace' from two strings containing the RE --- and the replacement template -compileSearchAndReplace_ :: (Monad m,Functor m) - => (String->s) - -> (String->Either String re) - -> String - -> String - -> m (SearchReplace re s) -compileSearchAndReplace_ pack compile_re re_s tpl = either fail return $ do - re <- compile_re re_s - ((n,cnms),_) <- extractNamedCaptures re_s - mapM_ (check n cnms) $ templateCaptures id tpl - return $ SearchReplace re $ pack tpl - where - check :: Int -> CaptureNames -> CaptureID -> Either String () - check n cnms cid = case cid of - IsCaptureOrdinal co -> check_co n co - IsCaptureName cn -> check_cn cnms cn - - check_co n (CaptureOrdinal i) = case i <= n of - True -> return () - False -> Left $ "capture ordinal out of range: " ++ - show i ++ " >= " ++ show n - - check_cn cnms cnm = case cnm `HMS.member` cnms of - True -> return () - False -> Left $ "capture name not defined: " ++ - show (getCaptureName cnm) - -($=~) :: String -> String -> Matches String -($=~) = (TDFA.=~) diff --git a/Text/RE/Internal/SearchReplace/TDFA.hs b/Text/RE/Internal/SearchReplace/TDFA.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Prelude.Compat -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' cast $ Just MultilineSensitive -edMultilineInsensitive = ed' cast $ Just MultilineInsensitive -edBlockSensitive = ed' cast $ Just BlockSensitive -edBlockInsensitive = ed' cast $ Just BlockInsensitive -ed_ = ed' cast Nothing - -cast :: Q Exp -cast = [|id|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/ByteString.hs b/Text/RE/Internal/SearchReplace/TDFA/ByteString.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/ByteString.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.ByteString - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import qualified Data.ByteString.Char8 as B -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE B.ByteString|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE B.ByteString|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/ByteString/Lazy.hs b/Text/RE/Internal/SearchReplace/TDFA/ByteString/Lazy.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/ByteString/Lazy.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.ByteString.Lazy - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import qualified Data.ByteString.Lazy.Char8 as LBS -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE LBS.ByteString|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE LBS.ByteString|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/Sequence.hs b/Text/RE/Internal/SearchReplace/TDFA/Sequence.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/Sequence.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.Sequence - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import qualified Data.Sequence as S -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE (S.Seq Char)|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE (S.Seq Char)|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/String.hs b/Text/RE/Internal/SearchReplace/TDFA/String.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/String.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.String - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - - -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE String|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE String|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/Text.hs b/Text/RE/Internal/SearchReplace/TDFA/Text.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/Text.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.Text - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import qualified Data.Text as T -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE T.Text|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE T.Text|] diff --git a/Text/RE/Internal/SearchReplace/TDFA/Text/Lazy.hs b/Text/RE/Internal/SearchReplace/TDFA/Text/Lazy.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFA/Text/Lazy.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFA.Text.Lazy - ( ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ - ) where - -import qualified Data.Text.Lazy as TL -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Text.RE.TDFA.RE -import Text.RE.Internal.SearchReplace.TDFAEdPrime -import Text.RE.SearchReplace -import Text.RE.Types.REOptions - - --- | the @[ed| ... /// ... |]@ quasi quoters -ed - , edMS - , edMI - , edBS - , edBI - , edMultilineSensitive - , edMultilineInsensitive - , edBlockSensitive - , edBlockInsensitive - , ed_ :: QuasiQuoter - -ed = ed' sr_cast $ Just minBound -edMS = edMultilineSensitive -edMI = edMultilineInsensitive -edBS = edBlockSensitive -edBI = edBlockInsensitive -edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive -edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive -edBlockSensitive = ed' sr_cast $ Just BlockSensitive -edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive -ed_ = ed' fn_cast Nothing - -sr_cast :: Q Exp -sr_cast = [|\x -> x :: SearchReplace RE TL.Text|] - -fn_cast :: Q Exp -fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE TL.Text|] diff --git a/Text/RE/Internal/SearchReplace/TDFAEdPrime.hs b/Text/RE/Internal/SearchReplace/TDFAEdPrime.hs deleted file mode 100644 --- a/Text/RE/Internal/SearchReplace/TDFAEdPrime.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Internal.SearchReplace.TDFAEdPrime - ( ed' - ) where - -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Prelude.Compat -import Text.RE.Internal.SearchReplace -import Text.RE.Internal.QQ -import Text.RE.TDFA.RE -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.Regex.TDFA - - --- | construct a quasi quoter from a casting function and @Just sro@ --- if the options are known, otherwise a function take takes the --- 'SimpleREOptions' and constructs the 'SearchReplace' template -ed' :: Q Exp -> Maybe SimpleREOptions -> QuasiQuoter -ed' qe mb = case mb of - Nothing -> - (qq0 "ed'") - { quoteExp = parse minBound $ \rs -> AppE <$> qe <*> [|flip unsafe_compile_sr rs|] - } - Just sro -> - (qq0 "ed'") - { quoteExp = parse sro $ \rs -> AppE <$> qe <*> [|unsafe_compile_sr_simple sro rs|] - } - where - parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp - parse sro mk ts = either error (\_->mk ts) ei - where - ei :: Either String (SearchReplace RE String) - ei = compileSearchReplace_ id (compileRegexWith sro) ts - -unsafe_compile_sr_simple :: IsRegex RE s - => SimpleREOptions - -> String - -> SearchReplace RE s -unsafe_compile_sr_simple sro = - unsafe_compile_sr $ unpackSimpleREOptions sro - -unsafe_compile_sr :: ( IsOption o RE CompOption ExecOption - , IsRegex RE s - ) - => o - -> String - -> SearchReplace RE s -unsafe_compile_sr os = - unsafeCompileSearchReplace_ packR $ compileRegexWithOptions os diff --git a/Text/RE/IsRegex.lhs b/Text/RE/IsRegex.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/IsRegex.lhs @@ -0,0 +1,60 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Text.RE.IsRegex + ( IsRegex(..) + , SearchReplace(..) + , searchReplaceAll + , searchReplaceFirst + ) where + +import Text.RE.ZeInternals.EscapeREString +import Text.RE.ZeInternals.Types.Match +import Text.RE.ZeInternals.Types.Matches +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.Types.SearchReplace +\end{code} + +\begin{code} +-- | the 'IsRegex' class allows polymorhic tools to be written that +-- will work with a variety of regex back ends and text types +class Replace s => IsRegex re s where + -- | finding the first match + matchOnce :: re -> s -> Match s + -- | finding all matches + matchMany :: re -> s -> Matches s + -- | compiling an RE, failing if the RE is not well formed + makeRegex :: (Functor m,Monad m) => s -> m re + -- | comiling an RE, specifying the 'SimpleREOptions' + makeRegexWith :: (Functor m,Monad m) => SimpleREOptions -> s -> m re + -- | compiling a 'SearchReplace' template from the RE text and the template Text, failing if they are not well formed + makeSearchReplace :: (Functor m,Monad m,IsRegex re s) => s -> s -> m (SearchReplace re s) + -- | compiling a 'SearchReplace' template specifing the 'SimpleREOptions' for the RE + makeSearchReplaceWith :: (Functor m,Monad m,IsRegex re s) => SimpleREOptions -> s -> s -> m (SearchReplace re s) + -- | incorporate an escaped string into a compiled RE with the default options + makeEscaped :: (Functor m,Monad m) => (s->s) -> s -> m re + -- | incorporate an escaped string into a compiled RE with the specified 'SimpleREOptions' + makeEscapedWith :: (Functor m,Monad m) => SimpleREOptions -> (s->s) -> s -> m re + -- | extract the text of the RE from the RE + regexSource :: re -> s + + makeRegex = makeRegexWith minBound + makeSearchReplace = makeSearchReplaceWith minBound + makeEscaped = makeEscapedWith minBound + makeEscapedWith o f = makeRegexWith o . f . packR . escapeREString . unpackR + +-- | searching and replacing the first occurrence +searchReplaceAll :: IsRegex re s => SearchReplace re s -> s -> s +searchReplaceAll SearchReplace{..} = replaceAll getTemplate . matchMany getSearch + +-- | searching and replaceing all occurrences +searchReplaceFirst :: IsRegex re s => SearchReplace re s -> s -> s +searchReplaceFirst SearchReplace{..} = replace getTemplate . matchOnce getSearch +\end{code} diff --git a/Text/RE/REOptions.lhs b/Text/RE/REOptions.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/REOptions.lhs @@ -0,0 +1,105 @@ +\begin{code} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.REOptions + ( + -- * SimpleREOptions + SimpleREOptions(..) + -- * REOptions_ + , REOptions_(..) + -- * IsOption + , IsOption(..) + -- * Macros + , Macros + , MacroID(..) + , emptyMacros + ) 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} +-- | the default API uses these simple, universal RE options, +-- which get auto-converted into the apropriate back-end 'REOptions_' +data SimpleREOptions + = MultilineSensitive -- ^ case-sensitive with ^ and $ matching the start and end of a line + | MultilineInsensitive -- ^ case-insensitive with ^ and $ matsh the start and end of a line + | BlockSensitive -- ^ case-sensitive with ^ and $ matching the start and end of the input text + | BlockInsensitive -- ^ case-insensitive with ^ and $ matching the start and end of the input text + deriving (Bounded,Enum,Eq,Ord,Show) +\end{code} + +\begin{code} +-- | we need to use this in the quasi quoters to specify @SimpleREOptions@ +-- selected by the quasi quoter +instance Lift SimpleREOptions where + lift sro = case sro of + MultilineSensitive -> conE 'MultilineSensitive + MultilineInsensitive -> conE 'MultilineInsensitive + BlockSensitive -> conE 'BlockSensitive + BlockInsensitive -> conE 'BlockInsensitive +\end{code} + +\begin{code} +-- | the general options for an RE are dependent on which back end is +-- being used and are parameterised over the @RE@ type for the back end, +-- and its @CompOption@ and @ExecOption@ types (the compile-time and +-- execution time options, respectively); each back end will define an +-- @REOptions@ type that fills out these three type parameters with the +-- apropriate types +data REOptions_ r c e = + REOptions + { optionsMacs :: !(Macros r) -- ^ the available TestBench RE macros + , optionsComp :: !c -- ^ the back end compile-time options + , optionsExec :: !e -- ^ the back end execution-time options + } + deriving (Show) +\end{code} + +\begin{code} +-- | a number of types can be used to encode @REOptions@, each of which +-- can be made a member of this class. +class IsOption o r c e | + e -> r, c -> e , e -> c, r -> c, c -> r, r -> e where + -- | convert the @o@ type into an @REOptions r c e@ + makeREOptions :: o -> REOptions_ r c e +\end{code} + +\begin{code} +-- | our macro tables are parameterised over the backend @RE@ type and +-- and just associate each @MacroID@ with an @RE@ +type Macros r = HM.HashMap MacroID r +\end{code} + +\begin{code} +-- | @MacroID@ is just a wrapped @String@ type with an @IsString@ +-- instance +newtype MacroID = + MacroID { getMacroID :: String } + deriving (IsString,Ord,Eq,Show) +\end{code} + +\begin{code} +-- | @MacroID@ is used with @HM.HashMap@ to build macro lookup tables +instance Hashable MacroID where + hashWithSalt i = hashWithSalt i . getMacroID +\end{code} + +\begin{code} +-- | a macro table containing no entries +emptyMacros :: Macros r +emptyMacros = HM.empty +\end{code} diff --git a/Text/RE/Replace.hs b/Text/RE/Replace.hs new file mode 100644 --- /dev/null +++ b/Text/RE/Replace.hs @@ -0,0 +1,23 @@ +module Text.RE.Replace + ( + -- * REContext and RELocation + REContext(..) + , RELocation(..) + , isTopLocation + -- * replaceAll + , replaceAll + , replaceAllCaptures + , replaceAllCaptures_ + , replaceAllCapturesM + -- * replace + , replace + , replaceCaptures + , replaceCaptures_ + , replaceCapturesM + -- * Replace and ReplaceMethods + , Replace(..) + , ReplaceMethods(..) + , replaceMethods + ) where + +import Text.RE.ZeInternals.Replace diff --git a/Text/RE/SearchReplace.hs b/Text/RE/SearchReplace.hs deleted file mode 100644 --- a/Text/RE/SearchReplace.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module Text.RE.SearchReplace - ( - -- * Serach and Replace - SearchReplace(..) - , searchReplaceFirst - , searchReplaceAll - ) where - -import Text.RE.Types.IsRegex -import Text.RE.Types.Replace -import Text.RE.Types.SearchReplace - - --- | searching and replacing the first occurrence -searchReplaceAll :: IsRegex re s => SearchReplace re s -> s -> s -searchReplaceAll SearchReplace{..} = replaceAll getTemplate . matchMany getSearch - --- | searching and replaceing all occurrences -searchReplaceFirst :: IsRegex re s => SearchReplace re s -> s -> s -searchReplaceFirst SearchReplace{..} = replace getTemplate . matchOnce getSearch diff --git a/Text/RE/Summa.hs b/Text/RE/Summa.hs --- a/Text/RE/Summa.hs +++ b/Text/RE/Summa.hs @@ -1,20 +1,20 @@ module Text.RE.Summa ( -- $collection - module Text.RE.SearchReplace + module Text.RE.IsRegex + , module Text.RE.Replace , module Text.RE.TestBench , module Text.RE.Tools - , module Text.RE.Types ) where -import Text.RE.SearchReplace +import Text.RE.IsRegex +import Text.RE.Replace import Text.RE.TestBench import Text.RE.Tools -import Text.RE.Types -- $collection -- -- This module collects together all of the generic regex APIs not --- exported by the API modules specific to each back end. The regex +-- exported by the back-end-specific API modules. The regex -- API is modular with only the most common types and functions being --- exported by these modules. The remining modules may be imported --- individually or en masse by importing this module. +-- exported by these modules but the remining modules may be imported +-- en masse by importing this module. diff --git a/Text/RE/TDFA.hs b/Text/RE/TDFA.hs --- a/Text/RE/TDFA.hs +++ b/Text/RE/TDFA.hs @@ -44,9 +44,9 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE + , module Text.RE.ZeInternals.TDFA -- * The [ed| ... |] quasi quoters - , module Text.RE.Internal.SearchReplace.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA -- * The Operator Instances -- $instances , module Text.RE.TDFA.ByteString @@ -59,19 +59,18 @@ import qualified Text.Regex.Base as B import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA -import Text.RE.SearchReplace import Text.RE.TDFA.ByteString() import Text.RE.TDFA.ByteString.Lazy() import Text.RE.TDFA.Sequence() import Text.RE.TDFA.String() import Text.RE.TDFA.Text() import Text.RE.TDFA.Text.Lazy() -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions +import Text.RE.IsRegex +import Text.RE.REOptions -- | find all matches in text; e.g., to count the number of naturals in s: @@ -133,7 +132,7 @@ -- -- * "Text.RE.TDFA.ByteString" -- * "Text.RE.TDFA.ByteString.Lazy" --- * "Text.RE.TDFA.RE" +-- * "Text.RE.ZeInternals.TDFA" -- * "Text.RE.TDFA.Sequence" -- * "Text.RE.TDFA.String" -- * "Text.RE.TDFA.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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.ByteString + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.ByteString -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.ByteString +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA 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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.ByteString.Lazy + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.ByteString.Lazy -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA diff --git a/Text/RE/TDFA/RE.hs b/Text/RE/TDFA/RE.hs deleted file mode 100644 --- a/Text/RE/TDFA/RE.hs +++ /dev/null @@ -1,429 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Text.RE.TDFA.RE - ( -- * About - -- $about - - -- * RE Type - RE - , regexType - , reOptions - , reSource - , reCaptureNames - , reRegex - -- * REOptions Type - , REOptions - , defaultREOptions - , noPreludeREOptions - -- * Compiling Regular Expressions - , compileRegex - , compileRegexWith - , compileRegexWithOptions - -- * Compiling Search-Replace Templates - , compileSearchReplace - , compileSearchReplaceWith - , compileSearchReplaceWithREOptions - -- * Escaping String - , escape - , escapeWith - , escapeWithOptions - , escapeREString - -- * Macros Standard Environment - , prelude - , preludeEnv - , preludeTestsFailing - , preludeTable - , preludeSummary - , preludeSources - , preludeSource - , unpackSimpleREOptions - -- * The Quasi Quoters - , re - , reMS - , reMI - , reBS - , reBI - , reMultilineSensitive - , reMultilineInsensitive - , reBlockSensitive - , reBlockInsensitive - , re_ - , cp - ) where - -import Data.Functor.Identity -import Language.Haskell.TH -import Language.Haskell.TH.Quote -import Prelude.Compat -import Text.RE.Internal.EscapeREString -import Text.RE.Internal.NamedCaptures -import Text.RE.Internal.PreludeMacros -import Text.RE.Internal.QQ -import Text.RE.Internal.SearchReplace -import Text.RE.SearchReplace -import Text.RE.TestBench -import Text.RE.Types.CaptureID -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.Regex.TDFA - - --- | the RE type for this back end representing a well-formed, compiled --- RE -data RE = - RE - { _re_options :: !REOptions - , _re_source :: !String - , _re_cnames :: !CaptureNames - , _re_regex :: !Regex - } - --- | some functions in the "Text.RE.TestBench" need the back end to --- be passed dynamically as a 'RegexType' parameters: use 'regexType' --- fpr this backend -regexType :: RegexType -regexType = - mkTDFA $ \txt env md -> txt =~ mdRegexSource regexType ExclCaptures env md - --- | extract the 'REOptions' from the @RE@ -reOptions :: RE -> REOptions -reOptions = _re_options - --- | extract the RE source string from the @RE@ -reSource :: RE -> String -reSource = _re_source - --- | extract the 'CaptureNames' from the @RE@ -reCaptureNames :: RE -> CaptureNames -reCaptureNames = _re_cnames - --- | extract the back end compiled 'Regex' type from the @RE@ -reRegex :: RE -> Regex -reRegex = _re_regex - - ------------------------------------------------------------------------- --- REOptions ------------------------------------------------------------------------- - --- | and the REOptions for this back end (see "Text.RE.Types.REOptions" --- for details) -type REOptions = REOptions_ RE CompOption ExecOption - -instance IsOption SimpleREOptions RE CompOption ExecOption where - makeREOptions = unpackSimpleREOptions - -instance IsOption (Macros RE) RE CompOption ExecOption where - makeREOptions ms = REOptions ms def_comp_option def_exec_option - -instance IsOption CompOption RE CompOption ExecOption where - makeREOptions co = REOptions prelude co def_exec_option - -instance IsOption ExecOption RE CompOption ExecOption where - makeREOptions eo = REOptions prelude def_comp_option eo - -instance IsOption REOptions RE CompOption ExecOption where - makeREOptions = id - -instance IsOption () RE CompOption ExecOption where - makeREOptions _ = unpackSimpleREOptions minBound - --- | the default 'REOptions' -defaultREOptions :: REOptions -defaultREOptions = makeREOptions (minBound::SimpleREOptions) - --- | the default 'REOptions' but with no RE macros defined -noPreludeREOptions :: REOptions -noPreludeREOptions = defaultREOptions { optionsMacs = emptyMacros } - --- | convert a universal 'SimpleReOptions' into the 'REOptions' used --- by this back end -unpackSimpleREOptions :: SimpleREOptions -> REOptions -unpackSimpleREOptions sro = - REOptions - { optionsMacs = prelude - , optionsComp = comp - , optionsExec = defaultExecOpt - } - where - comp = defaultCompOpt - { caseSensitive = cs - , multiline = ml - } - - (ml,cs) = case sro of - MultilineSensitive -> (,) True True - MultilineInsensitive -> (,) True False - BlockSensitive -> (,) False True - BlockInsensitive -> (,) False False - - ------------------------------------------------------------------------- --- Compiling Regular Expressions ------------------------------------------------------------------------- - --- | compile a 'String' into a 'RE' with the default options, --- generating an error if the RE is not well formed -compileRegex :: (Functor m,Monad m) => String -> m RE -compileRegex = compileRegexWithOptions () - --- | compile a 'String' into a 'RE' using the given @SimpleREOptions@, --- generating an error if the RE is not well formed -compileRegexWith :: (Functor m,Monad m) => SimpleREOptions -> String -> m RE -compileRegexWith = compileRegexWithOptions - --- | compile a 'String' into a 'RE' using the given @SimpleREOptions@, --- generating an error if the RE is not well formed -compileRegexWithOptions :: ( IsOption o RE CompOption ExecOption - , Functor m - , Monad m - ) - => o - -> String - -> m RE -compileRegexWithOptions = compileRegex_ . makeREOptions - - ------------------------------------------------------------------------- --- Compiling Search Replace Templates ------------------------------------------------------------------------- - --- | compile a SearchReplace template generating errors if the RE or --- the template are not well formed -- all capture references being checked -compileSearchReplace :: (Monad m,Functor m,IsRegex RE s) - => String - -> String - -> m (SearchReplace RE s) -compileSearchReplace = compileSearchReplaceWith minBound - --- | compile a SearchReplace template, with simple options, generating --- errors if the RE or the template are not well formed -- all capture --- references being checked -compileSearchReplaceWith :: (Monad m,Functor m,IsRegex RE s) - => SimpleREOptions - -> String - -> String - -> m (SearchReplace RE s) -compileSearchReplaceWith sro = compileSearchAndReplace_ packR $ compileRegexWith sro - --- | compile a SearchReplace template, with general options, generating --- errors if the RE or the template are not well formed -- all capture --- references being checked -compileSearchReplaceWithREOptions :: (Monad m,Functor m,IsRegex RE s) - => REOptions - -> String - -> String - -> m (SearchReplace RE s) -compileSearchReplaceWithREOptions os = compileSearchAndReplace_ packR $ compileRegexWithOptions os - - ------------------------------------------------------------------------- --- Escaping Strings ------------------------------------------------------------------------- - --- | convert a string into a RE that matches that string, and apply it --- to an argument continuation function to make up the RE string to be --- compiled -escape :: (Functor m,Monad m) - => (String->String) - -> String - -> m RE -escape = escapeWith minBound - --- | convert a string into a RE that matches that string, and apply it --- to an argument continuation function to make up the RE string to be --- compiled with the default options -escapeWith :: (Functor m,Monad m) - => SimpleREOptions - -> (String->String) - -> String - -> m RE -escapeWith = escapeWithOptions - --- | convert a string into a RE that matches that string, and apply it --- to an argument continuation function to make up the RE string to be --- compiled the given options -escapeWithOptions :: ( IsOption o RE CompOption ExecOption - , Functor m - , Monad m - ) - => o - -> (String->String) - -> String - -> m RE -escapeWithOptions o f = compileRegexWithOptions o . f . escapeREString - - ------------------------------------------------------------------------- --- Macro Standard Environment ------------------------------------------------------------------------- - --- | the standard table of 'Macros' used to compile REs (which can be --- extended or replace: see "Text.RE.TestBench") -prelude :: Macros RE -prelude = runIdentity $ preludeMacros mk regexType ExclCaptures - where - mk = Identity . unsafeCompileRegex_ noPreludeREOptions - --- | the standard 'MacroEnv' for this back end (see "Text.RE.TestBench") -preludeEnv :: MacroEnv -preludeEnv = preludeMacroEnv regexType - --- | the macros in the standard environment that are failing their tests --- (checked by the test suite to be empty) -preludeTestsFailing :: [MacroID] -preludeTestsFailing = badMacros $ preludeMacroEnv regexType - --- | a table the standard macros in markdown format -preludeTable :: String -preludeTable = preludeMacroTable regexType - --- | a summary of the macros in the standard environment for this back --- end in plain text -preludeSummary :: PreludeMacro -> String -preludeSummary = preludeMacroSummary regexType - --- | a listing of the RE text for each macro in the standard environment --- with all macros expanded to normal form -preludeSources :: String -preludeSources = preludeMacroSources regexType - --- | the prolude source of a given macro in the standard environment -preludeSource :: PreludeMacro -> String -preludeSource = preludeMacroSource regexType - - ------------------------------------------------------------------------- --- Quasi Quoters ------------------------------------------------------------------------- - --- | the @[re| ... |]@ and @[ed| ... /// ... |]@ quasi quoters -re - , reMS - , reMI - , reBS - , reBI - , reMultilineSensitive - , reMultilineInsensitive - , reBlockSensitive - , reBlockInsensitive - , re_ :: QuasiQuoter - -- , ed - -- , edMS - -- , edMI - -- , edBS - -- , edBI - -- , edMultilineSensitive - -- , edMultilineInsensitive - -- , edBlockSensitive - -- , edBlockInsensitive - -- , ed_ :: QuasiQuoter - -re = re' $ Just minBound -reMS = reMultilineSensitive -reMI = reMultilineInsensitive -reBS = reBlockSensitive -reBI = reBlockInsensitive -reMultilineSensitive = re' $ Just MultilineSensitive -reMultilineInsensitive = re' $ Just MultilineInsensitive -reBlockSensitive = re' $ Just BlockSensitive -reBlockInsensitive = re' $ Just BlockInsensitive -re_ = re' Nothing - - ------------------------------------------------------------------------- --- re Helpers ------------------------------------------------------------------------- - -re' :: Maybe SimpleREOptions -> QuasiQuoter -re' mb = case mb of - Nothing -> - (qq0 "re'") - { quoteExp = parse minBound (\rs->[|flip unsafeCompileRegex rs|]) - } - Just sro -> - (qq0 "re'") - { quoteExp = parse sro (\rs->[|unsafeCompileRegexSimple sro rs|]) - } - where - parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp - parse sro mk rs = either error (\_->mk rs) $ compileRegex_ os rs - where - os = unpackSimpleREOptions sro - -unsafeCompileRegexSimple :: SimpleREOptions -> String -> RE -unsafeCompileRegexSimple sro re_s = unsafeCompileRegex_ os re_s - where - os = unpackSimpleREOptions sro - -unsafeCompileRegex :: IsOption o RE CompOption ExecOption - => o - -> String - -> RE -unsafeCompileRegex = unsafeCompileRegex_ . makeREOptions - -unsafeCompileRegex_ :: REOptions -> String -> RE -unsafeCompileRegex_ os = either oops id . compileRegex_ os - where - oops = error . ("unsafeCompileRegex: " ++) - -compileRegex' :: (Functor m,Monad m) - => REOptions - -> String - -> m (CaptureNames,Regex) -compileRegex' REOptions{..} s0 = do - ((_,cnms),s2) <- either fail return $ extractNamedCaptures s1 - (,) cnms <$> makeRegexOptsM optionsComp optionsExec s2 - where - s1 = expandMacros reSource optionsMacs s0 - -compileRegex_ :: (Functor m,Monad m) - => REOptions - -> String - -> m RE -compileRegex_ os re_s = uncurry mk <$> compileRegex' os re_s - where - mk cnms rx = - RE - { _re_options = os - , _re_source = re_s - , _re_cnames = cnms - , _re_regex = rx - } - - ------------------------------------------------------------------------- --- Options Helpers ------------------------------------------------------------------------- - -def_comp_option :: CompOption -def_comp_option = optionsComp defaultREOptions - -def_exec_option :: ExecOption -def_exec_option = optionsExec defaultREOptions - - ------------------------------------------------------------------------- --- Haddock Sections ------------------------------------------------------------------------- - --- $about --- --- This module provides the regex PCRE back end. Most of the functions that --- you will need for day to day use are provided by the primary API modules --- (e.g., "Text.RE.TDFA.Text"). 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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.Sequence + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.Sequence ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.Sequence -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.Sequence +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA 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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.String + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.String ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.String -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.String +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA 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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.Text + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.Text ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.Text -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.Text +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA 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 @@ -44,8 +44,8 @@ , escape , escapeWith , escapeREString - , module Text.RE.TDFA.RE - , module Text.RE.Internal.SearchReplace.TDFA.Text.Lazy + , module Text.RE.ZeInternals.TDFA + , module Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy ) where import Prelude.Compat @@ -53,13 +53,12 @@ import Data.Typeable import Text.Regex.Base import Text.RE -import Text.RE.Internal.AddCaptureNames -import Text.RE.Internal.SearchReplace.TDFA.Text.Lazy -import Text.RE.SearchReplace -import Text.RE.Types.IsRegex -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.TDFA.RE +import Text.RE.ZeInternals.AddCaptureNames +import Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.RE.ZeInternals.TDFA import qualified Text.Regex.TDFA as TDFA diff --git a/Text/RE/TestBench.hs b/Text/RE/TestBench.hs new file mode 100644 --- /dev/null +++ b/Text/RE/TestBench.hs @@ -0,0 +1,186 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.RE.TestBench + ( + -- * The Test Bench + MacroEnv + , MacroDescriptor(..) + , RegexSource(..) + , WithCaptures(..) + -- ** Constructing a MacrosEnv + , mkMacros + -- ** Formatting Macros + , formatMacroTable + , formatMacroSummary + , formatMacroSources + , formatMacroSource + -- ** Formatting Macros + , testMacroEnv + , runTests + , runTests' + -- * Parsing + , parseInteger + , parseHex + , parseDouble + , parseString + , parseSimpleString + , parseDate + , parseSlashesDate + , parseTimeOfDay + , parseTimeZone + , parseDateTime + , parseDateTime8601 + , parseDateTimeCLF + , parseShortMonth + , shortMonthArray + , IPV4Address + , parseIPv4Address + , Severity(..) + , parseSeverity + , severityKeywords +-- , module Text.RE.ZeInternals.TestBench + ) 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 +import Text.RE.ZeInternals.TestBench + + +parseInteger :: Replace a => a -> Maybe Int +parseInteger = readMaybe . unpackR + +parseHex :: Replace a => a -> Maybe Int +parseHex = readMaybe . ("0x"++) . unpackR + +parseDouble :: Replace a => a -> Maybe Double +parseDouble = readMaybe . unpackR + +parseString :: Replace a => a -> Maybe T.Text +parseString = readMaybe . unpackR + +parseSimpleString :: Replace a => a -> Maybe T.Text +parseSimpleString = Just . T.dropEnd 1 . T.drop 1 . textifyR + +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 . unpackR + +parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t +parse_time tpls = prs . unpackR + 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 (=='.') . unpackR + 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 . textifyR + +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/TestBench.lhs b/Text/RE/TestBench.lhs deleted file mode 100644 --- a/Text/RE/TestBench.lhs +++ /dev/null @@ -1,589 +0,0 @@ -\begin{code} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - -module Text.RE.TestBench - ( MacroID(..) - , RegexType - , mkTDFA - , mkPCRE - , isTDFA - , isPCRE - , presentRegexType - , MacroEnv - , WithCaptures(..) - , MacroDescriptor(..) - , TestResult(..) - , RegexSource(..) - , FunctionID(..) - , mkMacros - , testMacroEnv - , badMacros - , runTests - , runTests' - , formatMacroTable - , dumpMacroTable - , formatMacroSummary - , formatMacroSources - , formatMacroSource - , testMacroDescriptors - , mdRegexSource - -- * Parsers - , module Text.RE.TestBench.Parsers - -- * Text.RE - , module Text.RE - ) where - -import Data.Array -import Data.Char -import qualified Data.HashMap.Lazy as HML -import qualified Data.List as L -import Data.Maybe -import Data.Ord -import Data.String -import Text.Printf -import Prelude.Compat -import Text.RE -import Text.RE.TestBench.Parsers -import Text.RE.Types.Capture -import Text.RE.Types.REOptions -import Text.RE.Types.Match -import Text.RE.Types.Matches -import Text.RE.Types.Replace -\end{code} - -Types ------ - -\begin{code} - -type TestBenchMatcher = - String -> MacroEnv -> MacroDescriptor -> Matches String - --- | what kind of back end will be compiling the RE, and its match --- function -data RegexType - = TDFA TestBenchMatcher - | PCRE TestBenchMatcher - --- | test RegexType for TDFA/PCREness -isTDFA, isPCRE :: RegexType -> Bool - -isTDFA (TDFA _) = True -isTDFA (PCRE _) = False - -isPCRE (TDFA _) = False -isPCRE (PCRE _) = True - -mkTDFA, mkPCRE :: TestBenchMatcher -> RegexType -mkTDFA = TDFA -mkPCRE = PCRE - -presentRegexType :: RegexType -> String -presentRegexType (TDFA _) = "TDFA" -presentRegexType (PCRE _) = "PCRE" - -instance Show RegexType where - show (TDFA _) = "TDFA " - show (PCRE _) = "PCRE " - --- | do we need the captures in the RE or whould they be stripped out --- where possible -data WithCaptures - = InclCaptures - | ExclCaptures - deriving (Eq,Ord,Show) - --- | each macro can reference others, the whole environment being --- required for each macro, so we use a Lazy HashMap -type MacroEnv = HML.HashMap MacroID MacroDescriptor - --- | describes a macro, giving the text of the RE and a si=ummary --- description -data MacroDescriptor = - MacroDescriptor - { _md_source :: !RegexSource -- ^ the RE - , _md_samples :: ![String] -- ^ some sample matches - , _md_counter_samples :: ![String] -- ^ some sample non-matches - , _md_test_results :: ![TestResult] -- ^ validation test results - , _md_parser :: !(Maybe FunctionID) -- ^ WA, the parser function - , _md_description :: !String -- ^ summary comment - } - deriving (Show) - --- | list of failures on a validation run -newtype TestResult = - TestResult { _TestResult :: String } - deriving (IsString,Show) - --- | a RE that should work for POSIX and PCRE with open brackets ('(') --- represented as follows: --- \( mere symbol --- (?: used for grouping only, not for captures --- (}: used for captures only, not for grouping --- (]: used for captures and grouping --- ( do not modify -newtype RegexSource = - RegexSource { _RegexSource :: String } - deriving (IsString,Show) - --- | name of the Haskell parser function for parsing the text matched --- by a macro -newtype FunctionID = - FunctionID { _FunctionID :: String } - deriving (IsString,Show) - --- | we are only interested in the open parentheses used for --- grouping and/or capturing; if neither grouping or capturing then --- there is no initial '(' or '(?:', just the suffic text -data REToken = - REToken - { _ret_prefix :: String -- ^ following text optional ( or (?: - , _ret_fixed :: Bool -- ^ a '(' that is not safe to modify - , _ret_grouping :: Bool -- ^ is this a grouping group - , _ret_capturing :: Bool -- ^ is this a capturing group - } - deriving (Show) -\end{code} - - -mkMacros --------- - -\begin{code} -mkMacros :: (Monad m,Functor m) - => (String->m r) - -> RegexType - -> WithCaptures - -> MacroEnv - -> m (Macros r) -mkMacros prs rty wc env = - HML.fromList <$> mapM (uncurry mk) (HML.toList env) - where - mk mid md = (,) mid <$> prs (mdRegexSource rty wc env md) -\end{code} - - -testMacroEnv, badMacros ------------------------ - -\begin{code} -testMacroEnv :: String -> RegexType -> MacroEnv -> IO Bool -testMacroEnv lab rty m_env = case badMacros m_env of - [] -> return True - fails -> do - putStrLn $ lab' ++ " has failing tests for these macros: " - putStr $ unlines $ [ " "++getMacroID mid | mid<-fails ] - putStrLn $ "The whole table:" - putStrLn $ "========================================================" - putStr $ formatMacroTable rty m_env - putStrLn $ "========================================================" - return False - where - lab' = lab ++ " [" ++ presentRegexType rty ++"]" - -badMacros :: MacroEnv -> [MacroID] -badMacros m_env = - [ mid - | (mid,MacroDescriptor{..}) <- HML.toList m_env - , not $ null _md_test_results - ] - -runTests :: (Eq a,Show a) - => RegexType - -> (String->Maybe a) - -> [(String,a)] - -> MacroEnv - -> MacroID - -> MacroDescriptor - -> MacroDescriptor -runTests rty parser = runTests' rty parser' - where - parser' caps = fmap capturedText (matchCapture caps) >>= parser - -runTests' :: (Eq a,Show a) - => RegexType - -> (Match String->Maybe a) - -> [(String,a)] - -> MacroEnv - -> MacroID - -> MacroDescriptor - -> MacroDescriptor -runTests' rty parser vector env mid md@MacroDescriptor{..} = - md { _md_test_results = test_results } - where - test_results = concat - [ concat $ map test vector - , concat $ map test_neg _md_counter_samples - ] - - test (src,x) = test' mid rty parser x $ match_ src env md - - test_neg src = test_neg' mid rty parser $ match_ src env md - - match_ = case rty of - TDFA tbmf -> tbmf - PCRE tbmf -> tbmf -\end{code} - - -dumpMacroTable, formatMacroTable, formatMacroSummary, formatMacroSources, formatMacroSource -------------------------------------------------------------------------------------------- - -\begin{code} -dumpMacroTable :: String -> RegexType -> MacroEnv -> IO () -dumpMacroTable lab rty m_env = do - writeFile fp_t $ formatMacroTable rty m_env - writeFile fp_s $ formatMacroSources rty ExclCaptures m_env - where - fp_t = "docs/" ++ rty_s ++ "-" ++ lab ++ ".txt" - fp_s = "docs/" ++ rty_s ++ "-" ++ lab ++ "-src.txt" - - rty_s = map toLower $ presentRegexType rty -\end{code} - -\begin{code} -formatMacroTable :: RegexType -> MacroEnv -> String -formatMacroTable rty env = unlines $ - format_table macro_table_hdr - [ macro_table_row rty mid md - | (mid,md) <- L.sortBy (comparing fst) $ HML.toList env - ] -\end{code} - -\begin{code} -formatMacroSummary :: RegexType -> MacroEnv -> MacroID -> String -formatMacroSummary rty env mid = maybe oops prep $ HML.lookup mid env - where - prep :: MacroDescriptor -> String - prep md = unlines $ concat $ map (fmt md) [minBound..maxBound] - - fmt :: MacroDescriptor -> Col -> [String] - fmt md c = - [ printf "%-15s : %s" (present_col c) ini - ] ++ map (" "++) lns - where - (ini,lns) = case macro_attribute rty mid md c of - [] -> (,) "" [] - [ln] -> (,) ln [] - lns_ -> (,) "" lns_ - - oops = error $ getMacroID mid ++ ": macro not defined in this environment" -\end{code} - -\begin{code} -formatMacroSources :: RegexType - -> WithCaptures - -> MacroEnv - -> String -formatMacroSources rty wc env = unlines $ - [ printf "%-20s : %s" (getMacroID mid) $ formatMacroSource rty wc env mid - | mid <- L.sort $ HML.keys env - ] -\end{code} - -\begin{code} -formatMacroSource :: RegexType - -> WithCaptures - -> MacroEnv - -> MacroID - -> String -formatMacroSource rty wc env mid = - mdRegexSource rty wc env $ fromMaybe oops $ HML.lookup mid env - where - oops = error $ "formatMacroSource: not found: " ++ getMacroID mid -\end{code} - - -testMacroDescriptors, regexSource ---------------------------------- - -\begin{code} -testMacroDescriptors :: [MacroDescriptor] -> [TestResult] -testMacroDescriptors = concat . map _md_test_results - -regexSource :: RegexType -> WithCaptures -> RegexSource -> String -regexSource rty wc = format_tokens rty wc . scan_re -\end{code} - - -Formatting helpers ------------------- - -\begin{code} -type TableRow = Array Col [String] - -data Col - = C_name - | C_caps - | C_regex - | C_examples - | C_anti_examples - | C_fails - | C_parser - | C_comment - deriving (Ix,Bounded,Enum,Ord,Eq,Show) - -present_col :: Col -> String -present_col = map tr . drop 2 . show - where - tr '_' = '-' - tr c = c - -macro_table_hdr :: TableRow -macro_table_hdr = listArray (minBound,maxBound) - [ [present_col c] - | c<-[minBound..maxBound] - ] - -macro_table_row :: RegexType -> MacroID -> MacroDescriptor -> TableRow -macro_table_row rty mid md = - listArray (minBound,maxBound) $ - map (macro_attribute rty mid md) [minBound..maxBound] - -macro_attribute :: RegexType - -> MacroID - -> MacroDescriptor - -> Col - -> [String] -macro_attribute rty mid MacroDescriptor{..} c = - case c of - C_name -> [getMacroID mid] - C_caps -> [show $ min_captures rty $ scan_re _md_source] - C_regex -> [regexSource rty ExclCaptures _md_source] - C_examples -> _md_samples - C_anti_examples -> _md_counter_samples - C_fails -> map _TestResult _md_test_results - C_parser -> [maybe "-" _FunctionID _md_parser] - C_comment -> [_md_description] - -format_table :: TableRow -> [TableRow] -> [String] -format_table hdr rows0 = concat - [ format_row cws hdr' - , format_row cws dsh - , concat $ map (format_row cws) rows - ] - where - dsh = listArray (minBound,maxBound) - [ [replicate n '-'] | n<-elems cws ] - - hdr' = hdr // [(,) C_regex $ [take n $ concat $ repeat "regex="] ] - where - n = min 29 $ cws!C_regex - - cws = widths $ hdr : rows - - rows = map wrap_row rows0 - -field_width :: Int -field_width = 40 - -wrap_row :: TableRow -> TableRow -wrap_row = fmap $ concat . map f - where - f, g :: String -> [String] - - f cts = (ini ++ ['\\' | not (null rst)]) : g rst - where - (ini,rst) = splitAt (1+field_width) cts - - g "" = [] - g cts = ('\\' : ini ++ ['\\' | not (null rst)]) : g rst - where - (ini,rst) = splitAt field_width cts - - -widths :: [TableRow] -> Array Col Int -widths rows = listArray (minBound,maxBound) - [ maximum $ concat [ map length $ row!c | row<-rows ] - | c<-[minBound..maxBound] - ] - -format_row :: Array Col Int -> TableRow -> [String] -format_row cw_arr row = - [ ("|"++) $ L.intercalate "|" - [ field cw_arr row c i | c<-[minBound..maxBound] ] - | i <- [0..depth-1] - ] - where - depth = maximum [ length $ row!c | c<-[minBound..maxBound] ] - -field :: Array Col Int -> TableRow -> Col -> Int -> String -field cws row c i = ljust (cws!c) $ sel i $ row!c - -sel :: Int -> [String] -> String -sel i ss = case drop i ss of - [] -> "" - s:_ -> s - -ljust :: Int -> String -> String -ljust w s = s ++ replicate n ' ' - where - n = max 0 $ w - length s - -min_captures :: RegexType -> [REToken] -> Int -min_captures rty rets = length - [ () - | REToken{..}<-rets - , _ret_fixed || (_ret_grouping && isTDFA rty) - ] -\end{code} - - -Formatting tokens ------------------ - -\begin{code} -format_tokens :: RegexType -> WithCaptures -> [REToken] -> String -format_tokens rty wc = foldr f "" - where - f REToken{..} rst = _ret_prefix ++ bra ++ xket rst - where - bra = case _ret_fixed of - True -> "(" - False -> - case (,) _ret_grouping (_ret_capturing && wc==InclCaptures) of - (False,False) -> "" - (True ,False) -> if isPCRE rty then "(?:" else "(" - (False,True ) -> "(" - (True ,True ) -> "(" - - xket = - case not _ret_grouping && _ret_capturing && wc==ExclCaptures of - True -> delete_ket 0 - False -> id - -delete_ket :: Int -> String -> String -delete_ket _ "" = error "delete_ket: end of input" -delete_ket n (c:t) = case c of - '\\' -> case t of - "" -> error "delete_ket: end of input" - c':t' -> c : c' : delete_ket n t' - ')' -> case n of - 0 -> t - _ -> c : delete_ket (n-1) t - '(' -> c : delete_ket (n+1) t - _ -> c : delete_ket n t -\end{code} - - -scan_re -------- - -\begin{code} -scan_re :: RegexSource -> [REToken] -scan_re (RegexSource src0) = loop src0 - where - loop "" = [] - loop src = - case rst of - '\\':t -> case t of - "" -> REToken (ini++['\\']) False False False : [] - c':t' -> REToken (ini++['\\',c']) False False False : loop t' - '(' :t -> case t of - c:':':t' - | c=='?' -> REToken ini False True False : loop t' - | c=='}' -> REToken ini False False True : loop t' - | c==']' -> REToken ini False True True : loop t' - _ -> REToken ini True True True : loop t - _ -> [REToken src False False False] - where - (ini,rst) = break chk src - - chk '\\' = True - chk '(' = True - chk _ = False -\end{code} - - -mdRegexSource -------------- - -\begin{code} -mdRegexSource :: RegexType - -> WithCaptures - -> MacroEnv - -> MacroDescriptor - -> String -mdRegexSource rty wc env md = - expandMacros' lu $ regexSource rty wc $ _md_source md - where - lu = fmap (regexSource rty wc . _md_source) . - flip HML.lookup env -\end{code} - - -test', test_neg' ----------------- - -\begin{code} -test' :: (Eq a,Show a) - => MacroID - -> RegexType - -> (Match String->Maybe a) - -> a - -> Matches String - -> [TestResult] -test' mid rty prs x Matches{..} = either (:[]) (const []) $ do - cs <- case allMatches of - [cs] -> return cs - _ -> oops "RE failed to parse" - mtx <- case matchCapture cs of - Nothing -> oops $ "RE parse failure: " ++ show cs - Just c -> return $ capturedText c - case mtx == matchesSource of - True -> return () - False -> oops "RE failed to match the whole text" - x' <- case prs cs of - Nothing -> oops "matched text failed to parse" - Just x' -> return x' - case x'==x of - True -> return () - False -> oops "parser failed to yield the expected result" - where - oops = Left . test_diagnostic mid False rty matchesSource - -test_neg' :: MacroID - -> RegexType - -> (Match String->Maybe a) - -> Matches String - -> [TestResult] -test_neg' mid rty prs Matches{..} = either id (const []) $ do - case allMatches of - [] -> return () - cz -> case ms of - [] -> return () - _ -> Left [oops "RE parse succeeded"] - where - ms = - [ () - | cs <- cz - , Just c <- [matchCapture cs] - , let t = capturedText c - , t == matchesSource - , isJust $ prs cs - ] - - where - oops = test_diagnostic mid True rty matchesSource - -test_diagnostic :: MacroID - -> Bool - -> RegexType - -> String - -> String - -> TestResult -test_diagnostic mid is_neg rty tst msg = - TestResult $ - printf "%-20s [%s %s] : %s (%s)" mid_s neg_s rty_s msg tst - where - mid_s = getMacroID mid - neg_s = if is_neg then "-ve" else "+ve" :: String - rty_s = presentRegexType rty -\end{code} diff --git a/Text/RE/TestBench/Parsers.hs b/Text/RE/TestBench/Parsers.hs deleted file mode 100644 --- a/Text/RE/TestBench/Parsers.hs +++ /dev/null @@ -1,166 +0,0 @@ -{-# 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 . unpackR - -parseHex :: Replace a => a -> Maybe Int -parseHex = readMaybe . ("0x"++) . unpackR - -parseDouble :: Replace a => a -> Maybe Double -parseDouble = readMaybe . unpackR - -parseString :: Replace a => a -> Maybe T.Text -parseString = readMaybe . unpackR - -parseSimpleString :: Replace a => a -> Maybe T.Text -parseSimpleString = Just . T.dropEnd 1 . T.drop 1 . textifyR - -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 . unpackR - -parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t -parse_time tpls = prs . unpackR - 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 (=='.') . unpackR - 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 . textifyR - -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 --- a/Text/RE/Tools/Edit.lhs +++ b/Text/RE/Tools/Edit.lhs @@ -29,11 +29,10 @@ import Data.Maybe import Prelude.Compat import Text.RE -import Text.RE.Types.Capture -import Text.RE.Types.IsRegex -import Text.RE.Types.LineNo -import Text.RE.Types.Replace -import Text.RE.Types.SearchReplace +import Text.RE.ZeInternals.Types.Capture +import Text.RE.IsRegex +import Text.RE.ZeInternals.Types.LineNo +import Text.RE.Replace -- | an 'Edits' script will, for each line in the file, either perform @@ -46,7 +45,7 @@ -- | each Edit action specifies how the match should be processed data Edit m re s = Template !(SearchReplace re s) - | Function !re REContext !(LineNo->Match s->Location->Capture s->m (Maybe s)) + | Function !re REContext !(LineNo->Match s->RELocation->Capture s->m (Maybe s)) | LineEdit !re !(LineNo->Matches s->m (LineEdit s)) -- | a LineEdit is the most general action thar can be performed on a line 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 @@ -28,8 +28,8 @@ import Prelude.Compat import Text.Printf import Text.RE -import Text.RE.Types.IsRegex -import Text.RE.Types.LineNo +import Text.RE.IsRegex +import Text.RE.ZeInternals.Types.LineNo -- | operates a bit like classic @grep@ printing out the lines matched 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 @@ -12,10 +12,10 @@ import Prelude.Compat import Text.RE -import Text.RE.Types.Capture -import Text.RE.Types.IsRegex -import Text.RE.Types.Match -import Text.RE.Types.Replace +import Text.RE.ZeInternals.Types.Capture +import Text.RE.IsRegex +import Text.RE.ZeInternals.Types.Match +import Text.RE.Replace -- | a simple regex-based scanner interpretter for prototyping 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 @@ -32,8 +32,8 @@ import Prelude.Compat import Text.RE import Text.RE.Tools.Edit -import Text.RE.Types.IsRegex -import Text.RE.Types.Replace +import Text.RE.IsRegex +import Text.RE.Replace -- | read a file, apply an 'Edits' script to each line it and diff --git a/Text/RE/Types.hs b/Text/RE/Types.hs deleted file mode 100644 --- a/Text/RE/Types.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Text.RE.Types - ( -- $collection - module Text.RE.Types.Capture - , module Text.RE.Types.CaptureID - , module Text.RE.Types.IsRegex - , module Text.RE.Types.LineNo - , module Text.RE.Types.Match - , module Text.RE.Types.Matches - , module Text.RE.Types.REOptions - , module Text.RE.Types.Replace - , module Text.RE.Types.SearchReplace - ) where - -import Text.RE.Types.Capture -import Text.RE.Types.CaptureID -import Text.RE.Types.IsRegex -import Text.RE.Types.LineNo -import Text.RE.Types.Match -import Text.RE.Types.Matches -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.Types.SearchReplace - --- $collection --- --- This module collects together all of the @Text.RE.Types.*@ modules --- to make it easy to import them all en masse. diff --git a/Text/RE/Types/Capture.lhs b/Text/RE/Types/Capture.lhs deleted file mode 100644 --- a/Text/RE/Types/Capture.lhs +++ /dev/null @@ -1,61 +0,0 @@ -\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 deleted file mode 100644 --- a/Text/RE/Types/CaptureID.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# 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 -- [cp|3|] - | IsCaptureName CaptureName -- [cp|y|] - 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 deleted file mode 100644 --- a/Text/RE/Types/IsRegex.lhs +++ /dev/null @@ -1,46 +0,0 @@ -\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.Internal.EscapeREString -import Text.RE.Types.Match -import Text.RE.Types.Matches -import Text.RE.Types.REOptions -import Text.RE.Types.Replace -import Text.RE.Types.SearchReplace -\end{code} - -\begin{code} --- | the 'IsRegex' class allows tools to be written that will work with --- regex back end text type supported by the back end -class Replace s => IsRegex re s where - -- | finding the first match - matchOnce :: re -> s -> Match s - -- | finding all matches - matchMany :: re -> s -> Matches s - -- | compiling an RE, failing if the RE is not well formed - makeRegex :: (Functor m,Monad m) => s -> m re - -- | comiling an RE, specifying the 'SimpleREOptions' - makeRegexWith :: (Functor m,Monad m) => SimpleREOptions -> s -> m re - -- | compiling a 'SearchReplace' template from the RE text and the template Text, failing if they are not well formed - makeSearchReplace :: (Functor m,Monad m,IsRegex re s) => s -> s -> m (SearchReplace re s) - -- | compiling a 'SearchReplace' template specifing the 'SimpleREOptions' for the RE - makeSearchReplaceWith :: (Functor m,Monad m,IsRegex re s) => SimpleREOptions -> s -> s -> m (SearchReplace re s) - -- | incorporate an escaped string into a compiled RE with the default options - makeEscaped :: (Functor m,Monad m) => (s->s) -> s -> m re - -- | incorporate an escaped string into a compiled RE with the specified 'SimpleREOptions' - makeEscapedWith :: (Functor m,Monad m) => SimpleREOptions -> (s->s) -> s -> m re - -- | extract the text of the RE from the RE - regexSource :: re -> s - - makeRegex = makeRegexWith minBound - makeSearchReplace = makeSearchReplaceWith minBound - makeEscaped = makeEscapedWith minBound - makeEscapedWith o f = makeRegexWith o . f . packR . escapeREString . unpackR -\end{code} diff --git a/Text/RE/Types/LineNo.hs b/Text/RE/Types/LineNo.hs deleted file mode 100644 --- a/Text/RE/Types/LineNo.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Text.RE.Types.LineNo where - - --- | our line numbers are of the proper zero-based kind -newtype LineNo = - ZeroBasedLineNo { getZeroBasedLineNo :: Int } - deriving (Show,Enum) - --- | the first line in a file -firstLine :: LineNo -firstLine = ZeroBasedLineNo 0 - --- | extract a conventional 1-based line number -getLineNo :: LineNo -> Int -getLineNo = succ . getZeroBasedLineNo - --- | inject a conventional 1-based line number -lineNo :: Int -> LineNo -lineNo = ZeroBasedLineNo . pred diff --git a/Text/RE/Types/Match.lhs b/Text/RE/Types/Match.lhs deleted file mode 100644 --- a/Text/RE/Types/Match.lhs +++ /dev/null @@ -1,194 +0,0 @@ -\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} --- | this instance hooks 'Match' into regex-base: regex consumers need --- not worry about any of this -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 deleted file mode 100644 --- a/Text/RE/Types/Matches.lhs +++ /dev/null @@ -1,80 +0,0 @@ -\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 'Match' instances 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} --- | this instance hooks 'Matches' into regex-base: regex consumers need --- not worry about any of this -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/REOptions.lhs b/Text/RE/Types/REOptions.lhs deleted file mode 100644 --- a/Text/RE/Types/REOptions.lhs +++ /dev/null @@ -1,94 +0,0 @@ -\begin{code} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE TemplateHaskellQuotes #-} -#else -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -#endif - -module Text.RE.Types.REOptions 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} --- | the default API uses these simple, universal RE options, --- which get auto-converted into the apropriate 'REOptions_' actually --- as apropriate the chosen back end -data SimpleREOptions - = MultilineSensitive -- ^ case-sensitive with ^ and $ matching the start and end of a line - | MultilineInsensitive -- ^ case-insensitive with ^ and $ matsh the start and end of a line - | BlockSensitive -- ^ case-sensitive with ^ and $ matching the start and end of the input text - | BlockInsensitive -- ^ case-insensitive with ^ and $ matching the start and end of the input text - deriving (Bounded,Enum,Eq,Ord,Show) -\end{code} - -\begin{code} --- | we need to use this in the quasi quoters to specify @SimpleREOptions@ --- selected by the quasi quoter -instance Lift SimpleREOptions where - lift sro = case sro of - MultilineSensitive -> conE 'MultilineSensitive - MultilineInsensitive -> conE 'MultilineInsensitive - BlockSensitive -> conE 'BlockSensitive - BlockInsensitive -> conE 'BlockInsensitive -\end{code} - -\begin{code} --- | the general options for an RE are dependent on which back end is --- being used and are parameterised over the @RE@ type for the back end, --- and its @CompOption@ and @ExecOption@ types (the compile-time and --- execution time options, respectively); each back end will define an --- @REOptions@ type that fills out these three type parameters with the --- apropriate types -data REOptions_ r c e = - REOptions - { optionsMacs :: !(Macros r) -- ^ the available TestBench RE macros - , optionsComp :: !c -- ^ the back end compile-time options - , optionsExec :: !e -- ^ the back end execution-time options - } - deriving (Show) -\end{code} - -\begin{code} --- | a number of types can be used to encode @REOptions@, each of which --- can be made a member of this class. -class IsOption o r c e | - e -> r, c -> e , e -> c, r -> c, c -> r, r -> e where - -- | convert the @o@ type into an @REOptions r c e@ - makeREOptions :: o -> REOptions_ r c e -\end{code} - -\begin{code} --- | @MacroID@ is just a wrapped @String@ type with an @IsString@ --- instance -newtype MacroID = - MacroID { getMacroID :: String } - deriving (IsString,Ord,Eq,Show) -\end{code} - -\begin{code} --- | @MacroID@ is used with @HM.HashMap@ to build macro lookup tables -instance Hashable MacroID where - hashWithSalt i = hashWithSalt i . getMacroID -\end{code} - -\begin{code} --- | our macro tables are parameterised over the backend @RE@ type and --- and just associate each @MacroID@ with an @RE@ -type Macros r = HM.HashMap MacroID r -\end{code} - -\begin{code} --- | a macro table containing no entries -emptyMacros :: Macros r -emptyMacros = HM.empty -\end{code} diff --git a/Text/RE/Types/Replace.lhs b/Text/RE/Types/Replace.lhs deleted file mode 100644 --- a/Text/RE/Types/Replace.lhs +++ /dev/null @@ -1,505 +0,0 @@ -\begin{code} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} - -module Text.RE.Types.Replace - ( Replace(..) - , ReplaceMethods(..) - , replaceMethods - , REContext(..) - , Location(..) - , isTopLocation - , replace - , replaceAll - , replaceAllCaptures - , replaceAllCaptures_ - , replaceAllCapturesM - , replaceCaptures - , replaceCaptures_ - , replaceCapturesM - , expandMacros - , expandMacros' - , templateCaptures - ) 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.RE.Types.Capture -import Text.RE.Types.CaptureID -import Text.RE.Types.Match -import Text.RE.Types.Matches -import Text.RE.Types.REOptions -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; lengthR is the minimum implementation -class (Show a,Eq a,Ord a,Extract a,Monoid a) => Replace a where - -- | length function for a - lengthR :: a -> Int - -- | inject String into a - packR :: String -> a - -- | project a onto a String - unpackR :: a -> String - -- | inject into Text - textifyR :: a -> T.Text - -- | project Text onto a - detextifyR :: T.Text -> a - -- | split into lines - linesR :: a -> [a] - -- | concatenate a list of lines - unlinesR :: [a] -> a - -- | append a newline - appendNewlineR :: a -> a - -- | apply a substitution function to a Capture - substR :: (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 - parseTemplateR :: a -> Match a -> Location -> Capture a -> Maybe a - - textifyR = T.pack . unpackR - detextifyR = packR . T.unpack - appendNewlineR = (<> packR "\n") - - substR 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 = lengthR - , methodSubst = substR - } -\end{code} - -\begin{code} --- | @REContext@ specifies which contexts the substitutions should be applied -data REContext - = 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 (parseTemplateR 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 - => REContext - -> (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 - -> REContext - -> (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 - -> REContext - -> (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 - => a - -> Match a - -> a -replace tpl c = replaceCaptures TOP (parseTemplateR 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 - => REContext - -> (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 - -> REContext - -> (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 - -> REContext - -> (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 - lengthR = length - packR = id - unpackR = id - textifyR = T.pack - detextifyR = T.unpack - linesR = lines - unlinesR = unlines - appendNewlineR = (<>"\n") - parseTemplateR = parseTemplateR' id - -instance Replace B.ByteString where - lengthR = B.length - packR = B.pack - unpackR = B.unpack - textifyR = TE.decodeUtf8 - detextifyR = TE.encodeUtf8 - linesR = B.lines - unlinesR = B.unlines - appendNewlineR = (<>"\n") - parseTemplateR = parseTemplateR' B.unpack - -instance Replace LBS.ByteString where - lengthR = fromEnum . LBS.length - packR = LBS.pack - unpackR = LBS.unpack - textifyR = TE.decodeUtf8 . LBS.toStrict - linesR = LBS.lines - unlinesR = LBS.unlines - detextifyR = LBS.fromStrict . TE.encodeUtf8 - appendNewlineR = (<>"\n") - parseTemplateR = parseTemplateR' LBS.unpack - -instance Replace (S.Seq Char) where - lengthR = S.length - packR = S.fromList - unpackR = F.toList - linesR = map packR . lines . unpackR - unlinesR = packR . unlines . map unpackR - parseTemplateR = parseTemplateR' F.toList - -instance Replace T.Text where - lengthR = T.length - packR = T.pack - unpackR = T.unpack - textifyR = id - detextifyR = id - linesR = T.lines - unlinesR = T.unlines - appendNewlineR = (<>"\n") - parseTemplateR = parseTemplateR' T.unpack - -instance Replace LT.Text where - lengthR = fromEnum . LT.length - packR = LT.pack - unpackR = LT.unpack - textifyR = LT.toStrict - detextifyR = LT.fromStrict - linesR = LT.lines - unlinesR = LT.unlines - appendNewlineR = (<>"\n") - parseTemplateR = parseTemplateR' 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 $=~ "@(@|\\{([^{}]+)\\})" - 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} --- | parse the replacement template in second argument, substititing --- the capture references with corresponding captures from the Match --- in the third argument (the result of a single match of the RE --- against the input text to be matched); Nothing is returned if the --- inputs are not well formed (currently all inputs are well formed) -parseTemplateR' :: ( Replace a - , RegexContext Regex a (Matches a) - , RegexMaker Regex CompOption ExecOption String - ) - => (a->String) - -> a - -> Match a - -> Location - -> Capture a - -> Maybe a -parseTemplateR' unpack tpl mtch _ _ = - Just $ replaceAllCaptures TOP phi $ scan_template tpl - where - phi t_mtch _ _ = either Just this $ parse_template_capture unpack t_mtch - - this cid = capturedText <$> mtch !$? cid - --- | list all of the CaptureID references in the replace template in --- the second argument -templateCaptures :: ( Replace a - , RegexContext Regex a (Matches a) - , RegexMaker Regex CompOption ExecOption String - ) - => (a->String) - -> a - -> [CaptureID] -templateCaptures unpack tpl = - [ cid - | mtch <- allMatches $ scan_template tpl - , Right cid <- [parse_template_capture unpack mtch] - ] - --- | parse a Match generated by acan_template, returning @Left "$") --- iff the capture reference is an escaped @$@ (i.e., @$$@) -parse_template_capture :: (a->String) -> Match a -> Either a CaptureID -parse_template_capture unpack t_mtch = case t_mtch !$? c2 of - Just cap -> case readMaybe stg of - Nothing -> Right $ IsCaptureName $ CaptureName $ T.pack stg - Just cn -> Right $ IsCaptureOrdinal $ CaptureOrdinal cn - where - stg = unpack $ capturedText cap - Nothing -> case s == "$" of - True -> Left t - False -> Right $ IsCaptureOrdinal $ CaptureOrdinal $ read s - where - s = unpack t - t = capturedText $ capture c1 t_mtch - - c1 = IsCaptureOrdinal $ CaptureOrdinal 1 - c2 = IsCaptureOrdinal $ CaptureOrdinal 2 - --- | scan a replacement template, returning a Match for each capture --- reference in the template (like $1, ${foo}) -scan_template :: ( Replace a - , RegexContext Regex a (Matches a) - , RegexMaker Regex CompOption ExecOption String - ) - => a - -> Matches a -scan_template tpl = tpl $=~ "\\$(\\$|[0-9]|\\{([^{}]+)\\})" -\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/Types/SearchReplace.hs b/Text/RE/Types/SearchReplace.hs deleted file mode 100644 --- a/Text/RE/Types/SearchReplace.hs +++ /dev/null @@ -1,15 +0,0 @@ - -module Text.RE.Types.SearchReplace - ( SearchReplace(..) - ) where - --- | contains a compiled RE and replacement template -data SearchReplace re s = - SearchReplace - { getSearch :: !re -- ^ the RE - , getTemplate :: !s -- ^ the replacement template - } - deriving (Show) - -instance Functor (SearchReplace re) where - fmap f (SearchReplace re x) = SearchReplace re (f x) diff --git a/Text/RE/ZeInternals/AddCaptureNames.hs b/Text/RE/ZeInternals/AddCaptureNames.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/AddCaptureNames.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.RE.ZeInternals.AddCaptureNames where + +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.ByteString.Char8 as B +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 +import Text.RE.ZeInternals.Types.CaptureID +import Text.RE.ZeInternals.Types.Match +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" diff --git a/Text/RE/ZeInternals/EscapeREString.hs b/Text/RE/ZeInternals/EscapeREString.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/EscapeREString.hs @@ -0,0 +1,29 @@ +module Text.RE.ZeInternals.EscapeREString where + +-- | Convert a string into a regular expression that will amtch that +-- string +escapeREString :: String -> String +escapeREString = foldr esc [] + where + esc c t | isMetaChar c = '\\' : c : t + | otherwise = c : t + +-- | returns True iff the charactr is an RE meta character +-- ('[', '*', '{', etc.) +isMetaChar :: Char -> Bool +isMetaChar c = case c of + '^' -> True + '\\' -> True + '.' -> True + '|' -> True + '*' -> True + '?' -> True + '+' -> True + '(' -> True + ')' -> True + '[' -> True + ']' -> True + '{' -> True + '}' -> True + '$' -> True + _ -> False diff --git a/Text/RE/ZeInternals/NamedCaptures.lhs b/Text/RE/ZeInternals/NamedCaptures.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/NamedCaptures.lhs @@ -0,0 +1,230 @@ +\begin{code} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.NamedCaptures + ( cp + , extractNamedCaptures + , idFormatTokenREOptions + , Token(..) + , validToken + , formatTokens + , formatTokens' + , formatTokens0 + , scan + ) where + +import Data.Char +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import GHC.Generics +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import Text.RE +import Text.RE.ZeInternals.PreludeMacros +import Text.RE.ZeInternals.QQ +import Text.RE.ZeInternals.TestBench +import Text.RE.Tools.Lex +import Text.RE.ZeInternals.Types.CaptureID +import Text.RE.ZeInternals.Types.Match +import Text.Regex.TDFA + + +-- | quasi quoter for CaptureID ([cp|0|],[cp|y|], etc.) +cp :: QuasiQuoter +cp = + (qq0 "cp") + { quoteExp = parse_capture + } + +-- | extract the CaptureNames from an RE or return an error diagnostic +-- if the RE is not well formed; also returs the total number of captures +-- in the RE +extractNamedCaptures :: String -> Either String ((Int,CaptureNames),String) +extractNamedCaptures s = Right (analyseTokens tks,formatTokens tks) + where + tks = scan s +\end{code} + + +Token +----- + +\begin{code} +-- | our RE scanner returns a list of these tokens +data Token + = ECap (Maybe String) + | PGrp + | PCap + | Bra + | BS Char + | Other Char + deriving (Show,Generic,Eq) + +-- | check that a token is well formed +validToken :: Token -> Bool +validToken tkn = case tkn of + ECap mb -> maybe True check_ecap mb + PGrp -> True + PCap -> True + Bra -> True + BS c -> is_dot c + Other c -> is_dot c + where + check_ecap s = not (null s) && all not_br s + is_dot c = c/='\n' + not_br c = not $ c `elem` "{}\n" + +\end{code} + + +Analysing [Token] -> CaptureNames +--------------------------------- + +\begin{code} +-- | analyse a token stream, returning the number of captures and the +-- 'CaptureNames' +analyseTokens :: [Token] -> (Int,CaptureNames) +analyseTokens tks0 = case count_em 1 tks0 of + (n,as) -> (n-1, HM.fromList as) + where + count_em n [] = (n,[]) + count_em n (tk:tks) = case count_em (n `seq` n+d) tks of + (n',as) -> (n',bd++as) + where + (d,bd) = case tk of + ECap (Just nm) -> (,) 1 [(CaptureName $ T.pack nm,CaptureOrdinal n)] + ECap Nothing -> (,) 1 [] + PGrp -> (,) 0 [] + PCap -> (,) 1 [] + Bra -> (,) 1 [] + BS _ -> (,) 0 [] + Other _ -> (,) 0 [] +\end{code} + + +Scanning Regex Strings +---------------------- + +\begin{code} +-- | scan a RE string into a list of RE Token +scan :: String -> [Token] +scan = alex' match al oops + where + al :: [(Regex,Match String->Maybe Token)] + al = + [ mk "\\$\\{([^{}]+)\\}\\(" $ ECap . Just . x_1 + , mk "\\$\\(" $ const $ ECap Nothing + , mk "\\(\\?:" $ const PGrp + , mk "\\(\\?" $ const PCap + , mk "\\(" $ const Bra + , mk "\\\\(.)" $ BS . s2c . x_1 + , mk "(.)" $ Other . s2c . x_1 + ] + + x_1 = captureText $ IsCaptureOrdinal $ CaptureOrdinal 1 + + s2c [c] = c + s2c _ = error "scan:s2c:internal error" + + mk s f = (either error id $ makeRegexM s,Just . f) + + oops = error "reScanner" +\end{code} + + +Parsing captures +---------------- + +\begin{code} +parse_capture :: String -> TH.Q TH.Exp +parse_capture s = case all isDigit s of + True -> [|IsCaptureOrdinal $ CaptureOrdinal $ read s|] + False -> [|IsCaptureName $ CaptureName $ T.pack s|] +\end{code} + + +Formatting [Token] +------------------ + +\begin{code} +-- | format [Token] into an RE string +formatTokens :: [Token] -> String +formatTokens = formatTokens' defFormatTokenREOptions + +-- | options for the general Token formatter below +data FormatTokenREOptions = + FormatTokenREOptions + { _fto_regex_type :: Maybe RegexType -- ^ Posix, PCRE or indeterminate REs? + , _fto_min_caps :: Bool -- ^ remove captures where possible + , _fto_incl_caps :: Bool -- ^ include the captures in the output + } + deriving (Show) + +-- | the default configuration for the Token formatter +defFormatTokenREOptions :: FormatTokenREOptions +defFormatTokenREOptions = + FormatTokenREOptions + { _fto_regex_type = Nothing + , _fto_min_caps = False + , _fto_incl_caps = False + } + +-- | a configuration that will preserve the parsed regular expression +-- in the output +idFormatTokenREOptions :: FormatTokenREOptions +idFormatTokenREOptions = + FormatTokenREOptions + { _fto_regex_type = Nothing + , _fto_min_caps = False + , _fto_incl_caps = True + } + +-- | the general Token formatter, generating REs according to the options +formatTokens' :: FormatTokenREOptions -> [Token] -> String +formatTokens' FormatTokenREOptions{..} = foldr f "" + where + f tk tl = t_s ++ tl + where + t_s = case tk of + ECap mb -> ecap mb + PGrp -> if maybe False isTDFA _fto_regex_type then "(" else "(?:" + PCap -> "(?" + Bra -> bra _fto_min_caps + BS c -> "\\" ++ [c] + Other c -> [c] + + ecap mb = case _fto_incl_caps of + True -> case mb of + Nothing -> "$(" + Just nm -> "${"++nm++"}(" + False -> bra _fto_min_caps + + bra mc = case mc && maybe False isPCRE _fto_regex_type of + True -> "(?:" + False -> "(" +\end{code} + +\begin{code} +-- this is a reference of formatTokens defFormatTokenREOptions, +-- used for testing the latter +formatTokens0 :: [Token] -> String +formatTokens0 = foldr f "" + where + f tk tl = t_s ++ tl + where + t_s = case tk of + ECap _ -> "(" + PGrp -> "(?:" + PCap -> "(?" + Bra -> "(" + BS c -> "\\" ++ [c] + Other c -> [c] +\end{code} diff --git a/Text/RE/ZeInternals/PreludeMacros.hs b/Text/RE/ZeInternals/PreludeMacros.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/PreludeMacros.hs @@ -0,0 +1,909 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Text.RE.ZeInternals.PreludeMacros + ( RegexType + , WithCaptures(..) + , MacroDescriptor(..) + , RegexSource(..) + , PreludeMacro(..) + , presentPreludeMacro + , preludeMacros + , preludeMacroTable + , preludeMacroSummary + , preludeMacroSources + , preludeMacroSource + , preludeMacroEnv + , preludeMacroDescriptor + ) where + +import Data.Array +import qualified Data.HashMap.Lazy as HML +import Data.List +import Data.Maybe +import qualified Data.Text as T +import Data.Time +import Prelude.Compat +import Text.RE.TestBench +import Text.RE.ZeInternals.TestBench +import Text.RE.REOptions + + +-- | generate the standard prelude Macros used to parse REs +preludeMacros :: (Monad m,Functor m) + => (String->m r) + -> RegexType + -> WithCaptures + -> m (Macros r) +preludeMacros prs rty wc = mkMacros prs rty wc $ preludeMacroEnv rty + +-- | format the standard prelude macros in a markdown table +preludeMacroTable :: RegexType -> String +preludeMacroTable rty = formatMacroTable rty $ preludeMacroEnv rty + +-- | generate a textual summary of the prelude macros +preludeMacroSummary :: RegexType -> PreludeMacro -> String +preludeMacroSummary rty = + formatMacroSummary rty (preludeMacroEnv rty) . prelude_macro_id + +-- | generate a plain text table giving the RE for each macro with all +-- macros expanded (to NF) +preludeMacroSources :: RegexType -> String +preludeMacroSources rty = + formatMacroSources rty ExclCaptures $ preludeMacroEnv rty + +-- | generate plain text giving theexpanded RE for a single macro +preludeMacroSource :: RegexType -> PreludeMacro -> String +preludeMacroSource rty = + formatMacroSource rty ExclCaptures (preludeMacroEnv rty) . prelude_macro_id + +-- | generate the `MacroEnv` for the standard prelude macros +preludeMacroEnv :: RegexType -> MacroEnv +preludeMacroEnv rty = fix $ prelude_macro_env rty + +prelude_macro_env :: RegexType -> MacroEnv -> MacroEnv +prelude_macro_env rty env = HML.fromList $ catMaybes + [ (,) (prelude_macro_id pm) <$> preludeMacroDescriptor rty env pm + | pm<-[minBound..maxBound] + ] + +-- | generate the `MacroDescriptor` for a given `PreludeMacro` +preludeMacroDescriptor :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +preludeMacroDescriptor rty env pm = case pm of + PM_nat -> natural_macro rty env pm + PM_hex -> natural_hex_macro rty env pm + PM_int -> integer_macro rty env pm + PM_frac -> decimal_macro rty env pm + PM_string -> string_macro rty env pm + PM_string_simple -> string_simple_macro rty env pm + PM_id -> id_macro rty env pm + PM_id' -> id'_macro rty env pm + PM_id_ -> id__macro rty env pm + PM_date -> date_macro rty env pm + PM_date_slashes -> date_slashes_macro rty env pm + PM_time -> time_macro rty env pm + PM_timezone -> timezone_macro rty env pm + PM_datetime -> datetime_macro rty env pm + PM_datetime_8601 -> datetime_8601_macro rty env pm + PM_datetime_clf -> datetime_clf_macro rty env pm + PM_shortmonth -> shortmonth_macro rty env pm + PM_address_ipv4 -> address_ipv4_macros rty env pm + PM_email_simple -> email_simple_macro rty env pm + PM_url -> url_macro rty env pm + PM_syslog_severity -> syslog_severity_macro rty env pm + +-- | an enumeration of all of the prelude macros +data PreludeMacro + -- numbers + = PM_nat + | PM_hex + | PM_int + | PM_frac + -- strings + | PM_string + | PM_string_simple + -- identifiers + | PM_id + | PM_id' + | PM_id_ + -- dates & times + | PM_date + | PM_date_slashes + | PM_time + | PM_timezone + | PM_datetime + | PM_datetime_8601 + | PM_datetime_clf + | PM_shortmonth + -- addresses + | PM_address_ipv4 + | PM_email_simple + | PM_url + -- syslog + | PM_syslog_severity + deriving (Bounded,Enum,Ord,Eq,Show) + +-- | naming the macros +presentPreludeMacro :: PreludeMacro -> String +presentPreludeMacro pm = case pm of + PM_id_ -> prelude_prefix++"id-" + _ -> fmt pm + where + fmt = (prelude_prefix++) . map tr . drop 3 . show + + tr '_' = '.' + tr c = c + +-- | all prelude macros are prefixed with this +prelude_prefix :: String +prelude_prefix = "%" + +prelude_macro_id :: PreludeMacro -> MacroID +prelude_macro_id = MacroID . presentPreludeMacro + +natural_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +natural_macro rty env pm = Just $ run_tests rty parseInteger samples env pm + MacroDescriptor + { macroSource = "[0-9]+" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseInteger" + , macroDescription = "a string of one or more decimal digits" + } + where + samples :: [(String,Int)] + samples = + [ (,) "0" 0 + , (,) "1234567890" 1234567890 + , (,) "00" 0 + , (,) "01" 1 + ] + + counter_samples = + [ "" + , "0A" + , "-1" + ] + +natural_hex_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +natural_hex_macro rty env pm = Just $ run_tests rty parseHex samples env pm + MacroDescriptor + { macroSource = "[0-9a-fA-F]+" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseHex" + , macroDescription = "a string of one or more hexadecimal digits" + } + where + samples :: [(String,Int)] + samples = + [ (,) "0" 0x0 + , (,) "12345678" 0x12345678 + , (,) "0abcdef" 0xabcdef + , (,) "0ABCDEF" 0xabcdef + , (,) "00" 0x0 + , (,) "010" 0x10 + ] + + counter_samples = + [ "" + , "0x10" + , "0z" + , "-1a" + ] + +integer_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +integer_macro rty env pm = Just $ run_tests rty parseInteger samples env pm + MacroDescriptor + { macroSource = "-?[0-9]+" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseInteger" + , macroDescription = "a decimal integer" + } + where + samples :: [(String,Int)] + samples = + [ (,) "0" 0 + , (,) "1234567890" 1234567890 + , (,) "00" 0 + , (,) "01" 1 + , (,) "-1" $ -1 + , (,) "-0" 0 + ] + + counter_samples = + [ "" + , "0A" + , "+0" + ] + +-- | a digit string macro +decimal_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +decimal_macro rty env pm = Just $ run_tests rty parseDouble samples env pm + MacroDescriptor + { macroSource = "-?[0-9]+(?:\\.[0-9]+)?" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseInteger" + , macroDescription = "a decimal integer" + } + where + samples :: [(String,Double)] + samples = + [ (,) "0" 0 + , (,) "1234567890" 1234567890 + , (,) "00" 0 + , (,) "01" 1 + , (,) "-1" $ -1 + , (,) "-0" 0 + , (,) "0.1234567890" 0.1234567890 + , (,) "-1.0" $ -1.0 + ] + + counter_samples = + [ "" + , "0A" + , "+0" + , "0." + , ".0" + , "." + , "-" + , "-." + , "-1." + , "-.1" + ] + +string_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +string_macro rty env pm + | isPCRE rty = Nothing + | otherwise = + Just $ run_tests rty (fmap T.unpack . parseString) samples env pm + MacroDescriptor + { macroSource = "\"(?:[^\"\\]+|\\\\[\\\"])*\"" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseString" + , macroDescription = "a double-quote string, with simple \\ escapes for \\s and \"s" + } + where + samples :: [(String,String)] + samples = + [ (,) "\"\"" "" + , (,) "\"foo\"" "foo" + , (,) "\"\\\"\"" "\"" + , (,) "\"\\\"\\\"\"" "\"\"" + , (,) "\"\\\"\\\\\\\"\"" "\"\\\"" + , (,) "\"\\\"foo\\\"\"" "\"foo\"" + , (,) "\"\"" "" + ] + + counter_samples = + [ "\"" + , "\"aa" + ] + +string_simple_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +string_simple_macro rty env pm = + Just $ run_tests rty (fmap T.unpack . parseSimpleString) samples env pm + MacroDescriptor + { macroSource = "\"[^\"[:cntrl:]]*\"" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseSimpleString" + , macroDescription = "a decimal integer" + } + where + samples :: [(String,String)] + samples = + [ (,) "\"\"" "" + , (,) "\"foo\"" "foo" + , (,) "\"\\\"" "\\" + , (,) "\"\"" "" + ] + + counter_samples = + [ "" + , "\"" + , "\"\\\"\"" + , "\"\\\"\\\"\"" + , "\"\\\"\\\\\\\"\"" + , "\"\\\"foo\\\"\"" + , "\"aa" + ] + +id_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +id_macro rty env pm = + Just $ run_tests rty Just samples env pm + MacroDescriptor + { macroSource = "_*[a-zA-Z][a-zA-Z0-9_]*" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Nothing + , macroDescription = "a standard C-style alphanumeric identifier (with _s)" + } + where + samples :: [(String,String)] + samples = + [ f "a" + , f "A" + , f "A1" + , f "a_" + , f "a1_B2" + , f "_abc" + , f "__abc" + ] + where + f s = (s,s) + + counter_samples = + [ "" + , "1" + , "_" + , "__" + , "__1" + , "1a" + , "a'" + ] + +id'_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +id'_macro rty env pm = + Just $ run_tests rty Just samples env pm + MacroDescriptor + { macroSource = "_*[a-zA-Z][a-zA-Z0-9_']*" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Nothing + , macroDescription = "a standard Haskell-style alphanumeric identifier (with '_'s and '''s)" + } + where + samples :: [(String,String)] + samples = + [ f "a" + , f "A" + , f "A1" + , f "a_" + , f "a1_B2" + , f "_abc" + , f "__abc" + , f "a'" + , f "_a'" + , f "a'b" + ] + where + f s = (s,s) + + counter_samples = + [ "" + , "1" + , "_" + , "__" + , "__1" + , "1a" + , "'" + , "'a" + , "_'" + , "_1'" + ] + +id__macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +id__macro rty env pm = + Just $ run_tests rty Just samples env pm + MacroDescriptor + { macroSource = "_*[a-zA-Z][a-zA-Z0-9_'-]*" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Nothing + , macroDescription = "an identifier with -s" + } + where + samples :: [(String,String)] + samples = + [ f "a" + , f "A" + , f "A1" + , f "a_" + , f "a1_B2" + , f "_abc" + , f "__abc" + , f "a'" + , f "_a'" + , f "a'b" + , f "a-" + , f "a1-B2" + , f "a1-B2-" + ] + where + f s = (s,s) + + counter_samples = + [ "" + , "1" + , "_" + , "__" + , "__1" + , "1a" + , "'" + , "'a" + , "_'" + , "_1'" + ] + +date_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +date_macro rty env pm = + Just $ run_tests rty parseDate samples env pm + MacroDescriptor + { macroSource = "[0-9]{4}-[0-9]{2}-[0-9]{2}" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseDate" + , macroDescription = "a YYYY-MM-DD format date" + } + where + samples :: [(String,Day)] + samples = + [ f "2016-12-31" + , f "0001-01-01" + , f "1000-01-01" + ] + where + f s = (s,read s) + + counter_samples = + [ "" + , "2016/01/31" + , "2016-1-31" + , "2016-01-1" + , "2016-001-01" + ] + +date_slashes_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +date_slashes_macro rty env pm = + Just $ run_tests rty parseSlashesDate samples env pm + MacroDescriptor + { macroSource = "[0-9]{4}/[0-9]{2}/[0-9]{2}" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseSlashesDate" + , macroDescription = "a YYYY/MM/DD format date" + } + where + samples :: [(String,Day)] + samples = + [ f "2016/12/31" + , f "0001/01/01" + , f "1000/01/01" + ] + where + f s = (s,read $ map tr s) + where + tr '/' = '-' + tr c = c + + counter_samples = + [ "" + , "2016-01-31" + , "2016/1/31" + , "2016/01/1" + , "2016/001/01" + ] + +time_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +time_macro rty env pm = + Just $ run_tests rty parseTimeOfDay samples env pm + MacroDescriptor + { macroSource = "[0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseTimeOfDay" + , macroDescription = "a HH:MM:SS[.Q+]" + } + where + samples :: [(String,TimeOfDay)] + samples = + [ f "00:00:00" 00 00 0 + , f "23:59:59" 23 59 59 + , f "00:00:00.1234567890" 00 00 $ 123456789 / 1000000000 + ] + where + f s h m ps = (s,TimeOfDay h m ps) + + counter_samples = + [ "" + , "235959" + , "10:20" + , "A00:00:00" + , "00:00:00A" + , "23:59:59." + ] + +timezone_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +timezone_macro rty env pm = + Just $ run_tests rty parseTimeZone samples env pm + MacroDescriptor + { macroSource = "(?:Z|[+-][0-9]{2}:?[0-9]{2})" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseTimeZone" + , macroDescription = "an IOS-8601 TZ specification" + } + where + samples :: [(String,TimeZone)] + samples = + [ f "Z" $ minutesToTimeZone 0 + , f "+00:00" $ minutesToTimeZone 0 + , f "+0000" $ minutesToTimeZone 0 + , f "+0200" $ minutesToTimeZone 120 + , f "-0100" $ minutesToTimeZone $ -60 + ] + where + f = (,) + + counter_samples = + [ "" + , "00" + , "A00:00" + , "UTC" + , "EST" + , " EST" + ] + +datetime_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +datetime_macro rty env pm = Just $ run_tests rty parseDateTime samples env pm + MacroDescriptor + { macroSource = "@{%date}[ T]@{%time}(?:@{%timezone}| UTC)?" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseDateTime" + , macroDescription = "ISO-8601 format date and time + simple variants" + } + where + samples :: [(String,UTCTime)] + samples = + [ f "2016-12-31 23:37:22.525343 UTC" "2016-12-31 23:37:22.525343Z" + , f "2016-12-31 23:37:22.525343" "2016-12-31 23:37:22.525343Z" + , f "2016-12-31 23:37:22" "2016-12-31 23:37:22Z" + , f "2016-12-31T23:37:22+0100" "2016-12-31 23:37:22+0100" + , f "2016-12-31T23:37:22-01:00" "2016-12-31 23:37:22-0100" + , f "2016-12-31T23:37:22-23:59" "2016-12-31 23:37:22-2359" + , f "2016-12-31T23:37:22Z" "2016-12-31 23:37:22Z" + ] + where + f :: String -> String -> (String,UTCTime) + f s r_s = (s,read r_s) + + counter_samples = + [ "" + , "2016-12-31 23:37:22.525343 EST" + ] + +datetime_8601_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +datetime_8601_macro rty env pm = + Just $ run_tests rty parseDateTime samples env pm + MacroDescriptor + { macroSource = "@{%date}T@{%time}@{%timezone}" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseDateTime8601" + , macroDescription = "YYYY-MM-DDTHH:MM:SS[.Q*](Z|[+-]HHMM) format date and time" + } + where + samples :: [(String,UTCTime)] + samples = + [ f "2016-12-31T23:37:22.343Z" "2016-12-31 23:37:22.343Z" + , f "2016-12-31T23:37:22-0100" "2016-12-31 23:37:22-0100" + , f "2016-12-31T23:37:22+23:59" "2016-12-31 23:37:22+2359" + ] + where + f :: String -> String -> (String,UTCTime) + f s r_s = (s,read r_s) + + counter_samples = + [ "" + , "2016-12-31 23:37:22.525343 EST" + ] + +datetime_clf_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor +datetime_clf_macro rty env pm = + Just $ run_tests rty parseDateTimeCLF samples env pm + MacroDescriptor + { macroSource = re + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseDateTimeCLF" + , macroDescription = "Common Log Format date+time: %d/%b/%Y:%H:%M:%S %z" + } + where + samples :: [(String,UTCTime)] + samples = + [ f "10/Oct/2000:13:55:36 -0700" "2000-10-10 13:55:36-0700" + , f "10/Oct/2000:13:55:36 +07:00" "2000-10-10 13:55:36+0700" + ] + where + f :: String -> String -> (String,UTCTime) + f s r_s = (s,read r_s) + + counter_samples = + [ "" + , "2016-12-31T23:37+0100" + , "10/Oct/2000:13:55:36-0700" + , "10/OCT/2000:13:55:36 -0700" + , "10/Oct/2000:13:55 -0700" + , "10/Oct/2000:13:55Z" + ] + + re = RegexSource $ unwords + [ "[0-9]{2}/@{%shortmonth}/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2}" + , "[+-][0-9]{2}:?[0-9]{2}" + ] + +shortmonth_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +shortmonth_macro rty env pm = + Just $ run_tests rty parseShortMonth samples env pm + MacroDescriptor + { macroSource = bracketedRegexSource $ + intercalate "|" $ map T.unpack $ elems shortMonthArray + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseShortMonth" + , macroDescription = "three letter month name: Jan-Dec" + } + where + samples :: [(String,Int)] + samples = + [ f "Jan" 1 + , f "Feb" 2 + , f "Dec" 12 + ] + where + f = (,) + + counter_samples = + [ "" + , "jan" + , "DEC" + , "January" + , "01" + , "1" + ] + +address_ipv4_macros :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +address_ipv4_macros rty env pm = + Just $ run_tests rty parseIPv4Address samples env pm + MacroDescriptor + { macroSource = "[0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseSeverity" + , macroDescription = "an a.b.c.d IPv4 address" + } + where + samples :: [(String,IPV4Address)] + samples = + [ f "0.0.0.0" ( 0, 0, 0, 0) + , f "123.45.6.78" (123, 45, 6, 78) + , f "9.9.9.9" ( 9, 9, 9, 9) + , f "255.255.255.255" (255,255,255,255) + ] + where + f = (,) + + counter_samples = + [ "" + , "foo" + , "1234.0.0.0" + , "1.2.3" + , "1.2.3." + , "1.2..4" + , "www.example.com" + , "2001:0db8:85a3:0000:0000:8a2e:0370:7334" + ] + +syslog_severity_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +syslog_severity_macro rty env pm = + Just $ run_tests rty parseSeverity samples env pm + MacroDescriptor + { macroSource = re + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Just "parseSeverity" + , macroDescription = "syslog severity keyword (debug-emerg)" + } + where + samples :: [(String,Severity)] + samples = + [ f "emerg" Emerg + , f "panic" Emerg + , f "alert" Alert + , f "crit" Crit + , f "err" Err + , f "error" Err + , f "warn" Warning + , f "warning" Warning + , f "notice" Notice + , f "info" Info + , f "debug" Debug + ] + where + f = (,) + + counter_samples = + [ "" + , "Emergency" + , "ALERT" + ] + + re = if isPCRE rty + then re_pcre + else re_tdfa + + re_tdfa = bracketedRegexSource $ + intercalate "|" $ + [ T.unpack kw + | (kw0,kws) <- map severityKeywords [minBound..maxBound] + , kw <- kw0:kws + ] + + re_pcre = bracketedRegexSource $ + intercalate "|" $ + [ T.unpack kw + | (kw0,kws) <- map severityKeywords $ + filter (/=Err) [minBound..maxBound] + , kw <- kw0:kws + ] ++ ["err(?:or)?"] + +email_simple_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +email_simple_macro rty env pm = + Just $ run_tests rty Just samples env pm + MacroDescriptor + { macroSource = "[a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9.-]+" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Nothing + , macroDescription = "an email address" + } + where + samples :: [(String,String)] + samples = + [ f "user-name%foo.bar.com@an-example.com" + ] + where + f s = (s,s) + + counter_samples = + [ "" + , "not-an-email-address" + , "@not-an-email-address" + ] +-- | see https://mathiasbynens.be/demo/url-regex +-- (based on @stephenhay URL) +url_macro :: RegexType + -> MacroEnv + -> PreludeMacro + -> Maybe MacroDescriptor +url_macro rty env pm = + Just $ run_tests rty Just samples env pm + MacroDescriptor + { macroSource = "([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*" + , macroSamples = map fst samples + , macroCounterSamples = counter_samples + , macroTestResults = [] + , macroParser = Nothing + , macroDescription = "a URL" + } + where + samples :: [(String,String)] + samples = + [ f "https://mathiasbynens.be/demo/url-regex" + , f "http://foo.com/blah_blah" + , f "http://foo.com/blah_blah/" + , f "http://foo.com/blah_blah_(wikipedia)" + , f "http://foo.com/blah_blah_(wikipedia)_(again)" + , f "http://www.example.com/wpstyle/?p=364" + , f "HTTPS://foo.bar/?q=Test%20URL-encoded%20stuff" + , f "HTTP://223.255.255.254" + , f "ftp://223.255.255.254" + , f "FTP://223.255.255.254" + ] + where + f s = (s,s) + + counter_samples = + [ "" + , "http://" + , "http://." + , "http://.." + , "http://../" + , "http://?" + , "http://??" + , "http://foo.bar?q=Spaces should be encoded" + , "//" + , "http://##/" + , "http://##" + , "http://##/" + ] + +run_tests :: (Eq a,Show a) + => RegexType + -> (String->Maybe a) + -> [(String,a)] + -> MacroEnv + -> PreludeMacro + -> MacroDescriptor + -> MacroDescriptor +run_tests rty parser vector env = + runTests rty parser vector env . prelude_macro_id + +bracketedRegexSource :: String -> RegexSource +bracketedRegexSource re_s = RegexSource $ "(?:" ++ re_s ++ ")" + +fix :: (a->a) -> a +fix f = f (fix f) diff --git a/Text/RE/ZeInternals/QQ.hs b/Text/RE/ZeInternals/QQ.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/QQ.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Text.RE.ZeInternals.QQ where + +import Control.Exception +import Data.Typeable +import Language.Haskell.TH.Quote + + +-- | used to throw an exception reporting an abuse of a quasi quoter +data QQFailure = + QQFailure + { _qqf_context :: String -- ^ in what context was the quasi quoter used + , _qqf_component :: String -- ^ how was the quasi quoter being abused + } + deriving (Show,Typeable) + +instance Exception QQFailure where + +-- | a quasi quoter that can be used in no context (to be extended with +-- the appropriate quasi quoter parser) +qq0 :: String -> QuasiQuoter +qq0 ctx = + QuasiQuoter + { quoteExp = const $ throw $ QQFailure ctx "expression" + , quotePat = const $ throw $ QQFailure ctx "pattern" + , quoteType = const $ throw $ QQFailure ctx "type" + , quoteDec = const $ throw $ QQFailure ctx "declaration" + } diff --git a/Text/RE/ZeInternals/Replace.lhs b/Text/RE/ZeInternals/Replace.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Replace.lhs @@ -0,0 +1,538 @@ +\begin{code} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module Text.RE.ZeInternals.Replace + ( + -- * REContext and RELocation + REContext(..) + , RELocation(..) + , isTopLocation + -- * replaceAll + , replaceAll + , replaceAllCaptures + , replaceAllCaptures_ + , replaceAllCapturesM + -- * replace + , replace + , replaceCaptures + , replaceCaptures_ + , replaceCapturesM + -- * expandMacros + , expandMacros + , expandMacros' + -- * templateCaptures + , templateCaptures + -- * Replace and ReplaceMethods + , Replace(..) + , ReplaceMethods(..) + , replaceMethods + ) 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.RE.ZeInternals.Types.Capture +import Text.RE.ZeInternals.Types.CaptureID +import Text.RE.ZeInternals.Types.Match +import Text.RE.ZeInternals.Types.Matches +import Text.RE.REOptions +import Text.Read +import Text.Regex.TDFA +import Text.Regex.TDFA.Text() +import Text.Regex.TDFA.Text.Lazy() +\end{code} + + +ReContext and RELocation +------------------------ + +\begin{code} +-- | @REContext@ specifies which contexts the substitutions should be applied +data REContext + = 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 @RELocation@ information passed into the substitution function +-- specifies which sub-expression is being substituted +data RELocation = + RELocation + { 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 :: RELocation -> 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 (parseTemplateR 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 + => REContext + -> (Match a->RELocation->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 + -> REContext + -> (Match a->RELocation->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 + -> REContext + -> (Match a->RELocation->Capture a->m (Maybe a)) + -> Matches a + -> m a +replaceAllCapturesM r ctx phi_ Matches{..} = + replaceCapturesM r ALL phi $ Match matchesSource cnms arr + where + phi _ (RELocation _ i) = case arr_c!i of + Just caps -> phi_ caps . uncurry RELocation $ 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 + => a + -> Match a + -> a +replace tpl c = replaceCaptures TOP (parseTemplateR 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 + => REContext + -> (Match a->RELocation->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 + -> REContext + -> (Match a->RELocation->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 + -> REContext + -> (Match a->RELocation->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 (RELocation 0 i) cap +\end{code} + +expandMacros +------------ + +\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 $=~ "@(@|\\{([^{}]+)\\})" + 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->RELocation->Capture a->Maybe a) + -> (Match a->RELocation->Capture a->m (Maybe a)) +lift_phi phi_ = phi + where + phi caps' loc' cap' = return $ phi_ caps' loc' cap' +\end{code} + + +templateCaptures +---------------- + +\begin{code} +-- | list all of the CaptureID references in the replace template in +-- the second argument +templateCaptures :: ( Replace a + , RegexContext Regex a (Matches a) + , RegexMaker Regex CompOption ExecOption String + ) + => (a->String) + -> a + -> [CaptureID] +templateCaptures unpack tpl = + [ cid + | mtch <- allMatches $ scan_template tpl + , Right cid <- [parse_template_capture unpack mtch] + ] + +-- | parse a Match generated by acan_template, returning @Left "$") +-- iff the capture reference is an escaped @$@ (i.e., @$$@) +parse_template_capture :: (a->String) -> Match a -> Either a CaptureID +parse_template_capture unpack t_mtch = case t_mtch !$? c2 of + Just cap -> case readMaybe stg of + Nothing -> Right $ IsCaptureName $ CaptureName $ T.pack stg + Just cn -> Right $ IsCaptureOrdinal $ CaptureOrdinal cn + where + stg = unpack $ capturedText cap + Nothing -> case s == "$" of + True -> Left t + False -> Right $ IsCaptureOrdinal $ CaptureOrdinal $ read s + where + s = unpack t + t = capturedText $ capture c1 t_mtch + + c1 = IsCaptureOrdinal $ CaptureOrdinal 1 + c2 = IsCaptureOrdinal $ CaptureOrdinal 2 + +-- | scan a replacement template, returning a Match for each capture +-- reference in the template (like $1, ${foo}) +scan_template :: ( Replace a + , RegexContext Regex a (Matches a) + , RegexMaker Regex CompOption ExecOption String + ) + => a + -> Matches a +scan_template tpl = tpl $=~ "\\$(\\$|[0-9]|\\{([^{}]+)\\})" +\end{code} + + +Replace and ReplaceMethods +-------------------------- + +\begin{code} +-- | Replace provides the missing needed to replace the matched +-- text in a @Replace a => Match a@. +class (Show a,Eq a,Ord a,Extract a,Monoid a) => Replace a where + -- | length function for a + lengthR :: a -> Int + -- | inject String into a + packR :: String -> a + -- | project a onto a String + unpackR :: a -> String + -- | inject into Text + textifyR :: a -> T.Text + -- | project Text onto a + detextifyR :: T.Text -> a + -- | split into lines + linesR :: a -> [a] + -- | concatenate a list of lines + unlinesR :: [a] -> a + -- | append a newline + appendNewlineR :: a -> a + -- | apply a substitution function to a Capture + substR :: (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 + parseTemplateR :: a -> Match a -> RELocation -> Capture a -> Maybe a + + textifyR = T.pack . unpackR + detextifyR = packR . T.unpack + appendNewlineR = (<> packR "\n") + + substR 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 = lengthR + , methodSubst = substR + } +\end{code} + + +The Replace Instances +--------------------- + +\begin{code} +instance Replace [Char] where + lengthR = length + packR = id + unpackR = id + textifyR = T.pack + detextifyR = T.unpack + linesR = lines + unlinesR = unlines + appendNewlineR = (<>"\n") + parseTemplateR = parseTemplateR' id + +instance Replace B.ByteString where + lengthR = B.length + packR = B.pack + unpackR = B.unpack + textifyR = TE.decodeUtf8 + detextifyR = TE.encodeUtf8 + linesR = B.lines + unlinesR = B.unlines + appendNewlineR = (<>"\n") + parseTemplateR = parseTemplateR' B.unpack + +instance Replace LBS.ByteString where + lengthR = fromEnum . LBS.length + packR = LBS.pack + unpackR = LBS.unpack + textifyR = TE.decodeUtf8 . LBS.toStrict + linesR = LBS.lines + unlinesR = LBS.unlines + detextifyR = LBS.fromStrict . TE.encodeUtf8 + appendNewlineR = (<>"\n") + parseTemplateR = parseTemplateR' LBS.unpack + +instance Replace (S.Seq Char) where + lengthR = S.length + packR = S.fromList + unpackR = F.toList + linesR = map packR . lines . unpackR + unlinesR = packR . unlines . map unpackR + parseTemplateR = parseTemplateR' F.toList + +instance Replace T.Text where + lengthR = T.length + packR = T.pack + unpackR = T.unpack + textifyR = id + detextifyR = id + linesR = T.lines + unlinesR = T.unlines + appendNewlineR = (<>"\n") + parseTemplateR = parseTemplateR' T.unpack + +instance Replace LT.Text where + lengthR = fromEnum . LT.length + packR = LT.pack + unpackR = LT.unpack + textifyR = LT.toStrict + detextifyR = LT.fromStrict + linesR = LT.lines + unlinesR = LT.unlines + appendNewlineR = (<>"\n") + parseTemplateR = parseTemplateR' LT.unpack +\end{code} + + +Parsing Replace Templates +------------------------- + +\begin{code} +-- | parse the replacement template in second argument, substititing +-- the capture references with corresponding captures from the Match +-- in the third argument (the result of a single match of the RE +-- against the input text to be matched); Nothing is returned if the +-- inputs are not well formed (currently all inputs are well formed) +parseTemplateR' :: ( Replace a + , RegexContext Regex a (Matches a) + , RegexMaker Regex CompOption ExecOption String + ) + => (a->String) + -> a + -> Match a + -> RELocation + -> Capture a + -> Maybe a +parseTemplateR' unpack tpl mtch _ _ = + Just $ replaceAllCaptures TOP phi $ scan_template tpl + where + phi t_mtch _ _ = either Just this $ parse_template_capture unpack t_mtch + + this cid = capturedText <$> mtch !$? cid +\end{code} + + +Helpers +------- + +\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/ZeInternals/SearchReplace.hs b/Text/RE/ZeInternals/SearchReplace.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Text.RE.ZeInternals.SearchReplace + ( unsafeCompileSearchReplace_ + , compileSearchReplace_ + , compileSearchAndReplace_ + ) where + +import qualified Data.HashMap.Strict as HMS +import Prelude.Compat +import Text.RE.ZeInternals.NamedCaptures +import Text.RE.ZeInternals.Replace +import Text.RE.ZeInternals.Types.Capture +import Text.RE.ZeInternals.Types.CaptureID +import Text.RE.ZeInternals.Types.Matches +import Text.RE.ZeInternals.Types.SearchReplace +import qualified Text.Regex.TDFA as TDFA + + +-- | warapper on 'compileSearchReplace_' that will generate an error +-- if any compilation errors are found +unsafeCompileSearchReplace_ :: (String->s) + -> (String->Either String re) + -> String + -> SearchReplace re s +unsafeCompileSearchReplace_ pk cf = either err id . compileSearchReplace_ pk cf + where + err msg = error $ "unsafeCompileSearchReplace_: " ++ msg + +-- | compile a SearchReplace template generating errors if the RE or +-- the template are not well formed -- all capture references being checked +compileSearchReplace_ :: (Monad m,Functor m) + => (String->s) + -> (String->Either String re) + -> String + -> m (SearchReplace re s) +compileSearchReplace_ pack compile_re sr_tpl = either fail return $ do + case mainCaptures $ sr_tpl $=~ "///" of + [cap] -> + compileSearchAndReplace_ pack compile_re + (capturePrefix cap) (captureSuffix cap) + _ -> Left $ "bad search-replace template syntax: " ++ sr_tpl + +-- | compile 'SearcgReplace' from two strings containing the RE +-- and the replacement template +compileSearchAndReplace_ :: (Monad m,Functor m) + => (String->s) + -> (String->Either String re) + -> String + -> String + -> m (SearchReplace re s) +compileSearchAndReplace_ pack compile_re re_s tpl = either fail return $ do + re <- compile_re re_s + ((n,cnms),_) <- extractNamedCaptures re_s + mapM_ (check n cnms) $ templateCaptures id tpl + return $ SearchReplace re $ pack tpl + where + check :: Int -> CaptureNames -> CaptureID -> Either String () + check n cnms cid = case cid of + IsCaptureOrdinal co -> check_co n co + IsCaptureName cn -> check_cn cnms cn + + check_co n (CaptureOrdinal i) = case i <= n of + True -> return () + False -> Left $ "capture ordinal out of range: " ++ + show i ++ " >= " ++ show n + + check_cn cnms cnm = case cnm `HMS.member` cnms of + True -> return () + False -> Left $ "capture name not defined: " ++ + show (getCaptureName cnm) + +($=~) :: String -> String -> Matches String +($=~) = (TDFA.=~) diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA.hs b/Text/RE/ZeInternals/SearchReplace/TDFA.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Prelude.Compat +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' cast $ Just MultilineSensitive +edMultilineInsensitive = ed' cast $ Just MultilineInsensitive +edBlockSensitive = ed' cast $ Just BlockSensitive +edBlockInsensitive = ed' cast $ Just BlockInsensitive +ed_ = ed' cast Nothing + +cast :: Q Exp +cast = [|id|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import qualified Data.ByteString.Char8 as B +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE B.ByteString|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE B.ByteString|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString/Lazy.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString/Lazy.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import qualified Data.ByteString.Lazy.Char8 as LBS +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE LBS.ByteString|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE LBS.ByteString|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/Sequence.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/Sequence.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/Sequence.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.Sequence + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import qualified Data.Sequence as S +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE (S.Seq Char)|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE (S.Seq Char)|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/String.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/String.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/String.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.String + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE String|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE String|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/Text.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/Text.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/Text.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.Text + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import qualified Data.Text as T +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE T.Text|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE T.Text|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFA/Text/Lazy.hs b/Text/RE/ZeInternals/SearchReplace/TDFA/Text/Lazy.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFA/Text/Lazy.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy + ( ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ + ) where + +import qualified Data.Text.Lazy as TL +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Text.RE.ZeInternals.TDFA +import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime +import Text.RE.REOptions +import Text.RE.ZeInternals.Types.SearchReplace + + +-- | the @[ed| ... /// ... |]@ quasi quoters +ed + , edMS + , edMI + , edBS + , edBI + , edMultilineSensitive + , edMultilineInsensitive + , edBlockSensitive + , edBlockInsensitive + , ed_ :: QuasiQuoter + +ed = ed' sr_cast $ Just minBound +edMS = edMultilineSensitive +edMI = edMultilineInsensitive +edBS = edBlockSensitive +edBI = edBlockInsensitive +edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive +edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive +edBlockSensitive = ed' sr_cast $ Just BlockSensitive +edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive +ed_ = ed' fn_cast Nothing + +sr_cast :: Q Exp +sr_cast = [|\x -> x :: SearchReplace RE TL.Text|] + +fn_cast :: Q Exp +fn_cast = [|\x -> x :: SimpleREOptions -> SearchReplace RE TL.Text|] diff --git a/Text/RE/ZeInternals/SearchReplace/TDFAEdPrime.hs b/Text/RE/ZeInternals/SearchReplace/TDFAEdPrime.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/SearchReplace/TDFAEdPrime.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif + +module Text.RE.ZeInternals.SearchReplace.TDFAEdPrime + ( ed' + ) where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Prelude.Compat +import Text.RE.ZeInternals.SearchReplace +import Text.RE.ZeInternals.QQ +import Text.RE.ZeInternals.TDFA +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.Replace +import Text.Regex.TDFA + + +-- | construct a quasi quoter from a casting function and @Just sro@ +-- if the options are known, otherwise a function take takes the +-- 'SimpleREOptions' and constructs the 'SearchReplace' template +ed' :: Q Exp -> Maybe SimpleREOptions -> QuasiQuoter +ed' qe mb = case mb of + Nothing -> + (qq0 "ed'") + { quoteExp = parse minBound $ \rs -> AppE <$> qe <*> [|flip unsafe_compile_sr rs|] + } + Just sro -> + (qq0 "ed'") + { quoteExp = parse sro $ \rs -> AppE <$> qe <*> [|unsafe_compile_sr_simple sro rs|] + } + where + parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp + parse sro mk ts = either error (\_->mk ts) ei + where + ei :: Either String (SearchReplace RE String) + ei = compileSearchReplace_ id (compileRegexWith sro) ts + +unsafe_compile_sr_simple :: IsRegex RE s + => SimpleREOptions + -> String + -> SearchReplace RE s +unsafe_compile_sr_simple sro = + unsafe_compile_sr $ unpackSimpleREOptions sro + +unsafe_compile_sr :: ( IsOption o RE CompOption ExecOption + , IsRegex RE s + ) + => o + -> String + -> SearchReplace RE s +unsafe_compile_sr os = + unsafeCompileSearchReplace_ packR $ compileRegexWithOptions os diff --git a/Text/RE/ZeInternals/TDFA.hs b/Text/RE/ZeInternals/TDFA.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/TDFA.hs @@ -0,0 +1,428 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +#else +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Text.RE.ZeInternals.TDFA + ( -- * About + -- $about + + -- * RE Type + RE + , regexType + , reOptions + , reSource + , reCaptureNames + , reRegex + -- * REOptions Type + , REOptions + , defaultREOptions + , noPreludeREOptions + -- * Compiling Regular Expressions + , compileRegex + , compileRegexWith + , compileRegexWithOptions + -- * Compiling Search-Replace Templates + , compileSearchReplace + , compileSearchReplaceWith + , compileSearchReplaceWithREOptions + -- * Escaping String + , escape + , escapeWith + , escapeWithOptions + , escapeREString + -- * Macros Standard Environment + , prelude + , preludeEnv + , preludeTestsFailing + , preludeTable + , preludeSummary + , preludeSources + , preludeSource + , unpackSimpleREOptions + -- * The Quasi Quoters + , re + , reMS + , reMI + , reBS + , reBI + , reMultilineSensitive + , reMultilineInsensitive + , reBlockSensitive + , reBlockInsensitive + , re_ + , cp + ) where + +import Data.Functor.Identity +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Prelude.Compat +import Text.RE.IsRegex +import Text.RE.REOptions +import Text.RE.ZeInternals.EscapeREString +import Text.RE.ZeInternals.NamedCaptures +import Text.RE.ZeInternals.PreludeMacros +import Text.RE.ZeInternals.Replace +import Text.RE.ZeInternals.QQ +import Text.RE.ZeInternals.SearchReplace +import Text.RE.ZeInternals.TestBench +import Text.RE.ZeInternals.Types.CaptureID +import Text.Regex.TDFA + + +-- | the RE type for this back end representing a well-formed, compiled +-- RE +data RE = + RE + { _re_options :: !REOptions + , _re_source :: !String + , _re_cnames :: !CaptureNames + , _re_regex :: !Regex + } + +-- | some functions in the "Text.RE.TestBench" need the back end to +-- be passed dynamically as a 'RegexType' parameters: use 'regexType' +-- fpr this backend +regexType :: RegexType +regexType = + mkTDFA $ \txt env md -> txt =~ mdRegexSource regexType ExclCaptures env md + +-- | extract the 'REOptions' from the @RE@ +reOptions :: RE -> REOptions +reOptions = _re_options + +-- | extract the RE source string from the @RE@ +reSource :: RE -> String +reSource = _re_source + +-- | extract the 'CaptureNames' from the @RE@ +reCaptureNames :: RE -> CaptureNames +reCaptureNames = _re_cnames + +-- | extract the back end compiled 'Regex' type from the @RE@ +reRegex :: RE -> Regex +reRegex = _re_regex + + +------------------------------------------------------------------------ +-- REOptions +------------------------------------------------------------------------ + +-- | and the REOptions for this back end (see "Text.RE.REOptions" +-- for details) +type REOptions = REOptions_ RE CompOption ExecOption + +instance IsOption SimpleREOptions RE CompOption ExecOption where + makeREOptions = unpackSimpleREOptions + +instance IsOption (Macros RE) RE CompOption ExecOption where + makeREOptions ms = REOptions ms def_comp_option def_exec_option + +instance IsOption CompOption RE CompOption ExecOption where + makeREOptions co = REOptions prelude co def_exec_option + +instance IsOption ExecOption RE CompOption ExecOption where + makeREOptions eo = REOptions prelude def_comp_option eo + +instance IsOption REOptions RE CompOption ExecOption where + makeREOptions = id + +instance IsOption () RE CompOption ExecOption where + makeREOptions _ = unpackSimpleREOptions minBound + +-- | the default 'REOptions' +defaultREOptions :: REOptions +defaultREOptions = makeREOptions (minBound::SimpleREOptions) + +-- | the default 'REOptions' but with no RE macros defined +noPreludeREOptions :: REOptions +noPreludeREOptions = defaultREOptions { optionsMacs = emptyMacros } + +-- | convert a universal 'SimpleReOptions' into the 'REOptions' used +-- by this back end +unpackSimpleREOptions :: SimpleREOptions -> REOptions +unpackSimpleREOptions sro = + REOptions + { optionsMacs = prelude + , optionsComp = comp + , optionsExec = defaultExecOpt + } + where + comp = defaultCompOpt + { caseSensitive = cs + , multiline = ml + } + + (ml,cs) = case sro of + MultilineSensitive -> (,) True True + MultilineInsensitive -> (,) True False + BlockSensitive -> (,) False True + BlockInsensitive -> (,) False False + + +------------------------------------------------------------------------ +-- Compiling Regular Expressions +------------------------------------------------------------------------ + +-- | compile a 'String' into a 'RE' with the default options, +-- generating an error if the RE is not well formed +compileRegex :: (Functor m,Monad m) => String -> m RE +compileRegex = compileRegexWithOptions () + +-- | compile a 'String' into a 'RE' using the given @SimpleREOptions@, +-- generating an error if the RE is not well formed +compileRegexWith :: (Functor m,Monad m) => SimpleREOptions -> String -> m RE +compileRegexWith = compileRegexWithOptions + +-- | compile a 'String' into a 'RE' using the given @SimpleREOptions@, +-- generating an error if the RE is not well formed +compileRegexWithOptions :: ( IsOption o RE CompOption ExecOption + , Functor m + , Monad m + ) + => o + -> String + -> m RE +compileRegexWithOptions = compileRegex_ . makeREOptions + + +------------------------------------------------------------------------ +-- Compiling Search Replace Templates +------------------------------------------------------------------------ + +-- | compile a SearchReplace template generating errors if the RE or +-- the template are not well formed -- all capture references being checked +compileSearchReplace :: (Monad m,Functor m,IsRegex RE s) + => String + -> String + -> m (SearchReplace RE s) +compileSearchReplace = compileSearchReplaceWith minBound + +-- | compile a SearchReplace template, with simple options, generating +-- errors if the RE or the template are not well formed -- all capture +-- references being checked +compileSearchReplaceWith :: (Monad m,Functor m,IsRegex RE s) + => SimpleREOptions + -> String + -> String + -> m (SearchReplace RE s) +compileSearchReplaceWith sro = compileSearchAndReplace_ packR $ compileRegexWith sro + +-- | compile a SearchReplace template, with general options, generating +-- errors if the RE or the template are not well formed -- all capture +-- references being checked +compileSearchReplaceWithREOptions :: (Monad m,Functor m,IsRegex RE s) + => REOptions + -> String + -> String + -> m (SearchReplace RE s) +compileSearchReplaceWithREOptions os = compileSearchAndReplace_ packR $ compileRegexWithOptions os + + +------------------------------------------------------------------------ +-- Escaping Strings +------------------------------------------------------------------------ + +-- | convert a string into a RE that matches that string, and apply it +-- to an argument continuation function to make up the RE string to be +-- compiled +escape :: (Functor m,Monad m) + => (String->String) + -> String + -> m RE +escape = escapeWith minBound + +-- | convert a string into a RE that matches that string, and apply it +-- to an argument continuation function to make up the RE string to be +-- compiled with the default options +escapeWith :: (Functor m,Monad m) + => SimpleREOptions + -> (String->String) + -> String + -> m RE +escapeWith = escapeWithOptions + +-- | convert a string into a RE that matches that string, and apply it +-- to an argument continuation function to make up the RE string to be +-- compiled the given options +escapeWithOptions :: ( IsOption o RE CompOption ExecOption + , Functor m + , Monad m + ) + => o + -> (String->String) + -> String + -> m RE +escapeWithOptions o f = compileRegexWithOptions o . f . escapeREString + + +------------------------------------------------------------------------ +-- Macro Standard Environment +------------------------------------------------------------------------ + +-- | the standard table of 'Macros' used to compile REs (which can be +-- extended or replace: see "Text.RE.TestBench") +prelude :: Macros RE +prelude = runIdentity $ preludeMacros mk regexType ExclCaptures + where + mk = Identity . unsafeCompileRegex_ noPreludeREOptions + +-- | the standard 'MacroEnv' for this back end (see "Text.RE.TestBench") +preludeEnv :: MacroEnv +preludeEnv = preludeMacroEnv regexType + +-- | the macros in the standard environment that are failing their tests +-- (checked by the test suite to be empty) +preludeTestsFailing :: [MacroID] +preludeTestsFailing = badMacros $ preludeMacroEnv regexType + +-- | a table the standard macros in markdown format +preludeTable :: String +preludeTable = preludeMacroTable regexType + +-- | a summary of the macros in the standard environment for this back +-- end in plain text +preludeSummary :: PreludeMacro -> String +preludeSummary = preludeMacroSummary regexType + +-- | a listing of the RE text for each macro in the standard environment +-- with all macros expanded to normal form +preludeSources :: String +preludeSources = preludeMacroSources regexType + +-- | the prolude source of a given macro in the standard environment +preludeSource :: PreludeMacro -> String +preludeSource = preludeMacroSource regexType + + +------------------------------------------------------------------------ +-- Quasi Quoters +------------------------------------------------------------------------ + +-- | the @[re| ... |]@ and @[ed| ... /// ... |]@ quasi quoters +re + , reMS + , reMI + , reBS + , reBI + , reMultilineSensitive + , reMultilineInsensitive + , reBlockSensitive + , reBlockInsensitive + , re_ :: QuasiQuoter + -- , ed + -- , edMS + -- , edMI + -- , edBS + -- , edBI + -- , edMultilineSensitive + -- , edMultilineInsensitive + -- , edBlockSensitive + -- , edBlockInsensitive + -- , ed_ :: QuasiQuoter + +re = re' $ Just minBound +reMS = reMultilineSensitive +reMI = reMultilineInsensitive +reBS = reBlockSensitive +reBI = reBlockInsensitive +reMultilineSensitive = re' $ Just MultilineSensitive +reMultilineInsensitive = re' $ Just MultilineInsensitive +reBlockSensitive = re' $ Just BlockSensitive +reBlockInsensitive = re' $ Just BlockInsensitive +re_ = re' Nothing + + +------------------------------------------------------------------------ +-- re Helpers +------------------------------------------------------------------------ + +re' :: Maybe SimpleREOptions -> QuasiQuoter +re' mb = case mb of + Nothing -> + (qq0 "re'") + { quoteExp = parse minBound (\rs->[|flip unsafeCompileRegex rs|]) + } + Just sro -> + (qq0 "re'") + { quoteExp = parse sro (\rs->[|unsafeCompileRegexSimple sro rs|]) + } + where + parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp + parse sro mk rs = either error (\_->mk rs) $ compileRegex_ os rs + where + os = unpackSimpleREOptions sro + +unsafeCompileRegexSimple :: SimpleREOptions -> String -> RE +unsafeCompileRegexSimple sro re_s = unsafeCompileRegex_ os re_s + where + os = unpackSimpleREOptions sro + +unsafeCompileRegex :: IsOption o RE CompOption ExecOption + => o + -> String + -> RE +unsafeCompileRegex = unsafeCompileRegex_ . makeREOptions + +unsafeCompileRegex_ :: REOptions -> String -> RE +unsafeCompileRegex_ os = either oops id . compileRegex_ os + where + oops = error . ("unsafeCompileRegex: " ++) + +compileRegex' :: (Functor m,Monad m) + => REOptions + -> String + -> m (CaptureNames,Regex) +compileRegex' REOptions{..} s0 = do + ((_,cnms),s2) <- either fail return $ extractNamedCaptures s1 + (,) cnms <$> makeRegexOptsM optionsComp optionsExec s2 + where + s1 = expandMacros reSource optionsMacs s0 + +compileRegex_ :: (Functor m,Monad m) + => REOptions + -> String + -> m RE +compileRegex_ os re_s = uncurry mk <$> compileRegex' os re_s + where + mk cnms rx = + RE + { _re_options = os + , _re_source = re_s + , _re_cnames = cnms + , _re_regex = rx + } + + +------------------------------------------------------------------------ +-- Options Helpers +------------------------------------------------------------------------ + +def_comp_option :: CompOption +def_comp_option = optionsComp defaultREOptions + +def_exec_option :: ExecOption +def_exec_option = optionsExec defaultREOptions + + +------------------------------------------------------------------------ +-- Haddock Sections +------------------------------------------------------------------------ + +-- $about +-- +-- This module provides the regex PCRE back end. Most of the functions that +-- you will need for day to day use are provided by the primary API modules +-- (e.g., "Text.RE.TDFA.Text"). diff --git a/Text/RE/ZeInternals/TestBench.lhs b/Text/RE/ZeInternals/TestBench.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/TestBench.lhs @@ -0,0 +1,590 @@ +\begin{code} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif + +module Text.RE.ZeInternals.TestBench + ( MacroID(..) + , RegexType + , mkTDFA + , mkPCRE + , isTDFA + , isPCRE + , presentRegexType + , MacroEnv + , WithCaptures(..) + , MacroDescriptor(..) + , TestResult(..) + , RegexSource(..) + , FunctionID(..) + , mkMacros + , testMacroEnv + , badMacros + , runTests + , runTests' + , formatMacroTable + , dumpMacroTable + , formatMacroSummary + , formatMacroSources + , formatMacroSource + , testMacroDescriptors + , mdRegexSource + ) where + +import Data.Array +import Data.Char +import qualified Data.HashMap.Lazy as HML +import qualified Data.List as L +import Data.Maybe +import Data.Ord +import Data.String +import Text.Printf +import Prelude.Compat +import Text.RE.REOptions +import Text.RE.ZeInternals.Replace +import Text.RE.ZeInternals.Types.Capture +import Text.RE.ZeInternals.Types.Match +import Text.RE.ZeInternals.Types.Matches +\end{code} + +Types +----- + +\begin{code} + +type TestBenchMatcher = + String -> MacroEnv -> MacroDescriptor -> Matches String + +-- | what kind of back end will be compiling the RE, and its match +-- function +data RegexType + = TDFA TestBenchMatcher + | PCRE TestBenchMatcher + +-- | test RegexType for TDFA/PCREness +isTDFA, isPCRE :: RegexType -> Bool + +isTDFA (TDFA _) = True +isTDFA (PCRE _) = False + +isPCRE (TDFA _) = False +isPCRE (PCRE _) = True + +mkTDFA, mkPCRE :: TestBenchMatcher -> RegexType +mkTDFA = TDFA +mkPCRE = PCRE + +presentRegexType :: RegexType -> String +presentRegexType (TDFA _) = "TDFA" +presentRegexType (PCRE _) = "PCRE" + +instance Show RegexType where + show (TDFA _) = "TDFA " + show (PCRE _) = "PCRE " + +-- | do we need the captures in the RE or whould they be stripped out +-- where possible +data WithCaptures + = InclCaptures -- ^ include all captures + | ExclCaptures -- ^ remove captures where possible + deriving (Eq,Ord,Show) + +-- | each macro can reference others, the whole environment being +-- required for each macro, so we use a Lazy HashMap +type MacroEnv = HML.HashMap MacroID MacroDescriptor + +-- | describes a macro, giving the text of the RE and a si=ummary +-- description +data MacroDescriptor = + MacroDescriptor + { macroSource :: !RegexSource -- ^ the RE + , macroSamples :: ![String] -- ^ some sample matches + , macroCounterSamples :: ![String] -- ^ some sample non-matches + , macroTestResults :: ![TestResult] -- ^ validation test results + , macroParser :: !(Maybe FunctionID) -- ^ WA, the parser function + , macroDescription :: !String -- ^ summary comment + } + deriving (Show) + +-- | list of failures on a validation run +newtype TestResult = + TestResult { _TestResult :: String } + deriving (IsString,Show) + +-- | a RE that should work for POSIX and PCRE with open brackets ('(') +-- represented as follows: +-- \( mere symbol +-- (?: used for grouping only, not for captures +-- (}: used for captures only, not for grouping +-- (]: used for captures and grouping +-- ( do not modify +newtype RegexSource = + RegexSource { _RegexSource :: String } + deriving (IsString,Show) + +-- | name of the Haskell parser function for parsing the text matched +-- by a macro +newtype FunctionID = + FunctionID { _FunctionID :: String } + deriving (IsString,Show) + +-- | we are only interested in the open parentheses used for +-- grouping and/or capturing; if neither grouping or capturing then +-- there is no initial '(' or '(?:', just the suffic text +data REToken = + REToken + { _ret_prefix :: String -- ^ following text optional ( or (?: + , _ret_fixed :: Bool -- ^ a '(' that is not safe to modify + , _ret_grouping :: Bool -- ^ is this a grouping group + , _ret_capturing :: Bool -- ^ is this a capturing group + } + deriving (Show) +\end{code} + + +mkMacros +-------- + +\begin{code} +-- | construct a macro table suitable for use with the RE compilers +mkMacros :: (Monad m,Functor m) + => (String->m r) + -> RegexType + -> WithCaptures + -> MacroEnv + -> m (Macros r) +mkMacros prs rty wc env = + HML.fromList <$> mapM (uncurry mk) (HML.toList env) + where + mk mid md = (,) mid <$> prs (mdRegexSource rty wc env md) +\end{code} + + +testMacroEnv, badMacros +----------------------- + +\begin{code} +-- | test that a MacroEnv is passing all of its built-in tests +testMacroEnv :: String -> RegexType -> MacroEnv -> IO Bool +testMacroEnv lab rty m_env = case badMacros m_env of + [] -> return True + fails -> do + putStrLn $ lab' ++ " has failing tests for these macros: " + putStr $ unlines $ [ " "++getMacroID mid | mid<-fails ] + putStrLn $ "The whole table:" + putStrLn $ "========================================================" + putStr $ formatMacroTable rty m_env + putStrLn $ "========================================================" + return False + where + lab' = lab ++ " [" ++ presentRegexType rty ++"]" + +badMacros :: MacroEnv -> [MacroID] +badMacros m_env = + [ mid + | (mid,MacroDescriptor{..}) <- HML.toList m_env + , not $ null macroTestResults + ] + +runTests :: (Eq a,Show a) + => RegexType + -> (String->Maybe a) + -> [(String,a)] + -> MacroEnv + -> MacroID + -> MacroDescriptor + -> MacroDescriptor +runTests rty parser = runTests' rty parser' + where + parser' caps = fmap capturedText (matchCapture caps) >>= parser + +runTests' :: (Eq a,Show a) + => RegexType + -> (Match String->Maybe a) + -> [(String,a)] + -> MacroEnv + -> MacroID + -> MacroDescriptor + -> MacroDescriptor +runTests' rty parser vector env mid md@MacroDescriptor{..} = + md { macroTestResults = test_results } + where + test_results = concat + [ concat $ map test vector + , concat $ map test_neg macroCounterSamples + ] + + test (src,x) = test' mid rty parser x $ match_ src env md + + test_neg src = test_neg' mid rty parser $ match_ src env md + + match_ = case rty of + TDFA tbmf -> tbmf + PCRE tbmf -> tbmf +\end{code} + + +dumpMacroTable, formatMacroTable, formatMacroSummary, formatMacroSources, formatMacroSource +------------------------------------------------------------------------------------------- + +\begin{code} +-- | dump a MacroEnv into the docs directory +dumpMacroTable :: String -> RegexType -> MacroEnv -> IO () +dumpMacroTable lab rty m_env = do + writeFile fp_t $ formatMacroTable rty m_env + writeFile fp_s $ formatMacroSources rty ExclCaptures m_env + where + fp_t = "docs/" ++ rty_s ++ "-" ++ lab ++ ".txt" + fp_s = "docs/" ++ rty_s ++ "-" ++ lab ++ "-src.txt" + + rty_s = map toLower $ presentRegexType rty +\end{code} + +\begin{code} +-- | format a macros table as a markdown table +formatMacroTable :: RegexType -> MacroEnv -> String +formatMacroTable rty env = unlines $ + format_table macro_table_hdr + [ macro_table_row rty mid md + | (mid,md) <- L.sortBy (comparing fst) $ HML.toList env + ] +\end{code} + +\begin{code} +-- | generate a plain text summary of a macro +formatMacroSummary :: RegexType -> MacroEnv -> MacroID -> String +formatMacroSummary rty env mid = maybe oops prep $ HML.lookup mid env + where + prep :: MacroDescriptor -> String + prep md = unlines $ concat $ map (fmt md) [minBound..maxBound] + + fmt :: MacroDescriptor -> Col -> [String] + fmt md c = + [ printf "%-15s : %s" (present_col c) ini + ] ++ map (" "++) lns + where + (ini,lns) = case macro_attribute rty mid md c of + [] -> (,) "" [] + [ln] -> (,) ln [] + lns_ -> (,) "" lns_ + + oops = error $ getMacroID mid ++ ": macro not defined in this environment" +\end{code} + +\begin{code} +-- | list the source REs for each macro in plain text +formatMacroSources :: RegexType + -> WithCaptures + -> MacroEnv + -> String +formatMacroSources rty wc env = unlines $ + [ printf "%-20s : %s" (getMacroID mid) $ formatMacroSource rty wc env mid + | mid <- L.sort $ HML.keys env + ] +\end{code} + +\begin{code} +-- | list the source of a single macro in plain text +formatMacroSource :: RegexType + -> WithCaptures + -> MacroEnv + -> MacroID + -> String +formatMacroSource rty wc env mid = + mdRegexSource rty wc env $ fromMaybe oops $ HML.lookup mid env + where + oops = error $ "formatMacroSource: not found: " ++ getMacroID mid +\end{code} + + +testMacroDescriptors, regexSource +--------------------------------- + +\begin{code} +testMacroDescriptors :: [MacroDescriptor] -> [TestResult] +testMacroDescriptors = concat . map macroTestResults + +regexSource :: RegexType -> WithCaptures -> RegexSource -> String +regexSource rty wc = format_tokens rty wc . scan_re +\end{code} + + +Formatting helpers +------------------ + +\begin{code} +type TableRow = Array Col [String] + +data Col + = C_name + | C_caps + | C_regex + | C_examples + | C_anti_examples + | C_fails + | C_parser + | C_comment + deriving (Ix,Bounded,Enum,Ord,Eq,Show) + +present_col :: Col -> String +present_col = map tr . drop 2 . show + where + tr '_' = '-' + tr c = c + +macro_table_hdr :: TableRow +macro_table_hdr = listArray (minBound,maxBound) + [ [present_col c] + | c<-[minBound..maxBound] + ] + +macro_table_row :: RegexType -> MacroID -> MacroDescriptor -> TableRow +macro_table_row rty mid md = + listArray (minBound,maxBound) $ + map (macro_attribute rty mid md) [minBound..maxBound] + +macro_attribute :: RegexType + -> MacroID + -> MacroDescriptor + -> Col + -> [String] +macro_attribute rty mid MacroDescriptor{..} c = + case c of + C_name -> [getMacroID mid] + C_caps -> [show $ min_captures rty $ scan_re macroSource] + C_regex -> [regexSource rty ExclCaptures macroSource] + C_examples -> macroSamples + C_anti_examples -> macroCounterSamples + C_fails -> map _TestResult macroTestResults + C_parser -> [maybe "-" _FunctionID macroParser] + C_comment -> [macroDescription] + +format_table :: TableRow -> [TableRow] -> [String] +format_table hdr rows0 = concat + [ format_row cws hdr' + , format_row cws dsh + , concat $ map (format_row cws) rows + ] + where + dsh = listArray (minBound,maxBound) + [ [replicate n '-'] | n<-elems cws ] + + hdr' = hdr // [(,) C_regex $ [take n $ concat $ repeat "regex="] ] + where + n = min 29 $ cws!C_regex + + cws = widths $ hdr : rows + + rows = map wrap_row rows0 + +field_width :: Int +field_width = 40 + +wrap_row :: TableRow -> TableRow +wrap_row = fmap $ concat . map f + where + f, g :: String -> [String] + + f cts = (ini ++ ['\\' | not (null rst)]) : g rst + where + (ini,rst) = splitAt (1+field_width) cts + + g "" = [] + g cts = ('\\' : ini ++ ['\\' | not (null rst)]) : g rst + where + (ini,rst) = splitAt field_width cts + + +widths :: [TableRow] -> Array Col Int +widths rows = listArray (minBound,maxBound) + [ maximum $ concat [ map length $ row!c | row<-rows ] + | c<-[minBound..maxBound] + ] + +format_row :: Array Col Int -> TableRow -> [String] +format_row cw_arr row = + [ ("|"++) $ L.intercalate "|" + [ field cw_arr row c i | c<-[minBound..maxBound] ] + | i <- [0..depth-1] + ] + where + depth = maximum [ length $ row!c | c<-[minBound..maxBound] ] + +field :: Array Col Int -> TableRow -> Col -> Int -> String +field cws row c i = ljust (cws!c) $ sel i $ row!c + +sel :: Int -> [String] -> String +sel i ss = case drop i ss of + [] -> "" + s:_ -> s + +ljust :: Int -> String -> String +ljust w s = s ++ replicate n ' ' + where + n = max 0 $ w - length s + +min_captures :: RegexType -> [REToken] -> Int +min_captures rty rets = length + [ () + | REToken{..}<-rets + , _ret_fixed || (_ret_grouping && isTDFA rty) + ] +\end{code} + + +Formatting tokens +----------------- + +\begin{code} +format_tokens :: RegexType -> WithCaptures -> [REToken] -> String +format_tokens rty wc = foldr f "" + where + f REToken{..} rst = _ret_prefix ++ bra ++ xket rst + where + bra = case _ret_fixed of + True -> "(" + False -> + case (,) _ret_grouping (_ret_capturing && wc==InclCaptures) of + (False,False) -> "" + (True ,False) -> if isPCRE rty then "(?:" else "(" + (False,True ) -> "(" + (True ,True ) -> "(" + + xket = + case not _ret_grouping && _ret_capturing && wc==ExclCaptures of + True -> delete_ket 0 + False -> id + +delete_ket :: Int -> String -> String +delete_ket _ "" = error "delete_ket: end of input" +delete_ket n (c:t) = case c of + '\\' -> case t of + "" -> error "delete_ket: end of input" + c':t' -> c : c' : delete_ket n t' + ')' -> case n of + 0 -> t + _ -> c : delete_ket (n-1) t + '(' -> c : delete_ket (n+1) t + _ -> c : delete_ket n t +\end{code} + + +scan_re +------- + +\begin{code} +scan_re :: RegexSource -> [REToken] +scan_re (RegexSource src0) = loop src0 + where + loop "" = [] + loop src = + case rst of + '\\':t -> case t of + "" -> REToken (ini++['\\']) False False False : [] + c':t' -> REToken (ini++['\\',c']) False False False : loop t' + '(' :t -> case t of + c:':':t' + | c=='?' -> REToken ini False True False : loop t' + | c=='}' -> REToken ini False False True : loop t' + | c==']' -> REToken ini False True True : loop t' + _ -> REToken ini True True True : loop t + _ -> [REToken src False False False] + where + (ini,rst) = break chk src + + chk '\\' = True + chk '(' = True + chk _ = False +\end{code} + + +mdRegexSource +------------- + +\begin{code} +mdRegexSource :: RegexType + -> WithCaptures + -> MacroEnv + -> MacroDescriptor + -> String +mdRegexSource rty wc env md = + expandMacros' lu $ regexSource rty wc $ macroSource md + where + lu = fmap (regexSource rty wc . macroSource) . + flip HML.lookup env +\end{code} + + +test', test_neg' +---------------- + +\begin{code} +test' :: (Eq a,Show a) + => MacroID + -> RegexType + -> (Match String->Maybe a) + -> a + -> Matches String + -> [TestResult] +test' mid rty prs x Matches{..} = either (:[]) (const []) $ do + cs <- case allMatches of + [cs] -> return cs + _ -> oops "RE failed to parse" + mtx <- case matchCapture cs of + Nothing -> oops $ "RE parse failure: " ++ show cs + Just c -> return $ capturedText c + case mtx == matchesSource of + True -> return () + False -> oops "RE failed to match the whole text" + x' <- case prs cs of + Nothing -> oops "matched text failed to parse" + Just x' -> return x' + case x'==x of + True -> return () + False -> oops "parser failed to yield the expected result" + where + oops = Left . test_diagnostic mid False rty matchesSource + +test_neg' :: MacroID + -> RegexType + -> (Match String->Maybe a) + -> Matches String + -> [TestResult] +test_neg' mid rty prs Matches{..} = either id (const []) $ do + case allMatches of + [] -> return () + cz -> case ms of + [] -> return () + _ -> Left [oops "RE parse succeeded"] + where + ms = + [ () + | cs <- cz + , Just c <- [matchCapture cs] + , let t = capturedText c + , t == matchesSource + , isJust $ prs cs + ] + + where + oops = test_diagnostic mid True rty matchesSource + +test_diagnostic :: MacroID + -> Bool + -> RegexType + -> String + -> String + -> TestResult +test_diagnostic mid is_neg rty tst msg = + TestResult $ + printf "%-20s [%s %s] : %s (%s)" mid_s neg_s rty_s msg tst + where + mid_s = getMacroID mid + neg_s = if is_neg then "-ve" else "+ve" :: String + rty_s = presentRegexType rty +\end{code} diff --git a/Text/RE/ZeInternals/Types/Capture.lhs b/Text/RE/ZeInternals/Types/Capture.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/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.ZeInternals.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/ZeInternals/Types/CaptureID.hs b/Text/RE/ZeInternals/Types/CaptureID.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Types/CaptureID.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Text.RE.ZeInternals.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 -- [cp|3|] + | IsCaptureName CaptureName -- [cp|y|] + 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/ZeInternals/Types/LineNo.hs b/Text/RE/ZeInternals/Types/LineNo.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Types/LineNo.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Text.RE.ZeInternals.Types.LineNo where + + +-- | our line numbers are of the proper zero-based kind +newtype LineNo = + ZeroBasedLineNo { getZeroBasedLineNo :: Int } + deriving (Show,Enum) + +-- | the first line in a file +firstLine :: LineNo +firstLine = ZeroBasedLineNo 0 + +-- | extract a conventional 1-based line number +getLineNo :: LineNo -> Int +getLineNo = succ . getZeroBasedLineNo + +-- | inject a conventional 1-based line number +lineNo :: Int -> LineNo +lineNo = ZeroBasedLineNo . pred diff --git a/Text/RE/ZeInternals/Types/Match.lhs b/Text/RE/ZeInternals/Types/Match.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Types/Match.lhs @@ -0,0 +1,194 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +\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.Regex.Base +import Text.RE.ZeInternals.Types.Capture +import Text.RE.ZeInternals.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} +-- | this instance hooks 'Match' into regex-base: regex consumers need +-- not worry about any of this +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/ZeInternals/Types/Matches.lhs b/Text/RE/ZeInternals/Types/Matches.lhs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Types/Matches.lhs @@ -0,0 +1,80 @@ +\begin{code} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable #-} +\end{code} + +\begin{code} +module Text.RE.ZeInternals.Types.Matches + ( Matches(..) + , anyMatches + , countMatches + , matches + , mainCaptures + ) where +\end{code} + +\begin{code} +import Data.Typeable +import Text.Regex.Base +import Text.RE.ZeInternals.Types.Capture +import Text.RE.ZeInternals.Types.CaptureID +import Text.RE.ZeInternals.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 'Match' instances 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} +-- | this instance hooks 'Matches' into regex-base: regex consumers need +-- not worry about any of this +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/ZeInternals/Types/SearchReplace.hs b/Text/RE/ZeInternals/Types/SearchReplace.hs new file mode 100644 --- /dev/null +++ b/Text/RE/ZeInternals/Types/SearchReplace.hs @@ -0,0 +1,15 @@ + +module Text.RE.ZeInternals.Types.SearchReplace + ( SearchReplace(..) + ) where + +-- | contains a compiled RE and replacement template +data SearchReplace re s = + SearchReplace + { getSearch :: !re -- ^ the RE + , getTemplate :: !s -- ^ the replacement template + } + deriving (Show) + +instance Functor (SearchReplace re) where + fmap f (SearchReplace re x) = SearchReplace re (f x) diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,10 @@ -*-change-log-*- +0.11.0.0 Chris Dornan 2017-03-29 + * Simplify API (#97) + * Rename Location to RELocation (#98) + * Rename the MacrosDescriptor Fields #99 + 0.10.0.3 Chris Dornan 2017-03-28 * Update to LTS-8.6 (#95) * Improve Haddocks for Text.RE.{TDFA,PCRE} (#94) diff --git a/regex.cabal b/regex.cabal --- a/regex.cabal +++ b/regex.cabal @@ -1,5 +1,5 @@ Name: regex -Version: 0.10.0.3 +Version: 0.11.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.10.0.3 + Tag: 0.11.0.0 @@ -41,49 +41,48 @@ Exposed-Modules: Text.RE - Text.RE.Internal.AddCaptureNames - Text.RE.Internal.EscapeREString - Text.RE.Internal.NamedCaptures - Text.RE.Internal.PreludeMacros - Text.RE.SearchReplace + Text.RE.IsRegex + Text.RE.Replace Text.RE.Summa Text.RE.TDFA Text.RE.TDFA.ByteString Text.RE.TDFA.ByteString.Lazy - Text.RE.TDFA.RE Text.RE.TDFA.Sequence Text.RE.TDFA.String Text.RE.TDFA.Text Text.RE.TDFA.Text.Lazy Text.RE.TestBench - Text.RE.TestBench.Parsers Text.RE.Tools Text.RE.Tools.Edit Text.RE.Tools.Grep Text.RE.Tools.Lex Text.RE.Tools.Sed - Text.RE.Types - Text.RE.Types.Capture - Text.RE.Types.CaptureID - Text.RE.Types.IsRegex - Text.RE.Types.LineNo - Text.RE.Types.Match - Text.RE.Types.Matches - Text.RE.Types.REOptions - Text.RE.Types.Replace - Text.RE.Types.SearchReplace + Text.RE.ZeInternals.AddCaptureNames + Text.RE.ZeInternals.EscapeREString + Text.RE.ZeInternals.NamedCaptures + Text.RE.ZeInternals.PreludeMacros + Text.RE.ZeInternals.Replace + Text.RE.ZeInternals.TDFA + Text.RE.ZeInternals.TestBench + Text.RE.ZeInternals.Types.Capture + Text.RE.ZeInternals.Types.CaptureID + Text.RE.ZeInternals.Types.LineNo + Text.RE.ZeInternals.Types.Match + Text.RE.ZeInternals.Types.Matches + Text.RE.REOptions + Text.RE.ZeInternals.Types.SearchReplace Other-Modules: - Text.RE.Internal.QQ - Text.RE.Internal.SearchReplace - Text.RE.Internal.SearchReplace.TDFA - Text.RE.Internal.SearchReplace.TDFA.ByteString - Text.RE.Internal.SearchReplace.TDFA.ByteString.Lazy - Text.RE.Internal.SearchReplace.TDFA.Sequence - Text.RE.Internal.SearchReplace.TDFA.String - Text.RE.Internal.SearchReplace.TDFA.Text - Text.RE.Internal.SearchReplace.TDFA.Text.Lazy - Text.RE.Internal.SearchReplace.TDFAEdPrime + Text.RE.ZeInternals.QQ + Text.RE.ZeInternals.SearchReplace + Text.RE.ZeInternals.SearchReplace.TDFA + Text.RE.ZeInternals.SearchReplace.TDFA.ByteString + Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy + Text.RE.ZeInternals.SearchReplace.TDFA.Sequence + Text.RE.ZeInternals.SearchReplace.TDFA.String + Text.RE.ZeInternals.SearchReplace.TDFA.Text + Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy + Text.RE.ZeInternals.SearchReplace.TDFAEdPrime Default-Language: Haskell2010