{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{-# LANGUAGE OverloadedStrings                  #-}
{-# LANGUAGE CPP                                #-}

module Text.RE.ZeInternals.TestBench.Parsers
  (
  -- * The Test Bench
    MacroEnv
  , MacroDescriptor(..)
  , RegexSource(..)
  , WithCaptures(..)
  , RegexType
  , isTDFA
  , isPCRE
  , presentRegexType
  -- ** 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
  ) 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.RE.Replace
import           Text.RE.ZeInternals.TestBench
import           Text.Read


parseInteger :: Replace a => a -> Maybe Int
parseInteger :: a -> Maybe Int
parseInteger = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (a -> String) -> a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR

parseHex :: Replace a => a -> Maybe Int
parseHex :: a -> Maybe Int
parseHex = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (a -> String) -> a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"0x"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR

parseDouble :: Replace a => a -> Maybe Double
parseDouble :: a -> Maybe Double
parseDouble = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double) -> (a -> String) -> a -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR

parseString :: Replace a => a -> Maybe T.Text
parseString :: a -> Maybe Text
parseString = String -> Maybe Text
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Text) -> (a -> String) -> a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR

parseSimpleString :: Replace a => a -> Maybe T.Text
parseSimpleString :: a -> Maybe Text
parseSimpleString = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (a -> Text) -> a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
1 (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Replace a => a -> Text
textifyR

date_templates, time_templates, timezone_templates,
  date_time_8601_templates, date_time_templates :: [String]
date_templates :: [String]
date_templates            = [String
"%F"]
time_templates :: [String]
time_templates            = [String
"%H:%M:%S",String
"%H:%M:%S%Q",String
"%H:%M"]
timezone_templates :: [String]
timezone_templates        = [String
"Z",String
"%z"]
date_time_8601_templates :: [String]
date_time_8601_templates  =
    [ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%sT%s%s" String
dt String
tm String
tz
        | String
dt <- [String]
date_templates
        , String
tm <- [String]
time_templates
        , String
tz <- [String]
timezone_templates
        ]
date_time_templates :: [String]
date_time_templates       =
    [ String -> String -> Char -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s%c%s%s" String
dt Char
sc String
tm String
tz
        | String
dt <- [String]
date_templates
        , Char
sc <- [Char
'T',Char
' ']
        , String
tm <- [String]
time_templates
        , String
tz <- [String]
timezone_templates [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
" UTC",String
""]
        ]

parseDate :: Replace a => a -> Maybe Day
parseDate :: a -> Maybe Day
parseDate = [String] -> a -> Maybe Day
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String]
date_templates

parseSlashesDate :: Replace a => a -> Maybe Day
parseSlashesDate :: a -> Maybe Day
parseSlashesDate = [String] -> a -> Maybe Day
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String
"%Y/%m/%d"]

parseTimeOfDay :: Replace a => a -> Maybe TimeOfDay
parseTimeOfDay :: a -> Maybe TimeOfDay
parseTimeOfDay = [String] -> a -> Maybe TimeOfDay
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String]
time_templates

parseTimeZone :: Replace a => a -> Maybe TimeZone
parseTimeZone :: a -> Maybe TimeZone
parseTimeZone = [String] -> a -> Maybe TimeZone
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String]
timezone_templates

parseDateTime :: Replace a => a -> Maybe UTCTime
parseDateTime :: a -> Maybe UTCTime
parseDateTime = [String] -> a -> Maybe UTCTime
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String]
date_time_templates

parseDateTime8601 :: Replace a => a -> Maybe UTCTime
parseDateTime8601 :: a -> Maybe UTCTime
parseDateTime8601 = [String] -> a -> Maybe UTCTime
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String]
date_time_8601_templates

parseDateTimeCLF :: Replace a => a -> Maybe UTCTime
parseDateTimeCLF :: a -> Maybe UTCTime
parseDateTimeCLF = [String] -> a -> Maybe UTCTime
forall t s. (ParseTime t, Replace s) => [String] -> s -> Maybe t
parse_time [String
"%d/%b/%Y:%H:%M:%S %z"]

parseShortMonth :: Replace a => a -> Maybe Int
parseShortMonth :: a -> Maybe Int
parseShortMonth = (String -> HashMap String Int -> Maybe Int)
-> HashMap String Int -> String -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> HashMap String Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap String Int
short_month_hm (String -> Maybe Int) -> (a -> String) -> a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR

parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t
parse_time :: [String] -> s -> Maybe t
parse_time [String]
tpls = String -> Maybe t
forall a. ParseTime a => String -> Maybe a
prs (String -> Maybe t) -> (s -> String) -> s -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Replace a => a -> String
unpackR
  where
    prs :: String -> Maybe a
prs String
s = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes
      [ Bool -> TimeLocale -> String -> String -> Maybe a
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True  TimeLocale
LC.defaultTimeLocale String
fmt String
s
          | String
fmt<-[String]
tpls
          ]
