.
25 |
26 | -- $use
27 | --
28 | -- This module just provides a brief overview of the regex package. You
29 | -- will need to import one of the API modules of which there is a choice
30 | -- which will depend upon two factors:
31 | --
32 | -- * Which flavour of regular expression do you want to use? If you need
33 | -- Posix flavour REs then you will want the TDFA modules, otherwise its
34 | -- PCRE for Perl-style REs.
35 | --
36 | -- * What type of text do you want to match: (slow) @String@s, @ByteString@,
37 | -- @ByteString.Lazy@, @Text@, @Text.Lazy@ or the anachronistic @Seq Char@
38 | -- or indeed some good old-fashioned polymorphic operators?
39 | --
40 | -- While we aim to provide all combinations of these choices, some of them
41 | -- are currently not available. In the regex package we have:
42 | --
43 | -- * "Text.RE.TDFA.ByteString"
44 | -- * "Text.RE.TDFA.ByteString.Lazy"
45 | -- * "Text.RE.ZeInternals.TDFA"
46 | -- * "Text.RE.TDFA.Sequence"
47 | -- * "Text.RE.TDFA.String"
48 | -- * "Text.RE.TDFA.Text"
49 | -- * "Text.RE.TDFA.Text.Lazy"
50 | -- * "Text.RE.TDFA"
51 | --
52 | -- The PCRE modules are contained in the separate @regex-with-pcre@
53 | -- package:
54 | --
55 | -- * Text.RE.PCRE.ByteString
56 | -- * Text.RE.PCRE.ByteString.Lazy
57 | -- * Text.RE.ZeInternals.PCRE
58 | -- * Text.RE.PCRE.Sequence
59 | -- * Text.RE.PCRE.String
60 | -- * Text.RE.PCRE
61 |
62 | -- $further
63 | -- For more specialist applications we have the following:
64 | --
65 | -- * "Text.RE.REOptions" for specifying back-end specific options;
66 | -- * "Text.RE.Replace" for the full text-replacement toolkit;
67 | -- * "Text.RE.TestBench" for building up, testing and documenting;
68 | -- macro environments for use in REs;
69 | -- * "Text.RE.Tools" for an AWK-like text-processing toolkit.
70 |
--------------------------------------------------------------------------------
/Text/RE/REOptions.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 | {-# LANGUAGE FunctionalDependencies #-}
5 | {-# LANGUAGE CPP #-}
6 | #if __GLASGOW_HASKELL__ >= 800
7 | {-# LANGUAGE TemplateHaskellQuotes #-}
8 | {-# LANGUAGE DeriveLift #-}
9 | {-# LANGUAGE StandaloneDeriving #-}
10 | #else
11 | {-# LANGUAGE QuasiQuotes #-}
12 | {-# LANGUAGE TemplateHaskell #-}
13 | #endif
14 |
15 | module Text.RE.REOptions
16 | (
17 | -- * The Options Tutorial
18 | -- $tutorial
19 |
20 | -- * 'SimpleREOptions'
21 | SimpleREOptions(..)
22 | -- * 'REOptions_'
23 | , REOptions_(..)
24 | -- * The Macro Tables
25 | , Macros
26 | , MacroID(..)
27 | , emptyMacros
28 | ) where
29 |
30 | import qualified Data.HashMap.Strict as HM
31 | import Data.Hashable
32 | import Data.String
33 | import Language.Haskell.TH.Syntax
34 | \end{code}
35 |
36 |
37 | The RE Options
38 | --------------
39 |
40 | \begin{code}
41 | -- | the default API uses these simple, universal RE options,
42 | -- which get auto-converted into the appropriate back-end 'REOptions_'
43 | data SimpleREOptions
44 | = MultilineSensitive -- ^ case-sensitive with ^ and $ matching the start and end of a line
45 | | MultilineInsensitive -- ^ case-insensitive with ^ and $ matsh the start and end of a line
46 | | BlockSensitive -- ^ case-sensitive with ^ and $ matching the start and end of the input text
47 | | BlockInsensitive -- ^ case-insensitive with ^ and $ matching the start and end of the input text
48 | deriving (Bounded,Enum,Eq,Ord,Show)
49 | \end{code}
50 |
51 | \begin{code}
52 | -- | we need to use this in the quasi quoters to specify @SimpleREOptions@
53 | -- selected by the quasi quoter
54 | deriving instance Lift SimpleREOptions
55 | \end{code}
56 |
57 | \begin{code}
58 | -- | the general options for an RE are dependent on which back end is
59 | -- being used and are parameterised over the @RE@ type for the back end,
60 | -- and its @CompOption@ and @ExecOption@ types (the compile-time and
61 | -- execution time options, respectively); each back end will define an
62 | -- @REOptions@ type that fills out these three type parameters with the
63 | -- appropriate types (see, for example, "Text.RE.TDFA")
64 | data REOptions_ r c e =
65 | REOptions
66 | { optionsMacs :: !(Macros r) -- ^ the available TestBench RE macros
67 | , optionsComp :: !c -- ^ the back end compile-time options
68 | , optionsExec :: !e -- ^ the back end execution-time options
69 | }
70 | deriving (Show)
71 | \end{code}
72 |
73 |
74 | The Macro Tables
75 | ----------------
76 |
77 | \begin{code}
78 | -- | our macro tables are parameterised over the back end @RE@ type and
79 | -- and just associate each @MacroID@ with an @RE@ (which may in turn
80 | -- contain macros to be expanded)
81 | type Macros r = HM.HashMap MacroID r
82 | \end{code}
83 |
84 | \begin{code}
85 | -- | @MacroID@ is just a wrapped @String@ type with an @IsString@
86 | -- instance
87 | newtype MacroID =
88 | MacroID { getMacroID :: String }
89 | deriving (IsString,Ord,Eq,Show)
90 | \end{code}
91 |
92 | \begin{code}
93 | -- | @MacroID@ is used with @HM.HashMap@ to build macro lookup tables
94 | instance Hashable MacroID where
95 | hashWithSalt i = hashWithSalt i . getMacroID
96 | \end{code}
97 |
98 | \begin{code}
99 | -- | a macro table containing no entries
100 | emptyMacros :: Macros r
101 | emptyMacros = HM.empty
102 | \end{code}
103 |
104 |
105 | \begin{code}
106 | -- $tutorial
107 | -- This API module provides the generic types used to specify the options
108 | -- when compiling REs for each of the backl ends.
109 | --
110 | -- See the tutorials at http://re-tutorial-options.regex.uk
111 | \end{code}
112 |
--------------------------------------------------------------------------------
/Text/RE/Replace.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.Replace
2 | (
3 | -- * The Replacing Tutorial
4 | -- $tutorial
5 |
6 | -- * replaceAll
7 | replaceAll
8 | , replaceAllCaptures
9 | , replaceAllCaptures_
10 | , replaceAllCapturesM
11 | -- * replace
12 | , replace
13 | , replaceCaptures
14 | , replaceCaptures_
15 | , replaceCapturesM
16 | -- * REContext and RELocation
17 | , REContext(..)
18 | , RELocation(..)
19 | , isTopLocation
20 | -- * Matches
21 | , Matches(..)
22 | , anyMatches
23 | , countMatches
24 | , matches
25 | , mainCaptures
26 | -- * Match
27 | , Match(..)
28 | , noMatch
29 | , emptyMatchArray
30 | , matched
31 | , matchedText
32 | , matchCapture
33 | , matchCaptures
34 | , (!$$)
35 | , captureText
36 | , (!$$?)
37 | , captureTextMaybe
38 | , (!$)
39 | , capture
40 | , (!$?)
41 | , captureMaybe
42 | , convertMatchText
43 | -- * Capture
44 | , Capture(..)
45 | , hasCaptured
46 | , capturePrefix
47 | , captureSuffix
48 | -- * CaptureID
49 | , CaptureID(..)
50 | , CaptureNames
51 | , noCaptureNames
52 | , CaptureName(..)
53 | , CaptureOrdinal(..)
54 | , findCaptureID
55 | -- * Replace and ReplaceMethods
56 | , Replace(..)
57 | , ReplaceMethods(..)
58 | , replaceMethods
59 | ) where
60 |
61 | import Text.RE.ZeInternals.Replace
62 | import Text.RE.ZeInternals.Types.Capture
63 | import Text.RE.ZeInternals.Types.CaptureID
64 | import Text.RE.ZeInternals.Types.Match
65 | import Text.RE.ZeInternals.Types.Matches
66 |
67 | -- $tutorial
68 | -- This API module covers the specialised regex tools for doing general
69 | -- editing on text, including the internal details of the 'Matches' and
70 | -- 'Match' types and the associated functions for extracting captures
71 | -- and applying functions to them to transform the subject text.
72 | --
73 | -- See the tutorials at http://re-tutorial-replacing.regex.uk
74 |
--------------------------------------------------------------------------------
/Text/RE/Summa.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.Summa
2 | ( -- $collection
3 | module Text.RE.REOptions
4 | , module Text.RE.Replace
5 | , module Text.RE.TestBench
6 | , module Text.RE.Tools
7 | ) where
8 |
9 | import Text.RE.REOptions
10 | import Text.RE.Replace
11 | import Text.RE.TestBench
12 | import Text.RE.Tools
13 |
14 | -- $collection
15 | --
16 | -- This module collects together all of the generic regex APIs not
17 | -- exported by the principal API modules, specialised for each back end
18 | -- and text type. The regex API is modular with only the most common types
19 | -- and functions being exported by these modules but the remaining modules
20 | -- may be imported en masse by importing this module.
21 |
--------------------------------------------------------------------------------
/Text/RE/TestBench.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Text.RE.TestBench
5 | (
6 | -- * The Test Bench Tutorial
7 | -- $tutorial
8 |
9 | -- * The Test Bench
10 | MacroEnv
11 | , MacroDescriptor(..)
12 | , RegexSource(..)
13 | , WithCaptures(..)
14 | , RegexType
15 | , isTDFA
16 | , isPCRE
17 | , presentRegexType
18 | -- ** Constructing a MacrosEnv
19 | , mkMacros
20 | -- ** Formatting Macros
21 | , formatMacroTable
22 | , formatMacroSummary
23 | , formatMacroSources
24 | , formatMacroSource
25 | , mdRegexSource
26 | -- ** Formatting Macros
27 | , testMacroEnv
28 | , runTests
29 | , runTests'
30 | -- * The Parsers
31 | , module Text.RE.TestBench.Parsers
32 | -- * The Match Type
33 | , Match
34 | ) where
35 |
36 | import Text.RE.TestBench.Parsers
37 | import Text.RE.ZeInternals.TestBench
38 | import Text.RE.ZeInternals.Types.Match
39 |
40 | -- $tutorial
41 | -- This API module provides a test bench for developing, documenting and
42 | -- testing regex RE macros.
43 | --
44 | -- See the tutorials at http://re-tutorial-testbench.regex.uk
45 |
--------------------------------------------------------------------------------
/Text/RE/TestBench/Parsers.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.TestBench.Parsers
2 | ( parseInteger
3 | , parseHex
4 | , parseDouble
5 | , parseString
6 | , parseSimpleString
7 | , parseDate
8 | , parseSlashesDate
9 | , parseTimeOfDay
10 | , parseTimeZone
11 | , parseDateTime
12 | , parseDateTime8601
13 | , parseDateTimeCLF
14 | , parseShortMonth
15 | , shortMonthArray
16 | , IPV4Address
17 | , parseIPv4Address
18 | , Severity(..)
19 | , parseSeverity
20 | , severityKeywords
21 | ) where
22 |
23 | import Text.RE.ZeInternals.TestBench.Parsers
24 |
--------------------------------------------------------------------------------
/Text/RE/Tools.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
2 |
3 | module Text.RE.Tools
4 | (
5 | -- * The Tools Tutorial
6 | -- $tutorial
7 |
8 | -- * Sed
9 | sed
10 | , sed'
11 | -- * Grep
12 | , grep
13 | , Verbosity(..)
14 | , Line(..)
15 | , grepLines
16 | , grepFilter
17 | , GrepScript
18 | , grepWithScript
19 | , report
20 | , linesMatched
21 | -- * Lex
22 | , alex
23 | , alex'
24 | -- * Find
25 | , FindMethods(..)
26 | , findMatches_
27 | , findMatches_'
28 | -- * IsRegex
29 | , IsRegex(..)
30 | , SearchReplace(..)
31 | , searchReplaceAll
32 | , searchReplaceFirst
33 | -- * Edit
34 | , Edits(..)
35 | , Edit(..)
36 | , LineEdit(..)
37 | , applyEdits
38 | , applyEdit
39 | , applyLineEdit
40 | -- * LineNo
41 | , LineNo(..)
42 | , firstLine
43 | , getLineNo
44 | , lineNo
45 | -- * Replace
46 | , module Text.RE.Replace
47 | ) where
48 |
49 | import Text.RE.Replace
50 | import Text.RE.Tools.Edit
51 | import Text.RE.Tools.Find
52 | import Text.RE.Tools.Grep
53 | import Text.RE.Tools.Lex
54 | import Text.RE.Tools.Sed
55 |
56 | -- $tutorial
57 | -- This API module provides some familiar RE tools on top of the core
58 | -- package functions and types.
59 | --
60 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
61 |
--------------------------------------------------------------------------------
/Text/RE/Tools/Find.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE NoImplicitPrelude #-}
3 | {-# LANGUAGE RecordWildCards #-}
4 | {-# LANGUAGE CPP #-}
5 | #if __GLASGOW_HASKELL__ >= 800
6 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
7 | #endif
8 |
9 | module Text.RE.Tools.Find
10 | (
11 | -- * Find
12 | -- $tutorial
13 | FindMethods(..)
14 | , findMatches_
15 | , findMatches_'
16 | -- * IsRegex
17 | , IsRegex(..)
18 | , SearchReplace(..)
19 | , searchReplaceAll
20 | , searchReplaceFirst
21 | -- * Replace
22 | , module Text.RE.Replace
23 | ) where
24 |
25 | import qualified Data.List as L
26 | import Prelude.Compat
27 | import Text.RE.Replace
28 | import Text.RE.Tools.IsRegex
29 | \end{code}
30 |
31 |
32 | \begin{code}
33 | -- | as we don't want the @directory@ and FilePath dependencies
34 | -- we will abstract the three calls we need into this record type
35 | data FindMethods s =
36 | FindMethods
37 | { doesDirectoryExistDM :: s -> IO Bool -- ^ doesDirectoryExist from
38 | -- System.Directory
39 | , listDirectoryDM :: s -> IO [s] -- ^ either getDirectoryContents
40 | -- or listDirectory from
41 | -- System.Directory
42 | , combineDM :: s -> s -> s -- ^ > from System.FilePath
43 | }
44 | \end{code}
45 |
46 |
47 | \begin{code}
48 | -- | recursively list all files whose filename matches given RE,
49 | -- sorting the list into ascending order; if the argument path has a
50 | -- trailing '/' then it will be removed
51 | findMatches_ :: IsRegex re s => FindMethods s -> re -> s -> IO [s]
52 | findMatches_ fm = findMatches_' fm L.sort matched
53 |
54 | -- | recursively list all files whose filename matches given RE,
55 | -- using the given function to determine which matches to accept
56 | findMatches_' :: IsRegex re s
57 | => FindMethods s -- ^ the directory and filepath methods
58 | -> ([s]->[s]) -- ^ result post-processing function
59 | -> (Match s->Bool) -- ^ filtering function
60 | -> re -- ^ re to be matched against the leaf filename
61 | -> s -- ^ root directory of the search
62 | -> IO [s]
63 | findMatches_' fm srt tst re fp = srt <$> find_ fm tst re (packR "") fp
64 |
65 | find_ :: IsRegex re s
66 | => FindMethods s
67 | -> (Match s->Bool)
68 | -> re
69 | -> s
70 | -> s
71 | -> IO [s]
72 | find_ fm@FindMethods{..} tst re fn fp = do
73 | is_dir <- doesDirectoryExistDM fp
74 | case is_dir of
75 | True -> do
76 | fns <- filter ordinary <$> listDirectoryDM fp
77 | concat <$>
78 | mapM (uncurry $ find_ fm tst re) [ (fn_,abs_path fn_) | fn_<-fns ]
79 | False -> return [ fp | lengthR fp /= 0 && tst (matchOnce re fn) ]
80 | where
81 | abs_path fn_ = fp `combineDM` fn_
82 | ordinary fn_ = not $ fn_ `elem` [packR ".",packR ".."]
83 | \end{code}
84 |
85 | \begin{code}
86 | -- $tutorial
87 | -- The Find toolkit traverses directory trees invoking actions for each
88 | -- file that matches a RE.
89 | --
90 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
91 | \end{code}
92 |
--------------------------------------------------------------------------------
/Text/RE/Tools/Grep.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE NoImplicitPrelude #-}
3 | {-# LANGUAGE RecordWildCards #-}
4 | {-# LANGUAGE FlexibleContexts #-}
5 | {-# LANGUAGE CPP #-}
6 |
7 | module Text.RE.Tools.Grep
8 | (
9 | -- Grep
10 | -- $tutorial
11 | grep
12 | , Verbosity(..)
13 | , Line(..)
14 | , grepLines
15 | , grepFilter
16 | , GrepScript
17 | , grepWithScript
18 | , report
19 | , linesMatched
20 | -- * IsRegex
21 | , IsRegex(..)
22 | , SearchReplace(..)
23 | , searchReplaceAll
24 | , searchReplaceFirst
25 | -- * LineNo
26 | , LineNo(..)
27 | , firstLine
28 | , getLineNo
29 | , lineNo
30 | -- * Replace
31 | , module Text.RE.Replace
32 | ) where
33 |
34 | import qualified Data.ByteString.Lazy.Char8 as LBS
35 | import Prelude.Compat
36 | import Text.Printf
37 | import Text.RE.Replace
38 | import Text.RE.Tools.IsRegex
39 | import Text.RE.ZeInternals.Types.LineNo
40 | \end{code}
41 |
42 |
43 | \begin{code}
44 | -- | operates a bit like classic @grep@ printing out the lines matched
45 | grep :: IsRegex re LBS.ByteString => Verbosity -> re -> FilePath -> IO ()
46 | grep v rex fp = grepLines rex fp >>= putStr . report v
47 | \end{code}
48 |
49 | \begin{code}
50 | -- | specifies whether to return the lines matched or missed
51 | data Verbosity
52 | = LinesMatched
53 | | LinesNotMatched
54 | deriving (Show,Eq,Ord)
55 | \end{code}
56 |
57 | \begin{code}
58 | -- | 'grepLines' returns a 'Line' for each line in the file, listing all
59 | -- of the 'Matches' for that line
60 | data Line s =
61 | Line
62 | { getLineNumber :: LineNo -- ^ the 'LineNo' for this line
63 | , getLineMatches :: Matches s -- ^ all the 'Matches' of the RE on this line
64 | }
65 | deriving (Show)
66 | \end{code}
67 |
68 | \begin{code}
69 | -- | returns a 'Line' for each line in the file, enumerating all of the
70 | -- matches for that line
71 | grepLines :: IsRegex re LBS.ByteString
72 | => re
73 | -> FilePath
74 | -> IO [Line LBS.ByteString]
75 | grepLines rex fp = grepFilter rex <$> LBS.readFile fp
76 | \end{code}
77 |
78 | \begin{code}
79 | -- | returns a 'Line' for each line in the argument text, enumerating
80 | -- all of the matches for that line
81 | grepFilter :: IsRegex re s => re -> s -> [Line s]
82 | grepFilter rex = grepWithScript [(rex,mk)] . linesR
83 | where
84 | mk i mtchs = Just $ Line i mtchs
85 | \end{code}
86 |
87 | \begin{code}
88 | -- | a GrepScript lists RE-action associations, with the first RE to match
89 | -- a line selecting the action to be executed on each line in the file
90 | type GrepScript re s t = [(re,LineNo -> Matches s -> Maybe t)]
91 |
92 | -- | given a list of lines, apply the 'GrepScript' to each line of the file
93 | grepWithScript :: IsRegex re s => GrepScript re s t -> [s] -> [t]
94 | grepWithScript scr = loop firstLine
95 | where
96 | loop _ [] = []
97 | loop i (ln:lns) = seq i $ choose i ln lns scr
98 |
99 | choose i _ lns [] = loop (succ i) lns
100 | choose i ln lns ((rex,f):scr') = case f i $ matchMany rex ln of
101 | Nothing -> choose i ln lns scr'
102 | Just t -> t : loop (succ i) lns
103 |
104 | -- | generate a grep report from a list of 'Line'
105 | report :: Verbosity -> [Line LBS.ByteString] -> String
106 | report v = unlines . map fmt . linesMatched v
107 | where
108 | fmt Line{..} =
109 | printf "%05d %s" (getLineNo getLineNumber) $
110 | LBS.unpack $ matchesSource getLineMatches
111 |
112 | -- | given a 'velocity' flag filter out either the lines matched or not
113 | -- matched
114 | linesMatched :: Verbosity -> [Line s] -> [Line s]
115 | linesMatched v = filter $ f . anyMatches . getLineMatches
116 | where
117 | f = case v of
118 | LinesMatched -> id
119 | LinesNotMatched -> not
120 | \end{code}
121 |
122 | \begin{code}
123 | -- $tutorial
124 | -- The Grep toolkit matches REs against each line of a text.
125 | --
126 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
127 | \end{code}
128 |
--------------------------------------------------------------------------------
/Text/RE/Tools/IsRegex.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.Tools.IsRegex
2 | (
3 | -- * IsRegex
4 | -- $tutorial
5 | IsRegex(..)
6 | , SearchReplace(..)
7 | , searchReplaceAll
8 | , searchReplaceFirst
9 | ) where
10 |
11 | import Text.RE.ZeInternals.Types.IsRegex
12 |
13 | -- $tutorial
14 | -- The @IsRegex@ class abstracts over each regex back end and the
15 | -- text types they support allowing general regex tools to constructed.
16 | --
17 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
18 |
--------------------------------------------------------------------------------
/Text/RE/Tools/Lex.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.Tools.Lex
2 | (
3 | -- * Find
4 | -- $tutorial
5 | alex
6 | , alex'
7 | -- * IsRegex
8 | , IsRegex(..)
9 | , SearchReplace(..)
10 | , searchReplaceAll
11 | , searchReplaceFirst
12 | -- * Replace
13 | , module Text.RE.Replace
14 | ) where
15 |
16 | import Text.RE.Replace
17 | import Text.RE.Tools.IsRegex
18 | import Text.RE.ZeInternals.Tools.Lex
19 |
20 | -- $tutorial
21 | -- The Lex toolkit uses REs to identify tokens in a file, returning a
22 | -- list of tokens.
23 | --
24 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
25 |
--------------------------------------------------------------------------------
/Text/RE/Tools/Sed.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE NoImplicitPrelude #-}
3 | {-# LANGUAGE RecordWildCards #-}
4 | {-# LANGUAGE FlexibleContexts #-}
5 | {-# LANGUAGE CPP #-}
6 | #if __GLASGOW_HASKELL__ >= 800
7 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
8 | #endif
9 |
10 | module Text.RE.Tools.Sed
11 | (
12 | -- * Sed
13 | -- $tutorial
14 | sed
15 | , sed'
16 | -- * Edit
17 | , Edits(..)
18 | , Edit(..)
19 | , LineEdit(..)
20 | , applyEdits
21 | , applyEdit
22 | , applyLineEdit
23 | -- * IsRegex
24 | , IsRegex(..)
25 | , SearchReplace(..)
26 | , searchReplaceAll
27 | , searchReplaceFirst
28 | -- * LineNo
29 | , LineNo(..)
30 | , firstLine
31 | , getLineNo
32 | , lineNo
33 | -- * Replace
34 | , module Text.RE.Replace
35 | ) where
36 |
37 | import qualified Data.ByteString.Lazy.Char8 as LBS
38 | import Prelude.Compat
39 | import Text.RE.Replace
40 | import Text.RE.Tools.Edit
41 | \end{code}
42 |
43 |
44 | \begin{code}
45 | -- | read a file, apply an 'Edits' script to each line it and
46 | -- write the file out again; "-" is used to indicate standard input
47 | -- standard output as appropriate
48 | sed :: IsRegex re LBS.ByteString
49 | => Edits IO re LBS.ByteString
50 | -> FilePath
51 | -> FilePath
52 | -> IO ()
53 | sed escr i_fp o_fp = do
54 | lns <- LBS.lines <$> read_file i_fp
55 | lns' <- sequence
56 | [ applyEdits lno escr s
57 | | (lno,s)<-zip [firstLine..] lns
58 | ]
59 | write_file o_fp $ LBS.concat lns'
60 | \end{code}
61 |
62 |
63 | \begin{code}
64 | -- | apply an 'Edits' script to each line of the argument text
65 | sed' :: (IsRegex re a,Monad m,Functor m)
66 | => Edits m re a
67 | -> a
68 | -> m a
69 | sed' escr t = do
70 | mconcat <$> sequence
71 | [ applyEdits lno escr s
72 | | (lno,s)<-zip [firstLine..] $ linesR t
73 | ]
74 | \end{code}
75 |
76 |
77 | \begin{code}
78 | read_file :: FilePath -> IO LBS.ByteString
79 | read_file "-" = LBS.getContents
80 | read_file fp = LBS.readFile fp
81 |
82 | write_file :: FilePath -> LBS.ByteString ->IO ()
83 | write_file "-" = LBS.putStr
84 | write_file fp = LBS.writeFile fp
85 | \end{code}
86 |
87 |
88 | \begin{code}
89 | -- $tutorial
90 | -- The Sed toolkit applies @Edits@ scripts to each line
91 | -- of a text, running the actions and adjusting each line
92 | -- accordingly.
93 | --
94 | -- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
95 | \end{code}
96 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.ZeInternals
2 | (
3 | -- * The regex Internal Modules
4 | -- $internals
5 |
6 | -- * Text.RE.ZeInternals.AddCaptureNames
7 | addCaptureNames
8 | , addCaptureNamesToMatches
9 | , addCaptureNamesToMatch
10 | -- * Text.RE.ZeInternals.EscapeREString
11 | , escapeREString
12 | -- * Text.RE.ZeInternals.NamedCaptures
13 | , cp
14 | , extractNamedCaptures
15 | , idFormatTokenREOptions
16 | , Token
17 | , validToken
18 | , formatTokens
19 | , formatTokens'
20 | , formatTokens0
21 | , scan
22 | -- * Text.RE.ZeInternals.Replace
23 | , expandMacros
24 | -- * Text.RE.ZeInternals.PreludeMacros
25 | , PreludeMacro(..)
26 | , presentPreludeMacro
27 | , preludeMacros
28 | , preludeMacroTable
29 | , preludeMacroSummary
30 | , preludeMacroSources
31 | , preludeMacroSource
32 | , preludeMacroEnv
33 | -- * Text.RE.ZeInternals.SearchReplace
34 | , unsafeCompileSearchReplace_
35 | , compileSearchReplace_
36 | , compileSearchAndReplace_
37 | -- * Text.RE.ZeInternals.QQ
38 | , QQFailure(..)
39 | , qq0
40 | -- * Text.RE.ZeInternals.TestBench
41 | , mkTDFA
42 | , mkPCRE
43 | , badMacros
44 | ) where
45 |
46 | import Text.RE.ZeInternals.AddCaptureNames
47 | import Text.RE.ZeInternals.EscapeREString
48 | import Text.RE.ZeInternals.NamedCaptures
49 | import Text.RE.ZeInternals.PreludeMacros
50 | import Text.RE.ZeInternals.QQ
51 | import Text.RE.ZeInternals.Replace
52 | import Text.RE.ZeInternals.SearchReplace
53 | import Text.RE.ZeInternals.TestBench
54 |
55 | -- $internals
56 | -- This module contains just what the test suite (re-tests) in regex-examples
57 | -- needs from the package internals to do its job and the ZeInternals
58 | -- types and functions needed by the regex-with-pcre package
59 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/AddCaptureNames.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE DeriveDataTypeable #-}
3 | {-# LANGUAGE ExistentialQuantification #-}
4 | {-# LANGUAGE ScopedTypeVariables #-}
5 | {-# LANGUAGE OverloadedStrings #-}
6 |
7 | module Text.RE.ZeInternals.AddCaptureNames where
8 |
9 | import qualified Data.ByteString.Char8 as B
10 | import qualified Data.ByteString.Lazy.Char8 as LBS
11 | import Data.Dynamic
12 | import Data.Maybe
13 | import qualified Data.Sequence as S
14 | import qualified Data.Text as T
15 | import qualified Data.Text.Lazy as TL
16 | import Prelude.Compat
17 | import Text.RE.ZeInternals.Types.CaptureID
18 | import Text.RE.ZeInternals.Types.Match
19 | import Text.RE.ZeInternals.Types.Matches
20 | import Unsafe.Coerce
21 |
22 |
23 | -- | a convenience function used by the API modules to insert
24 | -- capture names extracted from the parsed RE into the (*=~) result
25 | addCaptureNamesToMatches :: CaptureNames -> Matches a -> Matches a
26 | addCaptureNamesToMatches cnms mtchs =
27 | mtchs { allMatches = map (addCaptureNamesToMatch cnms) $ allMatches mtchs }
28 |
29 | -- | a convenience function used by the API modules to insert
30 | -- capture names extracted from the parsed RE into the (?=~) result
31 | addCaptureNamesToMatch :: CaptureNames -> Match a -> Match a
32 | addCaptureNamesToMatch cnms mtch = mtch { captureNames = cnms }
33 |
34 | -- | a hairy dynamically-typed function used with the legacy (=~) and (=~~)
35 | -- to see if it can/should add the capture names extracted from the RE
36 | -- into the polymorphic result of the operator (it does for any Match
37 | -- or Matches type, provided it is parameterised over a recognised type).
38 | -- The test suite is all over this one, testing all of these cases.
39 | addCaptureNames :: Typeable a => CaptureNames -> a -> a
40 | addCaptureNames cnms x = fromMaybe x $ listToMaybe $ catMaybes
41 | [ test_match x ( proxy :: String )
42 | , test_matches x ( proxy :: String )
43 | , test_match x ( proxy :: B.ByteString )
44 | , test_matches x ( proxy :: B.ByteString )
45 | , test_match x ( proxy :: LBS.ByteString )
46 | , test_matches x ( proxy :: LBS.ByteString )
47 | , test_match x ( proxy :: T.Text )
48 | , test_matches x ( proxy :: T.Text )
49 | , test_match x ( proxy :: TL.Text )
50 | , test_matches x ( proxy :: TL.Text )
51 | , test_match x ( proxy :: S.Seq Char )
52 | , test_matches x ( proxy :: S.Seq Char )
53 | ]
54 | where
55 | test_match :: Typeable t => r -> t -> Maybe r
56 | test_match r t = f r t $ addCaptureNamesToMatch cnms <$> fromDynamic dyn
57 | where
58 | f :: r' -> t' -> Maybe (Match t') -> Maybe r'
59 | f _ _ = unsafeCoerce
60 |
61 | test_matches :: Typeable t => r -> t -> Maybe r
62 | test_matches r t = f r t $ addCaptureNamesToMatches cnms <$> fromDynamic dyn
63 | where
64 | f :: r' -> t' -> Maybe (Matches t') -> Maybe r'
65 | f _ _ = unsafeCoerce
66 |
67 | dyn :: Dynamic
68 | dyn = toDyn x
69 |
70 | proxy :: a
71 | proxy = error "addCaptureNames"
72 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/EscapeREString.hs:
--------------------------------------------------------------------------------
1 | module Text.RE.ZeInternals.EscapeREString where
2 |
3 | -- | Convert a string into a regular expression that will match that
4 | -- string
5 | escapeREString :: String -> String
6 | escapeREString = foldr esc []
7 | where
8 | esc c t | isMetaChar c = '\\' : c : t
9 | | otherwise = c : t
10 |
11 | -- | returns True iff the character is an RE meta character
12 | -- ('[', '*', '{', etc.)
13 | isMetaChar :: Char -> Bool
14 | isMetaChar c = case c of
15 | '^' -> True
16 | '\\' -> True
17 | '.' -> True
18 | '|' -> True
19 | '*' -> True
20 | '?' -> True
21 | '+' -> True
22 | '(' -> True
23 | ')' -> True
24 | '[' -> True
25 | ']' -> True
26 | '{' -> True
27 | '}' -> True
28 | '$' -> True
29 | _ -> False
30 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/QQ.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveDataTypeable #-}
2 |
3 | module Text.RE.ZeInternals.QQ where
4 |
5 | import Control.Exception
6 | import Data.Typeable
7 | import Language.Haskell.TH.Quote
8 |
9 |
10 | -- | used to throw an exception reporting an abuse of a quasi quoter
11 | data QQFailure =
12 | QQFailure
13 | { _qqf_context :: String -- ^ in what context was the quasi quoter used
14 | , _qqf_component :: String -- ^ how was the quasi quoter being abused
15 | }
16 | deriving (Show,Typeable)
17 |
18 | instance Exception QQFailure where
19 |
20 | -- | a quasi quoter that can be used in no context (to be extended with
21 | -- the appropriate quasi quoter parser)
22 | qq0 :: String -> QuasiQuoter
23 | qq0 ctx =
24 | QuasiQuoter
25 | { quoteExp = const $ throw $ QQFailure ctx "expression"
26 | , quotePat = const $ throw $ QQFailure ctx "pattern"
27 | , quoteType = const $ throw $ QQFailure ctx "type"
28 | , quoteDec = const $ throw $ QQFailure ctx "declaration"
29 | }
30 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE RecordWildCards #-}
3 | {-# LANGUAGE CPP #-}
4 | #if __GLASGOW_HASKELL__ >= 800
5 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
6 | {-# LANGUAGE TemplateHaskellQuotes #-}
7 | #else
8 | {-# LANGUAGE QuasiQuotes #-}
9 | {-# LANGUAGE TemplateHaskell #-}
10 | #endif
11 | {-# OPTIONS_GHC -fno-warn-orphans #-}
12 | {-# OPTIONS_GHC -fno-warn-unused-imports #-}
13 |
14 | module Text.RE.ZeInternals.SearchReplace
15 | ( unsafeCompileSearchReplace_
16 | , compileSearchReplace_
17 | , compileSearchAndReplace_
18 | ) where
19 |
20 | import Control.Monad.Fail
21 | import qualified Data.HashMap.Strict as HMS
22 | import Prelude.Compat hiding (fail)
23 | import Text.RE.ZeInternals.NamedCaptures
24 | import Text.RE.ZeInternals.Replace
25 | import Text.RE.ZeInternals.Types.Capture
26 | import Text.RE.ZeInternals.Types.CaptureID
27 | import Text.RE.ZeInternals.Types.Matches
28 | import Text.RE.ZeInternals.Types.Poss
29 | import Text.RE.ZeInternals.Types.SearchReplace
30 | import qualified Text.Regex.TDFA as TDFA
31 |
32 |
33 | -- | warapper on 'compileSearchReplace_' that will generate an error
34 | -- if any compilation errors are found
35 | unsafeCompileSearchReplace_ :: (String->s)
36 | -> (String->Either String re)
37 | -> String
38 | -> SearchReplace re s
39 | unsafeCompileSearchReplace_ pk cf = poss err id . compileSearchReplace_ pk cf
40 | where
41 | err msg = error $ "unsafeCompileSearchReplace_: " ++ msg
42 |
43 | -- | compile a SearchReplace template generating errors if the RE or
44 | -- the template are not well formed -- all capture references being checked
45 | compileSearchReplace_ :: (Monad m,MonadFail m,Functor m)
46 | => (String->s)
47 | -> (String->Either String re)
48 | -> String
49 | -> m (SearchReplace re s)
50 | compileSearchReplace_ pack compile_re sr_tpl = poss fail return $ do
51 | case mainCaptures $ sr_tpl $=~ "///" of
52 | [cap] ->
53 | compileSearchAndReplace_ pack compile_re
54 | (capturePrefix cap) (captureSuffix cap)
55 | _ -> Eek $ "bad search-replace template syntax: " ++ sr_tpl
56 |
57 | -- | compile 'SearcgReplace' from two strings containing the RE
58 | -- and the replacement template
59 | compileSearchAndReplace_ :: (Monad m,MonadFail m,Functor m)
60 | => (String->s)
61 | -> (String->Either String re)
62 | -> String
63 | -> String
64 | -> m (SearchReplace re s)
65 | compileSearchAndReplace_ pack compile_re re_s tpl = either fail return $ do
66 | re <- compile_re re_s
67 | ((n,cnms),_) <- extractNamedCaptures re_s
68 | mapM_ (check n cnms) $ templateCaptures id tpl
69 | return $ SearchReplace re $ pack tpl
70 | where
71 | check :: Int -> CaptureNames -> CaptureID -> Either String ()
72 | check n cnms cid = case cid of
73 | IsCaptureOrdinal co -> check_co n co
74 | IsCaptureName cn -> check_cn cnms cn
75 |
76 | check_co n (CaptureOrdinal i) = case i <= n of
77 | True -> return ()
78 | False -> Left $ "capture ordinal out of range: " ++
79 | show i ++ " >= " ++ show n
80 |
81 | check_cn cnms cnm = case cnm `HMS.member` cnms of
82 | True -> return ()
83 | False -> Left $ "capture name not defined: " ++
84 | show (getCaptureName cnm)
85 |
86 | ($=~) :: String -> String -> Matches String
87 | ($=~) = (TDFA.=~)
88 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE CPP #-}
3 | #if __GLASGOW_HASKELL__ >= 800
4 | {-# LANGUAGE TemplateHaskellQuotes #-}
5 | #else
6 | {-# LANGUAGE QuasiQuotes #-}
7 | {-# LANGUAGE TemplateHaskell #-}
8 | #endif
9 |
10 | module Text.RE.ZeInternals.SearchReplace.PCRE
11 | ( ed
12 | , edMS
13 | , edMI
14 | , edBS
15 | , edBI
16 | , edMultilineSensitive
17 | , edMultilineInsensitive
18 | , edBlockSensitive
19 | , edBlockInsensitive
20 | , ed_
21 | ) where
22 |
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Prelude.Compat
26 | import Text.RE.REOptions
27 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
28 |
29 |
30 | -- | the @[ed| ... /// ... |]@ quasi quoters
31 | ed
32 | , edMS
33 | , edMI
34 | , edBS
35 | , edBI
36 | , edMultilineSensitive
37 | , edMultilineInsensitive
38 | , edBlockSensitive
39 | , edBlockInsensitive
40 | , ed_ :: QuasiQuoter
41 |
42 | ed = ed' cast $ Just minBound
43 | edMS = edMultilineSensitive
44 | edMI = edMultilineInsensitive
45 | edBS = edBlockSensitive
46 | edBI = edBlockInsensitive
47 | edMultilineSensitive = ed' cast $ Just MultilineSensitive
48 | edMultilineInsensitive = ed' cast $ Just MultilineInsensitive
49 | edBlockSensitive = ed' cast $ Just BlockSensitive
50 | edBlockInsensitive = ed' cast $ Just BlockInsensitive
51 | ed_ = ed' cast Nothing
52 |
53 | cast :: Q Exp
54 | cast = [|id|]
55 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/ByteString.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.ByteString
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.ByteString.Char8 as B
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE B.ByteString|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE B.ByteString|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/ByteString/Lazy.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.ByteString.Lazy
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.ByteString.Lazy.Char8 as LBS
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE LBS.ByteString|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE LBS.ByteString|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/Sequence.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.Sequence
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Sequence as S
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE (S.Seq Char)|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE (S.Seq Char)|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/String.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.String
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 |
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE String|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE String|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/Text.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.Text
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Text as T
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE T.Text|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE T.Text|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCRE/Text/Lazy.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.PCRE.Text.Lazy
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Text.Lazy as TL
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.PCRE
28 | import Text.RE.ZeInternals.SearchReplace.PCREEdPrime
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE TL.Text|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE TL.Text|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/PCREEdPrime.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE FlexibleContexts #-}
3 | {-# LANGUAGE CPP #-}
4 | #if __GLASGOW_HASKELL__ >= 800
5 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
6 | {-# LANGUAGE TemplateHaskellQuotes #-}
7 | #else
8 | {-# LANGUAGE QuasiQuotes #-}
9 | {-# LANGUAGE TemplateHaskell #-}
10 | #endif
11 |
12 | module Text.RE.ZeInternals.SearchReplace.PCREEdPrime
13 | ( ed'
14 | ) where
15 |
16 | import Language.Haskell.TH
17 | import Language.Haskell.TH.Quote
18 | import Prelude.Compat
19 | import Text.RE.REOptions
20 | import Text.RE.Replace
21 | import Text.RE.Tools.IsRegex
22 | import Text.RE.ZeInternals
23 | import Text.RE.ZeInternals.PCRE
24 | import Text.RE.ZeInternals.Types.Poss
25 |
26 |
27 | -- | construct a quasi quoter from a casting function and @Just sro@
28 | -- if the options are known, otherwise a function take takes the
29 | -- 'SimpleREOptions' and constructs the 'SearchReplace' template
30 | ed' :: Q Exp -> Maybe SimpleREOptions -> QuasiQuoter
31 | ed' qe mb = case mb of
32 | Nothing ->
33 | (qq0 "ed'")
34 | { quoteExp = parse minBound $ \rs -> AppE <$> qe <*> [|flip unsafe_compile_sr rs|]
35 | }
36 | Just sro ->
37 | (qq0 "ed'")
38 | { quoteExp = parse sro $ \rs -> AppE <$> qe <*> [|unsafe_compile_sr_simple sro rs|]
39 | }
40 | where
41 | parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp
42 | parse sro mk ts = either error (\_->mk ts) ei
43 | where
44 | ei :: Either String (SearchReplace RE String)
45 | ei = poss2either $ compileSearchReplace_ id (poss2either . compileRegexWith sro) ts
46 |
47 | unsafe_compile_sr_simple :: IsRegex RE s
48 | => SimpleREOptions
49 | -> String
50 | -> SearchReplace RE s
51 | unsafe_compile_sr_simple sro =
52 | unsafe_compile_sr $ unpackSimpleREOptions sro
53 |
54 | unsafe_compile_sr :: ( IsOption o, IsRegex RE s)
55 | => o
56 | -> String
57 | -> SearchReplace RE s
58 | unsafe_compile_sr os =
59 | unsafeCompileSearchReplace_ packR $ poss2either . compileRegexWithOptions os
60 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE CPP #-}
3 | #if __GLASGOW_HASKELL__ >= 800
4 | {-# LANGUAGE TemplateHaskellQuotes #-}
5 | #else
6 | {-# LANGUAGE QuasiQuotes #-}
7 | {-# LANGUAGE TemplateHaskell #-}
8 | #endif
9 |
10 | module Text.RE.ZeInternals.SearchReplace.TDFA
11 | ( ed
12 | , edMS
13 | , edMI
14 | , edBS
15 | , edBI
16 | , edMultilineSensitive
17 | , edMultilineInsensitive
18 | , edBlockSensitive
19 | , edBlockInsensitive
20 | , ed_
21 | ) where
22 |
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Prelude.Compat
26 | import Text.RE.REOptions
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 |
29 |
30 | -- | the @[ed| ... /// ... |]@ quasi quoters
31 | ed
32 | , edMS
33 | , edMI
34 | , edBS
35 | , edBI
36 | , edMultilineSensitive
37 | , edMultilineInsensitive
38 | , edBlockSensitive
39 | , edBlockInsensitive
40 | , ed_ :: QuasiQuoter
41 |
42 | ed = ed' cast $ Just minBound
43 | edMS = edMultilineSensitive
44 | edMI = edMultilineInsensitive
45 | edBS = edBlockSensitive
46 | edBI = edBlockInsensitive
47 | edMultilineSensitive = ed' cast $ Just MultilineSensitive
48 | edMultilineInsensitive = ed' cast $ Just MultilineInsensitive
49 | edBlockSensitive = ed' cast $ Just BlockSensitive
50 | edBlockInsensitive = ed' cast $ Just BlockInsensitive
51 | ed_ = ed' cast Nothing
52 |
53 | cast :: Q Exp
54 | cast = [|id|]
55 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.ByteString.Char8 as B
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE B.ByteString|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE B.ByteString|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/ByteString/Lazy.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.ByteString.Lazy.Char8 as LBS
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE LBS.ByteString|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE LBS.ByteString|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/Sequence.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.Sequence
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Sequence as S
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE (S.Seq Char)|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE (S.Seq Char)|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/String.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.String
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 |
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE String|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE String|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/Text.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.Text
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Text as T
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE T.Text|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE T.Text|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFA/Text/Lazy.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE CPP #-}
2 | #if __GLASGOW_HASKELL__ >= 800
3 | {-# LANGUAGE TemplateHaskellQuotes #-}
4 | #else
5 | {-# LANGUAGE QuasiQuotes #-}
6 | {-# LANGUAGE TemplateHaskell #-}
7 | #endif
8 |
9 | module Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy
10 | ( ed
11 | , edMultilineSensitive
12 | , edMultilineInsensitive
13 | , edBlockSensitive
14 | , edBlockInsensitive
15 | , edMS
16 | , edMI
17 | , edBS
18 | , edBI
19 | , ed_
20 | ) where
21 |
22 | import qualified Data.Text.Lazy as TL
23 | import Language.Haskell.TH
24 | import Language.Haskell.TH.Quote
25 | import Text.RE.REOptions
26 | import Text.RE.Tools.IsRegex
27 | import Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
28 | import Text.RE.ZeInternals.TDFA
29 |
30 | -- | @[ed| ... \/\/\/ ... |]@, is equivalent to @[edMultilineSensitive| ... \/\/\/ ... |]@,
31 | -- compiling a case-sensitive, multi-line 'SearchReplace'
32 | ed :: QuasiQuoter
33 | ed = ed' sr_cast $ Just minBound
34 |
35 | -- | @[edMultilineSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, multi-line 'SearchReplace' template
36 | edMultilineSensitive :: QuasiQuoter
37 | edMultilineSensitive = ed' sr_cast $ Just MultilineSensitive
38 |
39 | -- | @[edMultilineInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, multi-line 'SearchReplace' template
40 | edMultilineInsensitive :: QuasiQuoter
41 | edMultilineInsensitive = ed' sr_cast $ Just MultilineInsensitive
42 |
43 | -- | @[edBlockSensitive| ... \/\/\/ ... |]@ compiles a case-sensitive, non-multi-line 'SearchReplace' template
44 | edBlockSensitive :: QuasiQuoter
45 | edBlockSensitive = ed' sr_cast $ Just BlockSensitive
46 |
47 | -- | @[edBlockInsensitive| ... \/\/\/ ... |]@ compiles a case-insensitive, non-multi-line 'SearchReplace' template
48 | edBlockInsensitive :: QuasiQuoter
49 | edBlockInsensitive = ed' sr_cast $ Just BlockInsensitive
50 |
51 | -- | @[edMS| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineSensitive| ... \/\/\/ ... |]@
52 | edMS :: QuasiQuoter
53 | edMS = edMultilineSensitive
54 |
55 | -- | @[edMI| ... \/\/\/ ... |]@ is a shorthand for @[edMultilineInsensitive| ... \/\/\/ ... |]@
56 | edMI :: QuasiQuoter
57 | edMI = edMultilineInsensitive
58 |
59 | -- | @[edBS| ... \/\/\/ ... |]@ is a shorthand for @[edBlockSensitive| ... \/\/\/ ... |]@
60 | edBS :: QuasiQuoter
61 | edBS = edBlockSensitive
62 |
63 | -- | @[edBI| ... \/\/\/ ... |]@ is a shorthand for @[edBlockInsensitive| ... \/\/\/ ... |]@
64 | edBI :: QuasiQuoter
65 | edBI = edBlockInsensitive
66 |
67 | -- | @[ed_| ... \/\/\/ ... |]@ compiles a 'SearchReplace' template to produce a function that
68 | -- takes the RE options (e.g., a 'SimpleREOptions' value) and yields the
69 | -- 'SearchReplace' template compiled with those options. For example,
70 | --
71 | -- @s *=~/ [ed_|${hex}([0-9a-f]+)\/\/\/0x${hex}|] MultilineInsensitive@
72 | --
73 | -- prefixes the hexadecimal digit strings in s with @0x@, allowing for
74 | -- upper- or lower-case hex digits (which is entirely equivalent
75 | -- in this example to just using @[edMultilineInsensitive|[0-9a-f]+|]@).
76 | ed_ :: QuasiQuoter
77 | ed_ = ed' fn_cast Nothing
78 |
79 | sr_cast :: Q Exp
80 | sr_cast = [|\x -> x :: SearchReplace RE TL.Text|]
81 |
82 | fn_cast :: Q Exp
83 | fn_cast = [|\f x -> f x :: SearchReplace RE TL.Text|]
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/SearchReplace/TDFAEdPrime.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NoImplicitPrelude #-}
2 | {-# LANGUAGE FlexibleContexts #-}
3 | {-# LANGUAGE CPP #-}
4 | #if __GLASGOW_HASKELL__ >= 800
5 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
6 | {-# LANGUAGE TemplateHaskellQuotes #-}
7 | #else
8 | {-# LANGUAGE QuasiQuotes #-}
9 | {-# LANGUAGE TemplateHaskell #-}
10 | #endif
11 |
12 | module Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
13 | ( ed'
14 | ) where
15 |
16 | import Language.Haskell.TH
17 | import Language.Haskell.TH.Quote
18 | import Prelude.Compat
19 | import Text.RE.REOptions
20 | import Text.RE.Replace
21 | import Text.RE.Tools.IsRegex
22 | import Text.RE.ZeInternals
23 | import Text.RE.ZeInternals.TDFA
24 | import Text.RE.ZeInternals.Types.Poss
25 |
26 |
27 | -- | construct a quasi quoter from a casting function and @Just sro@
28 | -- if the options are known, otherwise a function take takes the
29 | -- 'SimpleREOptions' and constructs the 'SearchReplace' template
30 | ed' :: Q Exp -> Maybe SimpleREOptions -> QuasiQuoter
31 | ed' qe mb = case mb of
32 | Nothing ->
33 | (qq0 "ed'")
34 | { quoteExp = parse minBound $ \rs -> AppE <$> qe <*> [|flip unsafe_compile_sr rs|]
35 | }
36 | Just sro ->
37 | (qq0 "ed'")
38 | { quoteExp = parse sro $ \rs -> AppE <$> qe <*> [|unsafe_compile_sr_simple sro rs|]
39 | }
40 | where
41 | parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp
42 | parse sro mk ts = either error (\_->mk ts) ei
43 | where
44 | ei :: Either String (SearchReplace RE String)
45 | ei = poss2either $ compileSearchReplace_ id (poss2either . compileRegexWith sro) ts
46 |
47 | unsafe_compile_sr_simple :: IsRegex RE s
48 | => SimpleREOptions
49 | -> String
50 | -> SearchReplace RE s
51 | unsafe_compile_sr_simple sro =
52 | unsafe_compile_sr $ unpackSimpleREOptions sro
53 |
54 | unsafe_compile_sr :: (IsOption o, IsRegex RE s)
55 | => o
56 | -> String
57 | -> SearchReplace RE s
58 | unsafe_compile_sr os =
59 | unsafeCompileSearchReplace_ packR $ poss2either . compileRegexWithOptionsForQQ os
60 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Tools/Lex.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE NoImplicitPrelude #-}
3 |
4 | module Text.RE.ZeInternals.Tools.Lex
5 | ( alex
6 | , alex'
7 | ) where
8 |
9 | import Prelude.Compat
10 | import Text.RE.Replace
11 | import Text.RE.ZeInternals.Types.IsRegex
12 | \end{code}
13 |
14 |
15 | \begin{code}
16 | -- | a simple regex-based scanner interpreter for prototyping
17 | -- scanners
18 | alex :: IsRegex re s => [(re,Match s->Maybe t)] -> t -> s -> [t]
19 | alex = alex' matchOnce
20 |
21 | -- | a higher order version of 'alex' parameterised over the @matchOnce@
22 | -- function
23 | alex' :: Replace s
24 | => (re->s->Match s)
25 | -> [(re,Match s->Maybe t)]
26 | -> t
27 | -> s
28 | -> [t]
29 | alex' mo al t_err = loop
30 | where
31 | loop s = case lengthR s == 0 of
32 | True -> []
33 | False -> choose al s
34 |
35 | choose [] _ = [t_err]
36 | choose ((re,f):al') s = case mb_p of
37 | Just (s',t) -> t : loop s'
38 | _ -> choose al' s
39 | where
40 | mb_p = do
41 | cap <- matchCapture mtch
42 | case captureOffset cap == 0 of
43 | True -> (,) (captureSuffix cap) <$> f mtch
44 | False -> Nothing
45 |
46 | mtch = mo re s
47 | \end{code}
48 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/Capture.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE RecordWildCards #-}
3 | {-# LANGUAGE FlexibleInstances #-}
4 | {-# LANGUAGE UndecidableInstances #-}
5 | {-# LANGUAGE MultiParamTypeClasses #-}
6 | {-# LANGUAGE DeriveDataTypeable #-}
7 | \end{code}
8 |
9 | \begin{code}
10 | module Text.RE.ZeInternals.Types.Capture
11 | ( Capture(..)
12 | , hasCaptured
13 | , capturePrefix
14 | , captureSuffix
15 | ) where
16 | \end{code}
17 |
18 | \begin{code}
19 | import Text.Regex.Base
20 | \end{code}
21 |
22 |
23 |
24 | \begin{code}
25 | -- | the matching of a single sub-expression against part of the source
26 | -- text
27 | data Capture a =
28 | Capture
29 | { captureSource :: !a -- ^ the whole text that was searched
30 | , capturedText :: !a -- ^ the text that was matched
31 | , captureOffset :: !Int -- ^ the number of characters preceding the
32 | -- match with -1 used if no text was captured
33 | -- by the RE (not even the empty string)
34 | , captureLength :: !Int -- ^ the number of chacter in the captured
35 | -- sub-string
36 | }
37 | deriving (Show,Eq)
38 | \end{code}
39 |
40 | \begin{code}
41 | instance Functor Capture where
42 | fmap f c@Capture{..} =
43 | c
44 | { captureSource = f captureSource
45 | , capturedText = f capturedText
46 | }
47 | \end{code}
48 |
49 | \begin{code}
50 | -- | test if the capture has matched any text
51 | hasCaptured :: Capture a -> Bool
52 | hasCaptured = (>=0) . captureOffset
53 |
54 | -- | returns the text preceding the match
55 | capturePrefix :: Extract a => Capture a -> a
56 | capturePrefix Capture{..} = before captureOffset captureSource
57 |
58 | -- | returns the text after the match
59 | captureSuffix :: Extract a => Capture a -> a
60 | captureSuffix Capture{..} = after (captureOffset+captureLength) captureSource
61 | \end{code}
62 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/CaptureID.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 |
3 | module Text.RE.ZeInternals.Types.CaptureID where
4 |
5 | import qualified Data.HashMap.Strict as HMS
6 | import Data.Hashable
7 | import Data.Ix
8 | import qualified Data.Text as T
9 |
10 |
11 | -- | CaptureID identifies captures, either by number
12 | -- (e.g., [cp|1|]) or name (e.g., [cp|foo|]).
13 | data CaptureID
14 | = IsCaptureOrdinal CaptureOrdinal -- [cp|3|]
15 | | IsCaptureName CaptureName -- [cp|y|]
16 | deriving (Show,Ord,Eq)
17 |
18 | -- | the dictionary for named captures stored in compiled regular
19 | -- expressions associates
20 | type CaptureNames = HMS.HashMap CaptureName CaptureOrdinal
21 |
22 | -- | an empty 'CaptureNames' dictionary
23 | noCaptureNames :: CaptureNames
24 | noCaptureNames = HMS.empty
25 |
26 | -- | a 'CaptureName' is just the text of the name
27 | newtype CaptureName = CaptureName { getCaptureName :: T.Text }
28 | deriving (Show,Ord,Eq)
29 |
30 | instance Hashable CaptureName where
31 | hashWithSalt i = hashWithSalt i . getCaptureName
32 |
33 | -- | a 'CaptureOrdinal' is just the number of the capture, starting
34 | -- with 0 for the whole of the text matched, then in leftmost,
35 | -- outermost
36 | newtype CaptureOrdinal = CaptureOrdinal { getCaptureOrdinal :: Int }
37 | deriving (Show,Ord,Eq,Enum,Ix,Num)
38 |
39 | -- | look up a 'CaptureID' in the 'CaptureNames' dictionary
40 | findCaptureID :: CaptureID -> CaptureNames -> Either String CaptureOrdinal
41 | findCaptureID (IsCaptureOrdinal o) _ = Right o
42 | findCaptureID (IsCaptureName n) hms =
43 | maybe oops Right $ HMS.lookup n hms
44 | where
45 | oops = Left $ unlines $
46 | ("lookupCaptureID: " ++ T.unpack t ++ " not found in:") :
47 | [ " "++T.unpack (getCaptureName nm) | nm <- HMS.keys hms ]
48 | t = getCaptureName n
49 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/IsRegex.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE RecordWildCards #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 | {-# LANGUAGE AllowAmbiguousTypes #-}
5 | {-# LANGUAGE CPP #-}
6 | #if __GLASGOW_HASKELL__ >= 800
7 | {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
8 | {-# OPTIONS_GHC -fno-warn-unused-imports #-}
9 | #endif
10 |
11 | module Text.RE.ZeInternals.Types.IsRegex
12 | ( IsRegex(..)
13 | , SearchReplace(..)
14 | , searchReplaceAll
15 | , searchReplaceFirst
16 | ) where
17 |
18 | import Control.Monad.Fail
19 | import Text.RE.REOptions
20 | import Text.RE.Replace
21 | import Text.RE.ZeInternals.EscapeREString
22 | import Text.RE.ZeInternals.Types.SearchReplace
23 | \end{code}
24 |
25 | \begin{code}
26 | -- | the 'IsRegex' class allows polymorhic tools to be written that
27 | -- will work with a variety of regex back ends and text types
28 | class Replace s => IsRegex re s where
29 | -- | finding the first match
30 | matchOnce :: re -> s -> Match s
31 | -- | finding all matches
32 | matchMany :: re -> s -> Matches s
33 | -- | compiling an RE, failing if the RE is not well formed
34 | makeRegex :: (Functor m,Monad m, MonadFail m) => s -> m re
35 | -- | comiling an RE, specifying the 'SimpleREOptions'
36 | makeRegexWith :: (Functor m,Monad m, MonadFail m) => SimpleREOptions -> s -> m re
37 | -- | compiling a 'SearchReplace' template from the RE text and the template Text, failing if they are not well formed
38 | makeSearchReplace :: (Functor m,Monad m, MonadFail m,IsRegex re s) => s -> s -> m (SearchReplace re s)
39 | -- | compiling a 'SearchReplace' template specifying the 'SimpleREOptions' for the RE
40 | makeSearchReplaceWith :: (Functor m,Monad m, MonadFail m,IsRegex re s) => SimpleREOptions -> s -> s -> m (SearchReplace re s)
41 | -- | incorporate an escaped string into a compiled RE with the default options
42 | makeEscaped :: (Functor m,Monad m, MonadFail m) => (s->s) -> s -> m re
43 | -- | incorporate an escaped string into a compiled RE with the specified 'SimpleREOptions'
44 | makeEscapedWith :: (Functor m,Monad m, MonadFail m) => SimpleREOptions -> (s->s) -> s -> m re
45 | -- | extract the text of the RE from the RE
46 | regexSource :: re -> s
47 |
48 | makeRegex = makeRegexWith minBound
49 | makeSearchReplace = makeSearchReplaceWith minBound
50 | makeEscaped = makeEscapedWith minBound
51 | makeEscapedWith o f = makeRegexWith o . f . packR . escapeREString . unpackR
52 | \end{code}
53 |
54 | \begin{code}
55 | -- | search and replace all matches in the argument text; e.g., this function
56 | -- will convert every YYYY-MM-DD format date in its argument text into a
57 | -- DD\/MM\/YYYY date:
58 | --
59 | -- @searchReplaceAll [ed|${y}([0-9]{4})-0*${m}([0-9]{2})-0*${d}([0-9]{2})\/\/\/${d}\/${m}\/${y}|]@
60 | --
61 | searchReplaceAll :: IsRegex re s => SearchReplace re s -> s -> s
62 | searchReplaceAll SearchReplace{..} = replaceAll getTemplate . matchMany getSearch
63 |
64 | -- | search and replace the first occurrence only (if any) in the input text
65 | -- e.g., to prefix the first string of four hex digits in the imput text,
66 | -- if any, with @0x@:
67 | --
68 | -- @searchReplaceFirst [ed|[0-9A-Fa-f]{4}\/\/\/0x$0|]@
69 | --
70 | searchReplaceFirst :: IsRegex re s => SearchReplace re s -> s -> s
71 | searchReplaceFirst SearchReplace{..} = replace getTemplate . matchOnce getSearch
72 | \end{code}
73 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/LineNo.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 |
3 | module Text.RE.ZeInternals.Types.LineNo where
4 |
5 |
6 | -- | our line numbers are of the proper zero-based kind
7 | newtype LineNo =
8 | ZeroBasedLineNo { getZeroBasedLineNo :: Int }
9 | deriving (Show,Enum)
10 |
11 | -- | the first line in a file
12 | firstLine :: LineNo
13 | firstLine = ZeroBasedLineNo 0
14 |
15 | -- | extract a conventional 1-based line number
16 | getLineNo :: LineNo -> Int
17 | getLineNo = succ . getZeroBasedLineNo
18 |
19 | -- | inject a conventional 1-based line number
20 | lineNo :: Int -> LineNo
21 | lineNo = ZeroBasedLineNo . pred
22 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/Matches.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | {-# LANGUAGE RecordWildCards #-}
3 | {-# LANGUAGE FlexibleContexts #-}
4 | {-# LANGUAGE FlexibleInstances #-}
5 | {-# LANGUAGE UndecidableInstances #-}
6 | {-# LANGUAGE MultiParamTypeClasses #-}
7 | {-# LANGUAGE DeriveDataTypeable #-}
8 | {-# LANGUAGE MonoLocalBinds #-}
9 | \end{code}
10 |
11 | \begin{code}
12 | module Text.RE.ZeInternals.Types.Matches
13 | ( Matches(..)
14 | , anyMatches
15 | , countMatches
16 | , matches
17 | , mainCaptures
18 | ) where
19 | \end{code}
20 |
21 | \begin{code}
22 | import Data.Typeable
23 | import Text.RE.ZeInternals.Types.Capture
24 | import Text.RE.ZeInternals.Types.CaptureID
25 | import Text.RE.ZeInternals.Types.Match
26 | import Text.Regex.Base
27 | \end{code}
28 |
29 |
30 | \begin{code}
31 | -- | the result of matching a RE against a text (with @*=~@), retaining
32 | -- the text that was matched against
33 | data Matches a =
34 | Matches
35 | { matchesSource :: !a -- ^ the source text being matched
36 | , allMatches :: ![Match a] -- ^ all 'Match' instances found, left to right
37 | }
38 | deriving (Show,Eq,Typeable)
39 | \end{code}
40 |
41 | \begin{code}
42 | instance Functor Matches where
43 | fmap f Matches{..} =
44 | Matches
45 | { matchesSource = f matchesSource
46 | , allMatches = map (fmap f) allMatches
47 | }
48 | \end{code}
49 |
50 | \begin{code}
51 | -- | tests whether the RE matched the source text at all
52 | anyMatches :: Matches a -> Bool
53 | anyMatches = not . null . allMatches
54 |
55 | -- | count the matches
56 | countMatches :: Matches a -> Int
57 | countMatches = length . allMatches
58 |
59 | -- | list the texts that Matched
60 | matches :: Matches a -> [a]
61 | matches = map capturedText . mainCaptures
62 |
63 | -- | extract the main capture from each match
64 | mainCaptures :: Matches a -> [Capture a]
65 | mainCaptures ac = [ capture c0 cs | cs<-allMatches ac ]
66 | where
67 | c0 = IsCaptureOrdinal $ CaptureOrdinal 0
68 | \end{code}
69 |
70 | \begin{code}
71 | -- | this instance hooks 'Matches' into regex-base: regex consumers need
72 | -- not worry about any of this
73 | instance
74 | ( RegexContext regex source [MatchText source]
75 | , RegexLike regex source
76 | , RegexFix regex source
77 | ) =>
78 | RegexContext regex source (Matches source) where
79 | match r s = Matches s $ map (convertMatchText r s) $ match r s
80 | matchM r s = do
81 | y <- matchM r s
82 | return $ Matches s $ map (convertMatchText r s) y
83 | \end{code}
84 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/Poss.hs:
--------------------------------------------------------------------------------
1 | {-# OPTIONS_GHC -fno-warn-unused-imports #-}
2 |
3 | module Text.RE.ZeInternals.Types.Poss where
4 |
5 | import Control.Monad.Fail
6 |
7 |
8 | data Poss a
9 | = Eek String
10 | | Yup a
11 | deriving (Eq,Ord,Show)
12 |
13 | instance Functor Poss where
14 | fmap f p = case p of
15 | Eek m -> Eek m
16 | Yup x -> Yup $ f x
17 |
18 | instance Applicative Poss where
19 | pure = Yup
20 | (<*>) p1 p2 = case p1 of
21 | Eek m -> Eek m
22 | Yup f -> case p2 of
23 | Eek n -> Eek n
24 | Yup x -> Yup $ f x
25 |
26 | instance Monad Poss where
27 | return = pure
28 | (>>=) p f = case p of
29 | Eek m -> Eek m
30 | Yup x -> f x
31 |
32 | instance MonadFail Poss where
33 | fail = Eek
34 |
35 | poss :: (String->b) -> (a->b) -> Poss a -> b
36 | poss f _ (Eek s) = f s
37 | poss _ g (Yup x) = g x
38 |
39 | poss2either :: Poss a -> Either String a
40 | poss2either (Eek m) = Left m
41 | poss2either (Yup x) = Right x
42 |
--------------------------------------------------------------------------------
/Text/RE/ZeInternals/Types/SearchReplace.lhs:
--------------------------------------------------------------------------------
1 | \begin{code}
2 | module Text.RE.ZeInternals.Types.SearchReplace
3 | ( SearchReplace(..)
4 | ) where
5 |
6 | \end{code}
7 |
8 | \begin{code}
9 | -- | contains a compiled RE and replacement template
10 | data SearchReplace re s =
11 | SearchReplace
12 | { getSearch :: !re -- ^ the RE to match a string to replace
13 | , getTemplate :: !s -- ^ the replacement template with ${cap}
14 | -- used to identify a capture (by number or
15 | -- name if one was given) and '$$' being
16 | -- used to escape a single '$'
17 | }
18 | deriving (Show)
19 | \end{code}
20 |
21 | \begin{code}
22 | instance Functor (SearchReplace re) where
23 | fmap f (SearchReplace re x) = SearchReplace re (f x)
24 | \end{code}
25 |
--------------------------------------------------------------------------------
/bin/shc.xz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/bin/shc.xz
--------------------------------------------------------------------------------
/data/include-result.lhs:
--------------------------------------------------------------------------------
1 | re-pp and re-include test file
2 | ==============================
3 |
4 | This is a psuedo-Haskell script used to test the re-pp (and it cut-down
5 | variant, re-include).
6 |
7 |
8 | Here we have a couple of single-line vanilla code fragment.
9 | \begin{code}
10 | {-# LANGUAGE QuasiQuotes #-}
11 | \end{code}
12 |
13 | \begin{code}
14 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
15 | \end{code}
16 |
17 | And here is an empty one.
18 | \begin{code}
19 | \end{code}
20 |
21 | The top main stuff:
22 | %main top
23 |
24 | A multi-line vanilla code fragment.
25 |
26 | \begin{code}
27 | import Control.Applicative
28 | \end{code}
29 |
30 |
31 | An (self-)include directive
32 |
33 | \begin{code}
34 | evalme_PPT_01 = checkThis "" (Just 0) $ (length <$> Just [])
35 | \end{code}
36 |
37 |
38 |
39 | evalme frgment 1
40 | \begin{code}
41 | evalme_PPT_00 = checkThis "" (0) $ length []
42 | \end{code}
43 |
44 | evalme frgment 1
45 | \begin{code}
46 | evalme_PPT_01 = checkThis "" (Just 0) $ (length <$> Just [])
47 | \end{code}
48 |
49 | And the main bottom stuff.
50 | %main bottom
51 |
--------------------------------------------------------------------------------
/data/league-table.md:
--------------------------------------------------------------------------------
1 | # Premier League 2015-16: Top 7
2 |
3 | Pos|Club |Played |Won |Drawn |Lost |GF |GA |GD |Points
4 | ---|---------------------|-------|-------|-------|-------|-------|-------|-------|-------
5 | 1 |West Ham United |12 |5 |4 |3 |19 |18 |1 |19
6 | 2 |Tottenham Hotspur |12 |5 |3 |4 |20 |12 |8 |18
7 | 3 |Leicester City |12 |4 |6 |2 |17 |16 |1 |18
8 | 4 |Southampton FC |12 |5 |2 |5 |18 |16 |2 |17
9 | 5 |Arsenal FC |12 |4 |5 |3 |22 |21 |1 |17
10 | 6 |Manchester United |12 |4 |4 |4 |12 |16 |-4 |16
11 | 7 |Manchester City |12 |1 |4 |7 |14 |23 |-9 |7
12 |
--------------------------------------------------------------------------------
/data/pcre-macros-src.txt:
--------------------------------------------------------------------------------
1 | %address.ipv4 : [0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}
2 | %date : [0-9]{4}-[0-9]{2}-[0-9]{2}
3 | %date.slashes : [0-9]{4}/[0-9]{2}/[0-9]{2}
4 | %datetime : [0-9]{4}-[0-9]{2}-[0-9]{2}[ T][0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?(?:(?:Z|[+-][0-9]{2}:?[0-9]{2})| UTC)?
5 | %datetime.8601 : [0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?(?:Z|[+-][0-9]{2}:?[0-9]{2})
6 | %datetime.clf : [0-9]{2}/(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2} [+-][0-9]{2}:?[0-9]{2}
7 | %email.simple : [a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9.-]+
8 | %frac : -?[0-9]+(?:\.[0-9]+)?
9 | %hex : [0-9a-fA-F]+
10 | %id : _*[a-zA-Z][a-zA-Z0-9_]*
11 | %id' : _*[a-zA-Z][a-zA-Z0-9_']*
12 | %id- : _*[a-zA-Z][a-zA-Z0-9_'-]*
13 | %int : -?[0-9]+
14 | %nat : [0-9]+
15 | %shortmonth : (?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)
16 | %string.simple : "[^"[:cntrl:]]*"
17 | %syslog.severity : (?:emerg|panic|alert|crit|warning|warn|notice|info|debug|err(?:or)?)
18 | %time : [0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?
19 | %timezone : (?:Z|[+-][0-9]{2}:?[0-9]{2})
20 | %url : ([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*
21 |
--------------------------------------------------------------------------------
/data/pcre-nginx-log-processor-src.txt:
--------------------------------------------------------------------------------
1 | %address.ipv4 : [0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}
2 | %date : [0-9]{4}-[0-9]{2}-[0-9]{2}
3 | %date.slashes : [0-9]{4}/[0-9]{2}/[0-9]{2}
4 | %datetime : [0-9]{4}-[0-9]{2}-[0-9]{2}[ T][0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?(?:(?:Z|[+-][0-9]{2}:?[0-9]{2})| UTC)?
5 | %datetime.8601 : [0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?(?:Z|[+-][0-9]{2}:?[0-9]{2})
6 | %datetime.clf : [0-9]{2}/(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2} [+-][0-9]{2}:?[0-9]{2}
7 | %email.simple : [a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9.-]+
8 | %frac : -?[0-9]+(?:\.[0-9]+)?
9 | %hex : [0-9a-fA-F]+
10 | %id : _*[a-zA-Z][a-zA-Z0-9_]*
11 | %id' : _*[a-zA-Z][a-zA-Z0-9_']*
12 | %id- : _*[a-zA-Z][a-zA-Z0-9_'-]*
13 | %int : -?[0-9]+
14 | %nat : [0-9]+
15 | %shortmonth : (?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)
16 | %string.simple : "[^"[:cntrl:]]*"
17 | %syslog.severity : (?:emerg|panic|alert|crit|warning|warn|notice|info|debug|err(?:or)?)
18 | %time : [0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?
19 | %timezone : (?:Z|[+-][0-9]{2}:?[0-9]{2})
20 | %url : ([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*
21 | access : ([0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}) - ((?:-|[^[:space:]]+)) \[([0-9]{2}/(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2} [+-][0-9]{2}:?[0-9]{2})\] ("[^"[:cntrl:]]*") ([0-9]+) ([0-9]+) ("[^"[:cntrl:]]*") ("[^"[:cntrl:]]*") ("[^"[:cntrl:]]*")
22 | access_deg : - \[\] "" "" "" ""
23 | error : ([0-9]{4}/[0-9]{2}/[0-9]{2}) ([0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?) \[((?:emerg|panic|alert|crit|warning|warn|notice|info|debug|err(?:or)?))\] ((?:[0-9]+)#(?:[0-9]+):)(.*)
24 | pid#tid: : (?:[0-9]+)#(?:[0-9]+):
25 | user : (?:-|[^[:space:]]+)
26 |
--------------------------------------------------------------------------------
/data/pp-result-doc.lhs:
--------------------------------------------------------------------------------
1 | re-pp and re-include test file
2 | ==============================
3 |
4 | This is a psuedo-Haskell script used to test the re-pp (and it cut-down
5 | variant, re-include).
6 |
7 |
8 | Here we have a couple of single-line vanilla code fragment.
9 | \begin{code}
10 | {-# LANGUAGE QuasiQuotes #-}
11 | \end{code}
12 |
13 | \begin{code}
14 | \end{code}
15 |
16 | And here is an empty one.
17 | \begin{code}
18 | \end{code}
19 |
20 | The top main stuff:
21 |
22 | A multi-line vanilla code fragment.
23 |
24 | \begin{code}
25 | import Control.Applicative
26 | \end{code}
27 |
28 |
29 | An (self-)include directive
30 |
31 | \begin{code}
32 | evalme_PPT_01 = checkThis "" (Just 0) $ (length <$> Just [])
33 | \end{code}
34 |
35 |
36 |
37 | evalme frgment 1
38 | \begin{code}
39 | ghci> length []
40 | 0
41 | \end{code}
42 |
43 | evalme frgment 1
44 | \begin{code}
45 | ghci> length <$> Just []
46 | Just 0
47 | \end{code}
48 |
49 | And the main bottom stuff.
50 |
--------------------------------------------------------------------------------
/data/pp-result-gen.lhs:
--------------------------------------------------------------------------------
1 | re-pp and re-include test file
2 | ==============================
3 |
4 | This is a psuedo-Haskell script used to test the re-pp (and it cut-down
5 | variant, re-include).
6 |
7 |
8 | Here we have a couple of single-line vanilla code fragment.
9 | \begin{code}
10 | {-# LANGUAGE QuasiQuotes #-}
11 | \end{code}
12 |
13 | \begin{code}
14 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
15 | \end{code}
16 |
17 | And here is an empty one.
18 | \begin{code}
19 | \end{code}
20 |
21 | The top main stuff:
22 | \begin{code}
23 | module Main(main) where
24 | \end{code}
25 |
26 | *********************************************************
27 | *
28 | * WARNING: this is generated from pp-tutorial-master.lhs
29 | *
30 | *********************************************************
31 |
32 |
33 | A multi-line vanilla code fragment.
34 |
35 | \begin{code}
36 | import Control.Applicative
37 | \end{code}
38 |
39 |
40 | An (self-)include directive
41 | %include "data/pp-test.lhs" "^evalme_PPT_01"
42 |
43 | evalme frgment 1
44 | \begin{code}
45 | evalme_PPT_00 = checkThis "evalme_PPT_00" (0) $ length []
46 | \end{code}
47 |
48 | evalme frgment 1
49 | \begin{code}
50 | evalme_PPT_01 = checkThis "evalme_PPT_01" (Just 0) $ (length <$> Just [])
51 | \end{code}
52 |
53 | And the main bottom stuff.
54 | \begin{code}
55 | main :: IO ()
56 | main = runTheTests
57 | [ evalme_PPT_01
58 | , evalme_PPT_00
59 | ]
60 | \end{code}
61 |
62 |
--------------------------------------------------------------------------------
/data/pp-test.lhs:
--------------------------------------------------------------------------------
1 | re-pp and re-include test file
2 | ==============================
3 |
4 | This is a psuedo-Haskell script used to test the re-pp (and it cut-down
5 | variant, re-include).
6 |
7 |
8 | Here we have a couple of single-line vanilla code fragment.
9 | \begin{code}
10 | {-# LANGUAGE QuasiQuotes #-}
11 | \end{code}
12 |
13 | \begin{code}
14 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
15 | \end{code}
16 |
17 | And here is an empty one.
18 | \begin{code}
19 | \end{code}
20 |
21 | The top main stuff:
22 | %main top
23 |
24 | A multi-line vanilla code fragment.
25 |
26 | \begin{code}
27 | import Control.Applicative
28 | \end{code}
29 |
30 |
31 | An (self-)include directive
32 | %include "data/pp-test.lhs" "^evalme_PPT_01"
33 |
34 | evalme frgment 1
35 | \begin{code}
36 | evalme_PPT_00 = checkThis "" (0) $ length []
37 | \end{code}
38 |
39 | evalme frgment 1
40 | \begin{code}
41 | evalme_PPT_01 = checkThis "" (Just 0) $ (length <$> Just [])
42 | \end{code}
43 |
44 | And the main bottom stuff.
45 | %main bottom
46 |
--------------------------------------------------------------------------------
/data/tdfa-macros-src.txt:
--------------------------------------------------------------------------------
1 | %address.ipv4 : [0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}
2 | %date : [0-9]{4}-[0-9]{2}-[0-9]{2}
3 | %date.slashes : [0-9]{4}/[0-9]{2}/[0-9]{2}
4 | %datetime : [0-9]{4}-[0-9]{2}-[0-9]{2}[ T][0-9]{2}:[0-9]{2}:[0-9]{2}([.][0-9]+)?((Z|[+-][0-9]{2}:?[0-9]{2})| UTC)?
5 | %datetime.8601 : [0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}([.][0-9]+)?(Z|[+-][0-9]{2}:?[0-9]{2})
6 | %datetime.clf : [0-9]{2}/(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2} [+-][0-9]{2}:?[0-9]{2}
7 | %email.simple : [a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9.-]+
8 | %frac : -?[0-9]+(\.[0-9]+)?
9 | %hex : [0-9a-fA-F]+
10 | %id : _*[a-zA-Z][a-zA-Z0-9_]*
11 | %id' : _*[a-zA-Z][a-zA-Z0-9_']*
12 | %id- : _*[a-zA-Z][a-zA-Z0-9_'-]*
13 | %int : -?[0-9]+
14 | %nat : [0-9]+
15 | %shortmonth : (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)
16 | %string : "([^"\]+|\\[\"])*"
17 | %string.simple : "[^"[:cntrl:]]*"
18 | %syslog.severity : (emerg|panic|alert|crit|err|error|warning|warn|notice|info|debug)
19 | %time : [0-9]{2}:[0-9]{2}:[0-9]{2}([.][0-9]+)?
20 | %timezone : (Z|[+-][0-9]{2}:?[0-9]{2})
21 | %url : ([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*
22 |
--------------------------------------------------------------------------------
/examples/re-include.lhs:
--------------------------------------------------------------------------------
1 | Example: Include Processor
2 | ==========================
3 |
4 | This example looks for lines like
5 |
6 | ```
7 | %include "lib/md/load-tutorial-cabal-incl.md"
8 | ```
9 |
10 | on its input and replaces them with the contents of the names file.
11 |
12 | The tool is self-testing: run it with no arguments (or `cabal test`).
13 |
14 |
15 | \begin{code}
16 | {-# LANGUAGE NoImplicitPrelude #-}
17 | {-# LANGUAGE RecordWildCards #-}
18 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
19 | {-# LANGUAGE TemplateHaskell #-}
20 | {-# LANGUAGE QuasiQuotes #-}
21 | {-# LANGUAGE OverloadedStrings #-}
22 |
23 | module Main
24 | ( main
25 | ) where
26 |
27 | import Control.Applicative
28 | import qualified Data.ByteString.Lazy.Char8 as LBS
29 | import Data.Maybe
30 | import qualified Data.Text as T
31 | import Prelude.Compat
32 | import System.Environment
33 | import TestKit
34 | import Text.RE.Replace
35 | import Text.RE.TDFA.ByteString.Lazy
36 | import Text.RE.Tools.Edit
37 | import Text.RE.Tools.Grep
38 | import Text.RE.Tools.Sed
39 | \end{code}
40 |
41 | \begin{code}
42 | main :: IO ()
43 | main = do
44 | as <- getArgs
45 | case as of
46 | [] -> test
47 | ["test"] -> test
48 | [fn,fn'] | is_file fn -> loop fn fn'
49 | _ -> usage
50 | where
51 | is_file = not . (== "--") . take 2
52 |
53 | usage = do
54 | prg <- getProgName
55 | putStr $ unlines
56 | [ "usage:"
57 | , " "++prg++" [test]"
58 | , " "++prg++" (-|) (-|)"
59 | ]
60 | \end{code}
61 |
62 |
63 | The Sed Script
64 | --------------
65 |
66 | \begin{code}
67 | loop :: FilePath -> FilePath -> IO ()
68 | loop =
69 | sed $ Select
70 | [ Function [re|^%include ${file}(@{%string}) ${rex}(@{%string})$|] TOP include_file
71 | , Function [re|^.*$|] TOP $ \_ _ _ _->return Nothing
72 | ]
73 | \end{code}
74 |
75 | \begin{code}
76 | include_file :: LineNo
77 | -> Match LBS.ByteString
78 | -> RELocation
79 | -> Capture LBS.ByteString
80 | -> IO (Maybe LBS.ByteString)
81 | include_file _ mtch _ _ = fmap Just $
82 | extract fp =<< compileRegex re_s
83 | where
84 | fp = prs_s $ captureText [cp|file|] mtch
85 | re_s = prs_s $ captureText [cp|rex|] mtch
86 |
87 | prs_s = maybe (error "includeDoc") T.unpack . parseString
88 | \end{code}
89 |
90 |
91 | Extracting a Literate Fragment from a Haskell Program Text
92 | ----------------------------------------------------------
93 |
94 | \begin{code}
95 | extract :: FilePath -> RE -> IO LBS.ByteString
96 | extract fp rex = extr . LBS.lines <$> LBS.readFile fp
97 | where
98 | extr lns =
99 | case parse $ scan rex lns of
100 | Nothing -> oops
101 | Just (lno,n) -> LBS.unlines $ (hdr :) $ (take n $ drop i lns) ++ [ftr]
102 | where
103 | i = getZeroBasedLineNo lno
104 |
105 | oops = error $ concat
106 | [ "failed to locate fragment matching "
107 | , show $ reSource rex
108 | , " in file "
109 | , show fp
110 | ]
111 |
112 | hdr = ""
113 | ftr = "
"
114 | \end{code}
115 |
116 | \begin{code}
117 | parse :: [Token] -> Maybe (LineNo,Int)
118 | parse [] = Nothing
119 | parse (tk:tks) = case (tk,tks) of
120 | (Bra b_ln,Hit:Ket k_ln:_) -> Just (b_ln,count_lines_incl b_ln k_ln)
121 | _ -> parse tks
122 | \end{code}
123 |
124 | \begin{code}
125 | count_lines_incl :: LineNo -> LineNo -> Int
126 | count_lines_incl b_ln k_ln =
127 | getZeroBasedLineNo k_ln + 1 - getZeroBasedLineNo b_ln
128 | \end{code}
129 |
130 | \begin{code}
131 | data Token = Bra LineNo | Hit | Ket LineNo deriving (Show)
132 | \end{code}
133 |
134 | \begin{code}
135 | scan :: RE -> [LBS.ByteString] -> [Token]
136 | scan rex = grepWithScript
137 | [ (,) [re|\\begin\{code\}|] $ \i -> chk $ Bra i
138 | , (,) rex $ \_ -> chk Hit
139 | , (,) [re|\\end\{code\}|] $ \i -> chk $ Ket i
140 | ]
141 | where
142 | chk x mtchs = case anyMatches mtchs of
143 | True -> Just x
144 | False -> Nothing
145 | \end{code}
146 |
147 |
148 | Testing
149 | -------
150 |
151 | \begin{code}
152 | test :: IO ()
153 | test = do
154 | test_pp "include" loop "data/pp-test.lhs" "data/include-result.lhs"
155 | putStrLn "tests passed"
156 | \end{code}
157 |
--------------------------------------------------------------------------------
/examples/re-sort-imports.lhs:
--------------------------------------------------------------------------------
1 | Example: Sort-Import Processor
2 | ==============================
3 |
4 | This example looks for Haskell files and sorts their import statements
5 | into a standard (alphabetical) order
6 |
7 | \begin{code}
8 | {-# LANGUAGE NoImplicitPrelude #-}
9 | {-# LANGUAGE RecordWildCards #-}
10 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
11 | {-# LANGUAGE TemplateHaskell #-}
12 | {-# LANGUAGE QuasiQuotes #-}
13 | {-# LANGUAGE OverloadedStrings #-}
14 |
15 | module Main
16 | ( main
17 | ) where
18 |
19 | import Control.Applicative
20 | import qualified Control.Monad as M
21 | import qualified Data.ByteString.Lazy.Char8 as LBS
22 | import Prelude.Compat
23 | import System.Directory
24 | import System.Environment
25 | import System.Exit
26 | import System.FilePath
27 | import TestKit
28 | import Text.Printf
29 | import Text.RE.TDFA.String
30 | import Text.RE.Tools.Find
31 | \end{code}
32 |
33 | Mode
34 | ----
35 |
36 | This program can run in one of two modes.
37 |
38 | \begin{code}
39 | data Mode
40 | = Check -- only check for unsorted files, generating an
41 | -- error if any not sorted
42 | | Update -- update any unsorted files
43 | deriving (Eq,Show)
44 | \end{code}
45 |
46 | \begin{code}
47 | main :: IO ()
48 | main = do
49 | as <- getArgs
50 | case as of
51 | [] -> test
52 | ["test"] -> test
53 | ["update",fp] | is_file fp -> sort_r Update fp
54 | ["check" ,fp] | is_file fp -> sort_r Check fp
55 | _ -> usage
56 | where
57 | is_file = not . (== "--") . take 2
58 |
59 | test = do
60 | sort_r Check "Text"
61 | sort_r Check "examples"
62 |
63 | usage = do
64 | prg <- getProgName
65 | putStr $ unlines
66 | [ "usage:"
67 | , " "++prg++" [test]"
68 | , " "++prg++" check "
69 | , " "++prg++" update "
70 | ]
71 | \end{code}
72 |
73 |
74 | The Find Script
75 | ---------------
76 |
77 | \begin{code}
78 | sort_r :: Mode -> FilePath -> IO ()
79 | sort_r md root = findMatches_ fm [re|\.l?hs|] root >>= sort_these md root
80 | where
81 | fm = FindMethods
82 | { doesDirectoryExistDM = doesDirectoryExist
83 | , listDirectoryDM = getDirectoryContents
84 | , combineDM = (>)
85 | }
86 | \end{code}
87 |
88 |
89 | Processing the List of Files
90 | ----------------------------
91 |
92 | \begin{code}
93 | sort_these :: Mode -> FilePath -> [FilePath] -> IO ()
94 | sort_these md root fps = do
95 | ok <- and <$> mapM (sort_this md) fps
96 | case ok of
97 | True -> msg "all imports sorted"
98 | False -> case md of
99 | Check -> do
100 | msg "Some imports need sorting"
101 | exitWith $ ExitFailure 1
102 | Update ->
103 | msg "Some imports were sorted"
104 | where
105 | msg :: String -> IO ()
106 | msg s = printf "%-10s : %s\n" root s
107 | \end{code}
108 |
109 |
110 | Processing a single File
111 | ------------------------
112 |
113 | \begin{code}
114 | sort_this :: Mode -> FilePath -> IO Bool
115 | sort_this md fp = LBS.readFile fp >>= sort_this'
116 | where
117 | sort_this' lbs = do
118 | M.when (not same) $ putStrLn fp
119 | M.when (md==Update) $ LBS.writeFile fp lbs'
120 | return same
121 | where
122 | same = lbs==lbs'
123 | lbs' = sortImports lbs
124 | \end{code}
125 |
126 |
127 | Sorting the Imports of the Text of a Haskell Script
128 | ---------------------------------------------------
129 |
130 | The function for sorting a Haskell script, `sortImports` has been
131 | placed in `TestKit` so that it can be shared with re-gen-modules`.
132 |
133 | %include "examples/TestKit.lhs" "sortImports ::"
134 |
--------------------------------------------------------------------------------
/lib/README-regex.md:
--------------------------------------------------------------------------------
1 | # regex
2 |
3 | regex is a regular expression toolkit for regex-base with:
4 |
5 | * a text-replacement toolkit with type-safe text-replacement templates;
6 | * special datatypes for matches and captures;
7 | * compile-time checking of RE syntax;
8 | * a unified means of controlling case-sensitivity and multi-line options;
9 | * high-level AWK-like tools for building text processing apps;
10 | * the option of using match operators with reduced polymorphism on the
11 | text and result types;
12 | * regular expression macros including:
13 | + a number of useful RE macros;
14 | + a test bench for testing and documenting new macro environments;
15 | * built-in support for the TDFA and PCRE back ends;
16 | * comprehensive documentation, tutorials and copious examples.
17 |
18 |
19 | See the [About page](http://about.regex.uk) for details.
20 |
21 |
22 | ## regex and regex-examples
23 |
24 | The library and tutorial, tests and examples have been split across
25 | two packages:
26 |
27 | * the `regex` package contains the regex library with the Posix TDFA
28 | back end
29 | * the `regex-with-pcre` library package contains the extra modules
30 | needed for the PCRE back end
31 | * the `regex-examples` package contains the tutorial, tests
32 | and example programs.
33 |
34 |
35 | ## Road Map
36 |
37 | ☒ 2017-04-10 v1.0.0.0 [First stable release](https://github.com/iconnect/regex/milestone/3)
38 |
39 | ☒ 2017-06-03 v1.0.1.0 [PCRE.Text, strict PVP, Update Stackage vrns, add re-top](https://github.com/iconnect/regex/milestone/19)
40 |
41 | ☒ 2017-06-04 v1.0.1.1 [Fix 1.0.1.0 release bug and provisionally fix UTF8/PCRE interworking](https://github.com/iconnect/regex/milestone/20)
42 |
43 | ☒ 2017-06-05 v1.0.1.2 [Permit utf8-string-1](https://github.com/iconnect/regex/milestone/21)
44 |
45 | ☒ 2017-06-05 v1.0.1.3 [Suspend Windows tests for PCRE on UTF-8 text](https://github.com/iconnect/regex/milestone/22)
46 |
47 | ☒ 2018-12-14 v1.0.1.4 [Fix for GHC 8.4.4, GHC-8.6.2](https://github.com/iconnect/regex/milestone/23)
48 |
49 | ☒ 2018-12-18 v1.0.1.5 [TDFA quasi quoters not dealing with newlines](https://github.com/iconnect/regex/milestone/24)
50 |
51 | ☒ 2018-12-19 v1.0.2.0 [Tidy build issues](https://github.com/iconnect/regex/milestone/25)
52 |
53 | ☒ 2020-01-27 v1.1.0.0 [Adapt for MonadFail/base-4.13/GHC-8.8](https://github.com/iconnect/regex/milestone/26)
54 |
55 | ☒ 2021-12-18 v1.1.0.1 [Fix for base-4.16.0.0/GHC 9.2.1](https://github.com/iconnect/regex/milestone/27)
56 |
57 |
58 |
59 | See the [Roadmap page](http://roadmap.regex.uk) for details.
60 |
61 |
62 | ## The regex blog
63 |
64 | Check out the [regex blog](http://blog.regex.uk) for news articles and
65 | discussion concerning all things regex.
66 |
67 |
68 | ## Build Status
69 |
70 | [](https://hackage.haskell.org/package/regex) [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [](https://travis-ci.org/iconnect/regex) [](https://ci.appveyor.com/project/engineerirngirisconnectcouk/regex/branch/master) [](https://coveralls.io/github/iconnect/regex?branch=master)
71 |
72 | See [build status page](http://regex.uk/build-status) for details.
73 |
74 |
75 | ## Installing the Package
76 |
77 | The package can be easily installed with cabal or stack on GHC-8.0,
78 | 7.10 or 7.8 for the above platforms. See the
79 | [Installation page](http://installation.regex.uk) for details.
80 |
81 |
82 | ## The Tutorial Tests and Examples
83 |
84 | See the [Tutorial page](http://tutorial.regex.uk) and
85 | [Examples page](http://examples.regex.uk) for details.
86 |
87 |
88 | ## Helping Out
89 |
90 | If you have any feedback or suggestion then please drop us a line.
91 |
92 | * `t` [@hregex](https://twitter.com/hregex)\n
93 | * `e` maintainers@regex.uk\n
94 | * `w` http://issues.regex.uk
95 |
96 | The [Contact page](http://contact.regex.uk) has more details.
97 |
98 |
99 | ## The API
100 |
101 | The Haddocks can be found at http://hs.regex.uk.
102 |
103 |
104 | ## The Macro Tables
105 |
106 | The macro environments are an important part of the package and
107 | are documented [here](http://macros.regex.uk).
108 |
109 |
110 | ## The regex.uk Directory
111 |
112 | A handy overview of the regex.uk domain can be found
113 | [here](http://directory.regex.uk).
114 |
115 |
116 | ## The Changelog
117 |
118 | The `changelog` is posted [here](http://changelog.regex.uk).
119 |
120 |
121 | ## The Authors
122 |
123 | This library was written and is currently maintained by
124 | [Chris Dornan](mailto:chris.dornan@irisconnect.com) aka
125 | [@cdornan](https://twitter.com/cdornan)
126 |
--------------------------------------------------------------------------------
/lib/cabal-masters/constraints-incl.cabal:
--------------------------------------------------------------------------------
1 | %- array >= 0.4
2 | %- base >= 4 && < 5
3 | %- base-compat >= 0.6 && < 1
4 | %- blaze-html >= 0.8.1.0
5 | %- bytestring >= 0.10
6 | %- containers >= 0.4
7 | %- data-default >= 0.5.3
8 | %- directory >= 1.2.1.0
9 | %- filepath >= 1.3.0.2
10 | %- hashable >= 1.2
11 | %- heredoc >= 0.2.0.0
12 | %- http-conduit >= 2.1.7.2
13 | %- pandoc >= 1.13.2.1
14 | %- regex-base >= 0.93
15 | %- regex-pcre-builtin >= 0.94
16 | %- regex-tdfa >= 1.3.1.0
17 | %- shelly >= 1.6.1.2
18 | %- smallcheck >= 1.1.1
19 | %- tasty >= 0.10.1.2
20 | %- tasty-hunit >= 0.9.2
21 | %- tasty-smallcheck >= 0.8.0.1
22 | %- template-haskell >= 2.7
23 | %- text >= 1.2
24 | %- time >= 1.4.2
25 | %- time-locale-compat >= 0.1
26 | %- transformers >= 0.2.2
27 | %- unordered-containers >= 0.2
28 | %- utf8-string >= 1
29 |
--------------------------------------------------------------------------------
/lib/cabal-masters/library-incl.cabal:
--------------------------------------------------------------------------------
1 | Library
2 | Hs-Source-Dirs: .
3 | Exposed-Modules:
4 | Text.RE
5 | Text.RE.PCRE
6 | Text.RE.PCRE.ByteString
7 | Text.RE.PCRE.ByteString.Lazy
8 | Text.RE.PCRE.Sequence
9 | Text.RE.PCRE.String
10 | Text.RE.PCRE.Text
11 | Text.RE.PCRE.Text.Lazy
12 | Text.RE.REOptions
13 | Text.RE.Replace
14 | Text.RE.Summa
15 | Text.RE.TDFA
16 | Text.RE.TDFA.ByteString
17 | Text.RE.TDFA.ByteString.Lazy
18 | Text.RE.TDFA.Sequence
19 | Text.RE.TDFA.String
20 | Text.RE.TDFA.Text
21 | Text.RE.TDFA.Text.Lazy
22 | Text.RE.TestBench
23 | Text.RE.TestBench.Parsers
24 | Text.RE.Tools
25 | Text.RE.Tools.Edit
26 | Text.RE.Tools.Find
27 | Text.RE.Tools.Grep
28 | Text.RE.Tools.IsRegex
29 | Text.RE.Tools.Lex
30 | Text.RE.Tools.Sed
31 | Text.RE.ZeInternals
32 | Text.RE.ZeInternals.Types.Poss
33 |
34 | Other-Modules:
35 | Text.RE.ZeInternals.AddCaptureNames
36 | Text.RE.ZeInternals.EscapeREString
37 | Text.RE.ZeInternals.NamedCaptures
38 | Text.RE.ZeInternals.PCRE
39 | Text.RE.ZeInternals.PreludeMacros
40 | Text.RE.ZeInternals.QQ
41 | Text.RE.ZeInternals.Replace
42 | Text.RE.ZeInternals.SearchReplace
43 | Text.RE.ZeInternals.SearchReplace.PCRE
44 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString
45 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString.Lazy
46 | Text.RE.ZeInternals.SearchReplace.PCRE.Sequence
47 | Text.RE.ZeInternals.SearchReplace.PCRE.String
48 | Text.RE.ZeInternals.SearchReplace.PCRE.Text
49 | Text.RE.ZeInternals.SearchReplace.PCRE.Text.Lazy
50 | Text.RE.ZeInternals.SearchReplace.PCREEdPrime
51 | Text.RE.ZeInternals.SearchReplace.TDFA
52 | Text.RE.ZeInternals.SearchReplace.TDFA.ByteString
53 | Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy
54 | Text.RE.ZeInternals.SearchReplace.TDFA.Sequence
55 | Text.RE.ZeInternals.SearchReplace.TDFA.String
56 | Text.RE.ZeInternals.SearchReplace.TDFA.Text
57 | Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy
58 | Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
59 | Text.RE.ZeInternals.TDFA
60 | Text.RE.ZeInternals.TestBench
61 | Text.RE.ZeInternals.TestBench.Parsers
62 | Text.RE.ZeInternals.Tools.Lex
63 | Text.RE.ZeInternals.Types.Capture
64 | Text.RE.ZeInternals.Types.CaptureID
65 | Text.RE.ZeInternals.Types.IsRegex
66 | Text.RE.ZeInternals.Types.LineNo
67 | Text.RE.ZeInternals.Types.Match
68 | Text.RE.ZeInternals.Types.Matches
69 | Text.RE.ZeInternals.Types.SearchReplace
70 |
--------------------------------------------------------------------------------
/lib/cabal-masters/mega-regex.cabal:
--------------------------------------------------------------------------------
1 | Name: regex
2 | Version: <<$version$>>
3 | Synopsis: Toolkit for regex-base
4 | Description: A regular expression toolkit for regex-base with
5 | compile-time checking of RE syntax, data types for
6 | matches and captures, a text replacement toolkit,
7 | portable options, high-level AWK-like tools
8 | for building text processing apps, regular expression
9 | macros with parsers and test bench, comprehensive
10 | documentation, tutorials and copious examples.
11 | Homepage: http://regex.uk
12 | Author: Chris Dornan
13 | License: BSD3
14 | license-file: LICENSE
15 | Maintainer: Chris Dornan
16 | Copyright: Chris Dornan 2016-2017
17 | Category: Text
18 | Build-type: Simple
19 | Stability: Stable
20 | bug-reports: http://issues.regex.uk
21 |
22 | %include "lib/cabal-masters/test-extra-source-files-incl.cabal"
23 |
24 | Cabal-Version: >= 1.10
25 |
26 | Source-Repository head
27 | type: git
28 | location: https://github.com/iconnect/regex.git
29 |
30 | Source-Repository this
31 | Type: git
32 | Location: https://github.com/iconnect/regex.git
33 | Tag: <<$version$>>
34 |
35 | %Werror
36 | %filter-regex-with-pcre
37 | %include "lib/cabal-masters/constraints-incl.cabal"
38 |
39 | %include "lib/cabal-masters/library-incl.cabal"
40 |
41 | %build-depends-lib array bytestring base base-compat containers hashable regex-base regex-tdfa regex-pcre-builtin template-haskell text time time-locale-compat transformers unordered-containers utf8-string
42 |
43 | %include "lib/cabal-masters/executables-incl.cabal"
44 |
45 | -- Generated from lib/cabal-masters/mega-regex with re-gen-cabals
46 |
--------------------------------------------------------------------------------
/lib/cabal-masters/regex-examples.cabal:
--------------------------------------------------------------------------------
1 | Name: regex-examples
2 | Version: <<$version$>>
3 | Synopsis: Tutorial, tests and example programs for regex
4 | Description: Tutorial, tests and example programs for regex,
5 | a Regular Expression Toolkit for regex-base with
6 | Compile-time checking of RE syntax, data types for
7 | matches and captures, a text replacement toolkit,
8 | portable options, high-level AWK-like tools
9 | for building text processing apps, regular expression
10 | macros and test bench, a tutorial and copious examples.
11 | Homepage: http://regex.uk
12 | Author: Chris Dornan
13 | License: BSD3
14 | license-file: LICENSE
15 | Maintainer: Chris Dornan
16 | Copyright: Chris Dornan 2016-2017
17 | Category: Text
18 | Build-type: Simple
19 | Stability: Stable
20 | bug-reports: http://issues.regex.uk
21 |
22 | %include "lib/cabal-masters/test-extra-source-files-incl.cabal"
23 |
24 | Cabal-Version: >= 1.10
25 |
26 | Source-Repository head
27 | type: git
28 | location: https://github.com/iconnect/regex.git
29 |
30 | Source-Repository this
31 | Type: git
32 | Location: https://github.com/iconnect/regex.git
33 | Tag: <<$version$>>
34 |
35 | %Wwarn
36 | %include "lib/cabal-masters/constraints-incl.cabal"
37 | %include "lib/cabal-masters/executables-incl.cabal"
38 |
39 | -- Generated with re-gen-cabals
40 |
--------------------------------------------------------------------------------
/lib/cabal-masters/regex-incl.cabal:
--------------------------------------------------------------------------------
1 | Version: <<$version$>>
2 | Synopsis: Toolkit for regex-base
3 | Description: A regular expression toolkit for regex-base with
4 | compile-time checking of RE syntax, data types for
5 | matches and captures, a text replacement toolkit,
6 | portable options, high-level AWK-like tools
7 | for building text processing apps, regular expression
8 | macros with parsers and test bench, comprehensive
9 | documentation, tutorials and copious examples.
10 | Homepage: http://regex.uk
11 | Author: Chris Dornan
12 | License: BSD3
13 | license-file: LICENSE
14 | Maintainer: Chris Dornan
15 | Copyright: Chris Dornan 2016-2017
16 | Category: Text
17 | Build-type: Simple
18 | Stability: Stable
19 | bug-reports: http://issues.regex.uk
20 |
21 | Extra-Source-Files:
22 | README.md
23 | changelog
24 |
25 | Cabal-Version: >= 1.10
26 |
27 | Source-Repository head
28 | type: git
29 | location: https://github.com/iconnect/regex.git
30 |
31 | Source-Repository this
32 | Type: git
33 | Location: https://github.com/iconnect/regex.git
34 | Tag: <<$version$>>
35 |
36 | %Wwarn
37 |
--------------------------------------------------------------------------------
/lib/cabal-masters/regex-with-pcre.cabal:
--------------------------------------------------------------------------------
1 | Name: regex-with-pcre
2 | %include "lib/cabal-masters/regex-incl.cabal"
3 | %include "lib/cabal-masters/constraints-incl.cabal"
4 | Library
5 | Hs-Source-Dirs: .
6 |
7 | Exposed-Modules:
8 | Text.RE.PCRE
9 | Text.RE.PCRE.ByteString
10 | Text.RE.PCRE.ByteString.Lazy
11 | Text.RE.PCRE.Sequence
12 | Text.RE.PCRE.String
13 | Text.RE.PCRE.Text
14 | Text.RE.PCRE.Text.Lazy
15 |
16 | Other-Modules:
17 | Text.RE.ZeInternals.PCRE
18 | Text.RE.ZeInternals.SearchReplace.PCRE
19 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString
20 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString.Lazy
21 | Text.RE.ZeInternals.SearchReplace.PCRE.Sequence
22 | Text.RE.ZeInternals.SearchReplace.PCRE.String
23 | Text.RE.ZeInternals.SearchReplace.PCRE.Text
24 | Text.RE.ZeInternals.SearchReplace.PCRE.Text.Lazy
25 | Text.RE.ZeInternals.SearchReplace.PCREEdPrime
26 | Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
27 | Text.RE.ZeInternals.TDFA
28 |
29 | %build-depends-lib base base-compat bytestring containers regex-base regex regex-pcre-builtin regex-tdfa template-haskell text transformers unordered-containers
30 |
31 | -- Generated with re-gen-cabals
32 |
--------------------------------------------------------------------------------
/lib/cabal-masters/regex.cabal:
--------------------------------------------------------------------------------
1 | Name: regex
2 | %include "lib/cabal-masters/regex-incl.cabal"
3 | %include "lib/cabal-masters/constraints-incl.cabal"
4 | %include "lib/cabal-masters/library-incl.cabal" exclude "PCRE"
5 |
6 | %build-depends-lib array base base-compat bytestring containers hashable regex-base regex-pcre-builtin regex-tdfa template-haskell text time time-locale-compat transformers unordered-containers utf8-string
7 |
8 | -- Generated with re-gen-cabals
9 |
--------------------------------------------------------------------------------
/lib/cabal-masters/test-extra-source-files-incl.cabal:
--------------------------------------------------------------------------------
1 | Extra-Source-Files:
2 | README.md
3 | changelog
4 | data/2015-16-premierleague.txt
5 | data/access-errors.log
6 | data/access.log
7 | data/error.log
8 | data/events.log
9 | data/include-result.lhs
10 | data/league-table.md
11 | data/pp-result-doc.lhs
12 | data/pp-result-gen.lhs
13 | data/pp-test.lhs
14 | data/pcre-nginx-log-processor.txt
15 | data/tdfa-macros.txt
16 | data/pcre-macros.txt
17 | lib/cabal-masters/constraints-incl.cabal
18 | lib/cabal-masters/executables-incl.cabal
19 | lib/cabal-masters/library-incl.cabal
20 | lib/cabal-masters/mega-regex.cabal
21 | lib/cabal-masters/regex.cabal
22 | lib/cabal-masters/regex-examples.cabal
23 | lib/cabal-masters/test-extra-source-files-incl.cabal
24 | lib/mega-regex.cabal
25 | lib/version.txt
26 | src/Text/RE/PCRE/ByteString.hs
27 | src/Text/RE/PCRE/ByteString/Lazy.hs
28 | src/Text/RE/PCRE/Sequence.hs
29 | src/Text/RE/PCRE/String.hs
30 | src/Text/RE/PCRE/Text.hs
31 | src/Text/RE/PCRE/Text/Lazy.hs
32 | src/Text/RE/TDFA/ByteString.hs
33 | src/Text/RE/TDFA/ByteString/Lazy.hs
34 | src/Text/RE/TDFA/Sequence.hs
35 | src/Text/RE/TDFA/String.hs
36 | src/Text/RE/TDFA/Text.hs
37 | src/Text/RE/TDFA/Text/Lazy.hs
38 |
--------------------------------------------------------------------------------
/lib/favicons.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
--------------------------------------------------------------------------------
/lib/ghci:
--------------------------------------------------------------------------------
1 | :set -Wall
2 |
3 | :seti -XOverloadedStrings
4 | :seti -XQuasiQuotes
5 |
6 | :set -hide-package base-compat-batteries
7 |
8 | :set -iexamples
9 |
--------------------------------------------------------------------------------
/lib/hackage-template.svg:
--------------------------------------------------------------------------------
1 |
2 |
22 |
--------------------------------------------------------------------------------
/lib/md/about.md:
--------------------------------------------------------------------------------
1 | %heading#aboutregex About regex
2 |
3 | %include "lib/md/summary-incl.md"
4 |
5 |
6 | %heading#aboutfolks About the Maintainers
7 |
8 | [Chris Dornan](mailto:chris@chrisdornan.com) ([@cdornan](https://twitter.com/CDornan))
9 | is the [chief engineer](https://github.com/iconnect) at [IRIS Connect](http://www.irisconnect.co.uk/) and the
10 | original author of [Alex](http://hackage.haskell.org/package/alex).
11 |
--------------------------------------------------------------------------------
/lib/md/build-status.md:
--------------------------------------------------------------------------------
1 | %heading#build The Live Build Status
2 |
3 | All of the badges elsewhere represent the build status of the current version
4 | of regex in Hackage. This page however collects the live status of the
5 | Travis-CI and AppVeyor pipelines that monitor the head of the repository.
6 |
7 | | Service | O/S | Build | GHC | LTS | extra-deps (\*) | Werror | Build Status
8 | | ------------ | ------- | ------------- | ------ | ---- | ----------------------- | ------------- | -------------
9 | | Hackage | | | | | | ‑Wwarn | [](https://hackage.haskell.org/package/regex)
10 | | Licence | | | | | | | [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)
11 | | Travis CI | Linux | release-stack | 8.0.2 | 8.16 | | ‑Werror | [](https://travis-ci.org/iconnect/regex)
12 | | | Linux | stack | 7.10.3 | 6.33 | | ‑Werror |
13 | | | Linux | stack | 7.8.4 | 2.22 | regex-tdfa-text-1.0.0.3 | ‑Werror |
14 | | | Linux | stack | 8.0.2 | 8.16 | | ‑Werror |
15 | | | Linux | cabal | 7.10.3 | | | ‑Werror |
16 | | | Linux | stack | 8.0.2 | 2017‑06‑02 | | ‑Werror |
17 | | | macOS | stack | 7.8.4 | 2.22 | | ‑Werror |
18 | | | macOS | stack | 8.0.2 | 8.16 | | ‑Werror |
19 | | AppVeyor | Windows | stack | 8.0.2 | 8.16 | | ‑Werror | [](https://ci.appveyor.com/project/cdornan/regex)
20 | | coveralls.io | Linux | stack | 7.10.3 | 6.33 | | ‑Werror | [](https://coveralls.io/github/iconnect/regex?branch=master)
21 |
22 | (\*) extra-deps packages needed by the library only, apart from
23 | regex-pcre-text-0.94.0.0
24 |
25 | %heading#coveragenote Coverage Exceptions
26 |
27 | The following modules have been exempted from the code coverage statistics.
28 |
29 | | Module Exempted | Reason
30 | | -------------------- | -----------------------------------------------------------------------------
31 | | [Text.RE.ZeInternals.QQ](https://github.com/iconnect/regex/blob/master/Text/RE/Internal/QQ.hs) | Toolkit for use in quasi quoter contexts only which can't be measured by hps.
32 |
33 |
34 | %heading#hackagebuild The regex Hackage Matrix Builder
35 |
36 | The regex Hackage Matrix Builder summarizes the buildability of each version of
37 | each Hackage package:
38 |
39 | * [`regex`](https://matrix.hackage.haskell.org/package/regex)
40 | * [`regex-with-pcre`](https://matrix.hackage.haskell.org/package/regex-with-pcre)
41 | * [`regex-examples`](https://matrix.hackage.haskell.org/package/regex-examples)
42 |
--------------------------------------------------------------------------------
/lib/md/changelog.md:
--------------------------------------------------------------------------------
1 | %heading#changelog The regex Changelog
2 |
3 | ```changelog
4 | %include "changelog"
5 | ```
6 |
--------------------------------------------------------------------------------
/lib/md/contact.md:
--------------------------------------------------------------------------------
1 | %heading#helpingout Helping Out
2 |
3 | We are happy to receive feedback, suggestions, bug reports, fixes,
4 | documentation enhancements, and other improvements.
5 |
6 | Please report bugs via the [issue tracker](http://issues.regex.uk).
7 |
8 | You can tweet us [@hregex](https://twitter.com/hregex) or email us
9 | or .
10 |
--------------------------------------------------------------------------------
/lib/md/directory.md:
--------------------------------------------------------------------------------
1 | %heading#gendirectory The General Directory
2 |
3 | | address | goodies
4 | |-------------------------------------------|--------------------------------------
5 | | | the regex blog
6 | | | the live build status page
7 | | | the Hackage Matrix Builder regex page
8 | | | contacting the maintainer
9 | | | the regex GitHub repository
10 | | | this page
11 | | | the regex examples, tutorial and tests
12 | | | the Hackage Matrix Builder regex page
13 | | | the regex haddocks
14 | | | the regex haddocks
15 | | | the regex installation instructions
16 | | | the regex issue tracker
17 | | | the regex macro tables
18 | | | the table of PCRE macros
19 | | | tabulation of the source of each PCRE macro
20 | | mailto:regex@chrisdornan.com | regex maintainer contact email address
21 | | | the regex release roadmap and tentative schedule
22 | | | the live build status page
23 | | | the live build status page
24 | | | the table of TDFA macros
25 | | | tabulation of the source of each TDFA macro
26 | | | the @hregex twitter home page
27 |
28 |
29 | %heading#exdirectory The Examples Directory
30 |
31 | | address | goodies
32 | |-------------------------------------------|--------------------------------------
33 | | | examples/re-gen-cabals.lhs
34 | | | examples/re-gen-modules.lhs
35 | | | examples/re-include.lhs
36 | | | examples/re-nginx-log-processor.lhs
37 | | | examples/re-prep.lhs
38 | | | examples/re-sort-imports.lhs
39 | | | examples/re-tests.lhs
40 | | | examples/re-tutorial.lhs
41 | | | examples/tutorial-options.lhs
42 | | | examples/tutorial-replacing.lhs
43 | | | examples/tutorial-testbench.lhs
44 | | | examples/tutorial-tools.lhs
45 | | | examples/TestKit.lhs
46 |
47 |
48 |
49 | %heading#libdirectory The Library Modules Directory
50 |
51 | | address | goodies
52 | |-------------------------------------------|--------------------------------------
53 | | | RE.Capture
54 | | | RE.Edit
55 | | | RE.Grep
56 | | | RE.IsRegex
57 | | | RE.Lex
58 | | | RE.Match
59 | | | RE.Matches
60 | | | RE.NamedCaptures
61 | | | RE.Options
62 | | | Re.Replace
63 | | | RE.Sed
64 | | | RE.TestBench
65 |
--------------------------------------------------------------------------------
/lib/md/examples.md:
--------------------------------------------------------------------------------
1 | %heading#tutorial The Tutorial
2 |
3 | The Tutorial [examples/re-tutorial.lhs](re-tutorial.html)
4 | provides an introduction to the package with simple examples that you can try
5 | out in your favourite Haskell REPL and references to examples in the example
6 | programs and library code.
7 |
8 |
9 | %heading#tests The Test Suite
10 |
11 | The Library Tests [examples/re-tests.lhs](re-tests.html)
12 | contains a number of test suites for exercising various components of the library.
13 |
14 |
15 | %heading#programs The NGINX Log Processor
16 |
17 | The NGINX Log Processor Example [examples/re-nginx-log-processor.lhs](re-nginx-log-processor.html)
18 | provides an extended example of large-scale RE development with the regex test bench.
19 |
20 |
21 | %heading#tools The Regex Example Programs
22 |
23 | * The Include Processor Example [examples/re-include.lhs](re-include.html)
24 | is the starting point for the preprocessor that we use to generate the tutorial
25 | HTML and its derived test suite.
26 |
27 | * The Cabal Processor Example [examples/re-gen-cabals.lhs](re-gen-cabals.html)
28 | is the Sed preprocessor we use to generate our cabal file from the template
29 | in [lib/regex-master.cabal](https://github.com/iconnect/regex/blob/master/lib/regex-master.cabal).
30 |
31 | * The Tutorial Preprocessor [examples/re-prep.lhs](re-prep.html)
32 | contains the tool we use to generate the tutorial HTML and its derived test suite.
33 |
34 | * The API Module Generator [examples/re-gen-modules.lhs](re-gen-modules.html)
35 | contains a tool for generating the parts of the API that can be easily synthesized from a
36 | seed/master module.
37 |
38 | * The Cabal-file Generator [examples/re-gen-modules.lhs](re-gen-modules.html)
39 | contains a tool for generating the cabal file from the template(s) in `lib/cabal-masters`.
40 |
41 | * The league-table generator [examples/re-top.lhs](re-top.html) generates
42 | top-n league tables from this [openfootball](https://github.com/cdornan/eng-england/tree/corrections)
43 | data. Some example tables can be found [here](league-tables/index.html).
44 |
45 | %heading#library Selected Library Modules
46 |
47 | Some of the library modules have been prepared as literate programs for easy
48 | browsing of their underlying source code.
49 |
50 | * [Text.RE.Capture](Capture.html) contains the definitions of the
51 | `Matches`, `Match` and `Capture` data types (with helpers) that form the
52 | foundations for everything else.
53 |
54 | * [Text.RE.Replace](Replace.html) contains the text-replacement toolkit.
55 |
56 | * [Text.RE.Options](Options.html) contains the `Options` types for
57 | controlling RE parsing and compilation.
58 |
59 | * [Text.RE.IsRegex](IsRegex.html) contains the IsRegex class for writing
60 | polymorphic regex tools that work with all regex back ends and text
61 | type combinations.
62 |
63 | * [Text.RE.TestBench](TestBench.html) contains the test bench used to
64 | build the standard macro environment and can be used for developing
65 | other macro environments with test and documentation.
66 |
67 | * [Text.RE.Edit](Edit.html) contains the polymorphic editing toolkit
68 | used by `Text.RE.Tools.Sed`.
69 |
70 | * [Text.RE.Tools.Sed](Sed.html) contains the Sed tool for building
71 | awk-like text processors.
72 |
73 | * [Text.RE.Tools.Grep](Grep.html) contains a simple grep tool for
74 | extracting lines that match a RE from a file.
75 |
76 | * [Text.RE.Tools.Lex](Lex.html) contains a simple scanning tool for
77 | building prototype scanners before being discarded or converted
78 | into Alex scanners.
79 |
80 | * [Text.RE.Internal.NamedCaptures](NamedCaptures.html)
81 | is an internal library module for dealing with named captures in REs.
82 |
--------------------------------------------------------------------------------
/lib/md/index.md:
--------------------------------------------------------------------------------
1 | # <<$title$>>
2 |
3 | %include "lib/md/summary-incl.md"
4 |
5 | See the [About page](http://about.regex.uk) for details.
6 |
7 |
8 | %heading#twopackages regex and regex-examples
9 |
10 | The library and tutorial, tests and examples have been split across
11 | two packages:
12 |
13 | * the `regex` package contains the regex library with the Posix TDFA
14 | back end
15 | * the `regex-with-pcre` library package contains the extra modules
16 | needed for the PCRE back end
17 | * the `regex-examples` package contains the tutorial, tests
18 | and example programs.
19 |
20 |
21 | %heading#roadmap Road Map
22 |
23 | %include "lib/md/roadmap-incl.md"
24 |
25 | See the [Roadmap page](http://roadmap.regex.uk) for details.
26 |
27 |
28 | %heading#blogrm The regex blog
29 |
30 | Check out the [regex blog](http://blog.regex.uk) for news articles and
31 | discussion concerning all things regex.
32 |
33 |
34 | %heading#build Build Status
35 |
36 | [](https://hackage.haskell.org/package/regex) [](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) [](https://travis-ci.org/iconnect/regex) [](https://ci.appveyor.com/project/engineerirngirisconnectcouk/regex/branch/master) [](https://coveralls.io/github/iconnect/regex?branch=master)
37 |
38 | See [build status page](http://regex.uk/build-status) for details.
39 |
40 |
41 | %heading#installation Installing the Package
42 |
43 | The package can be easily installed with cabal or stack on GHC-8.0,
44 | 7.10 or 7.8 for the above platforms. See the
45 | [Installation page](http://installation.regex.uk) for details.
46 |
47 |
48 | %heading#examples The Tutorial Tests and Examples
49 |
50 | See the [Tutorial page](http://tutorial.regex.uk) and
51 | [Examples page](http://examples.regex.uk) for details.
52 |
53 |
54 | %heading#helping Helping Out
55 |
56 | If you have any feedback or suggestion then please drop us a line.
57 |
58 | * `t` [@hregex](https://twitter.com/hregex)
59 | * `e` maintainers@regex.uk
60 | * `w` http://issues.regex.uk
61 |
62 | The [Contact page](http://contact.regex.uk) has more details.
63 |
64 |
65 | %heading#api The API
66 |
67 | The Haddocks can be found at http://hs.regex.uk.
68 |
69 |
70 | %heading#macros The Macro Tables
71 |
72 | The macro environments are an important part of the package and
73 | are documented [here](http://macros.regex.uk).
74 |
75 |
76 | %heading#directory The regex.uk Directory
77 |
78 | A handy overview of the regex.uk domain can be found
79 | [here](http://directory.regex.uk).
80 |
81 |
82 | %heading#rmchangelog The Changelog
83 |
84 | The `changelog` is posted [here](http://changelog.regex.uk).
85 |
86 |
87 | %heading#authors The Authors
88 |
89 | This library was written and is currently maintained by
90 | [Chris Dornan](mailto:chris.dornan@irisconnect.com) aka
91 | [@cdornan](https://twitter.com/cdornan)
92 |
--------------------------------------------------------------------------------
/lib/md/installation.md:
--------------------------------------------------------------------------------
1 | %heading#cabalinstall Installing with Cabal
2 |
3 | The regex package is [tested with](build-status) GHC 7.8.4, 7.10.3 and 8.0.1:
4 |
5 | ```bash
6 | cabal update && cabal install regex
7 | ```
8 |
9 | %heading#stackinstall Installing with Stack
10 |
11 | We maintain for stack configurations:
12 |
13 | ```bash
14 | stack --stack-yaml stack-8.8.yaml install regex
15 | ```
16 |
17 | and
18 |
19 | ```bash
20 | stack --stack-yaml stack-8.6.yaml install regex
21 | ```
22 |
23 | and
24 |
25 | ```bash
26 | stack --stack-yaml stack-8.4.yaml install regex
27 | ```
28 |
29 | and
30 |
31 | ```bash
32 | stack --stack-yaml stack-8.2.yaml install regex
33 | ```
34 |
35 |
36 | %heading#cabaltutorial Loading the Tutorial with Cabal
37 |
38 | %include "lib/md/load-tutorial-cabal-incl.md"
39 |
40 |
41 | %heading#stacktutorial Loading the Tutorial with Stack
42 |
43 | %include "lib/md/load-tutorial-stack-incl.md"
44 |
45 |
46 | %heading#cabaltest Running the tests with Cabal
47 |
48 | To run the tests with cabal, change into the root folder and:
49 |
50 | ```bash
51 | cabal test
52 | ```
53 |
54 |
55 | %heading#stacktest Running the tests with Stack
56 |
57 | To test with GHC-8.0 from the root folder:
58 | ```bash
59 | stack test --stack-yaml stack-8.0.yaml
60 | ```
61 |
--------------------------------------------------------------------------------
/lib/md/load-tutorial-cabal-incl.md:
--------------------------------------------------------------------------------
1 | First unpack the source distribution and change into the root folder
2 | ```bash
3 | cabal unpack regex
4 | cd regex-*
5 | ```
6 |
7 | And load the tutorial into ghci with cabal:
8 | ```bash
9 | cabal configure
10 | cabal repl re-tutorial
11 | ```
12 |
--------------------------------------------------------------------------------
/lib/md/load-tutorial-stack-incl.md:
--------------------------------------------------------------------------------
1 | To load the tutorial into ghc-8.0 with stack (from the unpacked root folder):
2 | ```bash
3 | stack --stack-yaml stack-8.0.yaml exec ghci -- -ghci-script lib/ghci examples/re-tutorial.lhs
4 | ```
5 |
--------------------------------------------------------------------------------
/lib/md/macros.md:
--------------------------------------------------------------------------------
1 | %heading#macros The Macro Tables
2 |
3 | These tables document the macros for the standard environment and for the
4 | [examples/re-nginx-log-processor](../re-examples/nginx-log-processor.lhs).
5 |
6 | The main tables have the following columns.
7 |
8 | | column | content |
9 | |--------------------|-------------------------------------------------------|
10 | | **name** | name of the macro |
11 | | **caps** | the number of captures in the RE |
12 | | **regex** | the RE (with macros) |
13 | | **examples** | examples that should be matched by the RE |
14 | | **anti-examples** | examples that should not be match by the RE |
15 | | **fails** | messages for failing tests (should be empty) |
16 | | **parser** | name of Haskell parser for the matched text (optional)|
17 | | **comment** | notes |
18 |
19 | **These tables best viewed raw.**
20 |
21 | * The [Prelude macros for PCRE](pcre-macros.txt) (and the [macro sources](pcre-macros-src.txt))
22 | * The [Prelude macros for TDFA](tdfa-macros.txt) (and the [macro sources](tdfa-macros-src.txt))
23 | * The [nginx-log-processor macros (for PCRE)](pcre-nginx-log-processor.txt) ([and the macro sources](pcre-nginx-log-processor-src.txt))
24 |
--------------------------------------------------------------------------------
/lib/md/reblog.md:
--------------------------------------------------------------------------------
1 | %heading#blog The Regex Blog
2 |
3 | We have a blog for announcements, articles and chat.
4 |
5 | The blog isn't up and running yet — that should happen
6 | just after the release of
7 | [v0.5.0.0 on 2016-07-06](https://github.com/iconnect/regex/milestone/6).
8 |
9 | In the meantime it has the announcement of May's HaskellX Bytes talk.
10 |
11 |
12 | %heading#haskellxbtalk HaskellX Bytes Talk
13 |
14 | The
15 | [abstract](http://regex.uk/posts/2017-02-26-0-haskellx-bytes-why-res-matter)
16 | of the HaskellX Bytes Talk at
17 | [CodeNode](https://skillsmatter.com/contact-us), London,
18 | to be given by Chris Dornan from **2017-05-08T1830+0100** has been posted
19 | on the blog.
20 |
--------------------------------------------------------------------------------
/lib/md/roadmap-incl.md:
--------------------------------------------------------------------------------
1 | - [X] 2017-04-10 v1.0.0.0 [First stable release](https://github.com/iconnect/regex/milestone/3)
2 | - [X] 2017-06-03 v1.0.1.0 [PCRE.Text, strict PVP, Update Stackage vrns, add re-top](https://github.com/iconnect/regex/milestone/19)
3 | - [X] 2017-06-04 v1.0.1.1 [Fix 1.0.1.0 release bug and provisionally fix UTF8/PCRE interworking](https://github.com/iconnect/regex/milestone/20)
4 | - [X] 2017-06-05 v1.0.1.2 [Permit utf8-string-1](https://github.com/iconnect/regex/milestone/21)
5 | - [X] 2017-06-05 v1.0.1.3 [Suspend Windows tests for PCRE on UTF-8 text](https://github.com/iconnect/regex/milestone/22)
6 | - [X] 2018-12-14 v1.0.1.4 [Fix for GHC 8.4.4, GHC-8.6.2](https://github.com/iconnect/regex/milestone/23)
7 | - [X] 2018-12-18 v1.0.1.5 [TDFA quasi quoters not dealing with newlines](https://github.com/iconnect/regex/milestone/24)
8 | - [X] 2018-12-19 v1.0.2.0 [Tidy build issues](https://github.com/iconnect/regex/milestone/25)
9 | - [X] 2020-01-27 v1.1.0.0 [Adapt for MonadFail/base-4.13/GHC-8.8](https://github.com/iconnect/regex/milestone/26)
10 | - [X] 2021-12-18 v1.1.0.1 [Fix for base-4.16.0.0/GHC 9.2.1](https://github.com/iconnect/regex/milestone/27)
11 | - [X] 2022-06-20 v1.1.0.2 [fix for #171](https://github.com/iconnect/regex/issues/171)
12 |
--------------------------------------------------------------------------------
/lib/md/roadmap.md:
--------------------------------------------------------------------------------
1 | %heading#roadmap The regex Roadmap
2 |
3 | %include "lib/md/roadmap-incl.md"
4 |
--------------------------------------------------------------------------------
/lib/md/summary-incl.md:
--------------------------------------------------------------------------------
1 | regex is a regular expression toolkit for regex-base with:
2 |
3 | * a text-replacement toolkit with type-safe text-replacement templates;
4 | * special datatypes for matches and captures;
5 | * compile-time checking of RE syntax;
6 | * a unified means of controlling case-sensitivity and multi-line options;
7 | * high-level AWK-like tools for building text processing apps;
8 | * the option of using match operators with reduced polymorphism on the
9 | text and result types;
10 | * regular expression macros including:
11 | + a number of useful RE macros;
12 | + a test bench for testing and documenting new macro environments;
13 | * built-in support for the TDFA and PCRE back ends;
14 | * comprehensive documentation, tutorials and copious examples.
15 |
--------------------------------------------------------------------------------
/lib/md/tutorial.md:
--------------------------------------------------------------------------------
1 | %heading#tutorial The regex Tutorials
2 |
3 | We have five tutorials, each of which is a literate Haskell program
4 | with interactive examples that can be tried out with ghci.
5 |
6 | * The [**regex tutorial**](re-tutorial.html) covers basic usage only.
7 | (**This tutorial is incomplete.**)
8 |
9 | * The [**regex replacing tutorial**](re-tutorial-replacing.html) covers
10 | the general regex replacement toolkit including a detailed look
11 | at the `Matches` and `Match` types. (**This tutorial is incomplete.**)
12 |
13 | * The [**regex options tutorial**](re-tutorial-options.html) covers
14 | the different ways of specifying configuring RE parsing and
15 | compilation. (**This tutorial is incomplete.**)
16 |
17 | * The [**regex tools tutorial**](re-tutorial-tools.html) looks at the
18 | regex tools, including a detailed look at the `IsRegex` class.
19 | (**This tutorial is incomplete.**)
20 |
21 | * The [**regex testbench tutorial**](re-tutorial-testbench.html) looks
22 | at the regex test bench through the `re-nginx-log-processor`
23 | example. (**This tutorial is incomplete.**)
24 |
25 |
26 | %heading#cabaltutorial Loading the Tutorial with Cabal
27 |
28 | %include "lib/md/load-tutorial-cabal-incl.md"
29 |
30 |
31 | %heading#stacktutorial Loading the Tutorial with Stack
32 |
33 | %include "lib/md/load-tutorial-stack-incl.md"
34 |
--------------------------------------------------------------------------------
/lib/regex-with-pcre.cabal:
--------------------------------------------------------------------------------
1 | Name: regex-with-pcre
2 | Version: 1.1.0.2
3 | Synopsis: Toolkit for regex-base
4 | Description: A regular expression toolkit for regex-base with
5 | compile-time checking of RE syntax, data types for
6 | matches and captures, a text replacement toolkit,
7 | portable options, high-level AWK-like tools
8 | for building text processing apps, regular expression
9 | macros with parsers and test bench, comprehensive
10 | documentation, tutorials and copious examples.
11 | Homepage: http://regex.uk
12 | Author: Chris Dornan
13 | License: BSD3
14 | license-file: LICENSE
15 | Maintainer: Chris Dornan
16 | Copyright: Chris Dornan 2016-2017
17 | Category: Text
18 | Build-type: Simple
19 | Stability: Stable
20 | bug-reports: http://issues.regex.uk
21 |
22 | Extra-Source-Files:
23 | README.md
24 | changelog
25 |
26 | Cabal-Version: >= 1.10
27 |
28 | Source-Repository head
29 | type: git
30 | location: https://github.com/iconnect/regex.git
31 |
32 | Source-Repository this
33 | Type: git
34 | Location: https://github.com/iconnect/regex.git
35 | Tag: 1.1.0.2
36 |
37 |
38 |
39 | Library
40 | Hs-Source-Dirs: .
41 |
42 | Exposed-Modules:
43 | Text.RE.PCRE
44 | Text.RE.PCRE.ByteString
45 | Text.RE.PCRE.ByteString.Lazy
46 | Text.RE.PCRE.Sequence
47 | Text.RE.PCRE.String
48 | Text.RE.PCRE.Text
49 | Text.RE.PCRE.Text.Lazy
50 |
51 | Other-Modules:
52 | Text.RE.ZeInternals.PCRE
53 | Text.RE.ZeInternals.SearchReplace.PCRE
54 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString
55 | Text.RE.ZeInternals.SearchReplace.PCRE.ByteString.Lazy
56 | Text.RE.ZeInternals.SearchReplace.PCRE.Sequence
57 | Text.RE.ZeInternals.SearchReplace.PCRE.String
58 | Text.RE.ZeInternals.SearchReplace.PCRE.Text
59 | Text.RE.ZeInternals.SearchReplace.PCRE.Text.Lazy
60 | Text.RE.ZeInternals.SearchReplace.PCREEdPrime
61 | Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
62 | Text.RE.ZeInternals.TDFA
63 |
64 | Default-Language: Haskell2010
65 |
66 | Other-Extensions:
67 | AllowAmbiguousTypes
68 | CPP
69 | DeriveDataTypeable
70 | DeriveGeneric
71 | ExistentialQuantification
72 | FlexibleContexts
73 | FlexibleInstances
74 | FunctionalDependencies
75 | GeneralizedNewtypeDeriving
76 | MultiParamTypeClasses
77 | NoImplicitPrelude
78 | OverloadedStrings
79 | QuasiQuotes
80 | RecordWildCards
81 | ScopedTypeVariables
82 | TemplateHaskell
83 | TypeSynonymInstances
84 | UndecidableInstances
85 |
86 | if !impl(ghc >= 8.0)
87 | Other-Extensions: TemplateHaskell
88 | else
89 | Other-Extensions: TemplateHaskellQuotes
90 |
91 | GHC-Options:
92 | -Wall
93 | -fwarn-tabs
94 | -Wwarn
95 |
96 | Build-depends:
97 | regex
98 | , base >= 4 && < 5
99 | , base-compat >= 0.6 && < 1
100 | , bytestring >= 0.10
101 | , containers >= 0.4
102 | , regex-base >= 0.93
103 | , regex-pcre-builtin >= 0.94
104 | , regex-tdfa >= 1.3.1.0
105 | , template-haskell >= 2.7
106 | , text >= 1.2
107 | , transformers >= 0.2.2
108 | , unordered-containers >= 0.2
109 |
110 |
111 | -- Generated with re-gen-cabals
112 |
--------------------------------------------------------------------------------
/lib/regex.cabal:
--------------------------------------------------------------------------------
1 | Name: regex
2 | Version: 1.1.0.2
3 | Synopsis: Toolkit for regex-base
4 | Description: A regular expression toolkit for regex-base with
5 | compile-time checking of RE syntax, data types for
6 | matches and captures, a text replacement toolkit,
7 | portable options, high-level AWK-like tools
8 | for building text processing apps, regular expression
9 | macros with parsers and test bench, comprehensive
10 | documentation, tutorials and copious examples.
11 | Homepage: http://regex.uk
12 | Author: Chris Dornan
13 | License: BSD3
14 | license-file: LICENSE
15 | Maintainer: Chris Dornan
16 | Copyright: Chris Dornan 2016-2017
17 | Category: Text
18 | Build-type: Simple
19 | Stability: Stable
20 | bug-reports: http://issues.regex.uk
21 |
22 | Extra-Source-Files:
23 | README.md
24 | changelog
25 |
26 | Cabal-Version: >= 1.10
27 |
28 | Source-Repository head
29 | type: git
30 | location: https://github.com/iconnect/regex.git
31 |
32 | Source-Repository this
33 | Type: git
34 | Location: https://github.com/iconnect/regex.git
35 | Tag: 1.1.0.2
36 |
37 |
38 |
39 | Library
40 | Hs-Source-Dirs: .
41 | Exposed-Modules:
42 | Text.RE
43 | Text.RE.REOptions
44 | Text.RE.Replace
45 | Text.RE.Summa
46 | Text.RE.TDFA
47 | Text.RE.TDFA.ByteString
48 | Text.RE.TDFA.ByteString.Lazy
49 | Text.RE.TDFA.Sequence
50 | Text.RE.TDFA.String
51 | Text.RE.TDFA.Text
52 | Text.RE.TDFA.Text.Lazy
53 | Text.RE.TestBench
54 | Text.RE.TestBench.Parsers
55 | Text.RE.Tools
56 | Text.RE.Tools.Edit
57 | Text.RE.Tools.Find
58 | Text.RE.Tools.Grep
59 | Text.RE.Tools.IsRegex
60 | Text.RE.Tools.Lex
61 | Text.RE.Tools.Sed
62 | Text.RE.ZeInternals
63 | Text.RE.ZeInternals.Types.Poss
64 |
65 | Other-Modules:
66 | Text.RE.ZeInternals.AddCaptureNames
67 | Text.RE.ZeInternals.EscapeREString
68 | Text.RE.ZeInternals.NamedCaptures
69 | Text.RE.ZeInternals.PreludeMacros
70 | Text.RE.ZeInternals.QQ
71 | Text.RE.ZeInternals.Replace
72 | Text.RE.ZeInternals.SearchReplace
73 | Text.RE.ZeInternals.SearchReplace.TDFA
74 | Text.RE.ZeInternals.SearchReplace.TDFA.ByteString
75 | Text.RE.ZeInternals.SearchReplace.TDFA.ByteString.Lazy
76 | Text.RE.ZeInternals.SearchReplace.TDFA.Sequence
77 | Text.RE.ZeInternals.SearchReplace.TDFA.String
78 | Text.RE.ZeInternals.SearchReplace.TDFA.Text
79 | Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy
80 | Text.RE.ZeInternals.SearchReplace.TDFAEdPrime
81 | Text.RE.ZeInternals.TDFA
82 | Text.RE.ZeInternals.TestBench
83 | Text.RE.ZeInternals.TestBench.Parsers
84 | Text.RE.ZeInternals.Tools.Lex
85 | Text.RE.ZeInternals.Types.Capture
86 | Text.RE.ZeInternals.Types.CaptureID
87 | Text.RE.ZeInternals.Types.IsRegex
88 | Text.RE.ZeInternals.Types.LineNo
89 | Text.RE.ZeInternals.Types.Match
90 | Text.RE.ZeInternals.Types.Matches
91 | Text.RE.ZeInternals.Types.SearchReplace
92 |
93 |
94 | Default-Language: Haskell2010
95 |
96 | Other-Extensions:
97 | AllowAmbiguousTypes
98 | CPP
99 | DeriveDataTypeable
100 | DeriveGeneric
101 | ExistentialQuantification
102 | FlexibleContexts
103 | FlexibleInstances
104 | FunctionalDependencies
105 | GeneralizedNewtypeDeriving
106 | MultiParamTypeClasses
107 | NoImplicitPrelude
108 | OverloadedStrings
109 | QuasiQuotes
110 | RecordWildCards
111 | ScopedTypeVariables
112 | TemplateHaskell
113 | TypeSynonymInstances
114 | UndecidableInstances
115 |
116 | if !impl(ghc >= 8.0)
117 | Other-Extensions: TemplateHaskell
118 | else
119 | Other-Extensions: TemplateHaskellQuotes
120 |
121 | GHC-Options:
122 | -Wall
123 | -fwarn-tabs
124 | -Wwarn
125 |
126 | Build-depends:
127 | array >= 0.4
128 | , base >= 4 && < 5
129 | , base-compat >= 0.6 && < 1
130 | , bytestring >= 0.10
131 | , containers >= 0.4
132 | , hashable >= 1.2
133 | , regex-base >= 0.93
134 | , regex-pcre-builtin >= 0.94
135 | , regex-tdfa >= 1.3.1.0
136 | , template-haskell >= 2.7
137 | , text >= 1.2
138 | , time >= 1.4.2
139 | , time-locale-compat >= 0.1
140 | , transformers >= 0.2.2
141 | , unordered-containers >= 0.2
142 | , utf8-string >= 1
143 |
144 |
145 | -- Generated with re-gen-cabals
146 |
--------------------------------------------------------------------------------
/lib/release-testing/stack.yaml:
--------------------------------------------------------------------------------
1 | resolver: nightly-2022-06-04
2 | install-ghc: true
3 | flags: {}
4 | packages:
5 | - '.'
6 | - test-regex
7 | - test-regex-with-pcre
8 | system-ghc: false
9 | extra-deps:
10 | - regex-pcre-text-0.94.0.0
11 |
--------------------------------------------------------------------------------
/lib/version.txt:
--------------------------------------------------------------------------------
1 | 1.1.0.2
--------------------------------------------------------------------------------
/releases/regex-0.10.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.10.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.10.0.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.10.0.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.11.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.11.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.11.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.11.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.12.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.12.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.13.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.13.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.14.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.14.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.2.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.2.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.2.0.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.2.0.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.2.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.2.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.2.0.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.2.0.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.2.0.4.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.2.0.4.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.3.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.3.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.5.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.5.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.6.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.6.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.6.0.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.6.0.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.7.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.7.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.8.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.8.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-0.9.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-0.9.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.4.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.4.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.1.5.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.1.5.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.0.2.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.0.2.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.1.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.1.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-1.1.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-1.1.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.10.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.10.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.10.0.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.10.0.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.11.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.11.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.11.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.11.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.12.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.12.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.13.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.13.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.14.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.14.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.2.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.2.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.2.0.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.2.0.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.2.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.2.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.2.0.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.2.0.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.2.0.4.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.2.0.4.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.3.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.3.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.5.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.5.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.6.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.6.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.6.0.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.6.0.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.7.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.7.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.8.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.8.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-0.9.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-0.9.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.4.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.4.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.1.5.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.1.5.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.0.2.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.0.2.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.1.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.1.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-examples-1.1.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-examples-1.1.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.10.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.10.0.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.10.0.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.10.0.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.11.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.11.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.11.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.11.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.12.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.12.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.13.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.13.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.14.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.14.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.6.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.6.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.6.0.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.6.0.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.7.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.7.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.8.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.8.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-0.9.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-0.9.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.1.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.1.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.2.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.3.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.3.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.4.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.4.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.1.5.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.1.5.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.0.2.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.0.2.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.1.0.0.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.1.0.0.tar.gz
--------------------------------------------------------------------------------
/releases/regex-with-pcre-1.1.0.2.tar.gz:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/iconnect/regex/03a052825f48e001bba59773200e70d27f0d1e3d/releases/regex-with-pcre-1.1.0.2.tar.gz
--------------------------------------------------------------------------------
/src:
--------------------------------------------------------------------------------
1 | .
--------------------------------------------------------------------------------
/stack-8.10.2.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-12.26
2 | install-ghc: true
3 | system-ghc: false
4 | flags: {}
5 | packages:
6 | - '.'
7 | extra-deps:
8 | - shelly-1.8.0 # 1.8.1 and 1.9.0 are broken for windows: see https://github.com/yesodweb/Shelly.hs/issues/176
9 | - regex-tdfa-1.3.1.0
10 | - regex-base-0.94.0.0
11 | - regex-pcre-builtin-0.95.1.1.8.43
12 |
--------------------------------------------------------------------------------
/stack-8.10.2.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: regex-pcre-0.95.0.0@sha256:044727b7eb4d6ee11a1a2e857045d56c4eb16d55a50fa15ceb30b1ea376fb2e8,1951
9 | pantry-tree:
10 | size: 634
11 | sha256: 1931962cdccf17cf113c486f6b7025d3e37b3c17fb5adb7d79c4244c7549c7c8
12 | original:
13 | hackage: regex-pcre-0.95.0.0
14 | snapshots:
15 | - completed:
16 | size: 558061
17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/12/14.yaml
18 | sha256: 0c80697b1db876c0ab31b43e42be53f886657a336eca59c73c361078e631d65b
19 | original: nightly-2020-12-14
20 |
--------------------------------------------------------------------------------
/stack-8.10.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-18.14
2 | install-ghc: true
3 | system-ghc: false
4 | flags: {}
5 | packages:
6 | - '.'
7 | extra-deps:
8 | # Using an outdated shelly, forces an outdated 'time', which breaks unix, directory, ...
9 | # Instead, we don't build with 8.8 or 8.10 on Windows.
10 | # - shelly-1.8.0 # 1.8.1 and 1.9.0 are broken for windows: see https://github.com/yesodweb/Shelly.hs/issues/176
11 | # - time-1.8.0.4
12 | - regex-pcre-0.95.0.0
13 |
--------------------------------------------------------------------------------
/stack-8.6.5.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-14.27
2 | install-ghc: true
3 | system-ghc: false
4 | flags: {}
5 | packages:
6 | - '.'
7 | extra-deps:
8 | - shelly-1.8.0 # 1.8.1 and 1.9.0 are broken for windows: see https://github.com/yesodweb/Shelly.hs/issues/176
9 | - regex-tdfa-1.3.1.0
10 | - regex-base-0.94.0.0
11 | - regex-pcre-builtin-0.95.1.1.8.43
12 |
--------------------------------------------------------------------------------
/stack-8.6.5.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: shelly-1.8.0@sha256:67f5fcf434cb499a147e63b2ede8c0e7cc7e16739457f64f2cafd7aa96874c9d,5168
9 | pantry-tree:
10 | size: 2251
11 | sha256: 11dd744bbe1346f4aacca66c34370222b7c5520e25a41e34e9ebd8707baa79ca
12 | original:
13 | hackage: shelly-1.8.0
14 | - completed:
15 | hackage: regex-tdfa-1.3.1.0@sha256:bec13812a56a904ff3510caa19fe1b3ce3939e303604b1bcb3162771c52311ba,6324
16 | pantry-tree:
17 | size: 2566
18 | sha256: 0795972b182b375a05fe51aee34ec69dafe799017a49fd2a3e35162dff3f0850
19 | original:
20 | hackage: regex-tdfa-1.3.1.0
21 | - completed:
22 | hackage: regex-base-0.94.0.0@sha256:44aa95ca762294ffbb28cf0af9c567d93b5d2c56e4f38ce5385a257d899f968e,2253
23 | pantry-tree:
24 | size: 483
25 | sha256: 627ad9d564650590654720934224090a4e8fc3225e84a7fd1af83bc86b2d446a
26 | original:
27 | hackage: regex-base-0.94.0.0
28 | - completed:
29 | hackage: regex-pcre-builtin-0.95.1.1.8.43@sha256:2d671af361adf1776fde182a687bb6da022b1e5e3b0a064ce264289de63564a5,3088
30 | pantry-tree:
31 | size: 2587
32 | sha256: 9224e37b215488b81a0fab0e8caa991010a4e053ba0e001de0b02c46a420622c
33 | original:
34 | hackage: regex-pcre-builtin-0.95.1.1.8.43
35 | snapshots:
36 | - completed:
37 | size: 524162
38 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/21.yaml
39 | sha256: 9a55dd75853718f2bbbe951872b36a3b7802fcd71796e0f25b8664f24e34c666
40 | original: lts-14.21
41 |
--------------------------------------------------------------------------------
/stack-8.8.4.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-16.25
2 | install-ghc: true
3 | system-ghc: false
4 | flags: {}
5 | packages:
6 | - '.'
7 | extra-deps:
8 | - shelly-1.8.0 # 1.8.1 is broken for windows: see https://github.com/yesodweb/Shelly.hs/issues/176
9 | - regex-pcre-0.95.0.0
10 |
--------------------------------------------------------------------------------
/stack-8.8.4.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: regex-pcre-0.95.0.0@sha256:044727b7eb4d6ee11a1a2e857045d56c4eb16d55a50fa15ceb30b1ea376fb2e8,1951
9 | pantry-tree:
10 | size: 634
11 | sha256: 1931962cdccf17cf113c486f6b7025d3e37b3c17fb5adb7d79c4244c7549c7c8
12 | original:
13 | hackage: regex-pcre-0.95.0.0
14 | snapshots:
15 | - completed:
16 | size: 533252
17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/25.yaml
18 | sha256: 147598b98bdd95ec0409bac125a4f1bff3cd4f8d73334d283d098f66a4bcc053
19 | original: lts-16.25
20 |
--------------------------------------------------------------------------------
/stack-8.8.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-16.31
2 | install-ghc: true
3 | system-ghc: false
4 | flags: {}
5 | packages:
6 | - '.'
7 | extra-deps:
8 | # Using an outdated shelly, forces an outdated 'time', which breaks unix, directory, ...
9 | # Instead, we don't build with 8.8 or 8.10 on Windows.
10 | # - shelly-1.8.0 # 1.8.1 and 1.9.0 are broken for windows: see https://github.com/yesodweb/Shelly.hs/issues/176
11 | # - time-1.8.0.4
12 | - regex-pcre-0.95.0.0
13 |
--------------------------------------------------------------------------------
/stack-8.8.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: regex-pcre-0.95.0.0@sha256:323472b4a721694d3c0cc347affe7b69eec3ae2d9a782417dee2ff23aff1d81d,2461
9 | pantry-tree:
10 | size: 634
11 | sha256: e40638874bbff2b0d42f95358c755827cf0483bc4cdfabb23c8580cbca29e37e
12 | original:
13 | hackage: regex-pcre-0.95.0.0
14 | snapshots:
15 | - completed:
16 | size: 534126
17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
18 | sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
19 | original: lts-16.31
20 |
--------------------------------------------------------------------------------
/stack-9.2.yaml:
--------------------------------------------------------------------------------
1 | resolver: nightly-2022-06-04
2 |
3 | ghc-options:
4 | regex: -j10
5 |
6 | packages:
7 | - '.'
8 |
9 | extra-deps:
10 | - base-compat-0.12.1
11 | - base-compat-batteries-0.12.1
12 | - attoparsec-0.14.3
13 | - aeson-2.0.2.0
14 | - cryptonite-cd-0.29.1
15 | - memory-cd-0.16.0.1
16 | - basement-cd-0.0.12.1
17 |
18 | flags: {}
19 |
--------------------------------------------------------------------------------
/stack-9.2.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: base-compat-0.12.1@sha256:20e50848d9dfee1523fafe8950060b04fae43d402c15553da5c7cacd116f7846,6960
9 | pantry-tree:
10 | size: 9038
11 | sha256: 2f2c14615443954f117613d77835234b598718e611fb4cf4522e01980bf1bcbd
12 | original:
13 | hackage: base-compat-0.12.1
14 | - completed:
15 | hackage: base-compat-batteries-0.12.1@sha256:ee819d7570b2fda1012d29db945a1778c388ef8c0c282e45c8fe4eae7616a25c,8891
16 | pantry-tree:
17 | size: 11169
18 | sha256: 64edb51a988b4a362f0ba4172ad4e3d140ee69129dd68a4d08004fe506cc09ae
19 | original:
20 | hackage: base-compat-batteries-0.12.1
21 | - completed:
22 | hackage: attoparsec-0.14.3@sha256:214ff6d3f29793ba8053679e71c00bc2a79a58fa82641c3294627cbad6e2dce2,6192
23 | pantry-tree:
24 | size: 5305
25 | sha256: 882328ed1eb10a7173958fe19d56ed87205dddc640b86f107aa2a6e9f8536d46
26 | original:
27 | hackage: attoparsec-0.14.3
28 | - completed:
29 | hackage: aeson-2.0.2.0@sha256:bb41f39762d6f755431097ce0fa88d817108036e7f1c1ec06fd5990230860c76,6343
30 | pantry-tree:
31 | size: 37910
32 | sha256: 5303edc2f9516c7999c21fbfb218ad180dd91c2ceea570f8bc54818ea9ec1692
33 | original:
34 | hackage: aeson-2.0.2.0
35 | - completed:
36 | hackage: cryptonite-cd-0.29.1@sha256:fad461d58ebc25636a29a3b86f521fb63a20890b64ca0f3a4593e6786080ecc8,18873
37 | pantry-tree:
38 | size: 23325
39 | sha256: f3e5da28c709981bfa26fa787dfc8a96eb1d18348723fa3f6241e309a0ad95c9
40 | original:
41 | hackage: cryptonite-cd-0.29.1
42 | - completed:
43 | hackage: memory-cd-0.16.0.1@sha256:2e792919d8c03e0e516587ec896804f1fd472642b2ea61e736ce052886444ace,5101
44 | pantry-tree:
45 | size: 2509
46 | sha256: 730dc368aad2a80d0a785723f8452a361f6dd5c5f2e42d255edda5898a137bff
47 | original:
48 | hackage: memory-cd-0.16.0.1
49 | - completed:
50 | hackage: basement-cd-0.0.12.1@sha256:986d3e8fdd481d1457b2b0d9f067d6f4da39fc6185fb52686253faf61b49e78b,5746
51 | pantry-tree:
52 | size: 5931
53 | sha256: 0d376bf8c4329cd5dc16043e72d9d9fc0c53b63cdee8c5f5d27abd83a2e8e1dd
54 | original:
55 | hackage: basement-cd-0.0.12.1
56 | snapshots:
57 | - completed:
58 | size: 591687
59 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/6/4.yaml
60 | sha256: 113a36ecbaea7882508d1b1db11f07e3ae716a9d85bbf1b4ccd80728d4da9d7a
61 | original: nightly-2022-06-04
62 |
--------------------------------------------------------------------------------
/stack.yaml.lock:
--------------------------------------------------------------------------------
1 | # This file was autogenerated by Stack.
2 | # You should not edit this file by hand.
3 | # For more information, please see the documentation at:
4 | # https://docs.haskellstack.org/en/stable/lock_files
5 |
6 | packages:
7 | - completed:
8 | hackage: base-compat-0.12.1@sha256:20e50848d9dfee1523fafe8950060b04fae43d402c15553da5c7cacd116f7846,6960
9 | pantry-tree:
10 | size: 9038
11 | sha256: 2f2c14615443954f117613d77835234b598718e611fb4cf4522e01980bf1bcbd
12 | original:
13 | hackage: base-compat-0.12.1
14 | - completed:
15 | hackage: base-compat-batteries-0.12.1@sha256:ee819d7570b2fda1012d29db945a1778c388ef8c0c282e45c8fe4eae7616a25c,8891
16 | pantry-tree:
17 | size: 11169
18 | sha256: 64edb51a988b4a362f0ba4172ad4e3d140ee69129dd68a4d08004fe506cc09ae
19 | original:
20 | hackage: base-compat-batteries-0.12.1
21 | - completed:
22 | hackage: attoparsec-0.14.3@sha256:b65d94fa4ac2854e396d29532915c5fd6c48d000fea8b84f3c0d9c8430e36dc4,6183
23 | pantry-tree:
24 | size: 5305
25 | sha256: 0a15e87509cc67315b0531cac10baaaad5eef464c0bb5175d8ecbdcd7365e056
26 | original:
27 | hackage: attoparsec-0.14.3
28 | - completed:
29 | hackage: aeson-2.0.2.0@sha256:bb41f39762d6f755431097ce0fa88d817108036e7f1c1ec06fd5990230860c76,6343
30 | pantry-tree:
31 | size: 37910
32 | sha256: 5303edc2f9516c7999c21fbfb218ad180dd91c2ceea570f8bc54818ea9ec1692
33 | original:
34 | hackage: aeson-2.0.2.0
35 | - completed:
36 | hackage: cryptonite-cd-0.29.1@sha256:d1c76166cadcf49ae0b87465d9bb9cbf17b7779174cfe655915c3f4f75ad27f9,18834
37 | pantry-tree:
38 | size: 23325
39 | sha256: 3afca5f3374e921652d5ffeba890b3f21cd858dc41886255c221b0facd2eaf74
40 | original:
41 | hackage: cryptonite-cd-0.29.1
42 | - completed:
43 | hackage: memory-cd-0.16.0.1@sha256:b76547dbfa4470646b1a50a9b6cf087f5561bd741e819cfb2251a80f7ce45ec1,4905
44 | pantry-tree:
45 | size: 2509
46 | sha256: 8ded27c64e12d089882923c679e9cab95b993b9074d9dc3542bcde14d54994fd
47 | original:
48 | hackage: memory-cd-0.16.0.1
49 | - completed:
50 | hackage: basement-cd-0.0.12.1@sha256:b41b0cd85142c1b1591b4c4625944d8588400f6c73d0e4bc8b29a215ebfef1c6,5529
51 | pantry-tree:
52 | size: 5931
53 | sha256: 235d1cc30e9278e1a875d5645a5fd8db57f606e0e0038041b5d0813321afb761
54 | original:
55 | hackage: basement-cd-0.0.12.1
56 | snapshots:
57 | - completed:
58 | size: 591687
59 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/6/4.yaml
60 | sha256: 113a36ecbaea7882508d1b1db11f07e3ae716a9d85bbf1b4ccd80728d4da9d7a
61 | original: nightly-2022-06-04
62 |
--------------------------------------------------------------------------------