\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

-- | what flavour of regex are we dealing with
data RegexType
  = TDFA TestBenchMatcher
  | PCRE TestBenchMatcher

-- | test RegexType for TDFA/PCREness
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>"

-- | 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 (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)

-- | 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
    { MacroDescriptor -> RegexSource
macroSource         :: !RegexSource         -- ^ the RE
    , MacroDescriptor -> [String]
macroSamples        :: ![String]            -- ^ some sample matches
    , MacroDescriptor -> [String]
macroCounterSamples :: ![String]            -- ^ some sample non-matches
    , MacroDescriptor -> [TestResult]
macroTestResults    :: ![TestResult]        -- ^ validation test results
    , MacroDescriptor -> Maybe FunctionID
macroParser         :: !(Maybe FunctionID)  -- ^ WA, the parser function
    , MacroDescriptor -> String
macroDescription    :: !String              -- ^ summary comment
    }
  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)

-- | list of failures on a validation run
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)

-- | 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
_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)

-- | name of the Haskell parser function for parsing the text matched
-- by a macro
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)

-- | 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
    { REToken -> String
_ret_prefix    :: String  -- ^ following text optional ( or (?:
    , REToken -> Bool
_ret_fixed     :: Bool    -- ^ a '(' that is not safe to modify
    , REToken -> Bool
_ret_grouping  :: Bool    -- ^ is this a grouping group
    , REToken -> Bool
_ret_capturing :: Bool    -- ^ is this a capturing group
    }
  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}
-- | 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 :: (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}
-- | test that a MacroEnv is passing all of its built-in tests
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}
-- | format a macros table as a markdown table
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}
-- | generate a plain text summary of a macro
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}
-- | list the source REs for each macro in plain text
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}
-- | list the source of a single macro in plain text
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
  | C_comment
  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}