#if !MIN_VERSION_time(1,5,0)
    parseTimeM _ = parseTime
#endif

short_month_hm :: HM.HashMap String Int
short_month_hm :: HashMap String Int
short_month_hm = [(String, Int)] -> HashMap String Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Array Int Text
shortMonthArrayArray Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
!Int
i,Int
i) | Int
i<-[Int
1..Int
12] ]

shortMonthArray :: Array Int T.Text
shortMonthArray :: Array Int Text
shortMonthArray = (Int, Int) -> [Text] -> Array Int Text
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
12) ([Text] -> Array Int Text) -> [Text] -> Array Int Text
forall a b. (a -> b) -> a -> b
$
  Text -> [Text]
T.words Text
"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 :: a -> Maybe IPV4Address
parseIPv4Address = [String] -> Maybe IPV4Address
forall a b c d.
(Enum a, Enum b, Enum c, Enum d) =>
[String] -> Maybe (a, b, c, d)
prs ([String] -> Maybe IPV4Address)
-> (a -> [String]) -> a -> Maybe IPV4Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
words_by (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (String -> [String]) -> (a -> String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Replace a => a -> String
unpackR
  where
    prs :: [String] -> Maybe (a, b, c, d)
prs [String
a_s,String
b_s,String
c_s,String
d_s] = do
      Int
a <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
a_s
      Int
b <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
b_s
      Int
c <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
c_s
      Int
d <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
d_s
      case (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
is_o [Int
a,Int
b,Int
c,Int
d] of
        Bool
True  -> (a, b, c, d) -> Maybe (a, b, c, d)
forall a. a -> Maybe a
Just (Int -> a
forall a. Enum a => Int -> a
toEnum Int
a,Int -> b
forall a. Enum a => Int -> a
toEnum Int
b,Int -> c
forall a. Enum a => Int -> a
toEnum Int
c,Int -> d
forall a. Enum a => Int -> a
toEnum Int
d)
        Bool
False -> Maybe (a, b, c, d)
forall a. Maybe a
Nothing
    prs [String]
_ = Maybe (a, b, c, d)
forall a. Maybe a
Nothing

    is_o :: a -> Bool
is_o a
x = a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
255

data Severity
  = Emerg
  | Alert
  | Crit
  | Err
  | Warning
  | Notice
  | Info
  | Debug
  deriving (Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded,Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum,Eq Severity
Eq Severity
-> (Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord,Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq,Int -> Severity -> String -> String
[Severity] -> String -> String
Severity -> String
(Int -> Severity -> String -> String)
-> (Severity -> String)
-> ([Severity] -> String -> String)
-> Show Severity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Severity] -> String -> String
$cshowList :: [Severity] -> String -> String
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> String -> String
$cshowsPrec :: Int -> Severity -> String -> String
Show)

parseSeverity :: Replace a => a -> Maybe Severity
parseSeverity :: a -> Maybe Severity
parseSeverity = (Text -> HashMap Text Severity -> Maybe Severity)
-> HashMap Text Severity -> Text -> Maybe Severity
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text Severity -> Maybe Severity
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Text Severity
severity_hm (Text -> Maybe Severity) -> (a -> Text) -> a -> Maybe Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Replace a => a -> Text
textifyR

severity_hm :: HM.HashMap T.Text Severity
severity_hm :: HashMap Text Severity
severity_hm = [(Text, Severity)] -> HashMap Text Severity
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
  [ (Text
kw,Severity
pri)
      | Severity
pri<-[Severity
forall a. Bounded a => a
minBound..Severity
forall a. Bounded a => a
maxBound]
      , let (Text
kw0,[Text]
kws) = Severity -> (Text, [Text])
severityKeywords Severity
pri
      , Text
kw <- Text
kw0Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
kws
      ]

severityKeywords :: Severity -> (T.Text,[T.Text])
severityKeywords :: Severity -> (Text, [Text])
severityKeywords Severity
pri = case Severity
pri of
  Severity
Emerg     -> (,) Text
"emerg"    [Text
"panic"]
  Severity
Alert     -> (,) Text
"alert"    []
  Severity
Crit      -> (,) Text
"crit"     []
  Severity
Err       -> (,) Text
"err"      [Text
"error"]
  Severity
Warning   -> (,) Text
"warning"  [Text
"warn"]
  Severity
Notice    -> (,) Text
"notice"   []
  Severity
Info      -> (,) Text
"info"     []
  Severity
Debug     -> (,) Text
"debug"    []

words_by :: (Char->Bool) -> String -> [String]
words_by :: (Char -> Bool) -> String -> [String]
words_by Char -> Bool
f String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
f String
s of
  String
"" -> []
  String
s' -> String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> String -> [String]
words_by Char -> Bool
f String
s''
        where
          (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
f String
s'