{-# 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.Options import Text.RE.TestBench.Parsers import Text.RE.TestBench preludeMacros :: (Monad m,Functor m) => (String->m r) -> RegexType -> WithCaptures -> m (Macros r) preludeMacros prs rty wc = mkMacros prs rty wc $ preludeMacroEnv rty preludeMacroTable :: RegexType -> String preludeMacroTable rty = formatMacroTable rty $ preludeMacroEnv rty preludeMacroSummary :: RegexType -> PreludeMacro -> String preludeMacroSummary rty = formatMacroSummary rty (preludeMacroEnv rty) . prelude_macro_id preludeMacroSources :: RegexType -> String preludeMacroSources rty = formatMacroSources rty ExclCaptures $ preludeMacroEnv rty preludeMacroSource :: RegexType -> PreludeMacro -> String preludeMacroSource rty = formatMacroSource rty ExclCaptures (preludeMacroEnv rty) . prelude_macro_id 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] ] 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)