From e003c4fcce8dacc97d3c0fc497044c59b0ce14d5 Mon Sep 17 00:00:00 2001 From: Tom Knight Date: Tue, 31 Jan 2017 10:36:25 +0000 Subject: [PATCH 1/2] Wrap content in div and give it padding --- docs/lib/styles.css | 4 ++++ examples/re-pp.lhs | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/docs/lib/styles.css b/docs/lib/styles.css index b42d5d3..1254f98 100644 --- a/docs/lib/styles.css +++ b/docs/lib/styles.css @@ -2,6 +2,10 @@ * our local style sheet */ +div.content { + padding: 20px; +} + div.replcodeblock div.sourceCode pre.sourceCode.literate.haskell { background-color: #f2f2ff; border: 2px solid #ffcccc; diff --git a/examples/re-pp.lhs b/examples/re-pp.lhs index 7d14b11..53058a3 100644 --- a/examples/re-pp.lhs +++ b/examples/re-pp.lhs @@ -417,6 +417,7 @@ pandoc title in_file = pandoc' title in_file in_file pandoc' :: T.Text -> T.Text -> T.Text -> T.Text -> IO () pandoc' title repo_path in_file out_file = do writeFile "tmp/bc.html" bc + writeFile "tmp/ft.html" ft fmap (const ()) $ SH.shelly $ SH.verbosely $ SH.run "pandoc" @@ -424,6 +425,7 @@ pandoc' title repo_path in_file out_file = do , "-t", "html" , "-s" , "-B", "tmp/bc.html" + , "-A", "tmp/ft.html" , "-c", "lib/styles.css" , "-c", "lib/bs.css" , "-o", out_file @@ -437,8 +439,12 @@ pandoc' title repo_path in_file out_file = do , "'>" , T.unpack title , "" + , "
" ] + ft = concat + [ "
" ] + repo_url = concat [ "https://github.com/iconnect/regex/blob/master/" , T.unpack repo_path From 5a99bf8a24e22414d7f0ac7f7c7e9c91fa2ac526 Mon Sep 17 00:00:00 2001 From: Chris Dornan Date: Tue, 31 Jan 2017 11:37:08 +0000 Subject: [PATCH 2/2] Fix the literate programming stylesheet (fixes #1 -- Tom's fix) --- docs/Capture.html | 13 +- docs/Edit.html | 3 +- docs/Grep.html | 3 +- docs/IsRegex.html | 4 +- docs/Lex.html | 3 +- docs/NamedCaptures.html | 3 +- docs/Options.html | 11 +- docs/Replace.html | 3 +- docs/Sed.html | 3 +- docs/TestBench.html | 19 +-- docs/TestKit.html | 5 +- docs/re-gen-modules.html | 3 +- docs/re-include.html | 3 +- docs/re-nginx-log-processor.html | 37 +++--- docs/re-pp.html | 10 +- docs/re-tests.html | 199 +++++++++++++++++++++++++++++-- docs/re-tutorial.html | 17 +-- examples/re-pp.lhs | 3 +- 18 files changed, 278 insertions(+), 64 deletions(-) diff --git a/docs/Capture.html b/docs/Capture.html index d9bf921..89ca7ba 100644 --- a/docs/Capture.html +++ b/docs/Capture.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Capture
+
  1. Home
    2. > RE/Capture
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE UndecidableInstances       #-}
@@ -224,7 +224,10 @@
 captureSuffix :: Extract a => Capture a -> a
 captureSuffix Capture{..} = after (captureOffset+captureLength) captureSource
-- | for matching just the first RE against the source text
-instance RegexContext regex source (AllTextSubmatches (Array Int) (source,(Int,Int))) =>
+instance
+    ( RegexContext regex source (AllTextSubmatches (Array Int) (source,(Int,Int)))
+    , RegexLike    regex source
+    ) =>
   RegexContext regex source (Match source) where
     match  r s = cvt s $ getAllTextSubmatches $ match r s
     matchM r s = do
@@ -232,7 +235,10 @@
       return $ cvt s $ getAllTextSubmatches y
 
 -- | for matching all REs against the source text
-instance RegexContext regex source [MatchText source] =>
+instance
+    ( RegexContext regex source [MatchText source]
+    , RegexLike    regex source
+    ) =>
   RegexContext regex source (Matches source) where
     match  r s = Matches s $ map (cvt s) $ match r s
     matchM r s = do
@@ -257,5 +263,6 @@
         , captureOffset = off
         , captureLength = len
         }
