\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
, formatMacroSummary
, formatMacroSources
, formatMacroSource
, testMacroDescriptors
, mdRegexSource
) where
import Data.Array
import qualified Data.HashMap.Lazy as HML
import qualified Data.List as L
import Data.Maybe
import Data.Ord
import Data.String
import Prelude.Compat
import Text.Printf
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
data RegexType
= TDFA TestBenchMatcher
| PCRE TestBenchMatcher
isTDFA, isPCRE :: RegexType -> Bool
isTDFA :: RegexType -> Bool
isTDFA (TDFA TestBenchMatcher
_) = Bool
True
isTDFA (PCRE TestBenchMatcher
_) = Bool
False
isPCRE :: RegexType -> Bool
isPCRE (TDFA TestBenchMatcher
_) = Bool
False
isPCRE (PCRE TestBenchMatcher
_) = Bool
True
mkTDFA, mkPCRE :: TestBenchMatcher -> RegexType
mkTDFA :: TestBenchMatcher -> RegexType
mkTDFA = TestBenchMatcher -> RegexType
TDFA
mkPCRE :: TestBenchMatcher -> RegexType
mkPCRE = TestBenchMatcher -> RegexType
PCRE
presentRegexType :: RegexType -> String
presentRegexType :: RegexType -> String
presentRegexType (TDFA TestBenchMatcher
_) = String
"TDFA"
presentRegexType (PCRE TestBenchMatcher
_) = String
"PCRE"
instance Show RegexType where
show :: RegexType -> String
show (TDFA TestBenchMatcher
_) = String
"TDFA <function>"
show (PCRE TestBenchMatcher
_) = String
"PCRE <function>"
data WithCaptures
= InclCaptures
| ExclCaptures
deriving (WithCaptures -> WithCaptures -> Bool
(WithCaptures -> WithCaptures -> Bool)
-> (WithCaptures -> WithCaptures -> Bool) -> Eq WithCaptures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithCaptures -> WithCaptures -> Bool
$c/= :: WithCaptures -> WithCaptures -> Bool
== :: WithCaptures -> WithCaptures -> Bool
$c== :: WithCaptures -> WithCaptures -> Bool
Eq,Eq WithCaptures
Eq WithCaptures
-> (WithCaptures -> WithCaptures -> Ordering)
-> (WithCaptures -> WithCaptures -> Bool)
-> (WithCaptures -> WithCaptures -> Bool)
-> (WithCaptures -> WithCaptures -> Bool)
-> (WithCaptures -> WithCaptures -> Bool)
-> (WithCaptures -> WithCaptures -> WithCaptures)
-> (WithCaptures -> WithCaptures -> WithCaptures)
-> Ord WithCaptures
WithCaptures -> WithCaptures -> Bool
WithCaptures -> WithCaptures -> Ordering
WithCaptures -> WithCaptures -> WithCaptures
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 :: WithCaptures -> WithCaptures -> WithCaptures
$cmin :: WithCaptures -> WithCaptures -> WithCaptures
max :: WithCaptures -> WithCaptures -> WithCaptures
$cmax :: WithCaptures -> WithCaptures -> WithCaptures
>= :: WithCaptures -> WithCaptures -> Bool
$c>= :: WithCaptures -> WithCaptures -> Bool
> :: WithCaptures -> WithCaptures -> Bool
$c> :: WithCaptures -> WithCaptures -> Bool
<= :: WithCaptures -> WithCaptures -> Bool
$c<= :: WithCaptures -> WithCaptures -> Bool
< :: WithCaptures -> WithCaptures -> Bool
$c< :: WithCaptures -> WithCaptures -> Bool
compare :: WithCaptures -> WithCaptures -> Ordering
$ccompare :: WithCaptures -> WithCaptures -> Ordering
$cp1Ord :: Eq WithCaptures
Ord,Int -> WithCaptures -> ShowS
[WithCaptures] -> ShowS
WithCaptures -> String
(Int -> WithCaptures -> ShowS)
-> (WithCaptures -> String)
-> ([WithCaptures] -> ShowS)
-> Show WithCaptures
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithCaptures] -> ShowS
$cshowList :: [WithCaptures] -> ShowS
show :: WithCaptures -> String
$cshow :: WithCaptures -> String
showsPrec :: Int -> WithCaptures -> ShowS
$cshowsPrec :: Int -> WithCaptures -> ShowS
Show)
type MacroEnv = HML.HashMap MacroID MacroDescriptor
data MacroDescriptor =
MacroDescriptor
{ MacroDescriptor -> RegexSource
macroSource :: !RegexSource
, MacroDescriptor -> [String]
macroSamples :: ![String]
, MacroDescriptor -> [String]
macroCounterSamples :: ![String]
, MacroDescriptor -> [TestResult]
macroTestResults :: ![TestResult]
, MacroDescriptor -> Maybe FunctionID
macroParser :: !(Maybe FunctionID)
, MacroDescriptor -> String
macroDescription :: !String
}
deriving (Int -> MacroDescriptor -> ShowS
[MacroDescriptor] -> ShowS
MacroDescriptor -> String
(Int -> MacroDescriptor -> ShowS)
-> (MacroDescriptor -> String)
-> ([MacroDescriptor] -> ShowS)
-> Show MacroDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MacroDescriptor] -> ShowS
$cshowList :: [MacroDescriptor] -> ShowS
show :: MacroDescriptor -> String
$cshow :: MacroDescriptor -> String
showsPrec :: Int -> MacroDescriptor -> ShowS
$cshowsPrec :: Int -> MacroDescriptor -> ShowS
Show)
newtype TestResult =
TestResult { TestResult -> String
_TestResult :: String }
deriving (String -> TestResult
(String -> TestResult) -> IsString TestResult
forall a. (String -> a) -> IsString a
fromString :: String -> TestResult
$cfromString :: String -> TestResult
IsString,Int -> TestResult -> ShowS
[TestResult] -> ShowS
TestResult -> String
(Int -> TestResult -> ShowS)
-> (TestResult -> String)
-> ([TestResult] -> ShowS)
-> Show TestResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestResult] -> ShowS
$cshowList :: [TestResult] -> ShowS
show :: TestResult -> String
$cshow :: TestResult -> String
showsPrec :: Int -> TestResult -> ShowS
$cshowsPrec :: Int -> TestResult -> ShowS
Show)
newtype RegexSource =
RegexSource { RegexSource -> String
_RegexSource :: String }
deriving (String -> RegexSource
(String -> RegexSource) -> IsString RegexSource
forall a. (String -> a) -> IsString a
fromString :: String -> RegexSource
$cfromString :: String -> RegexSource
IsString,Int -> RegexSource -> ShowS
[RegexSource] -> ShowS
RegexSource -> String
(Int -> RegexSource -> ShowS)
-> (RegexSource -> String)
-> ([RegexSource] -> ShowS)
-> Show RegexSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegexSource] -> ShowS
$cshowList :: [RegexSource] -> ShowS
show :: RegexSource -> String
$cshow :: RegexSource -> String
showsPrec :: Int -> RegexSource -> ShowS
$cshowsPrec :: Int -> RegexSource -> ShowS
Show)
newtype FunctionID =
FunctionID { FunctionID -> String
_FunctionID :: String }
deriving (String -> FunctionID
(String -> FunctionID) -> IsString FunctionID
forall a. (String -> a) -> IsString a
fromString :: String -> FunctionID
$cfromString :: String -> FunctionID
IsString,Int -> FunctionID -> ShowS
[FunctionID] -> ShowS
FunctionID -> String
(Int -> FunctionID -> ShowS)
-> (FunctionID -> String)
-> ([FunctionID] -> ShowS)
-> Show FunctionID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionID] -> ShowS
$cshowList :: [FunctionID] -> ShowS
show :: FunctionID -> String
$cshow :: FunctionID -> String
showsPrec :: Int -> FunctionID -> ShowS
$cshowsPrec :: Int -> FunctionID -> ShowS
Show)
data REToken =
REToken
{ REToken -> String
_ret_prefix :: String
, REToken -> Bool
_ret_fixed :: Bool
, REToken -> Bool
_ret_grouping :: Bool
, REToken -> Bool
_ret_capturing :: Bool
}
deriving (Int -> REToken -> ShowS
[REToken] -> ShowS
REToken -> String
(Int -> REToken -> ShowS)
-> (REToken -> String) -> ([REToken] -> ShowS) -> Show REToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [REToken] -> ShowS
$cshowList :: [REToken] -> ShowS
show :: REToken -> String
$cshow :: REToken -> String
showsPrec :: Int -> REToken -> ShowS
$cshowsPrec :: Int -> REToken -> ShowS
Show)
\end{code}
mkMacros
\begin{code}
mkMacros :: (Monad m,Functor m)
=> (String->m r)
-> RegexType
-> WithCaptures
-> MacroEnv
-> m (Macros r)
mkMacros :: (String -> m r)
-> RegexType -> WithCaptures -> MacroEnv -> m (Macros r)
mkMacros String -> m r
prs RegexType
rty WithCaptures
wc MacroEnv
env =
[(MacroID, r)] -> Macros r
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HML.fromList ([(MacroID, r)] -> Macros r) -> m [(MacroID, r)] -> m (Macros r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((MacroID, MacroDescriptor) -> m (MacroID, r))
-> [(MacroID, MacroDescriptor)] -> m [(MacroID, r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((MacroID -> MacroDescriptor -> m (MacroID, r))
-> (MacroID, MacroDescriptor) -> m (MacroID, r)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MacroID -> MacroDescriptor -> m (MacroID, r)
forall a. a -> MacroDescriptor -> m (a, r)
mk) (MacroEnv -> [(MacroID, MacroDescriptor)]
forall k v. HashMap k v -> [(k, v)]
HML.toList MacroEnv
env)
where
mk :: a -> MacroDescriptor -> m (a, r)
mk a
mid MacroDescriptor
md = (,) a
mid (r -> (a, r)) -> m r -> m (a, r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m r
prs (RegexType -> WithCaptures -> MacroEnv -> MacroDescriptor -> String
mdRegexSource RegexType
rty WithCaptures
wc MacroEnv
env MacroDescriptor
md)
\end{code}
testMacroEnv, badMacros
\begin{code}
testMacroEnv :: String -> RegexType -> MacroEnv -> IO Bool
testMacroEnv :: String -> RegexType -> MacroEnv -> IO Bool
testMacroEnv String
lab RegexType
rty MacroEnv
m_env = case MacroEnv -> [MacroID]
badMacros MacroEnv
m_env of
[] -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[MacroID]
fails -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
lab' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has failing tests for these macros: "
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++MacroID -> String
getMacroID MacroID
mid | MacroID
mid<-[MacroID]
fails ]
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The whole table:"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"========================================================"
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ RegexType -> MacroEnv -> String
formatMacroTable RegexType
rty MacroEnv
m_env
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"========================================================"
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where
lab' :: String
lab' = String
lab String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ RegexType -> String
presentRegexType RegexType
rty String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]"
badMacros :: MacroEnv -> [MacroID]
badMacros :: MacroEnv -> [MacroID]
badMacros MacroEnv
m_env =
[ MacroID
mid
| (MacroID
mid,MacroDescriptor{String
[String]
[TestResult]
Maybe FunctionID
RegexSource
macroDescription :: String
macroParser :: Maybe FunctionID
macroTestResults :: [TestResult]
macroCounterSamples :: [String]
macroSamples :: [String]
macroSource :: RegexSource
macroDescription :: MacroDescriptor -> String
macroParser :: MacroDescriptor -> Maybe FunctionID
macroTestResults :: MacroDescriptor -> [TestResult]
macroCounterSamples :: MacroDescriptor -> [String]
macroSamples :: MacroDescriptor -> [String]
macroSource :: MacroDescriptor -> RegexSource
..}) <- MacroEnv -> [(MacroID, MacroDescriptor)]
forall k v. HashMap k v -> [(k, v)]
HML.toList MacroEnv
m_env
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TestResult] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestResult]
macroTestResults
]
runTests :: (Eq a,Show a)
=> RegexType
-> (String->Maybe a)
-> [(String,a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
runTests :: RegexType
-> (String -> Maybe a)
-> [(String, a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
runTests RegexType
rty String -> Maybe a
parser = RegexType
-> (Match String -> Maybe a)
-> [(String, a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
forall a.
(Eq a, Show a) =>
RegexType
-> (Match String -> Maybe a)
-> [(String, a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
runTests' RegexType
rty Match String -> Maybe a
parser'
where
parser' :: Match String -> Maybe a
parser' Match String
caps = (Capture String -> String)
-> Maybe (Capture String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Capture String -> String
forall a. Capture a -> a
capturedText (Match String -> Maybe (Capture String)
forall a. Match a -> Maybe (Capture a)
matchCapture Match String
caps) Maybe String -> (String -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe a
parser
runTests' :: (Eq a,Show a)
=> RegexType
-> (Match String->Maybe a)
-> [(String,a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
runTests' :: RegexType
-> (Match String -> Maybe a)
-> [(String, a)]
-> MacroEnv
-> MacroID
-> MacroDescriptor
-> MacroDescriptor
runTests' RegexType
rty Match String -> Maybe a
parser [(String, a)]
vector MacroEnv
env MacroID
mid md :: MacroDescriptor
md@MacroDescriptor{String
[String]
[TestResult]
Maybe FunctionID
RegexSource
macroDescription :: String
macroParser :: Maybe FunctionID
macroTestResults :: [TestResult]
macroCounterSamples :: [String]
macroSamples :: [String]
macroSource :: RegexSource
macroDescription :: MacroDescriptor -> String
macroParser :: MacroDescriptor -> Maybe FunctionID
macroTestResults :: MacroDescriptor -> [TestResult]
macroCounterSamples :: MacroDescriptor -> [String]
macroSamples :: MacroDescriptor -> [String]
macroSource :: MacroDescriptor -> RegexSource
..} =
MacroDescriptor
md { macroTestResults :: [TestResult]
macroTestResults = [TestResult]
test_results }
where
test_results :: [TestResult]
test_results = [[TestResult]] -> [TestResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[TestResult]] -> [TestResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TestResult]] -> [TestResult]) -> [[TestResult]] -> [TestResult]
forall a b. (a -> b) -> a -> b
$ ((String, a) -> [TestResult]) -> [(String, a)] -> [[TestResult]]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> [TestResult]
test [(String, a)]
vector
, [[TestResult]] -> [TestResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TestResult]] -> [TestResult]) -> [[TestResult]] -> [TestResult]
forall a b. (a -> b) -> a -> b
$ (String -> [TestResult]) -> [String] -> [[TestResult]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [TestResult]
test_neg [String]
macroCounterSamples
]
test :: (String, a) -> [TestResult]
test (String
src,a
x) = MacroID
-> RegexType
-> (Match String -> Maybe a)
-> a
-> Matches String
-> [TestResult]
forall a.
(Eq a, Show a) =>
MacroID
-> RegexType
-> (Match String -> Maybe a)
-> a
-> Matches String
-> [TestResult]
test' MacroID
mid RegexType
rty Match String -> Maybe a
parser a
x (Matches String -> [TestResult]) -> Matches String -> [TestResult]
forall a b. (a -> b) -> a -> b
$ TestBenchMatcher
match_ String
src MacroEnv
env MacroDescriptor
md
test_neg :: String -> [TestResult]
test_neg String
src = MacroID
-> RegexType
-> (Match String -> Maybe a)
-> Matches String
-> [TestResult]
forall a.
MacroID
-> RegexType
-> (Match String -> Maybe a)
-> Matches String
-> [TestResult]
test_neg' MacroID
mid RegexType
rty Match String -> Maybe a
parser (Matches String -> [TestResult]) -> Matches String -> [TestResult]
forall a b. (a -> b) -> a -> b
$ TestBenchMatcher
match_ String
src MacroEnv
env MacroDescriptor
md
match_ :: TestBenchMatcher
match_ = case RegexType
rty of
TDFA TestBenchMatcher
tbmf -> TestBenchMatcher
tbmf
PCRE TestBenchMatcher
tbmf -> TestBenchMatcher
tbmf
\end{code}
formatMacroTable, formatMacroSummary, formatMacroSources, formatMacroSource
\begin{code}
formatMacroTable :: RegexType -> MacroEnv -> String
formatMacroTable :: RegexType -> MacroEnv -> String
formatMacroTable RegexType
rty MacroEnv
env = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
TableRow -> [TableRow] -> [String]
format_table TableRow
macro_table_hdr
[ RegexType -> MacroID -> MacroDescriptor -> TableRow
macro_table_row RegexType
rty MacroID
mid MacroDescriptor
md
| (MacroID
mid,MacroDescriptor
md) <- ((MacroID, MacroDescriptor)
-> (MacroID, MacroDescriptor) -> Ordering)
-> [(MacroID, MacroDescriptor)] -> [(MacroID, MacroDescriptor)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (((MacroID, MacroDescriptor) -> MacroID)
-> (MacroID, MacroDescriptor)
-> (MacroID, MacroDescriptor)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (MacroID, MacroDescriptor) -> MacroID
forall a b. (a, b) -> a
fst) ([(MacroID, MacroDescriptor)] -> [(MacroID, MacroDescriptor)])
-> [(MacroID, MacroDescriptor)] -> [(MacroID, MacroDescriptor)]
forall a b. (a -> b) -> a -> b
$ MacroEnv -> [(MacroID, MacroDescriptor)]
forall k v. HashMap k v -> [(k, v)]
HML.toList MacroEnv
env
]
\end{code}
\begin{code}
formatMacroSummary :: RegexType -> MacroEnv -> MacroID -> String
formatMacroSummary :: RegexType -> MacroEnv -> MacroID -> String
formatMacroSummary RegexType
rty MacroEnv
env MacroID
mid = String
-> (MacroDescriptor -> String) -> Maybe MacroDescriptor -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. a
oops MacroDescriptor -> String
prep (Maybe MacroDescriptor -> String)
-> Maybe MacroDescriptor -> String
forall a b. (a -> b) -> a -> b
$ MacroID -> MacroEnv -> Maybe MacroDescriptor
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HML.lookup MacroID
mid MacroEnv
env
where
prep :: MacroDescriptor -> String
prep :: MacroDescriptor -> String
prep MacroDescriptor
md = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Col -> [String]) -> [Col] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (MacroDescriptor -> Col -> [String]
fmt MacroDescriptor
md) [Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound]
fmt :: MacroDescriptor -> Col -> [String]
fmt :: MacroDescriptor -> Col -> [String]
fmt MacroDescriptor
md Col
c =
[ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%-15s : %s" (Col -> String
present_col Col
c) String
ini
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
lns
where
(String
ini,[String]
lns) = case RegexType -> MacroID -> MacroDescriptor -> Col -> [String]
macro_attribute RegexType
rty MacroID
mid MacroDescriptor
md Col
c of
[] -> (,) String
"" []
[String
ln] -> (,) String
ln []
[String]
lns_ -> (,) String
"" [String]
lns_
oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ MacroID -> String
getMacroID MacroID
mid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": macro not defined in this environment"
\end{code}
\begin{code}
formatMacroSources :: RegexType
-> WithCaptures
-> MacroEnv
-> String
formatMacroSources :: RegexType -> WithCaptures -> MacroEnv -> String
formatMacroSources RegexType
rty WithCaptures
wc MacroEnv
env = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%-20s : %s" (MacroID -> String
getMacroID MacroID
mid) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ RegexType -> WithCaptures -> MacroEnv -> MacroID -> String
formatMacroSource RegexType
rty WithCaptures
wc MacroEnv
env MacroID
mid
| MacroID
mid <- [MacroID] -> [MacroID]
forall a. Ord a => [a] -> [a]
L.sort ([MacroID] -> [MacroID]) -> [MacroID] -> [MacroID]
forall a b. (a -> b) -> a -> b
$ MacroEnv -> [MacroID]
forall k v. HashMap k v -> [k]
HML.keys MacroEnv
env
]
\end{code}
\begin{code}
formatMacroSource :: RegexType
-> WithCaptures
-> MacroEnv
-> MacroID
-> String
formatMacroSource :: RegexType -> WithCaptures -> MacroEnv -> MacroID -> String
formatMacroSource RegexType
rty WithCaptures
wc MacroEnv
env MacroID
mid =
RegexType -> WithCaptures -> MacroEnv -> MacroDescriptor -> String
mdRegexSource RegexType
rty WithCaptures
wc MacroEnv
env (MacroDescriptor -> String) -> MacroDescriptor -> String
forall a b. (a -> b) -> a -> b
$ MacroDescriptor -> Maybe MacroDescriptor -> MacroDescriptor
forall a. a -> Maybe a -> a
fromMaybe MacroDescriptor
forall a. a
oops (Maybe MacroDescriptor -> MacroDescriptor)
-> Maybe MacroDescriptor -> MacroDescriptor
forall a b. (a -> b) -> a -> b
$ MacroID -> MacroEnv -> Maybe MacroDescriptor
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HML.lookup MacroID
mid MacroEnv
env
where
oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"formatMacroSource: not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MacroID -> String
getMacroID MacroID
mid
\end{code}
testMacroDescriptors, regexSource
\begin{code}
testMacroDescriptors :: [MacroDescriptor] -> [TestResult]
testMacroDescriptors :: [MacroDescriptor] -> [TestResult]
testMacroDescriptors = [[TestResult]] -> [TestResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TestResult]] -> [TestResult])
-> ([MacroDescriptor] -> [[TestResult]])
-> [MacroDescriptor]
-> [TestResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MacroDescriptor -> [TestResult])
-> [MacroDescriptor] -> [[TestResult]]
forall a b. (a -> b) -> [a] -> [b]
map MacroDescriptor -> [TestResult]
macroTestResults
regexSource :: RegexType -> WithCaptures -> RegexSource -> String
regexSource :: RegexType -> WithCaptures -> RegexSource -> String
regexSource RegexType
rty WithCaptures
wc = RegexType -> WithCaptures -> [REToken] -> String
format_tokens RegexType
rty WithCaptures
wc ([REToken] -> String)
-> (RegexSource -> [REToken]) -> RegexSource -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegexSource -> [REToken]
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
|
deriving (Ord Col
Ord Col
-> ((Col, Col) -> [Col])
-> ((Col, Col) -> Col -> Int)
-> ((Col, Col) -> Col -> Int)
-> ((Col, Col) -> Col -> Bool)
-> ((Col, Col) -> Int)
-> ((Col, Col) -> Int)
-> Ix Col
(Col, Col) -> Int
(Col, Col) -> [Col]
(Col, Col) -> Col -> Bool
(Col, Col) -> Col -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Col, Col) -> Int
$cunsafeRangeSize :: (Col, Col) -> Int
rangeSize :: (Col, Col) -> Int
$crangeSize :: (Col, Col) -> Int
inRange :: (Col, Col) -> Col -> Bool
$cinRange :: (Col, Col) -> Col -> Bool
unsafeIndex :: (Col, Col) -> Col -> Int
$cunsafeIndex :: (Col, Col) -> Col -> Int
index :: (Col, Col) -> Col -> Int
$cindex :: (Col, Col) -> Col -> Int
range :: (Col, Col) -> [Col]
$crange :: (Col, Col) -> [Col]
$cp1Ix :: Ord Col
Ix,Col
Col -> Col -> Bounded Col
forall a. a -> a -> Bounded a
maxBound :: Col
$cmaxBound :: Col
minBound :: Col
$cminBound :: Col
Bounded,Int -> Col
Col -> Int
Col -> [Col]
Col -> Col
Col -> Col -> [Col]
Col -> Col -> Col -> [Col]
(Col -> Col)
-> (Col -> Col)
-> (Int -> Col)
-> (Col -> Int)
-> (Col -> [Col])
-> (Col -> Col -> [Col])
-> (Col -> Col -> [Col])
-> (Col -> Col -> Col -> [Col])
-> Enum Col
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 :: Col -> Col -> Col -> [Col]
$cenumFromThenTo :: Col -> Col -> Col -> [Col]
enumFromTo :: Col -> Col -> [Col]
$cenumFromTo :: Col -> Col -> [Col]
enumFromThen :: Col -> Col -> [Col]
$cenumFromThen :: Col -> Col -> [Col]
enumFrom :: Col -> [Col]
$cenumFrom :: Col -> [Col]
fromEnum :: Col -> Int
$cfromEnum :: Col -> Int
toEnum :: Int -> Col
$ctoEnum :: Int -> Col
pred :: Col -> Col
$cpred :: Col -> Col
succ :: Col -> Col
$csucc :: Col -> Col
Enum,Eq Col
Eq Col
-> (Col -> Col -> Ordering)
-> (Col -> Col -> Bool)
-> (Col -> Col -> Bool)
-> (Col -> Col -> Bool)
-> (Col -> Col -> Bool)
-> (Col -> Col -> Col)
-> (Col -> Col -> Col)
-> Ord Col
Col -> Col -> Bool
Col -> Col -> Ordering
Col -> Col -> Col
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 :: Col -> Col -> Col
$cmin :: Col -> Col -> Col
max :: Col -> Col -> Col
$cmax :: Col -> Col -> Col
>= :: Col -> Col -> Bool
$c>= :: Col -> Col -> Bool
> :: Col -> Col -> Bool
$c> :: Col -> Col -> Bool
<= :: Col -> Col -> Bool
$c<= :: Col -> Col -> Bool
< :: Col -> Col -> Bool
$c< :: Col -> Col -> Bool
compare :: Col -> Col -> Ordering
$ccompare :: Col -> Col -> Ordering
$cp1Ord :: Eq Col
Ord,Col -> Col -> Bool
(Col -> Col -> Bool) -> (Col -> Col -> Bool) -> Eq Col
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Col -> Col -> Bool
$c/= :: Col -> Col -> Bool
== :: Col -> Col -> Bool
$c== :: Col -> Col -> Bool
Eq,Int -> Col -> ShowS
[Col] -> ShowS
Col -> String
(Int -> Col -> ShowS)
-> (Col -> String) -> ([Col] -> ShowS) -> Show Col
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Col] -> ShowS
$cshowList :: [Col] -> ShowS
show :: Col -> String
$cshow :: Col -> String
showsPrec :: Int -> Col -> ShowS
$cshowsPrec :: Int -> Col -> ShowS
Show)
present_col :: Col -> String
present_col :: Col -> String
present_col = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr ShowS -> (Col -> String) -> Col -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 ShowS -> (Col -> String) -> Col -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Col -> String
forall a. Show a => a -> String
show
where
tr :: Char -> Char
tr Char
'_' = Char
'-'
tr Char
c = Char
c
macro_table_hdr :: TableRow
macro_table_hdr :: TableRow
macro_table_hdr = (Col, Col) -> [[String]] -> TableRow
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Col
forall a. Bounded a => a
minBound,Col
forall a. Bounded a => a
maxBound)
[ [Col -> String
present_col Col
c]
| Col
c<-[Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound]
]
macro_table_row :: RegexType -> MacroID -> MacroDescriptor -> TableRow
macro_table_row :: RegexType -> MacroID -> MacroDescriptor -> TableRow
macro_table_row RegexType
rty MacroID
mid MacroDescriptor
md =
(Col, Col) -> [[String]] -> TableRow
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Col
forall a. Bounded a => a
minBound,Col
forall a. Bounded a => a
maxBound) ([[String]] -> TableRow) -> [[String]] -> TableRow
forall a b. (a -> b) -> a -> b
$
(Col -> [String]) -> [Col] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (RegexType -> MacroID -> MacroDescriptor -> Col -> [String]
macro_attribute RegexType
rty MacroID
mid MacroDescriptor
md) [Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound]
macro_attribute :: RegexType
-> MacroID
-> MacroDescriptor
-> Col
-> [String]
macro_attribute :: RegexType -> MacroID -> MacroDescriptor -> Col -> [String]
macro_attribute RegexType
rty MacroID
mid MacroDescriptor{String
[String]
[TestResult]
Maybe FunctionID
RegexSource
macroDescription :: String
macroParser :: Maybe FunctionID
macroTestResults :: [TestResult]
macroCounterSamples :: [String]
macroSamples :: [String]
macroSource :: RegexSource
macroDescription :: MacroDescriptor -> String
macroParser :: MacroDescriptor -> Maybe FunctionID
macroTestResults :: MacroDescriptor -> [TestResult]
macroCounterSamples :: MacroDescriptor -> [String]
macroSamples :: MacroDescriptor -> [String]
macroSource :: MacroDescriptor -> RegexSource
..} Col
c =
case Col
c of
Col
C_name -> [MacroID -> String
getMacroID MacroID
mid]
Col
C_caps -> [Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ RegexType -> [REToken] -> Int
min_captures RegexType
rty ([REToken] -> Int) -> [REToken] -> Int
forall a b. (a -> b) -> a -> b
$ RegexSource -> [REToken]
scan_re RegexSource
macroSource]
Col
C_regex -> [RegexType -> WithCaptures -> RegexSource -> String
regexSource RegexType
rty WithCaptures
ExclCaptures RegexSource
macroSource]
Col
C_examples -> [String]
macroSamples
Col
C_anti_examples -> [String]
macroCounterSamples
Col
C_fails -> (TestResult -> String) -> [TestResult] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestResult -> String
_TestResult [TestResult]
macroTestResults
Col
C_parser -> [String -> (FunctionID -> String) -> Maybe FunctionID -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"-" FunctionID -> String
_FunctionID Maybe FunctionID
macroParser]
Col
C_comment -> [String
macroDescription]
format_table :: TableRow -> [TableRow] -> [String]
format_table :: TableRow -> [TableRow] -> [String]
format_table TableRow
hdr [TableRow]
rows0 = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Array Col Int -> TableRow -> [String]
format_row Array Col Int
cws TableRow
hdr'
, Array Col Int -> TableRow -> [String]
format_row Array Col Int
cws TableRow
dsh
, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (TableRow -> [String]) -> [TableRow] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Array Col Int -> TableRow -> [String]
format_row Array Col Int
cws) [TableRow]
rows
]
where
dsh :: TableRow
dsh = (Col, Col) -> [[String]] -> TableRow
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Col
forall a. Bounded a => a
minBound,Col
forall a. Bounded a => a
maxBound)
[ [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'-'] | Int
n<-Array Col Int -> [Int]
forall i e. Array i e -> [e]
elems Array Col Int
cws ]
hdr' :: TableRow
hdr' = TableRow
hdr TableRow -> [(Col, [String])] -> TableRow
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [(,) Col
C_regex ([String] -> (Col, [String])) -> [String] -> (Col, [String])
forall a b. (a -> b) -> a -> b
$ [Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat String
"regex="] ]
where
n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
29 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Array Col Int
cwsArray Col Int -> Col -> Int
forall i e. Ix i => Array i e -> i -> e
!Col
C_regex
cws :: Array Col Int
cws = [TableRow] -> Array Col Int
widths ([TableRow] -> Array Col Int) -> [TableRow] -> Array Col Int
forall a b. (a -> b) -> a -> b
$ TableRow
hdr TableRow -> [TableRow] -> [TableRow]
forall a. a -> [a] -> [a]
: [TableRow]
rows
rows :: [TableRow]
rows = (TableRow -> TableRow) -> [TableRow] -> [TableRow]
forall a b. (a -> b) -> [a] -> [b]
map TableRow -> TableRow
wrap_row [TableRow]
rows0
field_width :: Int
field_width :: Int
field_width = Int
40
wrap_row :: TableRow -> TableRow
wrap_row :: TableRow -> TableRow
wrap_row = ([String] -> [String]) -> TableRow -> TableRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> [String]) -> TableRow -> TableRow)
-> ([String] -> [String]) -> TableRow -> TableRow
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([String] -> [[String]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
f
where
f, g :: String -> [String]
f :: String -> [String]
f String
cts = (String
ini String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\\' | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rst)]) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
g String
rst
where
(String
ini,String
rst) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
field_width) String
cts
g :: String -> [String]
g String
"" = []
g String
cts = (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
ini String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\\' | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rst)]) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
g String
rst
where
(String
ini,String
rst) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
field_width String
cts
widths :: [TableRow] -> Array Col Int
widths :: [TableRow] -> Array Col Int
widths [TableRow]
rows = (Col, Col) -> [Int] -> Array Col Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Col
forall a. Bounded a => a
minBound,Col
forall a. Bounded a => a
maxBound)
[ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> [Int]) -> [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ TableRow
rowTableRow -> Col -> [String]
forall i e. Ix i => Array i e -> i -> e
!Col
c | TableRow
row<-[TableRow]
rows ]
| Col
c<-[Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound]
]
format_row :: Array Col Int -> TableRow -> [String]
format_row :: Array Col Int -> TableRow -> [String]
format_row Array Col Int
cw_arr TableRow
row =
[ (String
"|"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"|"
[ Array Col Int -> TableRow -> Col -> Int -> String
field Array Col Int
cw_arr TableRow
row Col
c Int
i | Col
c<-[Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound] ]
| Int
i <- [Int
0..Int
depthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
]
where
depth :: Int
depth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ TableRow
rowTableRow -> Col -> [String]
forall i e. Ix i => Array i e -> i -> e
!Col
c | Col
c<-[Col
forall a. Bounded a => a
minBound..Col
forall a. Bounded a => a
maxBound] ]
field :: Array Col Int -> TableRow -> Col -> Int -> String
field :: Array Col Int -> TableRow -> Col -> Int -> String
field Array Col Int
cws TableRow
row Col
c Int
i = Int -> ShowS
ljust (Array Col Int
cwsArray Col Int -> Col -> Int
forall i e. Ix i => Array i e -> i -> e
!Col
c) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> String
sel Int
i ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ TableRow
rowTableRow -> Col -> [String]
forall i e. Ix i => Array i e -> i -> e
!Col
c
sel :: Int -> [String] -> String
sel :: Int -> [String] -> String
sel Int
i [String]
ss = case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
i [String]
ss of
[] -> String
""
String
s:[String]
_ -> String
s
ljust :: Int -> String -> String
ljust :: Int -> ShowS
ljust Int
w String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
where
n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
min_captures :: RegexType -> [REToken] -> Int
min_captures :: RegexType -> [REToken] -> Int
min_captures RegexType
rty [REToken]
rets = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
[ ()
| REToken{Bool
String
_ret_capturing :: Bool
_ret_grouping :: Bool
_ret_fixed :: Bool
_ret_prefix :: String
_ret_capturing :: REToken -> Bool
_ret_grouping :: REToken -> Bool
_ret_fixed :: REToken -> Bool
_ret_prefix :: REToken -> String
..}<-[REToken]
rets
, Bool
_ret_fixed Bool -> Bool -> Bool
|| (Bool
_ret_grouping Bool -> Bool -> Bool
&& RegexType -> Bool
isTDFA RegexType
rty)
]
\end{code}
Formatting tokens
\begin{code}
format_tokens :: RegexType -> WithCaptures -> [REToken] -> String
format_tokens :: RegexType -> WithCaptures -> [REToken] -> String
format_tokens RegexType
rty WithCaptures
wc = (REToken -> ShowS) -> String -> [REToken] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr REToken -> ShowS
f String
""
where
f :: REToken -> ShowS
f REToken{Bool
String
_ret_capturing :: Bool
_ret_grouping :: Bool
_ret_fixed :: Bool
_ret_prefix :: String
_ret_capturing :: REToken -> Bool
_ret_grouping :: REToken -> Bool
_ret_fixed :: REToken -> Bool
_ret_prefix :: REToken -> String
..} String
rst = String
_ret_prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bra String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
xket String
rst
where
bra :: String
bra = case Bool
_ret_fixed of
Bool
True -> String
"("
Bool
False ->
case (,) Bool
_ret_grouping (Bool
_ret_capturing Bool -> Bool -> Bool
&& WithCaptures
wcWithCaptures -> WithCaptures -> Bool
forall a. Eq a => a -> a -> Bool
==WithCaptures
InclCaptures) of
(Bool
False,Bool
False) -> String
""
(Bool
True ,Bool
False) -> if RegexType -> Bool
isPCRE RegexType
rty then String
"(?:" else String
"("
(Bool
False,Bool
True ) -> String
"("
(Bool
True ,Bool
True ) -> String
"("
xket :: ShowS
xket =
case Bool -> Bool
not Bool
_ret_grouping Bool -> Bool -> Bool
&& Bool
_ret_capturing Bool -> Bool -> Bool
&& WithCaptures
wcWithCaptures -> WithCaptures -> Bool
forall a. Eq a => a -> a -> Bool
==WithCaptures
ExclCaptures of
Bool
True -> Int -> ShowS
delete_ket Int
0
Bool
False -> ShowS
forall a. a -> a
id
delete_ket :: Int -> String -> String
delete_ket :: Int -> ShowS
delete_ket Int
_ String
"" = ShowS
forall a. HasCallStack => String -> a
error String
"delete_ket: end of input"
delete_ket Int
n (Char
c:String
t) = case Char
c of
Char
'\\' -> case String
t of
String
"" -> ShowS
forall a. HasCallStack => String -> a
error String
"delete_ket: end of input"
Char
c':String
t' -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
delete_ket Int
n String
t'
Char
')' -> case Int
n of
Int
0 -> String
t
Int
_ -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
delete_ket (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
t
Char
'(' -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
delete_ket (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
t
Char
_ -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
delete_ket Int
n String
t
\end{code}
scan_re
\begin{code}
scan_re :: RegexSource -> [REToken]
scan_re :: RegexSource -> [REToken]
scan_re (RegexSource String
src0) = String -> [REToken]
loop String
src0
where
loop :: String -> [REToken]
loop String
"" = []
loop String
src =
case String
rst of
Char
'\\':String
t -> case String
t of
String
"" -> String -> Bool -> Bool -> Bool -> REToken
REToken (String
iniString -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'\\']) Bool
False Bool
False Bool
False REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: []
Char
c':String
t' -> String -> Bool -> Bool -> Bool -> REToken
REToken (String
iniString -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'\\',Char
c']) Bool
False Bool
False Bool
False REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: String -> [REToken]
loop String
t'
Char
'(' :String
t -> case String
t of
Char
c:Char
':':String
t'
| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'?' -> String -> Bool -> Bool -> Bool -> REToken
REToken String
ini Bool
False Bool
True Bool
False REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: String -> [REToken]
loop String
t'
| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'}' -> String -> Bool -> Bool -> Bool -> REToken
REToken String
ini Bool
False Bool
False Bool
True REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: String -> [REToken]
loop String
t'
| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
']' -> String -> Bool -> Bool -> Bool -> REToken
REToken String
ini Bool
False Bool
True Bool
True REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: String -> [REToken]
loop String
t'
String
_ -> String -> Bool -> Bool -> Bool -> REToken
REToken String
ini Bool
True Bool
True Bool
True REToken -> [REToken] -> [REToken]
forall a. a -> [a] -> [a]
: String -> [REToken]
loop String
t
String
_ -> [String -> Bool -> Bool -> Bool -> REToken
REToken String
src Bool
False Bool
False Bool
False]
where
(String
ini,String
rst) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
chk String
src
chk :: Char -> Bool
chk Char
'\\' = Bool
True
chk Char
'(' = Bool
True
chk Char
_ = Bool
False
\end{code}
mdRegexSource
\begin{code}
mdRegexSource :: RegexType
-> WithCaptures
-> MacroEnv
-> MacroDescriptor
-> String
mdRegexSource :: RegexType -> WithCaptures -> MacroEnv -> MacroDescriptor -> String
mdRegexSource RegexType
rty WithCaptures
wc MacroEnv
env MacroDescriptor
md =
(MacroID -> Maybe String) -> ShowS
expandMacros' MacroID -> Maybe String
lu ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ RegexType -> WithCaptures -> RegexSource -> String
regexSource RegexType
rty WithCaptures
wc (RegexSource -> String) -> RegexSource -> String
forall a b. (a -> b) -> a -> b
$ MacroDescriptor -> RegexSource
macroSource MacroDescriptor
md
where
lu :: MacroID -> Maybe String
lu = (MacroDescriptor -> String)
-> Maybe MacroDescriptor -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RegexType -> WithCaptures -> RegexSource -> String
regexSource RegexType
rty WithCaptures
wc (RegexSource -> String)
-> (MacroDescriptor -> RegexSource) -> MacroDescriptor -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MacroDescriptor -> RegexSource
macroSource) (Maybe MacroDescriptor -> Maybe String)
-> (MacroID -> Maybe MacroDescriptor) -> MacroID -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(MacroID -> MacroEnv -> Maybe MacroDescriptor)
-> MacroEnv -> MacroID -> Maybe MacroDescriptor
forall a b c. (a -> b -> c) -> b -> a -> c
flip MacroID -> MacroEnv -> Maybe MacroDescriptor
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HML.lookup MacroEnv
env
\end{code}
test', test_neg'
\begin{code}
test' :: (Eq a,Show a)
=> MacroID
-> RegexType
-> (Match String->Maybe a)
-> a
-> Matches String
-> [TestResult]
test' :: MacroID
-> RegexType
-> (Match String -> Maybe a)
-> a
-> Matches String
-> [TestResult]
test' MacroID
mid RegexType
rty Match String -> Maybe a
prs a
x Matches{String
[Match String]
allMatches :: forall a. Matches a -> [Match a]
matchesSource :: forall a. Matches a -> a
allMatches :: [Match String]
matchesSource :: String
..} = (TestResult -> [TestResult])
-> (() -> [TestResult]) -> Either TestResult () -> [TestResult]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestResult -> [TestResult] -> [TestResult]
forall a. a -> [a] -> [a]
:[]) ([TestResult] -> () -> [TestResult]
forall a b. a -> b -> a
const []) (Either TestResult () -> [TestResult])
-> Either TestResult () -> [TestResult]
forall a b. (a -> b) -> a -> b
$ do
Match String
cs <- case [Match String]
allMatches of
[Match String
cs] -> Match String -> Either TestResult (Match String)
forall (m :: * -> *) a. Monad m => a -> m a
return Match String
cs
[Match String]
_ -> String -> Either TestResult (Match String)
forall b. String -> Either TestResult b
oops String
"RE failed to parse"
String
mtx <- case Match String -> Maybe (Capture String)
forall a. Match a -> Maybe (Capture a)
matchCapture Match String
cs of
Maybe (Capture String)
Nothing -> String -> Either TestResult String
forall b. String -> Either TestResult b
oops (String -> Either TestResult String)
-> String -> Either TestResult String
forall a b. (a -> b) -> a -> b
$ String
"RE parse failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Match String -> String
forall a. Show a => a -> String
show Match String
cs
Just Capture String
c -> String -> Either TestResult String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either TestResult String)
-> String -> Either TestResult String
forall a b. (a -> b) -> a -> b
$ Capture String -> String
forall a. Capture a -> a
capturedText Capture String
c
case String
mtx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
matchesSource of
Bool
True -> () -> Either TestResult ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> Either TestResult ()
forall b. String -> Either TestResult b
oops String
"RE failed to match the whole text"
a
x' <- case Match String -> Maybe a
prs Match String
cs of
Maybe a
Nothing -> String -> Either TestResult a
forall b. String -> Either TestResult b
oops String
"matched text failed to parse"
Just a
x' -> a -> Either TestResult a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x'
case a
x'a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x of
Bool
True -> () -> Either TestResult ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> Either TestResult ()
forall b. String -> Either TestResult b
oops String
"parser failed to yield the expected result"
where
oops :: String -> Either TestResult b
oops = TestResult -> Either TestResult b
forall a b. a -> Either a b
Left (TestResult -> Either TestResult b)
-> (String -> TestResult) -> String -> Either TestResult b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MacroID -> Bool -> RegexType -> String -> String -> TestResult
test_diagnostic MacroID
mid Bool
False RegexType
rty String
matchesSource
test_neg' :: MacroID
-> RegexType
-> (Match String->Maybe a)
-> Matches String
-> [TestResult]
test_neg' :: MacroID
-> RegexType
-> (Match String -> Maybe a)
-> Matches String
-> [TestResult]
test_neg' MacroID
mid RegexType
rty Match String -> Maybe a
prs Matches{String
[Match String]
allMatches :: [Match String]
matchesSource :: String
allMatches :: forall a. Matches a -> [Match a]
matchesSource :: forall a. Matches a -> a
..} = ([TestResult] -> [TestResult])
-> (() -> [TestResult]) -> Either [TestResult] () -> [TestResult]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [TestResult] -> [TestResult]
forall a. a -> a
id ([TestResult] -> () -> [TestResult]
forall a b. a -> b -> a
const []) (Either [TestResult] () -> [TestResult])
-> Either [TestResult] () -> [TestResult]
forall a b. (a -> b) -> a -> b
$ do
case [Match String]
allMatches of
[] -> () -> Either [TestResult] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Match String]
cz -> case [()]
ms of
[] -> () -> Either [TestResult] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[()]
_ -> [TestResult] -> Either [TestResult] ()
forall a b. a -> Either a b
Left [String -> TestResult
oops String
"RE parse succeeded"]
where
ms :: [()]
ms =
[ ()
| Match String
cs <- [Match String]
cz
, Just Capture String
c <- [Match String -> Maybe (Capture String)
forall a. Match a -> Maybe (Capture a)
matchCapture Match String
cs]
, let t :: String
t = Capture String -> String
forall a. Capture a -> a
capturedText Capture String
c
, String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
matchesSource
, Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ Match String -> Maybe a
prs Match String
cs
]
where
oops :: String -> TestResult
oops = MacroID -> Bool -> RegexType -> String -> String -> TestResult
test_diagnostic MacroID
mid Bool
True RegexType
rty String
matchesSource
test_diagnostic :: MacroID
-> Bool
-> RegexType
-> String
-> String
-> TestResult
test_diagnostic :: MacroID -> Bool -> RegexType -> String -> String -> TestResult
test_diagnostic MacroID
mid Bool
is_neg RegexType
rty String
tst String
msg =
String -> TestResult
TestResult (String -> TestResult) -> String -> TestResult
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%-20s [%s %s] : %s (%s)" String
mid_s String
neg_s String
rty_s String
msg String
tst
where
mid_s :: String
mid_s = MacroID -> String
getMacroID MacroID
mid
neg_s :: String
neg_s = if Bool
is_neg then String
"-ve" else String
"+ve" :: String
rty_s :: String
rty_s = RegexType -> String
presentRegexType RegexType
rty
\end{code}