Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 10 additions & 3 deletions docs/Capture.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Capture.lhs'>RE/Capture</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Capture.lhs'>RE/Capture</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE RecordWildCards #-}</span>
<span class="ot">{-# LANGUAGE FlexibleInstances #-}</span>
<span class="ot">{-# LANGUAGE UndecidableInstances #-}</span>
Expand Down Expand Up @@ -224,15 +224,21 @@
<span class="ot">captureSuffix ::</span> <span class="dt">Extract</span> a <span class="ot">=&gt;</span> <span class="dt">Capture</span> a <span class="ot">-&gt;</span> a
captureSuffix <span class="dt">Capture</span>{<span class="fu">..</span>} <span class="fu">=</span> after (captureOffset<span class="fu">+</span>captureLength) captureSource</code></pre></div>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="co">-- | for matching just the first RE against the source text</span>
<span class="kw">instance</span> <span class="dt">RegexContext</span> regex source (<span class="dt">AllTextSubmatches</span> (<span class="dt">Array</span> <span class="dt">Int</span>) (source,(<span class="dt">Int</span>,<span class="dt">Int</span>))) <span class="ot">=&gt;</span>
<span class="kw">instance</span>
( <span class="dt">RegexContext</span> regex source (<span class="dt">AllTextSubmatches</span> (<span class="dt">Array</span> <span class="dt">Int</span>) (source,(<span class="dt">Int</span>,<span class="dt">Int</span>)))
, <span class="dt">RegexLike</span> regex source
) <span class="ot">=&gt;</span>
<span class="dt">RegexContext</span> regex source (<span class="dt">Match</span> source) <span class="kw">where</span>
match r s <span class="fu">=</span> cvt s <span class="fu">$</span> getAllTextSubmatches <span class="fu">$</span> match r s
matchM r s <span class="fu">=</span> <span class="kw">do</span>
y <span class="ot">&lt;-</span> matchM r s
return <span class="fu">$</span> cvt s <span class="fu">$</span> getAllTextSubmatches y

<span class="co">-- | for matching all REs against the source text</span>
<span class="kw">instance</span> <span class="dt">RegexContext</span> regex source [<span class="dt">MatchText</span> source] <span class="ot">=&gt;</span>
<span class="kw">instance</span>
( <span class="dt">RegexContext</span> regex source [<span class="dt">MatchText</span> source]
, <span class="dt">RegexLike</span> regex source
) <span class="ot">=&gt;</span>
<span class="dt">RegexContext</span> regex source (<span class="dt">Matches</span> source) <span class="kw">where</span>
match r s <span class="fu">=</span> <span class="dt">Matches</span> s <span class="fu">$</span> map (cvt s) <span class="fu">$</span> match r s
matchM r s <span class="fu">=</span> <span class="kw">do</span>
Expand All @@ -257,5 +263,6 @@
, captureOffset <span class="fu">=</span> off
, captureLength <span class="fu">=</span> len
}</code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/Edit.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Edit.lhs'>RE/Edit</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Edit.lhs'>RE/Edit</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE RecordWildCards #-}</span>

<span class="kw">module</span> <span class="dt">Text.RE.Edit</span>
Expand Down Expand Up @@ -140,5 +140,6 @@
f (re,es) act <span class="fu">=</span> <span class="kw">do</span>
s <span class="ot">&lt;-</span> act
fromMaybe s <span class="fu">&lt;$&gt;</span> applyEdit id lno re es s</code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/Grep.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Tools/Grep.lhs'>RE/Tools/Grep</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Tools/Grep.lhs'>RE/Tools/Grep</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE RecordWildCards #-}</span>
<span class="ot">{-# LANGUAGE FlexibleContexts #-}</span>

Expand Down Expand Up @@ -104,5 +104,6 @@

<span class="ot">lines_matched ::</span> [<span class="dt">Line</span>] <span class="ot">-&gt;</span> [<span class="dt">Line</span>]
lines_matched <span class="fu">=</span> filter <span class="fu">$</span> anyMatches <span class="fu">.</span> _ln_matches</code></pre></div>
</div>
</body>
</html>
4 changes: 3 additions & 1 deletion docs/IsRegex.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,8 +47,9 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/IsRegex.lhs'>RE/IsRegex</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/IsRegex.lhs'>RE/IsRegex</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE MultiParamTypeClasses #-}</span>
<span class="ot">{-# LANGUAGE AllowAmbiguousTypes #-}</span>

<span class="kw">module</span> <span class="dt">Text.RE.IsRegex</span> <span class="kw">where</span>

Expand All @@ -58,5 +59,6 @@
<span class="ot"> matchOnce ::</span> re <span class="ot">-&gt;</span> s <span class="ot">-&gt;</span> <span class="dt">Match</span> s
<span class="ot"> matchMany ::</span> re <span class="ot">-&gt;</span> s <span class="ot">-&gt;</span> <span class="dt">Matches</span> s
<span class="ot"> regexSource ::</span> re <span class="ot">-&gt;</span> <span class="dt">String</span></code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/Lex.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Tools/Lex.lhs'>RE/Tools/Lex</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Tools/Lex.lhs'>RE/Tools/Lex</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="kw">module</span> <span class="dt">Text.RE.Tools.Lex</span> <span class="kw">where</span>

<span class="kw">import </span><span class="dt">Control.Applicative</span>
Expand Down Expand Up @@ -81,5 +81,6 @@
<span class="dt">False</span> <span class="ot">-&gt;</span> <span class="dt">Nothing</span>

mtch <span class="fu">=</span> mo re s</code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/NamedCaptures.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Internal/NamedCaptures.lhs'>RE/Internal/NamedCaptures</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Internal/NamedCaptures.lhs'>RE/Internal/NamedCaptures</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE QuasiQuotes #-}</span>
<span class="ot">{-# LANGUAGE TemplateHaskell #-}</span>
<span class="ot">{-# LANGUAGE FlexibleInstances #-}</span>
Expand Down Expand Up @@ -271,5 +271,6 @@ <h2 id="testing-analysing-token-unit-tests">Testing : Analysing <a href="#token"
xnc <span class="fu">=</span> either oops fst <span class="fu">.</span> extractNamedCaptures
<span class="kw">where</span>
oops <span class="fu">=</span> error <span class="st">&quot;analyseTokensTestTree: unexpected parse failure&quot;</span></code></pre></div>
</div>
</body>
</html>
11 changes: 6 additions & 5 deletions docs/Options.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Options.lhs'>RE/Options</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Options.lhs'>RE/Options</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE GeneralizedNewtypeDeriving #-}</span>
<span class="ot">{-# LANGUAGE TemplateHaskell #-}</span>
<span class="ot">{-# LANGUAGE QuasiQuotes #-}</span>
Expand All @@ -63,10 +63,10 @@
<span class="kw">import </span><span class="dt">Language.Haskell.TH.Syntax</span></code></pre></div>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="kw">data</span> <span class="dt">Options_</span> r c e <span class="fu">=</span>
<span class="dt">Options</span>
{<span class="ot"> _options_mode ::</span> <span class="dt">Mode</span>
,<span class="ot"> _options_macs ::</span> <span class="dt">Macros</span> r
,<span class="ot"> _options_comp ::</span> c
,<span class="ot"> _options_exec ::</span> e
{<span class="ot"> _options_mode ::</span> <span class="fu">!</span><span class="dt">Mode</span>
,<span class="ot"> _options_macs ::</span> <span class="fu">!</span>(<span class="dt">Macros</span> r)
,<span class="ot"> _options_comp ::</span> <span class="fu">!</span>c
,<span class="ot"> _options_exec ::</span> <span class="fu">!</span>e
}
<span class="kw">deriving</span> (<span class="dt">Show</span>)</code></pre></div>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="kw">class</span> <span class="dt">IsOption</span> o r c e <span class="fu">|</span>
Expand Down Expand Up @@ -96,5 +96,6 @@
<span class="dt">MultilineInsensitive</span> <span class="ot">-&gt;</span> conE <span class="ch">&#39;MultilineInsensitive</span>
<span class="dt">BlockSensitive</span> <span class="ot">-&gt;</span> conE <span class="ch">&#39;BlockSensitive</span>
<span class="dt">BlockInsensitive</span> <span class="ot">-&gt;</span> conE <span class="ch">&#39;BlockInsensitive</span></code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/Replace.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Replace.lhs'>RE/Replace</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Replace.lhs'>RE/Replace</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE QuasiQuotes #-}</span>
<span class="ot">{-# LANGUAGE OverloadedStrings #-}</span>
<span class="ot">{-# LANGUAGE RecordWildCards #-}</span>
Expand Down Expand Up @@ -475,5 +475,6 @@
)
<span class="ot">=&gt;</span> source <span class="ot">-&gt;</span> <span class="dt">String</span> <span class="ot">-&gt;</span> target
(<span class="fu">$=~</span>) <span class="fu">=</span> (<span class="fu">=~</span>)</code></pre></div>
</div>
</body>
</html>
3 changes: 2 additions & 1 deletion docs/Sed.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/Tools/Sed.lhs'>RE/Tools/Sed</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/Tools/Sed.lhs'>RE/Tools/Sed</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE RecordWildCards #-}</span>
<span class="ot">{-# LANGUAGE FlexibleContexts #-}</span>

Expand Down Expand Up @@ -96,5 +96,6 @@
<span class="ot">write_file ::</span> FilePath <span class="ot">-&gt;</span> <span class="dt">LBS.ByteString</span> <span class="ot">-&gt;</span><span class="dt">IO</span> ()
write_file <span class="st">&quot;-&quot;</span> <span class="fu">=</span> LBS.putStr
write_file fp <span class="fu">=</span> LBS.writeFile fp</code></pre></div>
</div>
</body>
</html>
19 changes: 10 additions & 9 deletions docs/TestBench.html
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@
<link rel="stylesheet" href="lib/bs.css" type="text/css" />
</head>
<body>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/Lainepress/regex/blob/master/Text/RE/TestBench.lhs'>RE/TestBench</a></ol>
<ol class='breadcrumb'><li><a href='.' title='Home'>Home</a></li> &gt; <a title='source file' href='https://github.com/iconnect/regex/blob/master/Text/RE/TestBench.lhs'>RE/TestBench</a></ol><div class='content'>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE RecordWildCards #-}</span>
<span class="ot">{-# LANGUAGE GeneralizedNewtypeDeriving #-}</span>
<span class="ot">{-# LANGUAGE OverloadedStrings #-}</span>
Expand All @@ -72,7 +72,7 @@
, formatMacroSources
, formatMacroSource
, testMacroDescriptors
, regexSource
<span class="co">-- , regexSource</span>
) <span class="kw">where</span>

<span class="kw">import </span><span class="dt">Data.Array</span>
Expand All @@ -93,7 +93,7 @@ <h2 id="types">Types</h2>
<span class="kw">data</span> <span class="dt">RegexType</span>
<span class="fu">=</span> <span class="dt">TDFA</span> <span class="co">-- the TDFA back end</span>
<span class="fu">|</span> <span class="dt">PCRE</span> <span class="co">-- the PCRE back end</span>
<span class="kw">deriving</span> (<span class="dt">Eq</span>,<span class="dt">Ord</span>,<span class="dt">Show</span>)
<span class="kw">deriving</span> (<span class="dt">Bounded</span>,<span class="dt">Enum</span>,<span class="dt">Eq</span>,<span class="dt">Ord</span>,<span class="dt">Show</span>)

<span class="co">-- | do we need the captures in the RE or whould they be stripped out</span>
<span class="co">-- where possible</span>
Expand All @@ -110,12 +110,12 @@ <h2 id="types">Types</h2>
<span class="co">-- description</span>
<span class="kw">data</span> <span class="dt">MacroDescriptor</span> <span class="fu">=</span>
<span class="dt">MacroDescriptor</span>
{<span class="ot"> _md_source ::</span> <span class="dt">RegexSource</span> <span class="co">-- ^ the RE</span>
,<span class="ot"> _md_samples ::</span> [<span class="dt">String</span>] <span class="co">-- ^ some sample matches</span>
,<span class="ot"> _md_counter_samples ::</span> [<span class="dt">String</span>] <span class="co">-- ^ some sample non-matches</span>
,<span class="ot"> _md_test_results ::</span> [<span class="dt">TestResult</span>] <span class="co">-- ^ validation test results</span>
,<span class="ot"> _md_parser ::</span> <span class="dt">Maybe</span> <span class="dt">FunctionID</span> <span class="co">-- ^ WA, the parser function</span>
,<span class="ot"> _md_description ::</span> <span class="dt">String</span> <span class="co">-- ^ summary comment</span>
{<span class="ot"> _md_source ::</span> <span class="fu">!</span><span class="dt">RegexSource</span> <span class="co">-- ^ the RE</span>
,<span class="ot"> _md_samples ::</span> <span class="fu">!</span>[<span class="dt">String</span>] <span class="co">-- ^ some sample matches</span>
,<span class="ot"> _md_counter_samples ::</span> <span class="fu">!</span>[<span class="dt">String</span>] <span class="co">-- ^ some sample non-matches</span>
,<span class="ot"> _md_test_results ::</span> <span class="fu">!</span>[<span class="dt">TestResult</span>] <span class="co">-- ^ validation test results</span>
,<span class="ot"> _md_parser ::</span> <span class="fu">!</span>(<span class="dt">Maybe</span> <span class="dt">FunctionID</span>) <span class="co">-- ^ WA, the parser function</span>
,<span class="ot"> _md_description ::</span> <span class="fu">!</span><span class="dt">String</span> <span class="co">-- ^ summary comment</span>
}
<span class="kw">deriving</span> (<span class="dt">Show</span>)

Expand Down Expand Up @@ -526,5 +526,6 @@ <h2 id="test-test_neg">test', test_neg'</h2>
mid_s <span class="fu">=</span> _MacroID mid
neg_s <span class="fu">=</span> <span class="kw">if</span> is_neg <span class="kw">then</span> <span class="st">&quot;-ve&quot;</span> <span class="kw">else</span> <span class="st">&quot;+ve&quot;</span><span class="ot"> ::</span> <span class="dt">String</span>
rty_s <span class="fu">=</span> show rty</code></pre></div>
</div>
</body>
</html>
Loading