+
diff --git a/docs/Edit.html b/docs/Edit.html index 685a8b2..efe41c2 100644 --- a/docs/Edit.html +++ b/docs/Edit.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Edit
+
  1. Home
    2. > RE/Edit
{-# LANGUAGE RecordWildCards            #-}
 
 module Text.RE.Edit
@@ -140,5 +140,6 @@
     f (re,es) act = do
       s <- act
       fromMaybe s <$> applyEdit id lno re es s
+
diff --git a/docs/Grep.html b/docs/Grep.html index 3e79bee..cb18bf3 100644 --- a/docs/Grep.html +++ b/docs/Grep.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Tools/Grep
+
  1. Home
    2. > RE/Tools/Grep
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE FlexibleContexts           #-}
 
@@ -104,5 +104,6 @@
 
 lines_matched :: [Line] -> [Line]
 lines_matched = filter $ anyMatches . _ln_matches
+
diff --git a/docs/IsRegex.html b/docs/IsRegex.html index 93e613e..e0cc5df 100644 --- a/docs/IsRegex.html +++ b/docs/IsRegex.html @@ -47,8 +47,9 @@ -
  1. Home
    2. > RE/IsRegex
+
  1. Home
    2. > RE/IsRegex
{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE AllowAmbiguousTypes        #-}
 
 module Text.RE.IsRegex where
 
@@ -58,5 +59,6 @@
   matchOnce   :: re -> s -> Match s
   matchMany   :: re -> s -> Matches s
   regexSource :: re -> String
+
diff --git a/docs/Lex.html b/docs/Lex.html index eb6edcd..4c42693 100644 --- a/docs/Lex.html +++ b/docs/Lex.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Tools/Lex
+
  1. Home
    2. > RE/Tools/Lex
module Text.RE.Tools.Lex where
 
 import           Control.Applicative
@@ -81,5 +81,6 @@
             False -> Nothing
 
         mtch = mo re s
+
diff --git a/docs/NamedCaptures.html b/docs/NamedCaptures.html index 0a91873..66c1db7 100644 --- a/docs/NamedCaptures.html +++ b/docs/NamedCaptures.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Internal/NamedCaptures
+
  1. Home
    2. > RE/Internal/NamedCaptures
{-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE FlexibleInstances          #-}
@@ -271,5 +271,6 @@ 
Testing : Analysing = either oops fst . extractNamedCaptures
       where
         oops = error "analyseTokensTestTree: unexpected parse failure"
+
diff --git a/docs/Options.html b/docs/Options.html index 99f6a03..ae9292c 100644 --- a/docs/Options.html +++ b/docs/Options.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Options
+
  1. Home
    2. > RE/Options
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE QuasiQuotes                #-}
@@ -63,10 +63,10 @@
 import           Language.Haskell.TH.Syntax
data Options_ r c e =
   Options
-    { _options_mode :: Mode
-    , _options_macs :: Macros r
-    , _options_comp :: c
-    , _options_exec :: e
+    { _options_mode :: !Mode
+    , _options_macs :: !(Macros r)
+    , _options_comp :: !c
+    , _options_exec :: !e
     }
   deriving (Show)
class IsOption o r c e |
@@ -96,5 +96,6 @@
     MultilineInsensitive  -> conE 'MultilineInsensitive
     BlockSensitive        -> conE 'BlockSensitive
     BlockInsensitive      -> conE 'BlockInsensitive
+
diff --git a/docs/Replace.html b/docs/Replace.html index b10904e..926a27c 100644 --- a/docs/Replace.html +++ b/docs/Replace.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Replace
+
  1. Home
    2. > RE/Replace
{-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
@@ -475,5 +475,6 @@
          )
       => source -> String -> target
 ($=~) = (=~)
+
diff --git a/docs/Sed.html b/docs/Sed.html index fa1fb2e..f35416d 100644 --- a/docs/Sed.html +++ b/docs/Sed.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/Tools/Sed
+
  1. Home
    2. > RE/Tools/Sed
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE FlexibleContexts           #-}
 
@@ -96,5 +96,6 @@
 write_file :: FilePath -> LBS.ByteString ->IO ()
 write_file "-" = LBS.putStr
 write_file fp  = LBS.writeFile fp
+
diff --git a/docs/TestBench.html b/docs/TestBench.html index 38e003c..ae103c4 100644 --- a/docs/TestBench.html +++ b/docs/TestBench.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > RE/TestBench
+
  1. Home
    2. > RE/TestBench
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings          #-}
@@ -72,7 +72,7 @@
   , formatMacroSources
   , formatMacroSource
   , testMacroDescriptors
-  , regexSource
+-- , regexSource
   ) where
 
 import           Data.Array
@@ -93,7 +93,7 @@ 
Types

 data RegexType
   = TDFA    -- the TDFA back end
   | PCRE    -- the PCRE back end
-  deriving (Eq,Ord,Show)
+  deriving (Bounded,Enum,Eq,Ord,Show)
 
 -- | do we need the captures in the RE or whould they be stripped out
 -- where possible
@@ -110,12 +110,12 @@ 
Types

 -- description
 data MacroDescriptor =
   MacroDescriptor
-    { _md_source          :: RegexSource      -- ^ the RE
-    , _md_samples         :: [String]         -- ^ some sample matches
-    , _md_counter_samples :: [String]         -- ^ some sample non-matches
-    , _md_test_results    :: [TestResult]     -- ^ validation test results
-    , _md_parser          :: Maybe FunctionID -- ^ WA, the parser function
-    , _md_description     :: String           -- ^ summary comment
+    { _md_source          :: !RegexSource         -- ^ the RE
+    , _md_samples         :: ![String]            -- ^ some sample matches
+    , _md_counter_samples :: ![String]            -- ^ some sample non-matches
+    , _md_test_results    :: ![TestResult]        -- ^ validation test results
+    , _md_parser          :: !(Maybe FunctionID)  -- ^ WA, the parser function
+    , _md_description     :: !String              -- ^ summary comment
     }
   deriving (Show)
 
@@ -526,5 +526,6 @@ 
test', test_neg'

     mid_s = _MacroID mid
     neg_s = if is_neg then "-ve" else "+ve" :: String
     rty_s = show rty
+
diff --git a/docs/TestKit.html b/docs/TestKit.html index 1473a7e..cf1a839 100644 --- a/docs/TestKit.html +++ b/docs/TestKit.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > TestKit
+
  1. Home
    2. > TestKit
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE OverloadedStrings          #-}
 
@@ -61,6 +61,7 @@
 import           Control.Exception
 import qualified Data.Text                                as T
 import qualified Shelly                                   as SH
+import           System.Directory
 import           System.Environment
 import           System.Exit
 import           System.IO
@@ -111,6 +112,7 @@ -> FilePath -> IO () test_pp lab loop test_file gold_file = do + createDirectoryIfMissing False "tmp" loop test_file tmp_pth ok <- cmp (T.pack tmp_pth) (T.pack gold_file) case ok of @@ -131,5 +133,6 @@ hPutStrLn stderr $ "testing results against model answers failed: " ++ show se return False
+ diff --git a/docs/re-gen-modules.html b/docs/re-gen-modules.html index 86db503..28bdea5 100644 --- a/docs/re-gen-modules.html +++ b/docs/re-gen-modules.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > re-gen-modules
+
  1. Home
    2. > re-gen-modules
{-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE OverloadedStrings          #-}
@@ -173,5 +173,6 @@
       hPutStrLn stderr $
         "testing results against model answers failed: " ++ show se
       return False
+
diff --git a/docs/re-include.html b/docs/re-include.html index ff790df..42fcf66 100644 --- a/docs/re-include.html +++ b/docs/re-include.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > re-include
+
  1. Home
    2. > re-include
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -148,5 +148,6 @@ 
Testing

 test = do
   test_pp "include" loop "data/pp-test.lhs" "data/include-result.lhs"
   putStrLn "tests passed"
+
diff --git a/docs/re-nginx-log-processor.html b/docs/re-nginx-log-processor.html index 9040ecb..9af6e68 100644 --- a/docs/re-nginx-log-processor.html +++ b/docs/re-nginx-log-processor.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > re-nginx-log-processor
+
  1. Home
    2. > re-nginx-log-processor
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -74,7 +74,6 @@
 import qualified Shelly                                   as SH
 import           System.Directory
 import           System.Environment
-import           System.Posix.Syslog
 import           System.Exit
 import           System.IO
 import           Text.RE.Options
@@ -151,9 +150,9 @@
   sed (script ctx) in_file out_file
script :: Ctx -> SedScript RE
 script ctx = Select
-    [ on [re_|@{access}|]     Acc parse_access
-    , on [re_|@{access_deg}|] AcQ parse_deg_access
-    , on [re_|@{error}|]      Err parse_error
+    [ on [re_|@{access}|]     ACC parse_access
+    , on [re_|@{access_deg}|] AQQ parse_deg_access
+    , on [re_|@{error}|]      ERR parse_error
     , on [re_|.*|]            QQQ parse_def
     ]
   where
@@ -199,7 +198,7 @@
 
 event_is_notifiable :: Event -> Bool
 event_is_notifiable Event{..} =
-  fromEnum (fromMaybe Debug _event_severity) <= fromEnum Error
+  fromEnum (fromMaybe Debug _event_severity) <= fromEnum Err
 
 flag_event :: Ctx -> Event -> IO ()
 flag_event False = const $ return ()
@@ -215,13 +214,13 @@
     { _event_line     :: LineNo
     , _event_source   :: Source
     , _event_utc      :: UTCTime
-    , _event_severity :: Maybe Priority
+    , _event_severity :: Maybe Severity
     , _event_address  :: IPV4Address
     , _event_details  :: LBS.ByteString
     }
   deriving (Show)
 
-data Source = Acc | AcQ | Err | QQQ
+data Source = ACC | AQQ | ERR | QQQ
   deriving (Show,Read)
 
 presentEvent :: Event -> LBS.ByteString
@@ -333,7 +332,7 @@
       { _md_source          = "(?:-|[^[:space:]]+)"
       , _md_samples         = map fst samples
       , _md_counter_samples = counter_samples
-      , _md_test_results    = def_test_results
+      , _md_test_results    = []
       , _md_parser          = Just "parse_user"
       , _md_description     = "a user ident (per RFC1413)"
       }
@@ -356,7 +355,7 @@
       { _md_source          = "(?:@{%natural})#(?:@{%natural}):"
       , _md_samples         = map fst samples
       , _md_counter_samples = counter_samples
-      , _md_test_results    = def_test_results
+      , _md_test_results    = []
       , _md_parser          = Just "parse_pid_tid"
       , _md_description     = "<PID>#<TID>:"
       }
@@ -381,7 +380,7 @@
       { _md_source          = access_re
       , _md_samples         = map fst samples
       , _md_counter_samples = counter_samples
-      , _md_test_results    = def_test_results
+      , _md_test_results    = []
       , _md_parser          = Just "parse_a"
       , _md_description     = "an Nginx access log file line"
       }
@@ -414,7 +413,7 @@
       { _md_source          = " -  \\[\\] \"\"   \"\" \"\" \"\""
       , _md_samples         = map fst samples
       , _md_counter_samples = counter_samples
-      , _md_test_results    = def_test_results
+      , _md_test_results    = []
       , _md_parser          = Nothing
       , _md_description     = "a degenerate Nginx access log file line"
       }
@@ -436,7 +435,7 @@
       { _md_source          = error_re
       , _md_samples         = map fst samples
       , _md_counter_samples = counter_samples
-      , _md_test_results    = def_test_results
+      , _md_test_results    = []
       , _md_parser          = Just "parse_e"
       , _md_description     = "an Nginx error log file line"
       }
@@ -447,7 +446,7 @@
             ERROR
               { _e_date     = read "2016-12-21"
               , _e_time     = read "11:53:35"
-              , _e_severity = Emergency
+              , _e_severity = Emerg
               , _e_pid_tid  = (1378,0)
               , _e_other    = " foo"
               }
@@ -455,7 +454,7 @@
             ERROR
               { _e_date     = read "2017-01-04"
               , _e_time     = read "05:40:19"
-              , _e_severity = Error
+              , _e_severity = Err
               , _e_pid_tid  = (31623,0)
               , _e_other    = " *1861296 no \"ssl_certificate\" is defined in server listening on SSL port while SSL handshaking, client: 192.168.31.38, server: 0.0.0.0:80"
               }
@@ -464,10 +463,7 @@
     counter_samples =
         [ ""
         , "foo"
-        ]
-
-def_test_results :: [TestResult]
-def_test_results = error "def_test_results"
+ ]

 --
 -- Access, access_re, deg_access, parse_deg_access, parse_access
@@ -546,7 +542,7 @@
   ERROR
     { _e_date     :: Day
     , _e_time     :: TimeOfDay
-    , _e_severity :: Priority
+    , _e_severity :: Severity
     , _e_pid_tid  :: (Int,Int)
     , _e_other    :: LBS.ByteString
     }
@@ -614,5 +610,6 @@
       hPutStrLn stderr $
         "testing results against model answers failed: " ++ show se
       return False
+ diff --git a/docs/re-pp.html b/docs/re-pp.html index 49ebac2..c1d5ec2 100644 --- a/docs/re-pp.html +++ b/docs/re-pp.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > re-pp
+
  1. Home
    2. > re-pp
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -369,6 +369,7 @@ 
pandoc

 pandoc' :: T.Text -> T.Text -> T.Text -> T.Text -> IO ()
 pandoc' title repo_path in_file out_file = do
   writeFile "tmp/bc.html" bc
+  writeFile "tmp/ft.html" ft
   fmap (const ()) $
     SH.shelly $ SH.verbosely $
       SH.run "pandoc"
@@ -376,6 +377,7 @@ 
pandoc

         , "-t", "html"
         , "-s"
         , "-B", "tmp/bc.html"
+        , "-A", "tmp/ft.html"
         , "-c", "lib/styles.css"
         , "-c", "lib/bs.css"
         , "-o", out_file
@@ -389,6 +391,11 @@ 
pandoc

       , "'>"
       , T.unpack title
       , "</a></ol>"
+      , "<div class='content'>"
+      ]
+
+    ft = concat
+      [ "</div>"
       ]
 
     repo_url = concat
@@ -403,5 +410,6 @@ 
testing

   gm <- genMode
   test_pp "pp-gen" (loop gm) "data/pp-test.lhs" "data/pp-result-gen.lhs"
   putStrLn "tests passed"
+
diff --git a/docs/re-tests.html b/docs/re-tests.html index c3cc579..ee2d782 100644 --- a/docs/re-tests.html +++ b/docs/re-tests.html @@ -47,32 +47,50 @@ -
  1. Home
    2. > re-tests
+
  1. Home
    2. > re-tests
{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 module Main (main) where
 
 import           Control.Applicative
+import           Control.Exception
 import           Data.Array
 import qualified Data.ByteString.Char8          as B
 import qualified Data.ByteString.Lazy.Char8     as LBS
-import           Data.Foldable
+import qualified Data.Foldable                  as F
+import           Data.Maybe
 import           Data.Monoid
 import qualified Data.Sequence                  as S
 import           Data.String
 import qualified Data.Text                      as T
 import qualified Data.Text.Lazy                 as LT
+import           Language.Haskell.TH.Quote
 import           Test.Tasty
 import           Test.Tasty.HUnit
+import qualified Text.Regex.PCRE                as PCRE_
+import qualified Text.Regex.TDFA                as TDFA_
 import           Text.RE
 import           Text.RE.Internal.NamedCaptures
-import qualified Text.RE.PCRE           as PCRE
-import           Text.RE.TDFA           as TDFA
+import           Text.RE.Internal.PreludeMacros
+import           Text.RE.Internal.QQ
+import qualified Text.RE.PCRE                   as PCRE
+import           Text.RE.TDFA                   as TDFA
 import           Text.RE.TestBench
 
-import           Text.RE.TDFA.String()
+import qualified Text.RE.PCRE.String            as P_ST
+import qualified Text.RE.PCRE.ByteString        as P_BS
+import qualified Text.RE.PCRE.ByteString.Lazy   as PLBS
+import qualified Text.RE.PCRE.Sequence          as P_SQ
+
+import qualified Text.RE.TDFA.String            as T_ST
+import qualified Text.RE.TDFA.ByteString        as T_BS
+import qualified Text.RE.TDFA.ByteString.Lazy   as TLBS
+import qualified Text.RE.TDFA.Sequence          as T_SQ
+import qualified Text.RE.TDFA.Text              as T_TX
+import qualified Text.RE.TDFA.Text.Lazy         as TLTX
 
 
 main :: IO ()
@@ -84,6 +102,8 @@
     , replace_tests
     , options_tests
     , namedCapturesTestTree
+    , many_tests
+    , misc_tests
     ]
 
 prelude_tests :: TestTree
@@ -248,7 +268,7 @@
       let ms = S.fromList str =~ regex_ :: Matches (S.Seq Char)
           f  = \_ (Location i j) Capture{..} -> Just $ S.fromList $
                   "(" <> show i <> ":" <> show_co j <> ":" <>
-                    toList capturedText <> ")"
+                    F.toList capturedText <> ")"
           r  = replaceAllCaptures' ALL f ms
       assertEqual "replaceAllCaptures'" r $
         S.fromList "(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"
@@ -302,6 +322,171 @@
       ]
     ]
   where
-    s = "0a\nbb\nFe\nA5" :: String
+ s = "0a\nbb\nFe\nA5" :: String + +many_tests :: TestTree +many_tests = testGroup "Many Tests" + [ testCase "PCRE a" $ test (PCRE.*=~) (PCRE.?=~) (PCRE.=~) (PCRE.=~~) matchOnce matchMany id re_pcre + , testCase "PCRE ByteString" $ test (P_BS.*=~) (P_BS.?=~) (P_BS.=~) (P_BS.=~~) matchOnce matchMany B.pack re_pcre + , testCase "PCRE ByteString.Lazy" $ test (PLBS.*=~) (PLBS.?=~) (PLBS.=~) (PLBS.=~~) matchOnce matchMany LBS.pack re_pcre + , testCase "PCRE Sequence" $ test (P_SQ.*=~) (P_SQ.?=~) (P_SQ.=~) (P_SQ.=~~) matchOnce matchMany S.fromList re_pcre + , testCase "PCRE String" $ test (P_ST.*=~) (P_ST.?=~) (P_ST.=~) (P_ST.=~~) matchOnce matchMany id re_pcre + , testCase "TDFA a" $ test (TDFA.*=~) (TDFA.?=~) (TDFA.=~) (TDFA.=~~) matchOnce matchMany id re_tdfa + , testCase "TDFA ByteString" $ test (T_BS.*=~) (T_BS.?=~) (T_BS.=~) (T_BS.=~~) matchOnce matchMany B.pack re_tdfa + , testCase "TDFA ByteString.Lazy" $ test (TLBS.*=~) (TLBS.?=~) (TLBS.=~) (TLBS.=~~) matchOnce matchMany LBS.pack re_tdfa + , testCase "TDFA Sequence" $ test (T_SQ.*=~) (T_SQ.?=~) (T_SQ.=~) (T_SQ.=~~) matchOnce matchMany S.fromList re_tdfa + , testCase "TDFA String" $ test (T_ST.*=~) (T_ST.?=~) (T_ST.=~) (T_ST.=~~) matchOnce matchMany id re_tdfa + , testCase "TDFA Text" $ test (T_TX.*=~) (T_TX.?=~) (T_TX.=~) (T_TX.=~~) matchOnce matchMany T.pack re_tdfa + , testCase "TDFA Text.Lazy" $ test (TLTX.*=~) (TLTX.?=~) (TLTX.=~) (TLTX.=~~) matchOnce matchMany LT.pack re_tdfa + ] + where + test :: (Show s,Eq s) + => (s->r->Matches s) + -> (s->r->Match s) + -> (s->r->Matches s) + -> (s->r->Maybe(Match s)) + -> (r->s->Match s) + -> (r->s->Matches s) + -> (String->s) + -> r + -> Assertion + test (%*=~) (%?=~) (%=~) (%=~~) mo mm inj r = do + 2 @=? countMatches mtchs + Just txt' @=? matchedText mtch + mtchs @=? mtchs' + mb_mtch @=? Just mtch + mtch @=? mtch'' + mtchs @=? mtchs'' + where + mtchs = txt %*=~ r + mtch = txt %?=~ r + mtchs' = txt %=~ r + mb_mtch = txt %=~~ r + mtch'' = mo r txt + mtchs'' = mm r txt + + txt = inj "2016-01-09 2015-12-5 2015-10-05" + txt' = inj "2016-01-09" + + re_pcre = fromMaybe oops $ PCRE.compileRegex () "[0-9]{4}-[0-9]{2}-[0-9]{2}" + re_tdfa = fromMaybe oops $ TDFA.compileRegex () "[0-9]{4}-[0-9]{2}-[0-9]{2}" + + oops = error "many_tests" + +misc_tests :: TestTree +misc_tests = testGroup "Miscelaneous Tests" + [ testGroup "QQ" + [ qq_tc "expression" quoteExp + , qq_tc "pattern" quotePat + , qq_tc "type" quoteType + , qq_tc "declaration" quoteDec + ] + , testGroup "PreludeMacros" + [ valid_string "preludeMacroTable" preludeMacroTable + , valid_macro "preludeMacroSummary" preludeMacroSummary + , valid_string "preludeMacroSources" preludeMacroSources + , valid_macro "preludeMacroSource" preludeMacroSource + ] + , testGroup "RE" + [ valid_res TDFA + [ TDFA.re + , TDFA.reMS + , TDFA.reMI + , TDFA.reBS + , TDFA.reBI + , TDFA.reMultilineSensitive + , TDFA.reMultilineInsensitive + , TDFA.reBlockSensitive + , TDFA.reBlockInsensitive + , TDFA.re_ + ] + , testCase "TDFA.regexType" $ TDFA @=? TDFA.regexType + , testCase "TDFA.reOptions" $ Simple @=? _options_mode (TDFA.reOptions tdfa_re) + , testCase "TDFA.makeOptions md" $ Block @=? _options_mode (makeOptions Block :: Options_ TDFA.RE TDFA_.CompOption TDFA_.ExecOption) + , testCase "TDFA.preludeTestsFailing" $ [] @=? TDFA.preludeTestsFailing + , ne_string "TDFA.preludeTable" TDFA.preludeTable + , ne_string "TDFA.preludeSources" TDFA.preludeSources + , testGroup "TDFA.preludeSummary" + [ ne_string (presentPreludeMacro pm) $ TDFA.preludeSummary pm + | pm <- tdfa_prelude_macros + ] + , testGroup "TDFA.preludeSource" + [ ne_string (presentPreludeMacro pm) $ TDFA.preludeSource pm + | pm <- tdfa_prelude_macros + ] + , valid_res PCRE + [ PCRE.re + , PCRE.reMS + , PCRE.reMI + , PCRE.reBS + , PCRE.reBI + , PCRE.reMultilineSensitive + , PCRE.reMultilineInsensitive + , PCRE.reBlockSensitive + , PCRE.reBlockInsensitive + , PCRE.re_ + ] + , testCase "PCRE.regexType" $ PCRE @=? PCRE.regexType + , testCase "PCRE.reOptions" $ Simple @=? _options_mode (PCRE.reOptions pcre_re) + , testCase "PCRE.makeOptions md" $ Block @=? _options_mode (makeOptions Block :: Options_ PCRE.RE PCRE_.CompOption PCRE_.ExecOption) + , testCase "PCRE.preludeTestsFailing" $ [] @=? PCRE.preludeTestsFailing + , ne_string "PCRE.preludeTable" PCRE.preludeTable + , ne_string "PCRE.preludeTable" PCRE.preludeSources + , testGroup "PCRE.preludeSummary" + [ ne_string (presentPreludeMacro pm) $ PCRE.preludeSummary pm + | pm <- pcre_prelude_macros + ] + , testGroup "PCRE.preludeSource" + [ ne_string (presentPreludeMacro pm) $ PCRE.preludeSource pm + | pm <- pcre_prelude_macros + ] + ] + ] + where + tdfa_re = fromMaybe oops $ TDFA.compileRegex () ".*" + pcre_re = fromMaybe oops $ PCRE.compileRegex () ".*" + + oops = error "misc_tests" + +qq_tc :: String -> (QuasiQuoter->String->a) -> TestTree +qq_tc sc prj = testCase sc $ + try tst >>= either hdl (const $ assertFailure "qq0") + where + tst :: IO () + tst = prj (qq0 "qq_tc") "" `seq` return () + + hdl :: QQFailure -> IO () + hdl qqf = do + "qq_tc" @=? _qqf_context qqf + sc @=? _qqf_component qqf + +valid_macro :: String -> (RegexType->PreludeMacro->String) -> TestTree +valid_macro label f = testGroup label + [ valid_string (presentPreludeMacro pm) (flip f pm) + | pm<-[minBound..maxBound] + ] + +valid_string :: String -> (RegexType->String) -> TestTree +valid_string label f = testGroup label + [ ne_string (show rty) $ f rty + | rty<-[TDFA] -- until PCRE has a binding for all macros + ] + +ne_string :: String -> String -> TestTree +ne_string label s = + testCase label $ assertBool "non-empty string" $ length s > 0 + +-- just evaluating quasi quoters to HNF for now -- they +-- being tested everywhere [re|...|] (etc.) calculations +-- are bings used but HPC isn't measuring this +valid_res :: RegexType -> [QuasiQuoter] -> TestTree +valid_res rty = testCase (show rty) . foldr seq (return ()) + +pcre_prelude_macros :: [PreludeMacro] +pcre_prelude_macros = filter (/= PM_string) [minBound..maxBound] + +tdfa_prelude_macros :: [PreludeMacro] +tdfa_prelude_macros = [minBound..maxBound]
+ diff --git a/docs/re-tutorial.html b/docs/re-tutorial.html index 10d57e1..366cda4 100644 --- a/docs/re-tutorial.html +++ b/docs/re-tutorial.html @@ -47,7 +47,7 @@ -
  1. Home
    2. > re-tutorial.lhs
+
  1. Home
    2. > re-tutorial.lhs

The Regex Tutorial

This is a literate Haskell programme lightly processed to produce this web presentation and also to generate a test suite that verifies that each of the example calculations are generating the expected results. You can load it into ghci and try out the examples either by running ghci itself from the root folder of the regex package:

ghci examples/re-tutorial.lhs
@@ -406,10 +406,10 @@

Compiling REs with the Complete 
data Options_ r c e =
   Options
-    { _options_mode :: Mode
-    , _options_macs :: Macros r
-    , _options_comp :: c
-    , _options_exec :: e
+    { _options_mode :: !Mode
+    , _options_macs :: !(Macros r)
+    , _options_comp :: !c
+    , _options_exec :: !e
     }
   deriving (Show)
@@ -488,9 +488,9 @@

Example: log processor: d 
script :: Ctx -> SedScript RE
 script ctx = Select
-    [ on [re_|@{access}|]     Acc parse_access
-    , on [re_|@{access_deg}|] AcQ parse_deg_access
-    , on [re_|@{error}|]      Err parse_error
+    [ on [re_|@{access}|]     ACC parse_access
+    , on [re_|@{access_deg}|] AQQ parse_deg_access
+    , on [re_|@{error}|]      ERR parse_error
     , on [re_|.*|]            QQQ parse_def
     ]
   where
@@ -728,5 +728,6 @@ 
Example: literate preprocessor

 
The preprocessor that converts this literate Haskell program into a web page and a test suite that makes plenty of use of regex is in examples/re-pp.lhs.

 
Example: gen-modules

 
The many TDFA and PCRE API modules (but not the RE modules) are all generated from Text.RE.TDFA.ByteString.Lazy with examples/re-gen-modules.lhs which is also an application of regex.

+
diff --git a/examples/re-pp.lhs b/examples/re-pp.lhs index 53058a3..599ea5a 100644 --- a/examples/re-pp.lhs +++ b/examples/re-pp.lhs @@ -443,7 +443,8 @@ pandoc' title repo_path in_file out_file = do ] ft = concat - [ "
" ] + [ "

" + ] repo_url = concat [ "https://github.com/iconnect/regex/blob/master/"