packages feed

regex 0.1.0.0 → 0.2.0.0

raw patch · 13 files changed

+33/−3909 lines, 13 filesdep −directorydep −http-conduitdep −regexdep ~base-compatPVP ok

version bump matches the API change (PVP)

Dependencies removed: directory, http-conduit, regex, shelly, smallcheck, tasty, tasty-hunit, tasty-smallcheck

Dependency ranges changed: base-compat

API changes (from Hackage documentation)

+ Text.RE: Line :: LineNo -> Matches ByteString -> Line
+ Text.RE: _ln_matches :: Line -> Matches ByteString
+ Text.RE: _ln_no :: Line -> LineNo
+ Text.RE: data Line
+ Text.RE.Tools.Grep: Line :: LineNo -> Matches ByteString -> Line
+ Text.RE.Tools.Grep: _ln_matches :: Line -> Matches ByteString
+ Text.RE.Tools.Grep: _ln_no :: Line -> LineNo
+ Text.RE.Tools.Grep: data Line

Files

README.markdown view
@@ -19,16 +19,25 @@ See the [About page](http://about.regex.uk) for details.  +## regex and regex-examples++  * the `regex` package contains the regex library+  * the `regex-examples` package contains the tutorial, tests+    and example programs++ ## Road Map  &nbsp;&nbsp;&nbsp;&nbsp;&#x2612;&nbsp;&nbsp;2017-01-26  v0.0.0.1  Pre-release (I)  &nbsp;&nbsp;&nbsp;&nbsp;&#x2612;&nbsp;&nbsp;2017-01-30  v0.0.0.2  Pre-release (II) -&nbsp;&nbsp;&nbsp;&nbsp;&#x2612;&nbsp;&nbsp;2017-02-19  v0.1.0.0  [Proposed core API with presentable Haddocks](https://github.com/iconnect/regex/milestone/1)+&nbsp;&nbsp;&nbsp;&nbsp;&#x2612;&nbsp;&nbsp;2017-02-18  v0.1.0.0  [Proposed core API with presentable Haddocks](https://github.com/iconnect/regex/milestone/1) -&nbsp;&nbsp;&nbsp;&nbsp;&#x2610;&nbsp;&nbsp;2017-02-26  v0.1.1.0  [Tutorials and examples finalized](https://github.com/iconnect/regex/milestone/2)+&nbsp;&nbsp;&nbsp;&nbsp;&#x2612;&nbsp;&nbsp;2017-02-19  v0.2.0.0  [Package split into regex and regex-examples](https://github.com/iconnect/regex/milestone/5) +&nbsp;&nbsp;&nbsp;&nbsp;&#x2610;&nbsp;&nbsp;2017-02-26  v0.3.0.0  [API adjustments, tutorials and examples finalized](https://github.com/iconnect/regex/milestone/2)+ &nbsp;&nbsp;&nbsp;&nbsp;&#x2610;&nbsp;&nbsp;2017-03-20  v1.0.0.0  [First stable release](https://github.com/iconnect/regex/milestone/3)  &nbsp;&nbsp;&nbsp;&nbsp;&#x2610;&nbsp;&nbsp;2017-08-31  v2.0.0.0  [Fast text replacement with benchmarks](https://github.com/iconnect/regex/milestone/4)@@ -40,7 +49,8 @@  ## Build Status -[![Hackage](http://regex.uk/badges/hackage.svg)](https://hackage.haskell.org/package/regex) [![BSD3 License](http://regex.uk/badges/license.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![Un*x build](http://regex.uk/badges/unix-build.svg)](https://travis-ci.org/iconnect/regex) [![Windows build](http://regex.uk/badges/windows-build.svg)](https://ci.appveyor.com/project/engineerirngirisconnectcouk/regex/branch/master) [![Coverage](http://regex.uk/badges/coverage.svg)](https://coveralls.io/github/iconnect/regex?branch=master)<br/>+[![Hackage](http://regex.uk/badges/hackage.svg)](https://hackage.haskell.org/package/regex) [![BSD3 License](http://regex.uk/badges/license.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [![Un*x build](http://regex.uk/badges/unix-build.svg)](https://travis-ci.org/iconnect/regex) [![Windows build](http://regex.uk/badges/windows-build.svg)](https://ci.appveyor.com/project/engineerirngirisconnectcouk/regex/branch/master) [![Coverage](http://regex.uk/badges/coverage.svg)](https://coveralls.io/github/iconnect/regex?branch=master)+ See [build status page](http://regex.uk/build-status) for details.  @@ -61,8 +71,10 @@  If you have any feedback or suggestion then please drop us a line. -&nbsp;&nbsp;&nbsp;&nbsp;`t` [&#64;hregex](https://twitter.com/hregex)<br/>-&nbsp;&nbsp;&nbsp;&nbsp;`e` maintainers@regex.uk<br/>+&nbsp;&nbsp;&nbsp;&nbsp;`t` [&#64;hregex](https://twitter.com/hregex)++&nbsp;&nbsp;&nbsp;&nbsp;`e` maintainers@regex.uk+ &nbsp;&nbsp;&nbsp;&nbsp;`w` http://issues.regex.uk  The [Contact page](http://contact.regex.uk) has more details.
Text/RE.hs view
@@ -116,6 +116,7 @@   , expandMacros'   -- * Tools   -- ** Grep+  , Line(..)   , grep   , grepLines   , GrepScript
Text/RE/Tools/Grep.lhs view
@@ -5,7 +5,8 @@ {-# LANGUAGE CPP                        #-}  module Text.RE.Tools.Grep-  ( grep+  ( Line(..)+  , grep   , grepLines   , GrepScript   , grepScript
changelog view
@@ -1,6 +1,10 @@ -*-change-log-*- -0.1.0.0 Chris Dornan <chris.dornan@irisconnect.co.uk> 2017-02-17+0.2.0.0 Chris Dornan <chris.dornan@irisconnect.co.uk> 2017-02-19+  * Split off the tutorial tests and examples into regex-examples,+    leaving just the library in regex++0.1.0.0 Chris Dornan <chris.dornan@irisconnect.co.uk> 2017-02-18   * Cabal file generated from a DRY template   * Library dependencies minimised, test depndencies moved into     examples/re-tests
− examples/TestKit.lhs
@@ -1,178 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE CPP                        #-}-#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif--module TestKit-  ( Vrn-  , bumpVersion-  , substVersion-  , substVersion_-  , Test-  , runTests-  , checkThis-  , test_pp-  , cmp-  ) where--import           Control.Applicative-import           Control.Exception-import qualified Control.Monad                            as M-import           Data.Maybe-import qualified Data.Text                                as T-import qualified Data.ByteString.Lazy.Char8               as LBS-import           Prelude.Compat-import qualified Shelly                                   as SH-import           System.Directory-import           System.Environment-import           System.Exit-import           System.IO-import           Text.Printf-import           Text.RE.TDFA-\end{code}---Vrn and friends------------------\begin{code}-data Vrn = Vrn { _vrn_a, _vrn_b, _vrn_c, _vrn_d :: Int }-  deriving (Show,Eq,Ord)---- | register a new version of the package-bumpVersion :: String -> IO ()-bumpVersion vrn_s = do-    vrn0 <- read_current_version-    rex' <- compileRegex () $ printf "- \\[[xX]\\].*%d\\.%d\\.%d\\.%d" _vrn_a _vrn_b _vrn_c _vrn_d-    nada <- null . linesMatched <$> grepLines rex' "lib/md/roadmap-incl.md"-    M.when nada $-      error $ vrn_s ++ ": not ticked off in the roadmap"-    rex  <- compileRegex () $ printf "%d\\.%d\\.%d\\.%d" _vrn_a _vrn_b _vrn_c _vrn_d-    nope <- null . linesMatched <$> grepLines rex "changelog"-    M.when nope $-      error $ vrn_s ++ ": not in the changelog"-    case vrn > vrn0 of-      True  -> do-        write_current_version vrn-        substVersion "lib/hackage-template.svg" "docs/badges/hackage.svg"-      False -> error $-        printf "version not later ~(%s > %s)" vrn_s $ present_vrn vrn0-  where-    vrn@Vrn{..} = parse_vrn vrn_s--substVersion :: FilePath -> FilePath -> IO ()-substVersion in_f out_f =-    LBS.readFile in_f >>= substVersion_ >>= LBS.writeFile out_f--substVersion_ :: (IsRegex RE a,Replace a) => a -> IO a-substVersion_ txt =-    flip replaceAll ms . pack_ . present_vrn <$> read_current_version-  where-    ms = txt *=~ [re|<<\$version\$>>|]--read_current_version :: IO Vrn-read_current_version = parse_vrn <$> readFile "lib/version.txt"--write_current_version :: Vrn -> IO ()-write_current_version = writeFile "lib/version.txt" . present_vrn--present_vrn :: Vrn -> String-present_vrn Vrn{..} = printf "%d.%d.%d.%d" _vrn_a _vrn_b _vrn_c _vrn_d--parse_vrn :: String -> Vrn-parse_vrn vrn_s = case matched m of-    True  -> Vrn (p [cp|a|]) (p [cp|b|]) (p [cp|c|]) (p [cp|d|])-    False -> error $ "not a valid version: " ++ vrn_s-  where-    p c  = fromMaybe oops $ parseInteger $ m !$$ c-    m    = vrn_s ?=~ [re|^${a}(@{%nat})\.${b}(@{%nat})\.${c}(@{%nat})\.${d}(@{%nat})$|]--    oops = error "parse_vrn"-\end{code}---Test and friends-------------------\begin{code}-data Test =-  Test-    { testLabel    :: String-    , testExpected :: String-    , testResult   :: String-    , testPassed   :: Bool-    }-  deriving (Show)--runTests :: [Test] -> IO ()-runTests tests = do-  as <- getArgs-  case as of-    [] -> return ()-    _  -> do-      pn <- getProgName-      putStrLn $ "usage:\n  "++pn++" --help"-      exitWith $ ExitFailure 1-  case filter (not . testPassed) tests of-    []  -> putStrLn $ "All "++show (length tests)++" tests passed."-    fts -> do-      mapM_ (putStr . present_test) fts-      putStrLn $ show (length fts) ++ " tests failed."-      exitWith $ ExitFailure 1--checkThis :: (Show a,Eq a) => String -> a -> a -> Test-checkThis lab ref val =-  Test-    { testLabel    = lab-    , testExpected = show ref-    , testResult   = show val-    , testPassed   = ref == val-    }--present_test :: Test -> String-present_test Test{..} = unlines-  [ "test: " ++ testLabel-  , "  expected : " ++ testExpected-  , "  result   : " ++ testResult-  , "  passed   : " ++ (if testPassed then "passed" else "**FAILED**")-  ]-\end{code}--\begin{code}-test_pp :: String-        -> (FilePath->FilePath->IO())-        -> FilePath-        -> 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-      True  -> return ()-      False -> do-        putStrLn $ lab ++ ": mismatch with " ++ gold_file-        exitWith $ ExitFailure 1-  where-    tmp_pth = "tmp/mod.lhs"-\end{code}--\begin{code}-cmp :: T.Text -> T.Text -> IO Bool-cmp src dst = handle hdl $ do-    _ <- SH.shelly $ SH.verbosely $-            SH.run "cmp" [src,dst]-    return True-  where-    hdl :: SomeException -> IO Bool-    hdl se = do-      hPutStrLn stderr $-        "testing results against model answers failed: " ++ show se-      return False-\end{code}
− examples/re-gen-cabals.lhs
@@ -1,191 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE CPP                        #-}--module Main (main) where--import qualified Data.ByteString.Lazy.Char8               as LBS-import           Data.Char-import           Data.IORef-import qualified Data.List                                as L-import qualified Data.Map                                 as Map-import           Data.Maybe-import           Data.Monoid-import           Prelude.Compat-import           System.Directory-import           System.Environment-import           System.Exit-import           System.IO-import           TestKit-import           Text.Printf-import           Text.RE.TDFA.ByteString.Lazy---main :: IO ()-main = do-  (pn,as) <- (,) <$> getProgName <*> getArgs-  case as of-    []        -> test-    ["test"]  -> test-    ["gen"]   -> gen  "lib/cabal-masters/regex.cabal" "regex.cabal"-    _         -> do-      hPutStrLn stderr $ "usage: " ++ pn ++ " [test|gen]"-      exitWith $ ExitFailure 1--test :: IO ()-test = do-  createDirectoryIfMissing False "tmp"-  gen "lib/cabal-masters/regex.cabal" "tmp/regex.cabal"-  ok <- cmp "tmp/regex.cabal" "regex.cabal"-  case ok of-    True  -> return ()-    False -> exitWith $ ExitFailure 1--gen :: FilePath -> FilePath -> IO ()-gen in_f out_f = do-    ctx <- setup-    substVersion in_f "tmp/regex-vrn.cabal"-    sed (gc_script ctx) "tmp/regex-vrn.cabal" out_f--data Ctx =-  Ctx-    { _ctx_package_constraints :: IORef (Map.Map LBS.ByteString LBS.ByteString)-    , _ctx_test_exe            :: IORef (Maybe TestExe)-    }--data TestExe =-  TestExe-    { _te_test :: Bool-    , _te_exe  :: Bool-    , _te_name :: LBS.ByteString-    , _te_text :: LBS.ByteString-    }-  deriving (Show)--setup :: IO Ctx-setup = Ctx <$> (newIORef Map.empty) <*> (newIORef Nothing)--gc_script :: Ctx -> SedScript RE-gc_script ctx = Select-    [ (,) [re|^%- +${pkg}(@{%id-}) +${cond}(.*)$|]             $ EDIT_gen $ cond_gen                 ctx-    , (,) [re|^%build-depends +${list}(@{%id-}( +@{%id-})+)$|] $ EDIT_gen $ build_depends_gen        ctx-    , (,) [re|^%test +${i}(@{%id-})$|]                         $ EDIT_gen $ test_exe_gen True  False ctx-    , (,) [re|^%exe +${i}(@{%id-})$|]                          $ EDIT_gen $ test_exe_gen False True  ctx-    , (,) [re|^%test-exe +${i}(@{%id-})$|]                     $ EDIT_gen $ test_exe_gen True  True  ctx-    , (,) [re|^.*$|]                                           $ EDIT_gen $ default_gen              ctx-    ]--cond_gen, build_depends_gen,-  default_gen :: Ctx-              -> LineNo-              -> Matches LBS.ByteString-              -> IO (LineEdit LBS.ByteString)--cond_gen Ctx{..} _ mtchs = do-    modifyIORef _ctx_package_constraints $ Map.insert pkg cond-    return Delete-  where-    pkg  = captureText [cp|pkg|]  mtch-    cond = captureText [cp|cond|] mtch--    mtch = allMatches mtchs !! 0--build_depends_gen ctx@Ctx{..} _ mtchs = do-    mp <- readIORef _ctx_package_constraints-    put ctx $ mk_build_depends mp lst-  where-    lst  = LBS.words $ captureText [cp|list|] mtch-    mtch = allMatches mtchs !! 0--default_gen ctx@Ctx{..} _ mtchs = do-    mb <- readIORef _ctx_test_exe-    case mb of-      Nothing -> return $ ReplaceWith ln-      Just te -> case isSpace $ LBS.head $ ln<>"\n" of-        True  -> put ctx ln-        False -> adjust_le (<>ln) <$> close_test_exe ctx te-  where-    ln   = matchSource mtch-    mtch = allMatches mtchs !! 0--test_exe_gen :: Bool-             -> Bool-             -> Ctx-             -> LineNo-             -> Matches LBS.ByteString-             -> IO (LineEdit LBS.ByteString)-test_exe_gen is_t is_e ctx _ mtchs = do-    mb <- readIORef  (_ctx_test_exe ctx)-    le <- maybe (return Delete) (close_test_exe ctx) mb-    writeIORef (_ctx_test_exe ctx) $ Just $-      TestExe-        { _te_test = is_t-        , _te_exe  = is_e-        , _te_name = i-        , _te_text = ""-        }-    return le-  where-    i    = captureText [cp|i|] mtch--    mtch = allMatches mtchs !! 0--close_test_exe :: Ctx -> TestExe -> IO (LineEdit LBS.ByteString)-close_test_exe ctx@Ctx{..} te = do-  writeIORef _ctx_test_exe Nothing-  put ctx $ mconcat $ concat $-    [ [ mk_test_exe False te "Executable" | _te_exe  te ]-    , [ mk_test_exe True  te "Test-Suite" | _te_test te ]-    ]--put :: Ctx -> LBS.ByteString -> IO (LineEdit LBS.ByteString)-put Ctx{..} lbs = do-    mb <- readIORef _ctx_test_exe-    case mb of-      Nothing -> return $ ReplaceWith lbs-      Just te -> do-        writeIORef _ctx_test_exe $ Just te { _te_text = _te_text te <> lbs <> "\n" }-        return Delete--mk_test_exe :: Bool -> TestExe -> LBS.ByteString -> LBS.ByteString-mk_test_exe is_t te te_lbs_kw = (<>_te_text te) $ LBS.unlines $ concat-    [ [ LBS.pack $ printf "%s %s" (LBS.unpack te_lbs_kw) nm ]-    , [ "    type:               exitcode-stdio-1.0" | is_t ]-    ]-  where-    nm = case is_t of-      True  -> LBS.unpack $ _te_name te <> "-test"-      False -> LBS.unpack $ _te_name te--mk_build_depends :: Map.Map LBS.ByteString LBS.ByteString-                 -> [LBS.ByteString]-                 -> LBS.ByteString-mk_build_depends mp pks = LBS.unlines $-        (:) "    Build-depends:" $-          map fmt $ zip (True : repeat False) $-              L.sortBy comp pks-  where-    fmt (isf,pk) = LBS.pack $-      printf "      %c %-20s %s"-        (if isf then ' ' else ',')-        (LBS.unpack pk)-        (maybe "" LBS.unpack $ Map.lookup pk mp)--    comp x y = case (x=="regex",y=="regex") of-      (True ,True ) -> EQ-      (True ,False) -> LT-      (False,True ) -> GT-      (False,False) -> compare x y--adjust_le :: (LBS.ByteString->LBS.ByteString)-          -> LineEdit LBS.ByteString-          -> LineEdit LBS.ByteString-adjust_le f le = case le of-  NoEdit          -> error "adjust_le: not enough context"-  ReplaceWith lbs -> ReplaceWith $ f lbs-  Delete          -> ReplaceWith $ f ""-\end{code}
− examples/re-gen-modules.lhs
@@ -1,128 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE CPP                        #-}--module Main (main) where--import           Control.Exception-import qualified Data.ByteString.Lazy.Char8               as LBS-import qualified Data.Text                                as T-import           Prelude.Compat-import qualified Shelly                                   as SH-import           System.Directory-import           System.Environment-import           System.Exit-import           System.IO-import           Text.RE.TDFA.ByteString.Lazy---main :: IO ()-main = do-  (pn,as) <- (,) <$> getProgName <*> getArgs-  case as of-    []        -> test-    ["test"]  -> test-    ["gen"]   -> gen-    _         -> do-      hPutStrLn stderr $ "usage: " ++ pn ++ " [test|gen]"-      exitWith $ ExitFailure 1--test :: IO ()-test = do-  createDirectoryIfMissing False "tmp"-  tdfa_ok <- and <$> mapM test' tdfa_edits-  pcre_ok <- and <$> mapM test' pcre_edits-  case tdfa_ok && pcre_ok of-    True  -> return ()-    False -> exitWith $ ExitFailure 1--test' :: (ModPath,SedScript RE) -> IO Bool-test' (mp,scr) = do-    putStrLn mp-    sed scr (mod_filepath source_mp) tmp_pth-    cmp     (T.pack tmp_pth) (T.pack $ mod_filepath mp)-  where-    tmp_pth = "tmp/prog.hs"--gen :: IO ()-gen = do-  mapM_ gen' tdfa_edits-  mapM_ gen' pcre_edits--gen' :: (ModPath,SedScript RE) -> IO ()-gen' (mp,scr) = do-  putStrLn mp-  sed scr (mod_filepath source_mp) (mod_filepath mp)--tdfa_edits :: [(ModPath,SedScript RE)]-tdfa_edits =-  [ tdfa_edit "Text.RE.TDFA.ByteString"       "B.ByteString"    "import qualified Data.ByteString               as B"-  , tdfa_edit "Text.RE.TDFA.Sequence"         "(S.Seq Char)"    "import qualified Data.Sequence                 as S"-  , tdfa_edit "Text.RE.TDFA.String"           "String"          ""-  , tdfa_edit "Text.RE.TDFA.Text"             "T.Text"          "import qualified Data.Text                     as T"-  , tdfa_edit "Text.RE.TDFA.Text.Lazy"        "TL.Text"         "import qualified Data.Text.Lazy                as TL"-  ]--pcre_edits :: [(ModPath,SedScript RE)]-pcre_edits =-  [ pcre_edit "Text.RE.PCRE.ByteString"       "B.ByteString"    "import qualified Data.ByteString               as B"-  , pcre_edit "Text.RE.PCRE.ByteString.Lazy"  "LBS.ByteString"  "import qualified Data.ByteString.Lazy          as LBS"-  , pcre_edit "Text.RE.PCRE.Sequence"         "(S.Seq Char)"    "import qualified Data.Sequence                 as S"-  , pcre_edit "Text.RE.PCRE.String"           "String"          ""-  ]--tdfa_edit :: ModPath-          -> LBS.ByteString-          -> LBS.ByteString-          -> (ModPath,SedScript RE)-tdfa_edit mp bs_lbs import_lbs =-    (,) mp $ Pipe-        [ (,) module_re $ EDIT_tpl $ LBS.pack mp-        , (,) import_re $ EDIT_tpl   import_lbs-        , (,) bs_re     $ EDIT_tpl   bs_lbs-        ]--pcre_edit :: ModPath-          -> LBS.ByteString-          -> LBS.ByteString-          -> (ModPath,SedScript RE)-pcre_edit mp bs_lbs import_lbs =-    (,) mp $ Pipe-        [ (,) tdfa_re   $ EDIT_tpl   "PCRE"-        , (,) module_re $ EDIT_tpl $ LBS.pack mp-        , (,) import_re $ EDIT_tpl   import_lbs-        , (,) bs_re     $ EDIT_tpl   bs_lbs-        ]--type ModPath = String--source_mp :: ModPath-source_mp = "Text.RE.TDFA.ByteString.Lazy"--tdfa_re, module_re, import_re, bs_re :: RE-tdfa_re   = [re|TDFA|]-module_re = [re|Text.RE.TDFA.ByteString.Lazy|]-import_re = [re|import qualified Data.ByteString.Lazy.Char8 *as LBS|]-bs_re     = [re|LBS.ByteString|]--mod_filepath :: ModPath -> FilePath-mod_filepath mp = map tr mp ++ ".hs"-  where-    tr '.' = '/'-    tr c   = c--cmp :: T.Text -> T.Text -> IO Bool-cmp src dst = handle hdl $ do-    _ <- SH.shelly $ SH.verbosely $-        SH.run "cmp" [src,dst]-    return True-  where-    hdl :: SomeException -> IO Bool-    hdl se = do-      hPutStrLn stderr $-        "testing results against model answers failed: " ++ show se-      return False-\end{code}
− examples/re-include.lhs
@@ -1,139 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE OverloadedStrings          #-}--module Main-  ( main-  ) where--import           Control.Applicative-import qualified Data.ByteString.Lazy.Char8               as LBS-import           Data.Maybe-import qualified Data.Text                                as T-import           Prelude.Compat-import           System.Environment-import           TestKit-import           Text.RE.Edit-import           Text.RE.TDFA.ByteString.Lazy-\end{code}--\begin{code}-main :: IO ()-main = do-  as  <- getArgs-  case as of-    []                    -> test-    ["test"]              -> test-    [fn,fn'] | is_file fn -> loop fn fn'-    _                     -> usage-  where-    is_file = not . (== "--") . take 2--    usage = do-      prg <- getProgName-      putStr $ unlines-        [ "usage:"-        , "  "++prg++" [test]"-        , "  "++prg++" (-|<in-file>) (-|<out-file>)"-        ]-\end{code}---The Sed Script-----------------\begin{code}-loop :: FilePath -> FilePath -> IO ()-loop =-  sed $ Select-    [ (,) [re|^%include ${file}(@{%string}) ${rex}(@{%string})$|] $ EDIT_fun TOP   include-    , (,) [re|^.*$|]                                              $ EDIT_fun TOP $ \_ _ _ _->return Nothing-    ]-\end{code}--\begin{code}-include :: LineNo-        -> Match LBS.ByteString-        -> Location-        -> Capture LBS.ByteString-        -> IO (Maybe LBS.ByteString)-include _ mtch _ _ = fmap Just $-    extract fp =<< compileRegex () re_s-  where-    fp    = prs_s $ captureText [cp|file|] mtch-    re_s  = prs_s $ captureText [cp|rex|]  mtch--    prs_s = maybe (error "includeDoc") T.unpack . parseString-\end{code}---Extracting a Literate Fragment from a Haskell Program Text-------------------------------------------------------------\begin{code}-extract :: FilePath -> RE -> IO LBS.ByteString-extract fp rex = extr . LBS.lines <$> LBS.readFile fp-  where-    extr lns =-      case parse $ scan rex lns of-        Nothing      -> oops-        Just (lno,n) -> LBS.unlines $ (hdr :) $ (take n $ drop i lns) ++ [ftr]-          where-            i = getZeroBasedLineNo lno--    oops = error $ concat-      [ "failed to locate fragment matching "-      , show $ reSource rex-      , " in file "-      , show fp-      ]--    hdr  = "<div class='includedcodeblock'>"-    ftr  = "</div>"-\end{code}--\begin{code}-parse :: [Token] -> Maybe (LineNo,Int)-parse []       = Nothing-parse (tk:tks) = case (tk,tks) of-  (Bra b_ln,Hit:Ket k_ln:_) -> Just (b_ln,count_lines_incl b_ln k_ln)-  _                         -> parse tks-\end{code}--\begin{code}-count_lines_incl :: LineNo -> LineNo -> Int-count_lines_incl b_ln k_ln =-  getZeroBasedLineNo k_ln + 1 - getZeroBasedLineNo b_ln-\end{code}--\begin{code}-data Token = Bra LineNo | Hit | Ket LineNo   deriving (Show)-\end{code}--\begin{code}-scan :: RE -> [LBS.ByteString] -> [Token]-scan rex = grepScript-    [ (,) [re|\\begin\{code\}|] $ \i -> chk $ Bra i-    , (,) rex                   $ \_ -> chk   Hit-    , (,) [re|\\end\{code\}|]   $ \i -> chk $ Ket i-    ]-  where-    chk x mtchs = case anyMatches mtchs of-      True  -> Just x-      False -> Nothing-\end{code}---Testing----------\begin{code}-test :: IO ()-test = do-  test_pp "include" loop "data/pp-test.lhs" "data/include-result.lhs"-  putStrLn "tests passed"-\end{code}
− examples/re-nginx-log-processor.lhs
@@ -1,589 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE OverloadedStrings          #-}--module Main-  ( main-  -- development-  , parse_a-  , parse_e-  ) where--import           Control.Applicative-import           Control.Exception-import           Control.Monad-import qualified Data.ByteString.Lazy.Char8               as LBS-import qualified Data.HashMap.Lazy                        as HML-import           Data.Functor.Identity-import           Data.Maybe-import           Data.String-import qualified Data.Text                                as T-import           Data.Time-import           Prelude.Compat-import qualified Shelly                                   as SH-import           System.Directory-import           System.Environment-import           System.Exit-import           System.IO-import           Text.RE.Options-import           Text.RE.Parsers-import           Text.RE.TestBench-import           Text.RE.PCRE.ByteString.Lazy-import qualified Text.RE.PCRE.String                      as S-import           Text.Printf-\end{code}--\begin{code}-main :: IO ()-main = do-  as  <- getArgs-  case as of-    ["--macro"      ] -> putStr      lp_macro_table-    ["--macro",mid_s] -> putStrLn  $ lp_macro_summary $ MacroID mid_s-    ["--regex"      ] -> putStr      lp_macro_sources-    ["--regex",mid_s] -> putStrLn  $ lp_macro_source  $ MacroID mid_s-    ["--test"       ] -> test-    []                -> test-    [in_file          ] | is_file in_file -> go True  in_file "-"-    [in_file,out_file ] | is_file in_file -> go True  in_file out_file-    _                                     -> usage-  where-    is_file = not . (== "--") . take 2--    usage = do-      pnm <- getProgName-      let prg = ((pnm++" ")++)-      putStr $ unlines-        [ "usage:"-        , prg " --help"-        , prg " --macro"-        , prg " --macro <macro-id>"-        , prg " --regex"-        , prg " --regex <macro-id>"-        , prg "[--test]"-        , prg "(-|<in-file>) [-|<out-fileß>]"-        ]-\end{code}--\begin{code}------- go-----test :: IO ()-test = do-  putStrLn "============================================================"-  putStrLn "Testing the macro environment."-  putStrLn "nginx-log-processor"-  dumpMacroTable        "nginx-log-processor" regexType lp_env-  me_ok <- testMacroEnv "nginx-log-processor" regexType lp_env-  putStrLn "============================================================"-  putStrLn "Testing the log processor on reference data."-  putStrLn ""-  lp_ok <- test_log_processor-  putStrLn "============================================================"-  case me_ok && lp_ok of-    True  -> return ()-    False -> exitWith $ ExitFailure 1---test_log_processor :: IO Bool-test_log_processor = do-    createDirectoryIfMissing False "tmp"-    go False "data/access-errors.log" "tmp/events.log"-    cmp "tmp/events.log" "data/events.log"-\end{code}--\begin{code}------- go-----go :: Bool -> FilePath -> FilePath -> IO ()-go rprt_flg in_file out_file = do-  ctx <- setup rprt_flg-  sed (script ctx) in_file out_file-\end{code}--\begin{code}-script :: Ctx -> SedScript RE-script ctx = Select-    [ 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-    on rex src prs =-      (,) (rex lpo) $ EDIT_fun TOP $ process_line ctx src prs--    parse_def      = fmap capturedText . matchCapture-\end{code}--\begin{code}-process_line :: IsEvent a-             => Ctx-             -> Source-             -> (Match LBS.ByteString->Maybe a)-             -> LineNo-             -> Match LBS.ByteString-             -> Location-             -> Capture LBS.ByteString-             -> IO (Maybe LBS.ByteString)-process_line ctx src prs lno cs _ _ = do-    when (event_is_notifiable event) $-      flag_event ctx event-    return $ Just $ presentEvent event-  where-    event     = maybe def_event (mkEvent lno src) $ prs cs--    def_event =-      Event-        { _event_line     = lno-        , _event_source   = src-        , _event_utc      = read "1970-01-01 00:00:00"-        , _event_severity = Nothing-        , _event_address  = (0,0,0,0)-        , _event_details  = ""-        }-------- Ctx, setup, event_is_notifiable, flag_event-----type Ctx = Bool--setup :: Bool -> IO Ctx-setup = return--event_is_notifiable :: Event -> Bool-event_is_notifiable Event{..} =-  fromEnum (fromMaybe Debug _event_severity) <= fromEnum Err--flag_event :: Ctx -> Event -> IO ()-flag_event False = const $ return ()-flag_event True  = LBS.hPutStrLn stderr . presentEvent-------- Event, presentEvent, IsEvent-----data Event =-  Event-    { _event_line     :: LineNo-    , _event_source   :: Source-    , _event_utc      :: UTCTime-    , _event_severity :: Maybe Severity-    , _event_address  :: IPV4Address-    , _event_details  :: LBS.ByteString-    }-  deriving (Show)--data Source = ACC | AQQ | ERR | QQQ-  deriving (Show,Read)--presentEvent :: Event -> LBS.ByteString-presentEvent Event{..} = LBS.pack $-  printf "%04d %s %s %-7s %3d.%3d.%3d.%3d [%s]"-    (getLineNo                _event_line    )-    (show                     _event_source  )-    (show                     _event_utc     )-    (maybe "-" svrty_kw       _event_severity)-                              a b c d-    (LBS.unpack               _event_details )-  where-    (a,b,c,d) = _event_address--    svrty_kw  = T.unpack . fst . severityKeywords--class IsEvent a where-  mkEvent :: LineNo -> Source -> a -> Event--instance IsEvent Access where-  mkEvent lno src Access{..} =-    Event-      { _event_line     = lno-      , _event_source   = src-      , _event_utc      = _a_time_local-      , _event_severity = Nothing-      , _event_address  = _a_remote_addr-      , _event_details  = LBS.pack $-          printf "%s %d %d %s %s %s"-            (T.unpack _a_request        )-                      _a_status-                      _a_body_bytes-            (T.unpack _a_http_referrer  )-            (T.unpack _a_http_user_agent)-            (T.unpack _a_other          )-      }--instance IsEvent Error where-  mkEvent lno src ERROR{..} =-    Event-      { _event_line     = lno-      , _event_source   = src-      , _event_utc      = UTCTime _e_date $ timeOfDayToTime _e_time-      , _event_severity = Just _e_severity-      , _event_address  = (0,0,0,0)-      , _event_details  = LBS.pack $ printf "%d#%d: %s" pid tid $ LBS.unpack _e_other-      }-    where-      (pid,tid) = _e_pid_tid--instance IsEvent LBS.ByteString where-  mkEvent lno src lbs =-    Event-      { _event_line     = lno-      , _event_source   = src-      , _event_utc      = read "1970-01-01 00:00:00"-      , _event_severity = Nothing-      , _event_address  = (0,0,0,0)-      , _event_details  = lbs-      }-------- Options and Prelude-----lpo :: Options-lpo = makeOptions lp_prelude--lp_prelude :: Macros RE-lp_prelude = runIdentity $ mkMacros mk regexType ExclCaptures lp_env-  where-    mk   = maybe oops Identity . compileRegex noPreludeOptions--    oops = error "lp_prelude"--lp_macro_table :: String-lp_macro_table = formatMacroTable regexType lp_env--lp_macro_summary :: MacroID -> String-lp_macro_summary = formatMacroSummary regexType lp_env--lp_macro_sources :: String-lp_macro_sources = formatMacroSources regexType ExclCaptures lp_env--lp_macro_source :: MacroID -> String-lp_macro_source = formatMacroSource regexType ExclCaptures lp_env--lp_env :: MacroEnv-lp_env = preludeEnv `HML.union` HML.fromList-    [ f "user"        user_macro-    , f "pid#tid:"    pid_tid_macro-    , f "access"      access_macro-    , f "access_deg"  access_deg_macro-    , f "error"       error_macro-    ]-  where-    f mid mk = (mid, mk lp_env mid)-------- The Macro Descriptors-----user_macro :: MacroEnv -> MacroID -> MacroDescriptor-user_macro env mid =-  runTests regexType parse_user samples env mid-    MacroDescriptor-      { _md_source          = "(?:-|[^[:space:]]+)"-      , _md_samples         = map fst samples-      , _md_counter_samples = counter_samples-      , _md_test_results    = []-      , _md_parser          = Just "parse_user"-      , _md_description     = "a user ident (per RFC1413)"-      }-  where-    samples :: [(String,User)]-    samples =-        [ f "joe"-        ]-      where-        f nm = (nm,User $ LBS.pack nm)--    counter_samples =-        [ "joe user"-        ]--pid_tid_macro :: MacroEnv -> MacroID -> MacroDescriptor-pid_tid_macro env mid =-  runTests regexType parse_pid_tid samples env mid-    MacroDescriptor-      { _md_source          = "(?:@{%nat})#(?:@{%nat}):"-      , _md_samples         = map fst samples-      , _md_counter_samples = counter_samples-      , _md_test_results    = []-      , _md_parser          = Just "parse_pid_tid"-      , _md_description     = "<PID>#<TID>:"-      }-  where-    samples :: [(String,(Int,Int))]-    samples =-        [ f "1378#0:" (1378,0)-        ]-      where-        f = (,)--    counter_samples =-        [ ""-        , "24#:"-        , "24.365:"-        ]--access_macro :: MacroEnv -> MacroID -> MacroDescriptor-access_macro env mid =-  runTests' regexType (parse_access . fmap LBS.pack) samples env mid-    MacroDescriptor-      { _md_source          = access_re-      , _md_samples         = map fst samples-      , _md_counter_samples = counter_samples-      , _md_test_results    = []-      , _md_parser          = Just "parse_a"-      , _md_description     = "an Nginx access log file line"-      }-  where-    samples :: [(String,Access)]-    samples =-        [ (,) "192.168.100.200 - - [12/Jan/2016:12:08:36 +0000] \"GET / HTTP/1.1\" 200 3700 \"-\" \"My Agent\" \"-\""-            Access-              { _a_remote_addr      = (192,168,100,200)-              , _a_remote_user      = "-"-              , _a_time_local       = read "2016-01-12 12:08:36 UTC"-              , _a_request          = "GET / HTTP/1.1"-              , _a_status           = 200-              , _a_body_bytes       = 3700-              , _a_http_referrer    = "-"-              , _a_http_user_agent  = "My Agent"-              , _a_other            = "-"-              }-        ]--    counter_samples =-        [ ""-        , " -  [] \"\"   \"\" \"\" \"\""-        ]--access_deg_macro :: MacroEnv -> MacroID -> MacroDescriptor-access_deg_macro env mid =-  runTests' regexType (parse_deg_access . fmap LBS.pack) samples env mid-    MacroDescriptor-      { _md_source          = " -  \\[\\] \"\"   \"\" \"\" \"\""-      , _md_samples         = map fst samples-      , _md_counter_samples = counter_samples-      , _md_test_results    = []-      , _md_parser          = Nothing-      , _md_description     = "a degenerate Nginx access log file line"-      }-  where-    samples :: [(String,Access)]-    samples =-        [ (,) " -  [] \"\"   \"\" \"\" \"\"" deg_access-        ]--    counter_samples =-        [ ""-        , "foo"-        ]--error_macro :: MacroEnv -> MacroID -> MacroDescriptor-error_macro env mid =-  runTests' regexType (parse_error . fmap LBS.pack) samples env mid-    MacroDescriptor-      { _md_source          = error_re-      , _md_samples         = map fst samples-      , _md_counter_samples = counter_samples-      , _md_test_results    = []-      , _md_parser          = Just "parse_e"-      , _md_description     = "an Nginx error log file line"-      }-  where-    samples :: [(String,Error)]-    samples =-        [ (,) "2016/12/21 11:53:35 [emerg] 1378#0: foo"-            ERROR-              { _e_date     = read "2016-12-21"-              , _e_time     = read "11:53:35"-              , _e_severity = Emerg-              , _e_pid_tid  = (1378,0)-              , _e_other    = " foo"-              }-        , (,) "2017/01/04 05:40:19 [error] 31623#0: *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"-            ERROR-              { _e_date     = read "2017-01-04"-              , _e_time     = read "05:40:19"-              , _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"-              }-        ]--    counter_samples =-        [ ""-        , "foo"-        ]-\end{code}--\begin{code}------- Access, access_re, deg_access, parse_deg_access, parse_access-----data Access =-  Access-    { _a_remote_addr      :: !IPV4Address-    , _a_remote_user      :: !User-    , _a_time_local       :: !UTCTime-    , _a_request          :: !T.Text-    , _a_status           :: !Int-    , _a_body_bytes       :: !Int-    , _a_http_referrer    :: !T.Text-    , _a_http_user_agent  :: !T.Text-    , _a_other            :: !T.Text-    }-  deriving (Eq,Show)-\end{code}--\begin{code}-access_re :: RegexSource-access_re = RegexSource $ unwords-  [ "(@{%address.ipv4})"-  , "-"-  , "(@{user})"-  , "\\[(@{%datetime.clf})\\]"-  , "(@{%string.simple})"-  , "(@{%nat})"-  , "(@{%nat})"-  , "(@{%string.simple})"-  , "(@{%string.simple})"-  , "(@{%string.simple})"-  ]-\end{code}--\begin{code}-deg_access :: Access-deg_access =-  Access-    { _a_remote_addr      = (0,0,0,0)-    , _a_remote_user      = "-"-    , _a_time_local       = read "1970-01-01 00:00:00"-    , _a_request          = ""-    , _a_status           = 0-    , _a_body_bytes       = 0-    , _a_http_referrer    = ""-    , _a_http_user_agent  = ""-    , _a_other            = ""-    }--parse_deg_access :: Match LBS.ByteString -> Maybe Access-parse_deg_access Match{..} =-  case matchSource == " -  [] \"\"   \"\" \"\" \"\"" of-    True  -> Just deg_access-    False -> Nothing--parse_a :: LBS.ByteString -> Maybe Access-parse_a lbs = parse_access $ lbs ?=~ [re_|@{access}|] lpo--parse_access :: Match LBS.ByteString -> Maybe Access-parse_access cs =-  Access-    <$> f parseIPv4Address  [cp|1|]-    <*> f parse_user        [cp|2|]-    <*> f parseDateTimeCLF  [cp|3|]-    <*> f parseSimpleString [cp|4|]-    <*> f parseInteger      [cp|5|]-    <*> f parseInteger      [cp|6|]-    <*> f parseSimpleString [cp|7|]-    <*> f parseSimpleString [cp|8|]-    <*> f parseSimpleString [cp|9|]-  where-    f psr i = psr $ capturedText $ capture i cs-------- Error, error_re, parse_error-----data Error =-  ERROR-    { _e_date     :: Day-    , _e_time     :: TimeOfDay-    , _e_severity :: Severity-    , _e_pid_tid  :: (Int,Int)-    , _e_other    :: LBS.ByteString-    }-  deriving (Eq,Show)--error_re :: RegexSource-error_re = RegexSource $ unwords-  [ "(@{%date.slashes})"-  , "(@{%time})"-  , "\\[(@{%syslog.severity})\\]"-  , "(@{pid#tid:})(.*)"-  ]--parse_e :: LBS.ByteString -> Maybe Error-parse_e lbs = parse_error $ lbs ?=~ [re_|@{error}|] lpo--parse_error :: Match LBS.ByteString -> Maybe Error-parse_error cs =-  ERROR-    <$> f parseSlashesDate    [cp|1|]-    <*> f parseTimeOfDay      [cp|2|]-    <*> f parseSeverity [cp|3|]-    <*> f parse_pid_tid       [cp|4|]-    <*> f Just                [cp|5|]-  where-    f psr i = psr $ capturedText $ capture i cs-------- User, parseUser-----newtype User =-    User { _User :: LBS.ByteString }-  deriving (IsString,Ord,Eq,Show)--parse_user :: Replace a => a -> Maybe User-parse_user = Just . User . LBS.pack . unpack_-------- parse_pid_tid-----parse_pid_tid :: Replace a => a -> Maybe (Int,Int)-parse_pid_tid x = case allMatches $ unpack_ x S.*=~ [re|@{%nat}|] of-    [cs,cs'] -> (,) <$> p cs <*> p cs'-    _        -> Nothing-  where-    p cs = matchCapture cs >>= parseInteger . capturedText-------- cmp-----cmp :: T.Text -> T.Text -> IO Bool-cmp src dst = handle hdl $ do-    _ <- SH.shelly $ SH.verbosely $-        SH.run "cmp" [src,dst]-    return True-  where-    hdl :: SomeException -> IO Bool-    hdl se = do-      hPutStrLn stderr $-        "testing results against model answers failed: " ++ show se-      return False-\end{code}
− examples/re-prep.lhs
@@ -1,828 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE OverloadedStrings          #-}--module Main-  ( main-  ) where--import           Control.Applicative-import qualified Control.Monad                            as M-import qualified Data.ByteString.Lazy.Char8               as LBS-import           Data.IORef-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text                                as T-import qualified Data.Text.Encoding                       as TE-import           Network.HTTP.Conduit-import           Prelude.Compat-import qualified Shelly                                   as SH-import           System.Directory-import           System.Environment-import           TestKit-import           Text.Heredoc-import           Text.Printf-import           Text.RE.Edit-import           Text.RE.TDFA.ByteString.Lazy-import qualified Text.RE.TDFA.Text                        as TT-\end{code}--\begin{code}-main :: IO ()-main = do-  as  <- getArgs-  case as of-    []                          -> test-    ["test"]                    -> test-    ["doc",fn,fn'] | is_file fn -> doc fn fn'-    ["gen",fn,fn'] | is_file fn -> gen fn fn'-    ["badges"]                  -> badges-    ["bump-version",vrn]        -> bumpVersion vrn-    ["pages"]                   -> pages-    ["all"]                     -> gen_all-    _                           -> usage-  where-    is_file = not . (== "--") . take 2--    doc fn fn' = docMode >>= \dm -> loop dm fn fn'-    gen fn fn' = genMode >>= \gm -> loop gm fn fn'--    usage = do-      pnm <- getProgName-      let prg = (("  "++pnm++" ")++)-      putStr $ unlines-        [ "usage:"-        , prg "--help"-        , prg "[test]"-        , prg "badges"-        , prg "bump-version <version>"-        , prg "pages"-        , prg "all"-        , prg "doc (-|<in-file>) (-|<out-file>)"-        , prg "gen (-|<in-file>) (-|<out-file>)"-        ]-\end{code}---The Sed Script-----------------\begin{code}--- | the MODE determines whether we are generating documentation--- or a Haskell testsuite and includes any IO-accessible state--- needed by the relevant processor-data MODE-  = Doc DocState  -- ^ document-generation state-  | Gen GenState  -- ^ adjusting-the-program-for-testing state-\end{code}--The `DocState` is initialised to `Outside` and flips though the different-states as it traverses a code block, so that we can wrap code-blocks in special <div class="replcodeblock"> blocks when their-first line indicates that it contains a REPL calculation, which the-style sheet can pick up and present accordingly.--\begin{code}-data DocMode-  = Outside     -- not inside a begin{code} ... \end{code} block-  | Beginning   -- at the start of a begin{code} ... \end{code} block-  | InsideRepl  -- inside a REPL code block-  | InsideProg  -- inside a non-REPL code block-  deriving (Eq,Show)--type DocState = IORef DocMode--genMode :: IO MODE-genMode = Gen <$> newIORef []-\end{code}--\begin{code}--- | the state is the accumulated test function identifiers for--- generating the list of them gets added to the end of the programme-type GenState = IORef [String]--docMode :: IO MODE-docMode = Doc <$> newIORef Outside-\end{code}---\begin{code}-loop :: MODE -> FilePath -> FilePath -> IO ()-loop mode =-  sed $ Select-    [ (,) [re|^%include ${file}(@{%string}) ${rex}(@{%string})$|]      $ EDIT_fun TOP $ inclde mode-    , (,) [re|^%main ${arg}(top|bottom)$|]                             $ EDIT_gen     $ main_  mode-    , (,) [re|^\\begin\{code\}$|]                                      $ EDIT_gen     $ begin  mode-    , (,) [re|^${fn}(evalme@{%id}) = checkThis ${arg}(@{%string}).*$|] $ EDIT_fun TOP $ evalme mode-    , (,) [re|^\\end\{code\}$|]                                        $ EDIT_fun TOP $ end    mode-    , (,) [re|^.*$|]                                                   $ EDIT_fun TOP $ other  mode-    ]-\end{code}--\begin{code}-inclde, evalme, end,-  other :: MODE-        -> LineNo-        -> Match LBS.ByteString-        -> Location-        -> Capture LBS.ByteString-        -> IO (Maybe LBS.ByteString)--main_,-  begin :: MODE-        -> LineNo-        -> Matches LBS.ByteString-        -> IO (LineEdit LBS.ByteString)--inclde (Doc _ ) = includeDoc-inclde (Gen _ ) = passthru--main_  (Doc _ ) = mainDoc-main_  (Gen gs) = mainGen    gs--begin  (Doc ds) = beginDoc   ds-begin  (Gen _ ) = passthru_g--evalme (Doc ds) = evalmeDoc  ds-evalme (Gen gs) = evalmeGen  gs--end    (Doc ds) = endDoc     ds-end    (Gen _ ) = passthru--other  (Doc ds) = otherDoc   ds-other  (Gen _ ) = passthru--passthru :: LineNo-         -> Match LBS.ByteString-         -> Location-         -> Capture LBS.ByteString-         -> IO (Maybe LBS.ByteString)-passthru _ _ _ _ = return Nothing--passthru_g :: LineNo-           -> Matches LBS.ByteString-           -> IO (LineEdit LBS.ByteString)-passthru_g _ _ = return NoEdit-\end{code}---Script to Generate the Whole Web Site----------------------------------------\begin{code}-gen_all :: IO ()-gen_all = do-    -- prepare HTML docs for the (literate) tools-    pd "re-gen-cabals"-    pd "re-gen-modules"-    pd "re-include"-    pd "re-nginx-log-processor"-    pd "re-prep"-    pd "re-tests"-    pd "TestKit"-    pd "RE/Capture"-    pd "RE/Edit"-    pd "RE/IsRegex"-    pd "RE/Options"-    pd "RE/Replace"-    pd "RE/TestBench"-    pd "RE/Tools/Grep"-    pd "RE/Tools/Lex"-    pd "RE/Tools/Sed"-    pd "RE/Internal/NamedCaptures"-    -- render the tutorial in HTML-    dm <- docMode-    loop dm "examples/re-tutorial-master.lhs" "tmp/re-tutorial.lhs"-    createDirectoryIfMissing False "tmp"-    pandoc_lhs'-      "re-tutorial.lhs"-      "examples/re-tutorial.lhs"-      "tmp/re-tutorial.lhs"-      "docs/re-tutorial.html"-    -- generate the tutorial-based tests-    gm <- genMode-    loop gm "examples/re-tutorial-master.lhs" "examples/re-tutorial.lhs"-    putStrLn ">> examples/re-tutorial.lhs"-    pages-  where-    pd fnm = case (mtch !$$? [cp|fdr|],mtch !$$? [cp|mnm|]) of-        (Nothing ,Just mnm) -> pandoc_lhs ("Text.RE."          <>mnm) ("Text/"    <>fnm<>".lhs") ("docs/"<>mnm<>".html")-        (Just fdr,Just mnm) -> pandoc_lhs ("Text.RE."<>fdr<>"."<>mnm) ("Text/"    <>fnm<>".lhs") ("docs/"<>mnm<>".html")-        _                   -> pandoc_lhs ("examples/"<>fnm<>".lhs" ) ("examples/"<>fnm<>".lhs") ("docs/"<>fnm<>".html")-      where-        mtch = fnm TT.?=~ [re|^RE/(${fdr}(Tools|Internal)/)?${mnm}(@{%id})|]-\end{code}---Generating the Tutorial--------------------------\begin{code}-includeDoc :: LineNo-           -> Match LBS.ByteString-           -> Location-           -> Capture LBS.ByteString-           -> IO (Maybe LBS.ByteString)-includeDoc _ mtch _ _ = fmap Just $-    extract fp =<< compileRegex () re_s-  where-    fp    = prs_s $ captureText [cp|file|] mtch-    re_s  = prs_s $ captureText [cp|rex|]  mtch--    prs_s = maybe (error "includeDoc") T.unpack . parseString-\end{code}--\begin{code}-mainDoc :: LineNo-        -> Matches LBS.ByteString-        -> IO (LineEdit LBS.ByteString)-mainDoc _ _ = return Delete-\end{code}--\begin{code}-beginDoc :: DocState-         -> LineNo-         -> Matches LBS.ByteString-         -> IO (LineEdit LBS.ByteString)-beginDoc ds _ _ = writeIORef ds Beginning >> return Delete-\end{code}--\begin{code}-evalmeDoc, endDoc, otherDoc :: DocState-                            -> LineNo-                            -> Match LBS.ByteString-                            -> Location-                            -> Capture LBS.ByteString-                            -> IO (Maybe LBS.ByteString)--evalmeDoc ds lno _ _ _ = do-  dm <- readIORef ds-  M.when (dm/=Beginning) $-    bad_state "evalme" lno dm-  writeIORef ds InsideRepl-  return $ Just $ "<div class=\"replcodeblock\">\n"<>begin_code--endDoc    ds lno _ _ _ = do-  dm <- readIORef ds-  case dm of-    Outside    -> bad_state "end" lno dm-    Beginning  -> return $ Just $ begin_code <> "\n" <> end_code-    InsideRepl -> return $ Just $ end_code   <> "\n</div>"-    InsideProg -> return   Nothing--otherDoc  ds _ mtch _ _ = do-  dm <- readIORef ds-  case dm of-    Beginning -> do-      writeIORef ds InsideProg-      return $ Just $ begin_code <> "\n" <> matchSource mtch-    _ -> return Nothing--bad_state :: String -> LineNo -> DocMode -> IO a-bad_state lab lno dm = error $-  printf "Bad document syntax: %s: %d: %s" lab (getLineNo lno) $ show dm-\end{code}---Generating the Tests-----------------------\begin{code}-evalmeGen :: GenState-          -> LineNo-          -> Match LBS.ByteString-          -> Location-          -> Capture LBS.ByteString-          -> IO (Maybe LBS.ByteString)-evalmeGen gs _ mtch0 _ _ = Just <$>-    replaceCapturesM replace_ ALL f mtch0-  where-    f mtch loc cap = case _loc_capture loc of-      2 -> do-          modifyIORef gs (ide:)-          return $ Just $ LBS.pack $ show ide-        where-          ide = LBS.unpack $ captureText [cp|fn|] mtch-      _ -> return $ Just $ capturedText cap-\end{code}--How are we doing?--\begin{code}-mainGen :: GenState-        -> LineNo-        -> Matches LBS.ByteString-        -> IO (LineEdit LBS.ByteString)-mainGen gs _ mtchs = case allMatches mtchs of-  [mtch]  ->-    case captureText [cp|arg|] $ mtch of-      "top"    -> return $ ReplaceWith $ LBS.unlines $-          [ begin_code-          , "module Main(main) where"-          , end_code-          , ""-          , "*********************************************************"-          , "*"-          , "* WARNING: this is generated from pp-tutorial-master.lhs "-          , "*"-          , "*********************************************************"-          ]-      "bottom" -> do-        fns <- readIORef gs-        return $ ReplaceWith $ LBS.unlines $-          [ begin_code-          , "main :: IO ()"-          , "main = runTests"-          ] ++ mk_list fns ++-          [ end_code-          ]-      _ -> error "mainGen (b)"-  _ -> error "mainGen (a)"-\end{code}--We cannot place these strings inline without confusing pandoc so we-use these definitions instead.--\begin{code}-begin_code, end_code :: LBS.ByteString-begin_code = "\\"<>"begin{code}"-end_code   = "\\"<>"end{code}"-\end{code}----\begin{code}-mk_list :: [String] -> [LBS.ByteString]-mk_list []          = ["[]"]-mk_list (ide0:ides) = f "[" ide0 $ foldr (f ",") ["  ]"] ides-  where-    f pfx ide t = ("  "<>pfx<>" "<>LBS.pack ide) : t-\end{code}---Extracting a Literate Fragment from a Haskell Program Text-------------------------------------------------------------\begin{code}-extract :: FilePath -> RE -> IO LBS.ByteString-extract fp rex = extr . LBS.lines <$> LBS.readFile fp-  where-    extr lns =-      case parse $ scan rex lns of-        Nothing      -> oops-        Just (lno,n) -> LBS.unlines $ (hdr :) $ (take n $ drop i lns) ++ [ftr]-          where-            i = getZeroBasedLineNo lno--    oops = error $ concat-      [ "failed to locate fragment matching "-      , show $ reSource rex-      , " in file "-      , show fp-      ]--    hdr  = "<div class='includedcodeblock'>"-    ftr  = "</div>"-\end{code}--\begin{code}-parse :: [Token] -> Maybe (LineNo,Int)-parse []       = Nothing-parse (tk:tks) = case (tk,tks) of-  (Bra b_ln,Hit:Ket k_ln:_) -> Just (b_ln,count_lines_incl b_ln k_ln)-  _                         -> parse tks-\end{code}--\begin{code}-count_lines_incl :: LineNo -> LineNo -> Int-count_lines_incl b_ln k_ln =-  getZeroBasedLineNo k_ln + 1 - getZeroBasedLineNo b_ln-\end{code}--\begin{code}-data Token = Bra LineNo | Hit | Ket LineNo   deriving (Show)-\end{code}--\begin{code}-scan :: RE -> [LBS.ByteString] -> [Token]-scan rex = grepScript-    [ (,) [re|\\begin\{code\}|] $ \i -> chk $ Bra i-    , (,) rex                   $ \_ -> chk   Hit-    , (,) [re|\\end\{code\}|]   $ \i -> chk $ Ket i-    ]-  where-    chk x mtchs = case anyMatches mtchs of-      True  -> Just x-      False -> Nothing-\end{code}---badges---------\begin{code}-badges :: IO ()-badges = do-    mapM_ collect-      [ (,) "license"             "https://img.shields.io/badge/license-BSD3-brightgreen.svg"-      , (,) "unix-build"          "https://img.shields.io/travis/iconnect/regex.svg?label=Linux%2BmacOS"-      , (,) "windows-build"       "https://img.shields.io/appveyor/ci/engineerirngirisconnectcouk/regex.svg?label=Windows"-      , (,) "coverage"            "https://img.shields.io/coveralls/iconnect/regex.svg"-      , (,) "build-status"        "https://img.shields.io/travis/iconnect/regex.svg?label=Build%20Status"-      , (,) "maintainers-contact" "https://img.shields.io/badge/email-maintainers%40regex.uk-blue.svg"-      , (,) "feedback-contact"    "https://img.shields.io/badge/email-feedback%40regex.uk-blue.svg"-      ]-  where-    collect (nm,url) = do-      putStrLn $ "updating badge: " ++ nm-      simpleHttp url >>= LBS.writeFile (badge_fn nm)--    badge_fn nm = "docs/badges/"++nm++".svg"-\end{code}---pages--------\begin{code}-pages :: IO ()-pages = do-  prep_page   MM_hackage "lib/md/index.md" "README.markdown"-  prep_page   MM_github  "lib/md/index.md" "README.md"-  mapM_ pandoc_page [minBound..maxBound]-\end{code}--\begin{code}-data Page-  = PG_index-  | PG_about-  | PG_contact-  | PG_build_status-  | PG_installation-  | PG_tutorial-  | PG_examples-  | PG_roadmap-  | PG_macros-  | PG_directory-  | PG_changelog-  deriving (Bounded,Enum,Eq,Ord,Show)--page_root :: Page -> String-page_root = map tr . drop 3 . show-  where-    tr '_' = '-'-    tr c   = c--page_master_file, page_docs_file :: Page -> FilePath-page_master_file pg = "lib/md/" ++ page_root pg ++ ".md"-page_docs_file   pg = "docs/"   ++ page_root pg ++ ".html"--page_address :: Page -> LBS.ByteString-page_address = LBS.pack . page_root--page_title :: Page -> LBS.ByteString-page_title pg = case pg of-  PG_index        -> "Home"-  PG_about        -> "About"-  PG_contact      -> "Contact"-  PG_build_status -> "Build Status"-  PG_installation -> "Installation"-  PG_tutorial     -> "Tutorial"-  PG_examples     -> "Examples"-  PG_roadmap      -> "Roadmap"-  PG_macros       -> "Macro Tables"-  PG_directory    -> "Directory"-  PG_changelog    -> "Change Log"-\end{code}--\begin{code}-pandoc_page :: Page -> IO ()-pandoc_page pg = do-  mt_lbs <- LBS.readFile $ page_master_file pg-  (hdgs,md_lbs) <- prep_page' MM_pandoc mt_lbs-  LBS.writeFile "tmp/metadata.markdown"  $ LBS.unlines ["---","title: "<>page_title pg,"---"]-  LBS.writeFile "tmp/heading.markdown"   $ page_heading pg-  LBS.writeFile "tmp/page_pre_body.html" $ mk_pre_body_html pg hdgs-  LBS.writeFile "tmp/page_pst_body.html"   pst_body_html-  LBS.writeFile "tmp/page.markdown"        md_lbs-  fmap (const ()) $-    SH.shelly $ SH.verbosely $-      SH.run "pandoc"-        [ "-f", "markdown+grid_tables+autolink_bare_uris"-        , "-t", "html5"-        , "-T", "regex"-        , "-s"-        , "-H", "lib/favicons.html"-        , "-B", "tmp/page_pre_body.html"-        , "-A", "tmp/page_pst_body.html"-        , "-c", "lib/styles.css"-        , "-o", T.pack $ page_docs_file pg-        , "tmp/metadata.markdown"-        , "tmp/heading.markdown"-        , "tmp/page.markdown"-        ]--data Heading =-  Heading-    { _hdg_id    :: LBS.ByteString-    , _hdg_title :: LBS.ByteString-    }-  deriving (Show)--data MarkdownMode-  = MM_github-  | MM_hackage-  | MM_pandoc-  deriving (Eq,Show)--page_heading :: Page -> LBS.ByteString-page_heading PG_index = ""-page_heading pg       =-  "<p class='pagebc'><a href='.' title='Home'>Home</a> &raquo; **"<>page_title pg<>"**</p>\n"--prep_page :: MarkdownMode -> FilePath -> FilePath -> IO ()-prep_page mmd in_fp out_fp = do-  lbs      <- LBS.readFile in_fp-  (_,lbs') <- prep_page' mmd lbs-  LBS.writeFile out_fp lbs'--prep_page' :: MarkdownMode -> LBS.ByteString -> IO ([Heading],LBS.ByteString)-prep_page' mmd lbs = do-    rf_h <- newIORef []-    rf_t <- newIORef False-    lbs1 <- sed' (scr rf_h rf_t) =<< include lbs-    lbs2 <- fromMaybe "" <$> fin_task_list' mmd rf_t-    hdgs <- reverse <$> readIORef rf_h-    return (hdgs,lbs1<>lbs2)-  where-    scr rf_h rf_t = Select-      [ (,) [re|^%heading#${ide}(@{%id}) +${ttl}([^ ].*)$|] $ EDIT_fun TOP $ heading       mmd rf_t rf_h-      , (,) [re|^- \[ \] +${itm}(.*)$|]                     $ EDIT_fun TOP $ task_list     mmd rf_t False-      , (,) [re|^- \[[Xx]\] +${itm}(.*)$|]                  $ EDIT_fun TOP $ task_list     mmd rf_t True-      , (,) [re|^.*$|]                                      $ EDIT_fun TOP $ fin_task_list mmd rf_t-      ]--heading :: MarkdownMode-        -> IORef Bool-        -> IORef [Heading]-        -> LineNo-        -> Match LBS.ByteString-        -> Location-        -> Capture LBS.ByteString-        -> IO (Maybe LBS.ByteString)-heading mmd rf_t rf_h _ mtch _ _ = do-    lbs <- fromMaybe "" <$> fin_task_list' mmd rf_t-    modifyIORef rf_h (Heading ide ttl:)-    return $ Just $ lbs<>h2-  where-    h2 = case mmd of-      MM_github  -> "## "<>ttl-      MM_hackage -> "## "<>ttl-      MM_pandoc  -> "<h2 id='"<>ide<>"'>"<>ttl<>"</h2>"--    ide = mtch !$$ [cp|ide|]-    ttl = mtch !$$ [cp|ttl|]--mk_pre_body_html :: Page -> [Heading] -> LBS.ByteString-mk_pre_body_html pg hdgs = hdr <> LBS.concat (map nav [minBound..maxBound]) <> ftr-  where-    hdr :: LBS.ByteString-    hdr = [here|    <div id="container">-    <div id="sidebar">-      <div id="corner">-        |] <> branding <> [here|-      </div>-      <div class="widget" id="pages">-        <ul class="page-nav">-|]--    nav dst_pg = LBS.unlines $-      nav_li "          " pg_cls pg_adr pg_ttl :-        [ nav_li "            " ["secnav"] ("#"<>_hdg_id) _hdg_title-          | Heading{..} <- hdgs-          , is_moi-          ]-      where-        pg_cls = ["pagenav",if is_moi then "moi" else "toi"]-        pg_adr = page_address dst_pg-        pg_ttl = page_title   dst_pg-        is_moi = pg == dst_pg--    nav_li pfx cls dst title = LBS.concat-      [ pfx-      , "<li class='"-      , LBS.unwords cls-      , "'><a href='"-      , dst-      , "'>"-      , title-      , "</a></li>"-      ]--    ftr = [here|          </ul>-      </div>-      <div class="supplementary widget" id="github">-        <a href="https://github.com/iconnect/regex"><img src="images/code.svg" alt="github code" /> Code</a>-      </div>-      <div class="supplementary widget" id="github-issues">-        <a href="https://github.com/iconnect/regex/issues"><img src="images/issue-opened.svg" alt="github code" /> Issues</a>-      </div>-      <div class="widget-divider">&nbsp;</div>-      <div class="supplementary widget" id="build-status">-        <a href="https://hackage.haskell.org/package/regex">-          <img src="badges/hackage.svg" alt="hackage version" />-        </a>-      </div>-      <div class="supplementary widget" id="build-status">-        <a href="build-status">-          <img src="badges/build-status.svg" alt="build status" />-        </a>-      </div>-      <div class="supplementary widget" id="maintainers-contact">-        <a href="mailto:maintainers@regex.uk">-          <img src="badges/maintainers-contact.svg" alt="build status" />-        </a>-      </div>-      <div class="supplementary widget" id="feedback-contact">-        <a href="mailto:feedback@regex.uk">-          <img src="badges/feedback-contact.svg" alt="build status" />-        </a>-      </div>-      <div class="supplementary widget twitter">-        <iframe style="width:162px; height:20px;" src="https://platform.twitter.com/widgets/follow_button.html?screen_name=hregex&amp;show_count=false">-        </iframe>-      </div>-    </div>-    <div id="content">-|]--pst_body_html :: LBS.ByteString-pst_body_html = [here|      </div>-    </div>-|]-\end{code}---Task Lists-------------\begin{code}--- | replacement function to convert GFM task list line into HTML if we--- aren't writing GFM (i.e.,  generating markdown for GitHub)-task_list :: MarkdownMode               -- ^ what flavour of md are we generating-          -> IORef Bool                 -- ^ will contain True iff we have already entered a task list-          -> Bool                       -- ^ true if this is a checjed line-          -> LineNo                     -- ^ line no of the replacement redex (unused)-          -> Match LBS.ByteString       -- ^ the matched task-list line-          -> Location                   -- ^ which match and capure (unused)-          -> Capture LBS.ByteString     -- ^ the capture weare replacing (unsuded)-          -> IO (Maybe LBS.ByteString)  -- ^ the replacement text, or Nothing to indicate no change to this line-task_list mmd rf chk _ mtch _ _ =-  case mmd of-    MM_github  -> return Nothing-    MM_hackage -> return $ Just $ "&nbsp;&nbsp;&nbsp;&nbsp;"<>cb<>"&nbsp;&nbsp;"<>itm<>"\n"-    MM_pandoc  -> do-      in_tl <- readIORef rf-      writeIORef rf True-      return $ tl_line in_tl chk-  where-    tl_line in_tl enbl = Just $ LBS.concat-      [ if in_tl then "" else "<ul class='contains-task-list'>\n"-      , "  <li class='task-list-item'>"-      , "<input type='checkbox' class='task-list-item-checkbox'"-      , if enbl then " checked=''" else ""-      , " disabled=''/>"-      , itm-      , "</li>"-      ]--    cb  = if chk then "&#x2612;" else "&#x2610;"--    itm = mtch !$$ [cp|itm|]---- | replacement function used for 'other' lines -- terminate any task--- list that was being generated-fin_task_list :: MarkdownMode               -- ^ what flavour of md are we generating-              -> IORef Bool                 -- ^ will contain True iff we have already entered a task list-              -> LineNo                     -- ^ line no of the replacement redex (unused)-              -> Match LBS.ByteString       -- ^ the matched task-list line-              -> Location                   -- ^ which match and capure (unused)-              -> Capture LBS.ByteString     -- ^ the capture weare replacing (unsuded)-              -> IO (Maybe LBS.ByteString)  -- ^ the replacement text, or Nothing to indicate no change to this line-fin_task_list mmd rf_t _ mtch _ _ =-  fmap (<>matchSource mtch) <$> fin_task_list' mmd rf_t---- | close any task list being processed, returning the closing text--- as necessary-fin_task_list' :: MarkdownMode              -- ^ what flavour of md are we generating-               -> IORef Bool                -- ^ will contain True iff we have already entered a task list-               -> IO (Maybe LBS.ByteString) -- ^ task-list closure HTML, if task-list HTML needs closing-fin_task_list' mmd rf = do-  in_tl <- readIORef rf-  writeIORef rf False-  case mmd==MM_github || not in_tl of-    True  -> return Nothing-    False -> return $ Just $ "</ul>\n"-\end{code}---Literate Haskell Pages-------------------------\begin{code}-pandoc_lhs :: T.Text -> T.Text -> T.Text -> IO ()-pandoc_lhs title in_file = pandoc_lhs' title in_file in_file--pandoc_lhs' :: T.Text -> T.Text -> T.Text -> T.Text -> IO ()-pandoc_lhs' title repo_path in_file out_file = do-  LBS.writeFile "tmp/metadata.markdown"  $-                    LBS.unlines-                      [ "---"-                      , "title: "<>LBS.fromStrict (TE.encodeUtf8 title)-                      ,"---"-                      ]-  LBS.writeFile "tmp/bc.html" bc-  LBS.writeFile "tmp/ft.html" ft-  fmap (const ()) $-    SH.shelly $ SH.verbosely $-      SH.run "pandoc"-        [ "-f", "markdown+lhs+grid_tables"-        , "-t", "html5"-        , "-T", "regex"-        , "-s"-        , "-H", "lib/favicons.html"-        , "-B", "tmp/bc.html"-        , "-A", "tmp/ft.html"-        , "-c", "lib/lhs-styles.css"-        , "-c", "lib/bs.css"-        , "-o", out_file-        , "tmp/metadata.markdown"-        , in_file-        ]-  where-    bc = LBS.unlines-    --  [ "<div class='brandingdiv'>"-    --  , "  " <> branding-    --  , "</div>"-      [ "<div class='bcdiv'>"-      , "  <ol class='breadcrumb'>"-      , "    <li>"<>branding<>"</li>"-      , "    <li><a title='source file' href='" <>-              repo_url <> "'>" <> (LBS.pack $ T.unpack title) <> "</a></li>"-      , "</ol>"-      , "</div>"-      , "<div class='litcontent'>"-      ]--    ft = LBS.concat-      [ "</div>"-      ]--    repo_url = LBS.concat-      [ "https://github.com/iconnect/regex/blob/master/"-      , LBS.pack $ T.unpack repo_path-      ]-\end{code}---simple include processor---------------------------\begin{code}-include :: LBS.ByteString -> IO LBS.ByteString-include = sed' $ Select-    [ (,) [re|^%include ${file}(@{%string})$|] $ EDIT_fun TOP   incl-    , (,) [re|^.*$|]                           $ EDIT_fun TOP $ \_ _ _ _->return Nothing-    ]-  where-    incl _ mtch _ _ = Just <$> LBS.readFile (prs_s $ mtch !$$ [cp|file|])-    prs_s           = maybe (error "include") T.unpack . parseString-\end{code}---branding-----------\begin{code}-branding :: LBS.ByteString-branding = [here|<a href="." style="Arial, 'Helvetica Neue', Helvetica, sans-serif;" id="branding">[<span style='color:red;'>re</span>|${<span style='color:red;'>gex</span>}(.*)|<span></span>]</a>|]-\end{code}---testing----------\begin{code}-test :: IO ()-test = do-  dm <- docMode-  test_pp "pp-doc" (loop dm) "data/pp-test.lhs" "data/pp-result-doc.lhs"-  gm <- genMode-  test_pp "pp-gen" (loop gm) "data/pp-test.lhs" "data/pp-result-gen.lhs"-  putStrLn "tests passed"-\end{code}
− examples/re-tests.lhs
@@ -1,522 +0,0 @@-\begin{code}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE QuasiQuotes                #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# OPTIONS_GHC -fno-warn-orphans       #-}--module Main (main) where--import           Control.Exception-import           Data.Array-import qualified Data.ByteString.Char8          as B-import qualified Data.ByteString.Lazy.Char8     as LBS-import qualified Data.Foldable                  as F-import qualified Data.HashMap.Strict            as HM-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           Prelude.Compat-import           Test.SmallCheck.Series-import           Test.Tasty-import           Test.Tasty.HUnit-import           Test.Tasty.SmallCheck          as SC-import           Text.Heredoc-import qualified Text.Regex.PCRE                as PCRE_--import qualified Text.Regex.TDFA                as TDFA_-import           Text.RE-import           Text.RE.Internal.NamedCaptures-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 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 ()-main = defaultMain $-  testGroup "Tests"-    [ prelude_tests-    , parsing_tests-    , core_tests-    , replace_tests-    , options_tests-    , namedCapturesTestTree-    , many_tests-    , misc_tests-    ]--prelude_tests :: TestTree-prelude_tests = testGroup "Prelude"-  [ tc TDFA TDFA.preludeEnv-  , tc PCRE PCRE.preludeEnv-  ]-  where-    tc rty m_env =-      testCase (show rty) $ do-        dumpMacroTable "macros" rty m_env-        assertBool "testMacroEnv" =<< testMacroEnv "prelude" rty m_env--str_, str' :: String-str_      = "a bbbb aa b"-str'      = "foo"--regex_, regex_alt :: RE-regex_    = [re|(a+) (b+)|]-regex_alt = [re|(a+)|(b+)|]--regex_str_matches :: Matches String-regex_str_matches =-  Matches-    { matchesSource = "a bbbb aa b"-    , allMatches =-        [ regex_str_match-        , regex_str_match_2-        ]-    }--regex_str_match :: Match String-regex_str_match =-  Match-    { matchSource   = "a bbbb aa b"-    , captureNames  = noCaptureNames-    , matchArray    = array (0,2)-        [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "a bbbb", captureOffset = 0, captureLength = 6})-        , (1,Capture {captureSource = "a bbbb aa b", capturedText = "a"     , captureOffset = 0, captureLength = 1})-        , (2,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb"  , captureOffset = 2, captureLength = 4})-        ]-    }--regex_str_match_2 :: Match String-regex_str_match_2 =-  Match-    { matchSource   = "a bbbb aa b"-    , captureNames  = noCaptureNames-    , matchArray    = array (0,2)-        [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "aa b", captureOffset = 7 , captureLength = 4})-        , (1,Capture {captureSource = "a bbbb aa b", capturedText = "aa"  , captureOffset = 7 , captureLength = 2})-        , (2,Capture {captureSource = "a bbbb aa b", capturedText = "b"   , captureOffset = 10, captureLength = 1})-        ]-    }--regex_alt_str_matches :: Matches String-regex_alt_str_matches =-  Matches-    { matchesSource = "a bbbb aa b"-    , allMatches    =-        [ Match-            { matchSource   = "a bbbb aa b"-            , captureNames  = noCaptureNames-            , matchArray    = array (0,2)-                [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "a", captureOffset = 0, captureLength = 1})-                , (1,Capture {captureSource = "a bbbb aa b", capturedText = "a", captureOffset = 0, captureLength = 1})-                , (2,Capture {captureSource = "a bbbb aa b", capturedText = "", captureOffset = -1, captureLength = 0})-                ]-            }-        , Match-            { matchSource   = "a bbbb aa b"-            , captureNames  = noCaptureNames-            , matchArray    = array (0,2)-                [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb", captureOffset = 2 , captureLength = 4})-                , (1,Capture {captureSource = "a bbbb aa b", capturedText = ""    , captureOffset = -1, captureLength = 0})-                , (2,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb", captureOffset = 2 , captureLength = 4})-                ]-            }-        , Match-            { matchSource   = "a bbbb aa b"-            , captureNames  = noCaptureNames-            , matchArray    = array (0,2)-                [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "aa", captureOffset = 7 , captureLength = 2})-                , (1,Capture {captureSource = "a bbbb aa b", capturedText = "aa", captureOffset = 7 , captureLength = 2})-                , (2,Capture {captureSource = "a bbbb aa b", capturedText = ""  , captureOffset = -1, captureLength = 0})-                ]-            }-        , Match-            { matchSource   = "a bbbb aa b"-            , captureNames  = noCaptureNames-            , matchArray    = array (0,2)-                [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "b", captureOffset = 10, captureLength = 1})-                , (1,Capture {captureSource = "a bbbb aa b", capturedText = "" , captureOffset = -1, captureLength = 0})-                , (2,Capture {captureSource = "a bbbb aa b", capturedText = "b", captureOffset = 10, captureLength = 1})-                ]-            }-        ]-    }--parsing_tests :: TestTree-parsing_tests = testGroup "Parsing"-  [ testCase "complete check (matchM/ByteString)" $ do-      r    <- compileRegex () $ reSource regex_-      assertEqual "Match" (B.pack <$> regex_str_match) $ B.pack str_ ?=~ r-  , testCase "matched (matchM/Text)" $ do-      r     <- compileRegex () $ reSource regex_-      assertEqual "matched" True $ matched $ T.pack str_ ?=~ r-  ]--core_tests :: TestTree-core_tests = testGroup "Match"-  [ testCase "text (=~~Text.Lazy)" $ do-      txt <- LT.pack str_ =~~ [re|(a+) (b+)|] :: IO (LT.Text)-      assertEqual "text" txt "a bbbb"-  , testCase "multi (=~~/String)" $ do-      let sm = str_ =~ regex_ :: Match String-          m  = capture [cp|0|] sm-      assertEqual "captureSource" "a bbbb aa b" $ captureSource m-      assertEqual "capturedText"  "a bbbb"      $ capturedText  m-      assertEqual "capturePrefix" ""            $ capturePrefix m-      assertEqual "captureSuffix" " aa b"       $ captureSuffix m-  , testCase "complete (=~~/ByteString)" $ do-      mtch <- B.pack str_ =~~ regex_ :: IO (Match B.ByteString)-      assertEqual "Match" mtch $ B.pack <$> regex_str_match-  , testCase "complete (all,String)" $ do-      let mtchs = str_ =~ regex_     :: Matches String-      assertEqual "Matches" mtchs regex_str_matches-  , testCase "complete (all,reg_alt)" $ do-      let mtchs = str_ =~ regex_alt  :: Matches String-      assertEqual "Matches" mtchs regex_alt_str_matches-  , testCase "complete (=~~,all)" $ do-      mtchs <- str_ =~~ regex_       :: IO (Matches String)-      assertEqual "Matches" mtchs regex_str_matches-  , testCase "fail (all)" $ do-      let mtchs = str' =~ regex_    :: Matches String-      assertEqual "not.anyMatches" False $ anyMatches mtchs-  ]--replace_tests :: TestTree-replace_tests = testGroup "Replace"-  [ testCase "String/single" $ do-      let m = str_ =~ regex_ :: Match String-          r = replaceCaptures' ALL fmt m-      assertEqual "replaceCaptures'" r "(0:0:(0:1:a) (0:2:bbbb)) aa b"-  , testCase "String/alt" $ do-      let ms = str_ =~ regex_ :: Matches String-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  , testCase "String" $ do-      let ms = str_ =~ regex_ :: Matches String-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  , testCase "ByteString" $ do-      let ms = B.pack str_ =~ regex_ :: Matches B.ByteString-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  , testCase "LBS.ByteString" $ do-      let ms = LBS.pack str_ =~ regex_ :: Matches LBS.ByteString-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  , testCase "Seq Char" $ do-      let ms = S.fromList str_ =~ regex_ :: Matches (S.Seq Char)-          f  = \_ (Location i j) Capture{..} -> Just $ S.fromList $-                  "(" <> show i <> ":" <> show_co j <> ":" <>-                    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))"-  , testCase "Text" $ do-      let ms = T.pack str_ =~ regex_ :: Matches T.Text-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  , testCase "LT.Text" $ do-      let ms = LT.pack str_ =~ regex_ :: Matches LT.Text-          r  = replaceAllCaptures' ALL fmt ms-      chk r-  ]-  where-    chk r =-      assertEqual-        "replaceAllCaptures'"-        r-        "(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"--    fmt :: (IsString s,Replace s) => a -> Location -> Capture s -> Maybe s-    fmt _ (Location i j) Capture{..} = Just $ "(" <> pack_ (show i) <> ":" <>-      pack_ (show_co j) <> ":" <> capturedText <> ")"--    show_co (CaptureOrdinal j) = show j--options_tests :: TestTree-options_tests = testGroup "Simple Options"-  [ testGroup "TDFA Simple Options"-      [ testCase "default (MultilineSensitive)" $ assertEqual "#" 2 $-          countMatches $ s TDFA.*=~ [TDFA.re|[0-9a-f]{2}$|]-      , testCase "MultilineSensitive" $ assertEqual "#" 2 $-          countMatches $ s TDFA.*=~ [TDFA.reMultilineSensitive|[0-9a-f]{2}$|]-      , testCase "MultilineInsensitive" $ assertEqual "#" 4 $-          countMatches $ s TDFA.*=~ [TDFA.reMultilineInsensitive|[0-9a-f]{2}$|]-      , testCase "BlockSensitive" $ assertEqual "#" 0 $-          countMatches $ s TDFA.*=~ [TDFA.reBlockSensitive|[0-9a-f]{2}$|]-      , testCase "BlockInsensitive" $ assertEqual "#" 1 $-          countMatches $ s TDFA.*=~ [TDFA.reBlockInsensitive|[0-9a-f]{2}$|]-      ]-  , testGroup "PCRE Simple Options"-      [ testCase "default (MultilineSensitive)" $ assertEqual "#" 2 $-          countMatches $ s PCRE.*=~ [PCRE.re|[0-9a-f]{2}$|]-      , testCase "MultilineSensitive" $ assertEqual "#" 2 $-          countMatches $ s PCRE.*=~ [PCRE.reMultilineSensitive|[0-9a-f]{2}$|]-      , testCase "MultilineInsensitive" $ assertEqual "#" 4 $-          countMatches $ s PCRE.*=~ [PCRE.reMultilineInsensitive|[0-9a-f]{2}$|]-      , testCase "BlockSensitive" $ assertEqual "#" 0 $-          countMatches $ s PCRE.*=~ [PCRE.reBlockSensitive|[0-9a-f]{2}$|]-      , testCase "BlockInsensitive" $ assertEqual "#" 1 $-          countMatches $ s PCRE.*=~ [PCRE.reBlockInsensitive|[0-9a-f]{2}$|]-      ]-    ]-  where-    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]-\end{code}---Testing : FormatToken/Scan Properties----------------------------------------\begin{code}-namedCapturesTestTree :: TestTree-namedCapturesTestTree = localOption (SmallCheckDepth 4) $-  testGroup "NamedCaptures"-    [ formatScanTestTree-    , analyseTokensTestTree-    ]-\end{code}--\begin{code}-instance Monad m => Serial m Token-\end{code}---Testing : FormatToken/Scan Properties----------------------------------------\begin{code}-formatScanTestTree :: TestTree-formatScanTestTree =-  testGroup "FormatToken/Scan Properties"-    [ localOption (SmallCheckDepth 4) $-        SC.testProperty "formatTokens == formatTokens0" $-          \tks -> formatTokens tks == formatTokens0 tks-    , localOption (SmallCheckDepth 4) $-        SC.testProperty "scan . formatTokens' idFormatTokenOptions == id" $-          \tks -> all validToken tks ==>-                    scan (formatTokens' idFormatTokenOptions tks) == tks-    ]-\end{code}---Testing : Analysing [Token] Unit Tests-----------------------------------------\begin{code}-analyseTokensTestTree :: TestTree-analyseTokensTestTree =-  testGroup "Analysing [Token] Unit Tests"-    [ tc [here|foobar|]                                       []-    , tc [here||]                                             []-    , tc [here|$([0-9]{4})|]                                  []-    , tc [here|${x}()|]                                       [(1,"x")]-    , tc [here|${}()|]                                        []-    , tc [here|${}()${foo}()|]                                [(2,"foo")]-    , tc [here|${x}(${y()})|]                                 [(1,"x")]-    , tc [here|${x}(${y}())|]                                 [(1,"x"),(2,"y")]-    , tc [here|${a}(${b{}())|]                                [(1,"a")]-    , tc [here|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|] [(1,"y"),(2,"m"),(3,"d")]-    , tc [here|@$(@|\{${name}([^{}]+)\})|]                    [(2,"name")]-    , tc [here|${y}[0-9]{4}|]                                 []-    , tc [here|${}([0-9]{4})|]                                []-    ]-  where-    tc s al =-      testCase s $ assertEqual "CaptureNames"-        (xnc s)-        (HM.fromList-          [ (CaptureName $ T.pack n,CaptureOrdinal i)-              | (i,n)<-al-              ]-        )--    xnc = either oops fst . extractNamedCaptures-      where-        oops = error "analyseTokensTestTree: unexpected parse failure"-\end{code}
− examples/re-tutorial.lhs
@@ -1,862 +0,0 @@-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:-```bash-ghci examples/re-tutorial.lhs-```-or using `cabal repl`:-```-cabal configure --enable-tests-cabal repl examples/re-tutorial.lhs-```--Depending upon how you have configured and run `ghci` you may need to-set one of _ghci_'s interctive settings &mdash; the topic of the next-section.---Setting Up: The Pragmas--------------------------Haskell programs typically start with a few compiler pragmas to switch-on the language extensions needed by the module. Because regex uses-Template Haskell to check regular expressions at compile time `QuasiQuotes`-should be enabled.--\begin{code}-{-# LANGUAGE QuasiQuotes #-}-\end{code}--Use this command to configure ghci accordingly (not necessary if you-have launched ghci with `cabal repl`):-```-:seti -XQuasiQuotes-```--Because we are mimicking the REPL in this tutorial we will leave off the type-signatures on the example calculations and disable the compiler-warnings about missing type signatures.-\begin{code}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-\end{code}--This pragma is a just technical pragma, combined with the-`Prelude.Compat` import below used to avoid certain warnings while-comiling against multiple versions of the compiler. It can be safely-ignored.-\begin{code}-{-# LANGUAGE NoImplicitPrelude #-}-\end{code}---Loading Up: The Imports--------------------------\begin{code}-module Main(main) where-\end{code}--*********************************************************-*-* WARNING: this is generated from pp-tutorial-master.lhs -*-*********************************************************--We have two things to consider in the import to access the regex-goodies, which will take the form:-```haskell-import Text.RE.<regex-flavour>.<text-type>?-```--  * Which [flavour of regular expressions](https://wiki.haskell.org/Regular_expressions) do I need?-      + `PCRE` : [Perl-style](https://en.wikibooks.org/wiki/Regular_Expressions/Perl-Compatible_Regular_Expressions) regular expressions;-      + `TDFA`: [Posix-style](https://en.wikipedia.org/wiki/Regular_expression#POSIX_extended) regular expressions.--  * And which type of text am I matching?-      + `String` : low-performing, classic Haskell strings;-      + `ByteString` : raw bytestrings;-      + `ByteString.Lazy` : raw lazy bytestrings;-      + `Text`: efficient text (currently available for `TDFA` only);-      + `Text.Lazy` : efficient, lazy text (currently available for-        `TDFA` only);-      + polymorphic: if you need matching operators that work with all-        available text types then do not specify the `<text-type>` in-        the import path.--For this tutorial we will use classic Haskell strings but any application-dealing with bulk text will probably want to choose one of the other-options.-\begin{code}-import           Text.RE.TDFA.String-\end{code}-If you are predominantly matching against a single type in your module-then you will probably find it more convenient to use the relevant module-rather than than the more polymorphic opertors but it is really a-matter of convenience.--We will also need access to a small selection of common libraries for-our examples.-\begin{code}-import           Control.Applicative-import           Data.Maybe-import qualified Data.Text                      as T-import           Text.Printf-\end{code}--And finally we a special edition of the prelude (see the commentary for-the pragma section above) and a small specail toolkit will be used to help-manage the example calculations.-\begin{code}-import           Prelude.Compat-import           TestKit-\end{code}-This allows simple calculations to be defined stylistically-in the source program, presented as calculations when rendered-in HTML and tested that they have the expected result.-\begin{code}-evalme_LOA_00 = checkThis "evalme_LOA_00" 0 $-  length []-\end{code}-This trivial example calculation will be tested for equality to 0.---Matching with the regex-base Operators-----------------------------------------regex supports the regex-base polymorphic match operators. Used in a-`Bool` context `=~` will evaluate to True iff the string on the left matches-the RE on the right.-\begin{code}-evalme_TRD_00 = checkThis "evalme_TRD_00" True $-  ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Bool)-\end{code}-Note that we enclose the RE itself in `[re|` ... `|]` quasi quote brackets,-allowing the compiler to run some regex code at compile time to verify that-the RE conforms to the correct syntax for the chosen RE flavour of choice-(`TDFA` in this case). The above expression should evaluate to `True` as the-string contains a matching sub-string.--Used in an `Int` context `=~` will count the number of matches in the target string.-\begin{code}-evalme_TRD_01 = checkThis "evalme_TRD_01" 2 $-  ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Int)-\end{code}--To determine the string that has matched the modaic `=~~` operator can be used-in a `Maybe` context.-\begin{code}-evalme_TRD_02 = checkThis "evalme_TRD_02" (Just "2016-01-09") $-  ("2016-01-09 2015-12-5 2015-10-05" =~~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Maybe String)-\end{code}-This should evaluate to `Just "2016-01-09"`.--A `=~` in a `[[String]]` extracts all of the matched substrings:-\begin{code}-evalme_TRD_04 = checkThis "evalme_TRD_04" [["2016-01-09"],["2015-10-05"]] $-  ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: [[String]])-\end{code}-yields `[["2016-01-09"],["2015-10-05"]]`.--regex provides special operators and types for extracting the first-match or all of the non-overlapping substrings matching a regular expression-which provide a little more structure that the flexible, venerable regex-base-match operators.---Single Matches with `?=~`----------------------------regex also provides two matching operators: one for looking for the first-match in its search string and the other for finding all of the matches. The-first-match operator, `?=~`, yields the result of attempting to find the first-match. (It's result type will be explained below.) The boolean `matched`-function can be used to test whether a match was found.-\begin{code}-evalme_SGL_01 = checkThis "evalme_SGL_01" True $-  matched $ "2016-01-09 2015-12-5 2015-10-05" ?=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]-\end{code}-This should yield `True`.--To get the matched text use `matchText`, which returns `Nothing` if no match was-found in the search string.-\begin{code}-evalme_SGL_02 = checkThis "evalme_SGL_02" (Just "2016-01-09") $-  matchedText $ "2016-01-09 2015-12-5 2015-10-05" ?=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]-\end{code}-This should yield `Just "2016-01-09"`.---Multiple Matches with `*=~`------------------------------Use `*=~` to locate all of the non-overlapping substrings that matches a RE.-`anyMatches` will return `True` iff any matches are found (and they will be).-\begin{code}-evalme_MLT_01 = checkThis "evalme_MLT_01" True $-  anyMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]-\end{code}--`countMatches` will tell us how many sub-strings matched (2).-\begin{code}-evalme_MLT_02 = checkThis "evalme_MLT_02" 2 $-  countMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]-\end{code}--`matches` will return all of the matches.-\begin{code}-evalme_MLT_03 = checkThis "evalme_MLT_03" ["2016-01-09","2015-10-05"] $-  matches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]-\end{code}-This should yield `["2016-01-09","2015-10-05"]`.---Simple Text Replacement--------------------------regex supports the replacement of matched text with alternative text. This-section will cover replacement text specified with templates. More flexible-tools that allow functions calculate the replacement text are covered below.--_Capture_ sub-expressions, whose matched text can be inserted into the-replacement template, can be specified as follows:--  * `$(` ... `)` identifies a capture that can be identified by its-    left-to-right position relative to the other captures in the replacement-    template, with `$1` being used to represent the leftmost capture, `$2` the-    next leftmost capture, and so on;--  * `${foo}(` ... `)` can be used to identify a capture by name. Such captures-    can be identified either by their left-to-right position in the regular-    expression or by `${foo}` in the template.--A function to convert ISO format dates into a UK-format date could be written-thus:-\begin{code}-uk_dates :: String -> String-uk_dates src =-  replaceAll "${d}/${m}/${y}" $ src *=~ [re|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|]-\end{code}-with-\begin{code}-evalme_RPL_01 = checkThis "evalme_RPL_01" "09/01/2016 2015-12-5 05/10/2015" $-  uk_dates "2016-01-09 2015-12-5 2015-10-05"-\end{code}-yielding `"09/01/2016 2015-12-5 05/10/2015"`.--The same function written with numbered captures:-\begin{code}-uk_dates' :: String -> String-uk_dates' src =-  replaceAll "$3/$2/$1" $ src *=~ [re|$([0-9]{4})-$([0-9]{2})-$([0-9]{2})|]-\end{code}-with-\begin{code}-evalme_RPL_02 = checkThis "evalme_RPL_02" "09/01/2016 2015-12-5 05/10/2015" $-  uk_dates' "2016-01-09 2015-12-5 2015-10-05"-\end{code}-yielding the same result.--(Most regex conventions use plain parentheses, `(` ... `)`, to mark-captures but we would like to reserve those exclusively for grouping-in regex REs.)---Matches/Match/Capture------------------------The types returned by the `?=~` and `*=~` form the foundations of the-package. Understandingv these simple types is the key to understanding-the package.--The type of `*=~` in this module (imported from-`Text.RE.TDFA.String`) is:-<div class='inlinecodeblock'>-```-(*=~) :: String -> RE -> Matches String-```-</div>-with `Matches` defined in `Text.RE.Capture` thus:--%include "Text/RE/Capture.lhs" "^data Matches "--The critical component of the `Matches` type is the `[Match a]` in-`allMatches`, containing the details all of each substring matched by-the RE. The `matchSource` component also retains a copy of the original-search string but the critical information is in `allmatches`.--The type of `?=~` in this module (imported from-`Text.RE.TDFA.String`) is:-<div class='inlinecodeblock'>-```-(?=~) :: String -> RE -> Match String-```-</div>-with `Match` (referenced in the definition of `Matches` above) defined-in `Text.RE.Capture` thus:--%include "Text/RE/Capture.lhs" "^data Match "--Like `matchesSource` above, `matchSource` retains the original search-string, but also a `CaptureNames` field listing all of the capture-names in the RE (needed by the text replacemnt tools).--But the 'real' content of `Match` is to be found in the `MatchArray`,-enumerating all of the substrings captured by this match, starting with-`0` for the substring captured by the whole RE, `1` for the leftmost-explicit capture in the RE, `2` for the next leftmost capture, and so-on.--Each captured substring is represented by the following `Capture` type:--%include "Text/RE/Capture.lhs" "^data Capture "--Here we list the whole original search string in `captureSource` and-the text of the sub-string captured in `capturedText`. `captureOffset`-contains the number of characters preceding the captured substring, or-is negative if no substring was captured (which is a different-situation from epsilon, the empty string, being captured).-`captureLength` gives the length of the captured string in-`capturedText`.--The test suite in [examples/re-tests.lhs](re-tests.html) contains extensive-worked-out examples of these `Matches`/`Match`/`Capture` types.---Simple Options-----------------By default regular expressions are of the multi-line case-sensitive-variety so this query-\begin{code}-evalme_SOP_01 = checkThis "evalme_SOP_01" 2 $-  countMatches $ "0a\nbb\nFe\nA5" *=~ [re|[0-9a-f]{2}$|]-\end{code}-finds 2 matches, the '$' anchor matching each of the newlines, but only-the first two lowercase hex numbers matching the RE. The case sensitivity-and multiline-ness can be controled by selecting alternative parsers.--+--------------------------+-------------+-----------+----------------+-| long name                | short forms | multiline | case sensitive |-+==========================+=============+===========+================+-| reMultilineSensitive     | reMS, re    | yes       | yes            |-+--------------------------+-------------+-----------+----------------+-| reMultilineInsensitive   | reMI        | yes       | no             |-+--------------------------+-------------+-----------+----------------+-| reBlockSensitive         | reBS        | no        | yes            |-+--------------------------+-------------+-----------+----------------+-| reBlockInsensitive       | reBI        | no        | no             |-+--------------------------+-------------+-----------+----------------+--So while the default setup-\begin{code}-evalme_SOP_02 = checkThis "evalme_SOP_02" 2 $-  countMatches $ "0a\nbb\nFe\nA5" *=~ [reMultilineSensitive|[0-9a-f]{2}$|]-\end{code}-finds 2 matches, a case-insensitive RE-\begin{code}-evalme_SOP_03 = checkThis "evalme_SOP_03" 4 $-  countMatches $ "0a\nbb\nFe\nA5" *=~ [reMultilineInsensitive|[0-9a-f]{2}$|]-\end{code}-finds 4 matches, while a non-multiline RE-\begin{code}-evalme_SOP_04 = checkThis "evalme_SOP_04" 0 $-  countMatches $ "0a\nbb\nFe\nA5" *=~ [reBlockSensitive|[0-9a-f]{2}$|]-\end{code}-finds no matches but a non-multiline, case-insensitive match-\begin{code}-evalme_SOP_05 = checkThis "evalme_SOP_05" 1 $-  countMatches $ "0a\nbb\nFe\nA5" *=~ [reBlockInsensitive|[0-9a-f]{2}$|]-\end{code}-finds the final match.--For the hard of typing the shortforms are available.-\begin{code}-evalme_SOP_06 = checkThis "evalme_SOP_06" True $-  matched $ "SuperCaliFragilisticExpialidocious" ?=~ [reMI|supercalifragilisticexpialidocious|]-\end{code}---Using Functions to Replace Text----------------------------------Sometimes you will need to process each string captured by an RE with a-function. `replaceAllCaptures` takes a `Phi` and a `Matches` and-applies the function to each captured substring according to the-`Context` specified in `Phi`, as we can see in the following example function-to clean up all of the mis-formatted dates in the argument string,-\begin{code}-fixup_dates :: String -> String-fixup_dates src =-    replaceAllCaptures phi $ src *=~ [re|([0-9]+)-([0-9]+)-([0-9]+)|]-  where-    phi = Phi SUB $ \loc s -> case _loc_capture loc of-      1 -> printf "%04d" (read s :: Int)-      2 -> printf "%02d" (read s :: Int)-      3 -> printf "%02d" (read s :: Int)-      _ -> error "fixup_date"-\end{code}-which will fix up our running example-\begin{code}-evalme_RPF_01 = checkThis "evalme_RPF_01" "2016-01-09 2015-12-05 2015-10-05" $-  fixup_dates "2016-01-09 2015-12-5 2015-10-05"-\end{code}-returning `"2016-01-09 2015-12-05 2015-10-05"`.--The `Phi`, `Context` and `Location` types are defined in-`Text.RE.Replace` as follows.--%include "Text/RE/Replace.lhs" "^data Phi"--The processing function gets applied to the captures specified by the-`Context`, which can be directed to process `ALL` of the captures,-including the substring captured by the whole RE and all of the-subsidiary capture, or just the `TOP`, `0` capture that the whole RE-matches, or just the `SUB` (subsidiary) captures, as was the case above.--If this doesn't provide enough flexibility, the `replaceAllCaptures'`-function accepts a processing function that takes the full `Match`-context for each capture along with the `Location` and the `Capture`-itself.--%include "Text/RE/Replace.lhs" "replaceAllCaptures' ::"--The above fixup function can be extended to enclose whole date in-square brackets and rewritten with the above more general replacement-function.-\begin{code}-fixup_and_reformat_dates :: String -> String-fixup_and_reformat_dates src =-    replaceAllCaptures' ALL f $ src *=~ [re|([0-9]+)-([0-9]+)-([0-9]+)|]-  where-    f _ loc cap = Just $ case _loc_capture loc of-        0 -> printf "[%s]"       txt-        1 -> printf "%04d" (read txt :: Int)-        2 -> printf "%02d" (read txt :: Int)-        3 -> printf "%02d" (read txt :: Int)-        _ -> error "fixup_date"-      where-        txt = capturedText cap-\end{code}-The `fixup_and_reformat_dates` applied to our running example,-\begin{code}-evalme_RPF_02 = checkThis "evalme_RPF_02" "[2016-01-09] [2015-12-05] [2015-10-05]" $-  fixup_and_reformat_dates "2016-01-09 2015-12-5 2015-10-05"-\end{code}-yields `"[2016-01-09] [2015-12-05] [2015-10-05]"`.--`Text.RE.Replace` provides analagous functions for replacing the-test of a single `Match` returned from `?=~`.---Macros and Parsers---------------------regex supports macros in regular expressions. There are a bunch of-standard macros and you can define your own.--RE macros are enclosed in `@{` ... '}'. By convention the macros in-the standard environment start with a '%'. `@{%date}` will match an-ISO 8601 date, this-\begin{code}-evalme_MAC_00 = checkThis "evalme_MAC_00" 2 $-  countMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|@{%date}|]-\end{code}-picking out the two dates.--See the tables listing the standard macros in the tables folder of-the distribution.--See the log-processor example and the `Text.RE.TestBench` for-more on how you can develop, document and test RE macros with the-regex test bench.---Compiling REs with the Complete Options------------------------------------------Each type of RE &mdash; TDFA and PCRE &mdash; has it own complile-time-options and execution-time options, called in each case `CompOption` and-`ExecOption`. The above simple options selected with the RE-parser (`reMultilineSensitive`, etc.) configures the RE backend-accordingly so that you don't have to, but you may need full access to-you chosen back end's options, or you may need to supply a different-set of macros to those provided in the standard environment. In which-case you will need to know about the `Options` type, defined by each of-the back ends in terms of the `Options_` type of `Text.RE.Options`-as follows.-<div class='inlinecodeblock'>-```-type Options = Options_ RE CompOption ExecOption-```-</div>-(Bear in mind that `CompOption` and `ExecOption` will be different-types for each back end.)--The `Options_` type is defined in `Text.RE.Options` as follows:--%include "Text/RE/Options.lhs" "data Options_"--  * `_options_mode` is an experimental feature that controls the RE-    parser.--  * `_options_macs` contains the macro definitions used to compile-    the REs (see above Macros section);--  * `_options_comp` contains the back end compile-time options;--  * `_options_exec` contains the back end execution-time options.--(For more information on the options provided by the back ends see the-decumentation for `regex-tdfa` and `regex-pcre` as apropriate.)--Each backend provides a function to compile REs from some options and a-string containing the RE as follows:-<div class='inlinecodeblock'>-```-compileRegex :: ( IsOption o RE CompOption ExecOption-                , Functor m-                , Monad   m-                )-             => o-             -> String-             -> m RE-```-</div>-where `o` is some type that is recognised as a type that can configure-REs. Your configuration-type options are:--  * `()` (the unit type) means just use the default multi-line-    case-sensitive that we get with the `re` parser.--  * `SimpleRegexOptions` this is just a simple enum type that we use to-    encode the standard options:--%include "Text/RE/Options.lhs" "^data SimpleRegexOptions"--  * `Mode`: you can specify the parser mode;--  * `Macros RE`: you can specify the macros use instead of the standard-    environment;--  * `CompOption`: you can specify the compile-time options for the back-    end;--  * `ExecOption`: you can specify the execution-time options for the-    back end;--  * `Options`: you can specify all of the options.--The compilation may fail so it is expressed monadically. For the-following examples we will use the following helper to just `error`-the failure.-\begin{code}-check_for_failure :: Either String a -> a-check_for_failure = either error id-\end{code}--\begin{code}-evalme_OPT_00 = checkThis "evalme_OPT_00" 2 $-  countMatches $-    "2016-01-09 2015-12-5 2015-10-05" *=~-      check_for_failure-        (compileRegex () "@{%date}")-\end{code}-\begin{code}-evalme_OPT_01 = checkThis "evalme_OPT_01" 1 $-  countMatches $-    "0a\nbb\nFe\nA5" *=~-      check_for_failure-        (compileRegex BlockInsensitive "[0-9a-f]{2}$")-\end{code}--This will allow you to compile regular expressions when the either the-text to be compiled or the options have been dynamically determined.---Specifying Options with `re_`--------------------------------If you just need to specify some non-standard options while statically-checking the validity of the RE (with the default options) then you can-use the `re_` parser:-\begin{code}-evalme_REU_01 = checkThis "evalme_REU_01" 1 $-  countMatches $-    "0a\nbb\nFe\nA5" *=~ [re_|[0-9a-f]{2}$|] BlockInsensitive-\end{code}-Any option `o` such that `IsOption o RE CompOption ExecOption` (i.e.,-any option type accepted by `compileRegex` above) can be used with-`[re_` ..`|]`.---The Tools: 'grep', 'lex' and 'sed'-------------------------------------The classic tools assocciated with regular expressions have inspired some-regex conterparts.--  * [Text.RE.Tools.Grep}(Grep.html): takes a regular expression and a-    file or lazy ByteString (depending upon the variant) and returns all of the-    matching lines. (Used in the [include](re-include.html) example.)--  * [Text.RE.Tools.Lex}(Lex.html): takes an association list of REs and-    token-generating functions and the input text and returns a list of tokens.-    This should never be used where performance is important (use Alex),-    except as a development prototype (used internally in-    [Text.RE.Internal.NamedCaptures](NamedCaptures.html)).--  * [Text.RE.Tools.Lex}(Sed.html) using [Text.RE.Edit](Edit.html):-    takes an association list of regular expressions and substitution actions,-    some input text and invokes the associated action on each line of the file-    that matches one of the REs, substituting the text returned from the action-    in the output stream. (Used in the [include](re-include.html),-    [gen-modules](re-gen-modules.html),-    [log-processor](re-nginx-log-processor.html) and [tutorial-pp](re-prep)-    examples.)---The Examples---------------The remaining sections have been given over to various standalone-examples. All bar the first are taken from the package itself, each-contributing to either the API or the tools used to prepare the-documentation and test suites.---Example: log processor: development with macros--------------------------------------------------To test regex at scale &mdash; which is to say, developing with-relatively complex  REs &mdash;-[a preprocessor](re-nginx-log-processor.html) for parsing NGINX access-and error logs has been written. Each line of input may be either a line-from an NGINX access log or the event log, producing a standard-format-event log on the output.--As a taster, here is the main script, where each type of line is-recognised by a high-level macro.--%include "examples/re-nginx-log-processor.lhs" "script ::"--Thes macros are based on the standard macros, using-`Text.RE.TestBench` to build the up into the above high-level-scanners with the apropriate-[tests and documentation](https://github.com/iconnect/regex/tree/master/tables).--The RE for recognising the access-log lines is built up here.--%include "examples/re-nginx-log-processor.lhs" "access_re ::"--(N.B., The Test Bench currently requires that we write our REs in Haskell-strings.)--See [the log-processor program sources](re-nginx-log-processor.html) for details.---Example: Scanning REs: Named Captures----------------------------------------This package needs to recognise all captures in a regular expression so-that it can associate the named captures with their cature ordinal.--Here is the prototype scanner.--%include "Text/RE/Internal/NamedCaptures.lhs" "scan ::"--Once the package has stabilised it should be rewritten with Alex.--See [Text.RE.Internal.NamedCaptures](NamedCaptures.html) for-details.---Anti-Example: Scanning REs in the TestBench----------------------------------------------The [Text.RE.TestBench](TestBench.html) contains an almost-identical parser to the above, written with recursive functions.--%include "Text/RE/TestBench.lhs" "scan_re ::"--Once some technical issues have been ersolved it will use the above-scanner in [Text.RE.Internal.NamedCaptures](NamedCaptures.html).---Example: filename analysis-----------------------------The preprocessor used to prepare the literate programs for this-package's website uses the following 'gen_all' diriver which uses-REs to analyse file paths.--%include "examples/re-prep.lhs" "^gen_all ::"--See [examples/re-prep.lhs](re-prep.html)---Example: parsing RE macros-----------------------------The regex RE macros are parsed with code that looks similar to-this.--\begin{code}--- | expand the @{..} macos in the argument string using the given--- function-expandMacros_ :: (MacroID->Maybe String) -> String -> String-expandMacros_ lu = fixpoint e_m-  where-    e_m re_s =-        replaceAllCaptures' TOP phi $ re_s *=~ [re|@$(@|\{${name}([^{}]+)\})|]--    phi mtch _ cap = case txt == "@@" of-        True  -> Just   "@"-        False -> Just $ fromMaybe txt $ lu ide-      where-        txt = capturedText cap-        ide = MacroID $ capturedText $ capture [cp|name|] mtch--fixpoint :: (Eq a) => (a->a) -> a -> a-fixpoint f = chk . iterate f-  where-    chk (x:x':_) | x==x' = x-    chk xs               = chk $ tail xs-\end{code}--For example:-\begin{code}-evalme_PMC_00 = checkThis "evalme_PMC_00" "foo MacroID {_MacroID = \"bar\"} baz" $-  expandMacros_ (Just . show) "foo @{bar} baz"-\end{code}--See [Text.RE.Replace](Replace.html) for details.---Example: Parsing Replace Templates-------------------------------------The regex replacement templates are parsed with code similar to this.--\begin{code}-type Template = String--parse_tpl_ :: Template-           -> Match String-           -> Location-           -> Capture String-           -> Maybe String-parse_tpl_ tpl mtch _ _ =-    Just $ replaceAllCaptures' TOP phi $-      tpl *=~ [re|\$${arg}(\$|[0-9]+|\{${name}([^{}]+)\})|]-  where-    phi t_mtch _ _ = case t_mtch !$? [cp|name|] of-      Just cap -> this $ CID_name $ CaptureName txt-        where-          txt = T.pack $ capturedText cap-      Nothing -> case t == "$" of-        True  -> Just t-        False -> this $ CID_ordinal $ CaptureOrdinal $ read t-      where-        t = capturedText $ capture [cp|arg|] t_mtch--        this cid = capturedText <$> mtch !$? cid--my_replace :: RE -> Template-> String -> String-my_replace rex tpl src = replaceAllCaptures' TOP (parse_tpl_ tpl) $ src *=~ rex-\end{code}--It can be tested with our date-reformater example.--\begin{code}-date_reformat :: String -> String-date_reformat = my_replace [re|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|] "${y}/${m}/${d}"-\end{code}--This should yield `"2016/01/11"`:--\begin{code}-evalme_TPL_00 = checkThis "evalme_TPL_00" "2016/01/11" $-  date_reformat "2016-01-11"-\end{code}--See [Text.RE.Replace](Replace.html)---Example: include preprocessor--------------------------------The 'include' preprocessor for extracting literate programming fragments-(used in this and most of the other sections of the tutorial) has been-lifted out of the main preprocessor into its own example.--Here is sed script that makes up the main loop.--%include "examples/re-include.lhs" "loop ::"--The `extract` action takes the path to the file containing the fragment-and the RE that will match a line in the fragment and returns the text-of the fragment (wrapped in a simple styling div).--%include "examples/re-include.lhs" "extract ::"--And here is the scanner for recognising the literate fragments.--%include "examples/re-include.lhs" "scan ::"--See [examples/re-include.lhs](re-include.html)---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-prep.lhs](re-prep.html).---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](re-gen-modules.html) which is also an-application of regex.---\begin{code}-main :: IO ()-main = runTests-  [ evalme_TPL_00-  , evalme_PMC_00-  , evalme_REU_01-  , evalme_OPT_01-  , evalme_OPT_00-  , evalme_MAC_00-  , evalme_RPF_02-  , evalme_RPF_01-  , evalme_SOP_06-  , evalme_SOP_05-  , evalme_SOP_04-  , evalme_SOP_03-  , evalme_SOP_02-  , evalme_SOP_01-  , evalme_RPL_02-  , evalme_RPL_01-  , evalme_MLT_03-  , evalme_MLT_02-  , evalme_MLT_01-  , evalme_SGL_02-  , evalme_SGL_01-  , evalme_TRD_04-  , evalme_TRD_02-  , evalme_TRD_01-  , evalme_TRD_00-  , evalme_LOA_00-  ]-\end{code}-
regex.cabal view
@@ -1,5 +1,5 @@ Name:                   regex-Version:                0.1.0.0+Version:                0.2.0.0 Synopsis:               Toolkit for regex-base Description:            A Regular Expression Toolkit for regex-base with                         Compile-time checking of RE syntax, data types for@@ -7,16 +7,16 @@                         portable options, high-level AWK-like tools                         for building text processing apps, regular expression                         macros and test bench, a tutorial and copious examples.-Homepage:               https://iconnect.github.io/regex+Homepage:               http://regex.uk Author:                 Chris Dornan License:                BSD3 license-file:           LICENSE-Maintainer:             chris.dornan@irisconnect.co.uk+Maintainer:             Chris Dornan <chris@regex.uk> Copyright:              Chris Dornan 2016-2017 Category:               Text Build-type:             Simple-Stability:              rfc-bug-reports:            https://github.com/iconnect/regex/issues+Stability:              RFC+bug-reports:            http://issues.regex.uk  Extra-Source-Files:     README.markdown@@ -31,9 +31,10 @@ Source-Repository this     Type:               git     Location:           https://github.com/iconnect/regex.git-    Tag:                0.1.0.0+    Tag:                0.2.0.0  + Library     Hs-Source-Dirs:     .     Exposed-Modules:@@ -96,463 +97,5 @@       , unordered-containers >= 0.2.5.1  -Executable re-gen-cabals-    Hs-Source-Dirs:     examples -    Main-Is:            re-gen-cabals.lhs--    Other-Modules:-      TestKit--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6---Test-Suite re-gen-cabals-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-gen-cabals.lhs--    Other-Modules:-      TestKit--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6----Executable re-gen-modules-    Hs-Source-Dirs:     examples--    Main-Is:            re-gen-modules.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6---Test-Suite re-gen-modules-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-gen-modules.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6----Executable re-include-    Hs-Source-Dirs:     examples--    Main-Is:            re-include.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6---Test-Suite re-include-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-include.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6----Executable re-nginx-log-processor-    Hs-Source-Dirs:     examples--    Main-Is:            re-nginx-log-processor.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6-      , time                 >= 1.4.2-      , time-locale-compat   >= 0.1.0.1-      , transformers         >= 0.2.2-      , unordered-containers >= 0.2.5.1---Test-Suite re-nginx-log-processor-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-nginx-log-processor.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , regex-base           >= 0.93.2-      , regex-tdfa           >= 1.2.0-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6-      , time                 >= 1.4.2-      , time-locale-compat   >= 0.1.0.1-      , transformers         >= 0.2.2-      , unordered-containers >= 0.2.5.1----Executable re-prep-    Hs-Source-Dirs:     examples--    Main-Is:            re-prep.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , heredoc              >= 0.2.0.0-      , http-conduit         >= 2.1.7.2-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6---Test-Suite re-prep-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-prep.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , directory            >= 1.2.1.0-      , heredoc              >= 0.2.0.0-      , http-conduit         >= 2.1.7.2-      , shelly               >= 1.6.1.2-      , text                 >= 1.2.0.6----Executable re-tests-    Hs-Source-Dirs:     examples--    Main-Is:            re-tests.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , heredoc              >= 0.2.0.0-      , regex-base           >= 0.93.2-      , regex-pcre-builtin   >= 0.94.4.8.8.35-      , regex-tdfa           >= 1.2.0-      , regex-tdfa-text      >= 1.0.0.3-      , smallcheck           >= 1.1.1-      , tasty                >= 0.10.1.2-      , tasty-hunit          >= 0.9.2-      , tasty-smallcheck     >= 0.8.0.1-      , template-haskell     >= 2.7-      , text                 >= 1.2.0.6-      , unordered-containers >= 0.2.5.1---Test-Suite re-tests-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-tests.lhs--    Default-Language:   Haskell2010-    GHC-Options:-      -Wall-      -fwarn-tabs--    Other-Modules:-      TestKit--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , heredoc              >= 0.2.0.0-      , regex-base           >= 0.93.2-      , regex-pcre-builtin   >= 0.94.4.8.8.35-      , regex-tdfa           >= 1.2.0-      , regex-tdfa-text      >= 1.0.0.3-      , smallcheck           >= 1.1.1-      , tasty                >= 0.10.1.2-      , tasty-hunit          >= 0.9.2-      , tasty-smallcheck     >= 0.8.0.1-      , template-haskell     >= 2.7-      , text                 >= 1.2.0.6-      , unordered-containers >= 0.2.5.1----Executable re-tutorial-    Hs-Source-Dirs:     examples--    Main-Is:            re-tutorial.lhs--    Other-Modules:-      TestKit--    Default-Language:   Haskell2010-    Default-Extensions: QuasiQuotes-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , hashable             >= 1.2.3.3-      , heredoc              >= 0.2.0.0-      , regex-base           >= 0.93.2-      , regex-pcre-builtin   >= 0.94.4.8.8.35-      , regex-tdfa           >= 1.2.0-      , regex-tdfa-text      >= 1.0.0.3-      , shelly               >= 1.6.1.2-      , smallcheck           >= 1.1.1-      , tasty                >= 0.10.1.2-      , tasty-hunit          >= 0.9.2-      , tasty-smallcheck     >= 0.8.0.1-      , template-haskell     >= 2.7-      , text                 >= 1.2.0.6-      , time                 >= 1.4.2-      , time-locale-compat   >= 0.1.0.1-      , transformers         >= 0.2.2-      , unordered-containers >= 0.2.5.1---Test-Suite re-tutorial-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-tutorial.lhs--    Other-Modules:-      TestKit--    Default-Language:   Haskell2010-    Default-Extensions: QuasiQuotes-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , hashable             >= 1.2.3.3-      , heredoc              >= 0.2.0.0-      , regex-base           >= 0.93.2-      , regex-pcre-builtin   >= 0.94.4.8.8.35-      , regex-tdfa           >= 1.2.0-      , regex-tdfa-text      >= 1.0.0.3-      , shelly               >= 1.6.1.2-      , smallcheck           >= 1.1.1-      , tasty                >= 0.10.1.2-      , tasty-hunit          >= 0.9.2-      , tasty-smallcheck     >= 0.8.0.1-      , template-haskell     >= 2.7-      , text                 >= 1.2.0.6-      , time                 >= 1.4.2-      , time-locale-compat   >= 0.1.0.1-      , transformers         >= 0.2.2-      , unordered-containers >= 0.2.5.1----Test-Suite re-tutorial-os-test-    type:               exitcode-stdio-1.0-    Hs-Source-Dirs:     examples--    Main-Is:            re-tutorial.lhs--    Other-Modules:-      TestKit--    Default-Language:   Haskell2010-    Extensions:         OverloadedStrings-    Default-Extensions: QuasiQuotes-    GHC-Options:-      -Wall-      -fwarn-tabs--    Build-depends:-        regex                -      , array                >= 0.4-      , base                 >= 4 && < 5-      , base-compat          >= 0.6.0-      , bytestring           >= 0.10.2.0-      , containers           >= 0.4-      , directory            >= 1.2.1.0-      , hashable             >= 1.2.3.3-      , heredoc              >= 0.2.0.0-      , regex-base           >= 0.93.2-      , regex-pcre-builtin   >= 0.94.4.8.8.35-      , regex-tdfa           >= 1.2.0-      , regex-tdfa-text      >= 1.0.0.3-      , shelly               >= 1.6.1.2-      , smallcheck           >= 1.1.1-      , tasty                >= 0.10.1.2-      , tasty-hunit          >= 0.9.2-      , tasty-smallcheck     >= 0.8.0.1-      , template-haskell     >= 2.7-      , text                 >= 1.2.0.6-      , time                 >= 1.4.2-      , time-locale-compat   >= 0.1.0.1-      , transformers         >= 0.2.2-      , unordered-containers >= 0.2.5.1----- Generated from lib/rgex-master.cabal with re-gen-cabals+-- Generated from lib/cabal-masters/mega-regex with re-gen-cabals