regex (empty) → 0.0.0.1
raw patch · 42 files changed
+7038/−0 lines, 42 filesdep +arraydep +basedep +bytestringsetup-changed
Dependencies added: array, base, bytestring, containers, directory, hashable, heredoc, hsyslog, regex, regex-base, regex-pcre-builtin, regex-tdfa, regex-tdfa-text, shelly, smallcheck, tasty, tasty-hunit, tasty-smallcheck, template-haskell, text, time, transformers, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Text/RE.hs +21/−0
- Text/RE/Capture.lhs +252/−0
- Text/RE/CaptureID.hs +39/−0
- Text/RE/Edit.lhs +94/−0
- Text/RE/Internal/AddCaptureNames.hs +11/−0
- Text/RE/Internal/NamedCaptures.lhs +271/−0
- Text/RE/Internal/PreludeMacros.hs +852/−0
- Text/RE/Internal/QQ.hs +21/−0
- Text/RE/IsRegex.lhs +16/−0
- Text/RE/LineNo.hs +18/−0
- Text/RE/Options.lhs +77/−0
- Text/RE/PCRE.hs +57/−0
- Text/RE/PCRE/ByteString.hs +53/−0
- Text/RE/PCRE/ByteString/Lazy.hs +53/−0
- Text/RE/PCRE/RE.hs +246/−0
- Text/RE/PCRE/Sequence.hs +53/−0
- Text/RE/PCRE/String.hs +53/−0
- Text/RE/Parsers.hs +156/−0
- Text/RE/Replace.lhs +496/−0
- Text/RE/TDFA.hs +60/−0
- Text/RE/TDFA/ByteString.hs +53/−0
- Text/RE/TDFA/ByteString/Lazy.hs +53/−0
- Text/RE/TDFA/RE.hs +242/−0
- Text/RE/TDFA/Sequence.hs +53/−0
- Text/RE/TDFA/String.hs +53/−0
- Text/RE/TDFA/Text.hs +53/−0
- Text/RE/TDFA/Text/Lazy.hs +53/−0
- Text/RE/TestBench.lhs +557/−0
- Text/RE/Tools/Grep.lhs +58/−0
- Text/RE/Tools/Lex.lhs +35/−0
- Text/RE/Tools/Sed.lhs +50/−0
- changelog +4/−0
- examples/TestKit.lhs +94/−0
- examples/re-gen-modules.lhs +127/−0
- examples/re-include.lhs +138/−0
- examples/re-nginx-log-processor.lhs +592/−0
- examples/re-pp.lhs +459/−0
- examples/re-tests.lhs +257/−0
- examples/re-tutorial.lhs +859/−0
- regex.cabal +317/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016-2017, Chris Dornan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Iris Connect nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/RE.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-dodgy-exports #-}++module Text.RE+ ( module Text.RE.Capture+ , module Text.RE.CaptureID+ , module Text.RE.Edit+ , module Text.RE.IsRegex+ , module Text.RE.LineNo+ , module Text.RE.Options+ , module Text.RE.Parsers+ , module Text.RE.Replace+ ) where++import Text.RE.Capture+import Text.RE.CaptureID+import Text.RE.Edit+import Text.RE.IsRegex+import Text.RE.LineNo+import Text.RE.Options+import Text.RE.Parsers+import Text.RE.Replace
+ Text/RE/Capture.lhs view
@@ -0,0 +1,252 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+\end{code}++\begin{code}+module Text.RE.Capture+ ( Matches(..)+ , Match(..)+ , Capture(..)+ -- Matches functions+ , anyMatches+ , countMatches+ , matches+ , mainCaptures+ -- Match functions+ , matched+ , matchedText+ , matchCapture+ , matchCaptures+ , captureText+ , captureTextMaybe+ , capture+ , captureMaybe+ -- Capture functions+ , hasCaptured+ , capturePrefix+ , captureSuffix+ ) where+\end{code}++\begin{code}+import Data.Array+import Data.Maybe+import Text.Regex.Base+import Text.RE.CaptureID+\end{code}++++\begin{code}+-- | the result type to use when every match is needed, not just the+-- first match of the RE against the source+data Matches a =+ Matches+ { matchesSource :: !a -- ^ the source text being matched+ , allMatches :: [Match a] -- ^ all captures found, left to right+ }+ deriving (Show,Eq)+\end{code}++\begin{code}+-- | the result of matching a RE to a text once, listing the text that+-- was matched and the named captures in the RE and all of the substrings+-- matched, with the text captured by the whole RE; a complete failure+-- to match will be represented with an empty array (with bounds (0,-1))+data Match a =+ Match+ { matchSource :: !a -- ^ the whole source text+ , captureNames :: CaptureNames -- ^ the RE's capture names+ , matchArray :: !(Array CaptureOrdinal (Capture a))+ -- ^ 0..n-1 captures,+ -- starting with the+ -- text matched by the+ -- whole RE+ }+ deriving (Show,Eq)+\end{code}++\begin{code}+-- | the matching of a single sub-expression against part of the source+-- text+data Capture a =+ Capture+ { captureSource :: !a -- ^ the whole text that was searched+ , capturedText :: !a -- ^ the text that was matched+ , captureOffset :: !Int -- ^ the number of characters preceding the+ -- match with -1 used if no text was captured+ -- by the RE (not even the empty string)+ , captureLength :: !Int -- ^ the number of chacter in the captured+ -- sub-string+ }+ deriving (Show,Eq)+\end{code}++\begin{code}+instance Functor Matches where+ fmap f Matches{..} =+ Matches+ { matchesSource = f matchesSource+ , allMatches = map (fmap f) allMatches+ }++instance Functor Match where+ fmap f Match{..} =+ Match+ { matchSource = f matchSource+ , captureNames = captureNames+ , matchArray = fmap (fmap f) matchArray+ }++instance Functor Capture where+ fmap f c@Capture{..} =+ c+ { captureSource = f captureSource+ , capturedText = f capturedText+ }+\end{code}++\begin{code}+-- | tests whether the RE matched the source text at all+anyMatches :: Matches a -> Bool+anyMatches = not . null . allMatches++-- | count the matches+countMatches :: Matches a -> Int+countMatches = length . allMatches++matches :: Matches a -> [a]+matches = map capturedText . mainCaptures++-- | extract the main capture from each match+mainCaptures :: Matches a -> [Capture a]+mainCaptures ac = [ capture c0 cs | cs<-allMatches ac ]+ where+ c0 = CID_ordinal $ CaptureOrdinal 0+\end{code}++++\begin{code}+-- | tests whether the RE matched the source text at all+matched :: Match a -> Bool+matched = isJust . matchCapture++-- | tests whether the RE matched the source text at all+matchedText :: Match a -> Maybe a+matchedText = fmap capturedText . matchCapture++-- | the top-level capture if the source text matched the RE,+-- Nothing otherwise+matchCapture :: Match a -> Maybe (Capture a)+matchCapture = fmap fst . matchCaptures++-- | the top-level capture and the sub captures if the text matched+-- the RE, Nothing otherwise+matchCaptures :: Match a -> Maybe (Capture a,[Capture a])+matchCaptures Match{..} = case rangeSize (bounds matchArray) == 0 of+ True -> Nothing+ False -> Just (matchArray!0,drop 1 $ elems matchArray)++-- | look up the text of the nth capture, 0 being the match of the whole+-- RE against the source text, 1, the first bracketed sub-expression to+-- be matched and so on+captureText :: CaptureID -> Match a -> a+captureText cid mtch = capturedText $ capture cid mtch++-- | look up the text of the nth capture (0 being the match of the+-- whole), returning Nothing if the Match doesn't contain the capture+captureTextMaybe :: CaptureID -> Match a -> Maybe a+captureTextMaybe cid mtch = do+ cap <- captureMaybe cid mtch+ case hasCaptured cap of+ True -> Just $ capturedText cap+ False -> Nothing++-- | look up the nth capture, 0 being the match of the whole RE against+-- the source text, 1, the first bracketed sub-expression to be matched+-- and so on+capture :: CaptureID -> Match a -> Capture a+capture cid mtch = fromMaybe oops $ captureMaybe cid mtch+ where+ oops = error $ "capture: out of bounds (" ++ show cid ++ ")"++-- | look up the nth capture, 0 being the match of the whole RE against+-- the source text, 1, the first bracketed sub-expression to be matched+-- and so on, returning Nothing if there is no such capture, or if the+-- capture failed to capture anything (being in a failed alternate)+captureMaybe :: CaptureID -> Match a -> Maybe (Capture a)+captureMaybe cid mtch@Match{..} = do+ cap <- case bounds matchArray `inRange` CaptureOrdinal i of+ True -> Just $ matchArray ! CaptureOrdinal i+ False -> Nothing+ case hasCaptured cap of+ True -> Just cap+ False -> Nothing+ where+ i = lookupCaptureID cid mtch++lookupCaptureID :: CaptureID -> Match a -> Int+lookupCaptureID cid Match{..} = findCaptureID cid captureNames+\end{code}+++\begin{code}+-- | test if the capture has matched any text+hasCaptured :: Capture a -> Bool+hasCaptured = (>=0) . captureOffset++-- | returns the text preceding the match+capturePrefix :: Extract a => Capture a -> a+capturePrefix Capture{..} = before captureOffset captureSource++-- | returns the text after the match+captureSuffix :: Extract a => Capture a -> a+captureSuffix Capture{..} = after (captureOffset+captureLength) captureSource+\end{code}+++++\begin{code}+-- | for matching just the first RE against the source text+instance RegexContext regex source (AllTextSubmatches (Array Int) (source,(Int,Int))) =>+ RegexContext regex source (Match source) where+ match r s = cvt s $ getAllTextSubmatches $ match r s+ matchM r s = do+ y <- matchM r s+ return $ cvt s $ getAllTextSubmatches y++-- | for matching all REs against the source text+instance RegexContext regex source [MatchText source] =>+ RegexContext regex source (Matches source) where+ match r s = Matches s $ map (cvt s) $ match r s+ matchM r s = do+ y <- matchM r s+ return $ Matches s $ map (cvt s) y+\end{code}++\begin{code}+cvt :: source -> MatchText source -> Match source+cvt hay arr =+ Match+ { matchSource = hay+ , captureNames = noCaptureNames+ , matchArray =+ ixmap (CaptureOrdinal lo,CaptureOrdinal hi) getCaptureOrdinal $+ fmap f arr+ }+ where+ (lo,hi) = bounds arr++ f (ndl,(off,len)) =+ Capture+ { captureSource = hay+ , capturedText = ndl+ , captureOffset = off+ , captureLength = len+ }+\end{code}
+ Text/RE/CaptureID.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Text.RE.CaptureID where++import Data.Ix+import Data.Hashable+import qualified Data.HashMap.Strict as HMS+import Data.Maybe+import qualified Data.Text as T+++data CaptureID+ = CID_ordinal CaptureOrdinal+ | CID_name CaptureName+ deriving (Show,Ord,Eq)++type CaptureNames = HMS.HashMap CaptureName CaptureOrdinal++noCaptureNames :: CaptureNames+noCaptureNames = HMS.empty++newtype CaptureName = CaptureName { getCaptureName :: T.Text }+ deriving (Show,Ord,Eq)++instance Hashable CaptureName where+ hashWithSalt i = hashWithSalt i . getCaptureName++newtype CaptureOrdinal = CaptureOrdinal { getCaptureOrdinal :: Int }+ deriving (Show,Ord,Eq,Enum,Ix,Num)++findCaptureID :: CaptureID -> CaptureNames -> Int+findCaptureID (CID_ordinal o) _ = getCaptureOrdinal o+findCaptureID (CID_name n) hms =+ getCaptureOrdinal $ fromMaybe oops $ HMS.lookup n hms+ where+ oops = error $ unlines $+ ("lookupCaptureID: " ++ T.unpack t ++ " not found in:") :+ [ " "++T.unpack (getCaptureName nm) | nm <- HMS.keys hms ]+ t = getCaptureName n
+ Text/RE/Edit.lhs view
@@ -0,0 +1,94 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}++module Text.RE.Edit+ ( LineNo+ , Edits(..)+ , Edit(..)+ , LineEdit(..)+ , applyEdits+ , applyEdit+ , applyLineEdit+ ) where++import Control.Applicative+import Data.Maybe+import Data.Monoid+import Text.RE.Capture+import Text.RE.IsRegex+import Text.RE.LineNo+import Text.RE.Replace+++data Edits m re s+ = Select [(re,Edit m s)]+ | Pipe [(re,Edit m s)]++data Edit m s+ = EDIT_tpl s+ | EDIT_phi (Phi s)+ | EDIT_fun Context (LineNo->Match s->Location->Capture s->m (Maybe s))+ | EDIT_gen (LineNo->Matches s->m (LineEdit s))++data LineEdit s+ = NoEdit+ | ReplaceWith s+ | Delete+ deriving (Show)++applyEdits :: (IsRegex re s,Monad m,Functor m)+ => LineNo+ -> Edits m re s+ -> s+ -> m s+applyEdits lno ez0 s0 = case ez0 of+ Select ez -> select_edit_scripts lno ez s0+ Pipe ez -> pipe_edit_scripts lno ez s0++applyEdit :: (IsRegex re s,Monad m,Functor m)+ => (s->s)+ -> LineNo+ -> re+ -> Edit m s+ -> s+ -> m (Maybe s)+applyEdit anl lno re edit s =+ case allMatches acs of+ [] -> return Nothing+ _ -> fmap Just $ case edit of+ EDIT_tpl tpl -> return $ anl $ replaceAll tpl acs+ EDIT_phi phi -> return $ anl $ replaceAllCaptures phi acs+ EDIT_fun ctx f -> anl <$> replaceAllCapturesM replace_ ctx (f lno) acs+ EDIT_gen g -> fromMaybe s' . applyLineEdit anl <$> g lno acs+ where+ s' = anl s+ acs = matchMany re s++applyLineEdit :: Monoid s => (s->s) -> LineEdit s -> Maybe s+applyLineEdit _ NoEdit = Nothing+applyLineEdit anl (ReplaceWith s) = Just $ anl s+applyLineEdit _ Delete = Just $ mempty++select_edit_scripts :: (IsRegex re s,Monad m,Functor m)+ => LineNo+ -> [(re,Edit m s)]+ -> s+ -> m s+select_edit_scripts lno ps0 s = select ps0+ where+ select [] = return $ appendNewline s+ select ((re,es):ps) =+ applyEdit appendNewline lno re es s >>= maybe (select ps) return++pipe_edit_scripts :: (IsRegex re s,Monad m,Functor m)+ => LineNo+ -> [(re,Edit m s)]+ -> s+ -> m s+pipe_edit_scripts lno ez s0 =+ appendNewline <$> foldr f (return s0) ez+ where+ f (re,es) act = do+ s <- act+ fromMaybe s <$> applyEdit id lno re es s+\end{code}
+ Text/RE/Internal/AddCaptureNames.hs view
@@ -0,0 +1,11 @@+module Text.RE.Internal.AddCaptureNames where++import Text.RE+++addCaptureNamesToMatches :: CaptureNames -> Matches a -> Matches a+addCaptureNamesToMatches cnms mtchs =+ mtchs { allMatches = map (addCaptureNamesToMatch cnms) $ allMatches mtchs }++addCaptureNamesToMatch :: CaptureNames -> Match a -> Match a+addCaptureNamesToMatch cnms mtch = mtch { captureNames = cnms }
+ Text/RE/Internal/NamedCaptures.lhs view
@@ -0,0 +1,271 @@+\begin{code}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module Text.RE.Internal.NamedCaptures+ ( cp+ , extractNamedCaptures+ , namedCapturesTestTree+ )+ where++import Data.Char+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import GHC.Generics+import qualified Language.Haskell.TH as TH+import Language.Haskell.TH.Quote+import Test.SmallCheck.Series+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.SmallCheck as SC+import Text.Heredoc+import Text.RE+import Text.RE.Internal.PreludeMacros+import Text.RE.Internal.QQ+import Text.RE.Tools.Lex+import Text.Regex.PCRE+++cp :: QuasiQuoter+cp =+ (qq0 "re_")+ { quoteExp = parse_capture+ }++extractNamedCaptures :: String -> Either String (CaptureNames,String)+extractNamedCaptures s = Right (analyseTokens tks,formatTokens tks)+ where+ tks = scan s++namedCapturesTestTree :: TestTree+namedCapturesTestTree = localOption (SmallCheckDepth 4) $+ testGroup "NamedCaptures"+ [ formatScanTestTree+ , analyseTokensTestTree+ ]+\end{code}+++Token+-----++\begin{code}+data Token+ = ECap (Maybe String)+ | PGrp+ | PCap+ | Bra+ | BS Char+ | Other Char+ deriving (Show,Generic,Eq)++instance Monad m => Serial m Token++validToken :: Token -> Bool+validToken tkn = case tkn of+ ECap mb -> maybe True check_ecap mb+ PGrp -> True+ PCap -> True+ Bra -> True+ BS c -> is_dot c+ Other c -> is_dot c+ where+ check_ecap s = not (null s) && all not_br s+ is_dot c = c/='\n'+ not_br c = not $ c `elem` "{}\n"++\end{code}+++Analysing [Token] -> CaptureNames+---------------------------------++\begin{code}+analyseTokens :: [Token] -> CaptureNames+analyseTokens = HM.fromList . count_em 1+ where+ count_em _ [] = []+ count_em n (tk:tks) = bd ++ count_em (n `seq` n+d) tks+ where+ (d,bd) = case tk of+ ECap (Just nm) -> (,) 1 [(CaptureName $ T.pack nm,CaptureOrdinal n)]+ ECap Nothing -> (,) 1 []+ PGrp -> (,) 0 []+ PCap -> (,) 1 []+ Bra -> (,) 1 []+ BS _ -> (,) 0 []+ Other _ -> (,) 0 []+\end{code}+++Scanning Regex Strings+----------------------++\begin{code}+scan :: String -> [Token]+scan = alex' match al oops+ where+ al :: [(Regex,Match String->Maybe Token)]+ al =+ [ mk [here|\$\{([^{}]+)\}\(|] $ ECap . Just . x_1+ , mk [here|\$\(|] $ const $ ECap Nothing+ , mk [here|\(\?:|] $ const PGrp+ , mk [here|\(\?|] $ const PCap+ , mk [here|\(|] $ const Bra+ , mk [here|\\(.)|] $ BS . s2c . x_1+ , mk [here|(.)|] $ Other . s2c . x_1+ ]++ x_1 = captureText $ CID_ordinal $ CaptureOrdinal 1++ s2c [c] = c+ s2c _ = error "scan:s2c:internal error"++ mk s f = (either error id $ makeRegexM s,Just . f)++ oops = error "reScanner"+\end{code}+++Parsing captures+----------------++\begin{code}+parse_capture :: String -> TH.Q TH.Exp+parse_capture s = case all isDigit s of+ True -> [|CID_ordinal $ CaptureOrdinal $ read s|]+ False -> [|CID_name $ CaptureName $ T.pack s|]+\end{code}+++Formatting [Token]+------------------++\begin{code}+formatTokens :: [Token] -> String+formatTokens = formatTokens' defFormatTokenOptions++data FormatTokenOptions =+ FormatTokenOptions+ { _fto_regex_type :: Maybe RegexType+ , _fto_min_caps :: Bool+ , _fto_incl_caps :: Bool+ }+ deriving (Show)++defFormatTokenOptions :: FormatTokenOptions+defFormatTokenOptions =+ FormatTokenOptions+ { _fto_regex_type = Nothing+ , _fto_min_caps = False+ , _fto_incl_caps = False+ }++idFormatTokenOptions :: FormatTokenOptions+idFormatTokenOptions =+ FormatTokenOptions+ { _fto_regex_type = Nothing+ , _fto_min_caps = False+ , _fto_incl_caps = True+ }++formatTokens' :: FormatTokenOptions -> [Token] -> String+formatTokens' FormatTokenOptions{..} = foldr f ""+ where+ f tk tl = t_s ++ tl+ where+ t_s = case tk of+ ECap mb -> ecap mb+ PGrp -> if _fto_regex_type == Just TDFA then "(" else "(?:"+ PCap -> "(?"+ Bra -> bra _fto_min_caps+ BS c -> "\\" ++ [c]+ Other c -> [c]++ ecap mb = case _fto_incl_caps of+ True -> case mb of+ Nothing -> "$("+ Just nm -> "${"++nm++"}("+ False -> bra _fto_min_caps++ bra mc = case mc && _fto_regex_type == Just PCRE of+ True -> "(?:"+ False -> "("+\end{code}++\begin{code}+-- this is a reference of formatTokens defFormatTokenOptions,+-- used for testing the latter+formatTokens0 :: [Token] -> String+formatTokens0 = foldr f ""+ where+ f tk tl = t_s ++ tl+ where+ t_s = case tk of+ ECap _ -> "("+ PGrp -> "(?:"+ PCap -> "(?"+ Bra -> "("+ BS c -> "\\" ++ [c]+ Other c -> [c]+\end{code}+++Testing : FormatToken/Scan Properties+-------------------------------------++\begin{code}+formatScanTestTree :: TestTree+formatScanTestTree =+ testGroup "FormatToken/Scan Properties"+ [ localOption (SmallCheckDepth 4) $+ SC.testProperty "formatTokens == formatTokens0" $+ \tks -> formatTokens tks == formatTokens0 tks+ , localOption (SmallCheckDepth 4) $+ SC.testProperty "scan . formatTokens' idFormatTokenOptions == id" $+ \tks -> all validToken tks ==>+ scan (formatTokens' idFormatTokenOptions tks) == tks+ ]+\end{code}+++Testing : Analysing [Token] Unit Tests+--------------------------------------++\begin{code}+analyseTokensTestTree :: TestTree+analyseTokensTestTree =+ testGroup "Analysing [Token] Unit Tests"+ [ tc [here|foobar|] []+ , tc [here||] []+ , tc [here|$([0-9]{4})|] []+ , tc [here|${x}()|] [(1,"x")]+ , tc [here|${}()|] []+ , tc [here|${}()${foo}()|] [(2,"foo")]+ , tc [here|${x}(${y()})|] [(1,"x")]+ , tc [here|${x}(${y}())|] [(1,"x"),(2,"y")]+ , tc [here|${a}(${b{}())|] [(1,"a")]+ , tc [here|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|] [(1,"y"),(2,"m"),(3,"d")]+ , tc [here|@$(@|\{${name}([^{}]+)\})|] [(2,"name")]+ , tc [here|${y}[0-9]{4}|] []+ , tc [here|${}([0-9]{4})|] []+ ]+ where+ tc s al =+ testCase s $ assertEqual "CaptureNames"+ (xnc s)+ (HM.fromList+ [ (CaptureName $ T.pack n,CaptureOrdinal i)+ | (i,n)<-al+ ]+ )++ xnc = either oops fst . extractNamedCaptures+ where+ oops = error "analyseTokensTestTree: unexpected parse failure"+\end{code}
+ Text/RE/Internal/PreludeMacros.hs view
@@ -0,0 +1,852 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.RE.Internal.PreludeMacros+ ( RegexType(..)+ , WithCaptures(..)+ , MacroDescriptor(..)+ , RegexSource(..)+ , PreludeMacro(..)+ , preludeMacros+ , preludeMacroTable+ , preludeMacroSummary+ , preludeMacroSources+ , preludeMacroSource+ , preludeMacroEnv+ , preludeMacroDescriptor+ ) where++import Control.Applicative+import Data.Array+import qualified Data.HashMap.Lazy as HML+import Data.List+import Data.Maybe+import Data.Time+import System.Posix.Syslog+import Text.RE.Options+import Text.RE.Parsers+import Text.RE.TestBench+++preludeMacros :: (Monad m,Functor m)+ => (String->m r)+ -> RegexType+ -> WithCaptures+ -> m (Macros r)+preludeMacros prs rty wc = mkMacros prs rty wc $ preludeMacroEnv rty++preludeMacroTable :: RegexType -> String+preludeMacroTable rty = formatMacroTable rty $ preludeMacroEnv rty++preludeMacroSummary :: RegexType -> PreludeMacro -> String+preludeMacroSummary rty =+ formatMacroSummary rty (preludeMacroEnv rty) . prelude_macro_id++preludeMacroSources :: RegexType -> String+preludeMacroSources rty =+ formatMacroSources rty ExclCaptures $ preludeMacroEnv rty++preludeMacroSource :: RegexType -> PreludeMacro -> String+preludeMacroSource rty =+ formatMacroSource rty ExclCaptures (preludeMacroEnv rty) . prelude_macro_id++preludeMacroEnv :: RegexType -> MacroEnv+preludeMacroEnv TDFA = prelude_macro_env_tdfa+preludeMacroEnv PCRE = prelude_macro_env_pcre++prelude_macro_env_pcre :: MacroEnv+prelude_macro_env_pcre = fix $ prelude_macro_env PCRE++prelude_macro_env_tdfa :: MacroEnv+prelude_macro_env_tdfa = fix $ prelude_macro_env TDFA++prelude_macro_env :: RegexType -> MacroEnv -> MacroEnv+prelude_macro_env rty env = HML.fromList $ catMaybes+ [ (,) (prelude_macro_id pm) <$> preludeMacroDescriptor rty env pm+ | pm<-[minBound..maxBound]+ ]++preludeMacroDescriptor :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+preludeMacroDescriptor rty env pm = case pm of+ PM_natural -> natural_macro rty env pm+ PM_natural_hex -> natural_hex_macro rty env pm+ PM_integer -> integer_macro rty env pm+ PM_decimal -> decimal_macro rty env pm+ PM_string -> string_macro rty env pm+ PM_string_simple -> string_simple_macro rty env pm+ PM_id -> id_macro rty env pm+ PM_id' -> id'_macro rty env pm+ PM_date -> date_macro rty env pm+ PM_date_slashes -> date_slashes_macro rty env pm+ PM_time -> time_macro rty env pm+ PM_timezone -> timezone_macro rty env pm+ PM_datetime -> datetime_macro rty env pm+ PM_datetime_8601 -> datetime_8601_macro rty env pm+ PM_datetime_clf -> datetime_clf_macro rty env pm+ PM_shortmonth -> shortmonth_macro rty env pm+ PM_address_ipv4 -> address_ipv4_macros rty env pm+ PM_email_simple -> email_simple_macro rty env pm+ PM_url -> url_macro rty env pm+ PM_syslog_severity -> syslog_severity_macro rty env pm++-- | an enumeration of all of the prelude macros+data PreludeMacro+ -- numbers+ = PM_natural+ | PM_natural_hex+ | PM_integer+ | PM_decimal+ -- strings+ | PM_string+ | PM_string_simple+ -- identifiers+ | PM_id+ | PM_id'+ -- dates & times+ | PM_date+ | PM_date_slashes+ | PM_time+ | PM_timezone+ | PM_datetime+ | PM_datetime_8601+ | PM_datetime_clf+ | PM_shortmonth+ -- addresses+ | PM_address_ipv4+ | PM_email_simple+ | PM_url+ -- syslog+ | PM_syslog_severity+ deriving (Bounded,Enum,Ord,Eq,Show)++-- | naming the macros+presentPreludeMacro :: PreludeMacro -> String+presentPreludeMacro = (prelude_prefix++) . map tr . drop 3 . show+ where+ tr '_' = '.'+ tr c = c++-- | all prelude macros are prefixed with this+prelude_prefix :: String+prelude_prefix = "%"++prelude_macro_id :: PreludeMacro -> MacroID+prelude_macro_id = MacroID . presentPreludeMacro++natural_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+natural_macro rty env pm = Just $ run_tests rty parseInteger samples env pm+ MacroDescriptor+ { _md_source = "[0-9]+"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseInteger"+ , _md_description = "a string of one or more decimal digits"+ }+ where+ samples :: [(String,Int)]+ samples =+ [ (,) "0" 0+ , (,) "1234567890" 1234567890+ , (,) "00" 0+ , (,) "01" 1+ ]++ counter_samples =+ [ ""+ , "0A"+ , "-1"+ ]++natural_hex_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+natural_hex_macro rty env pm = Just $ run_tests rty parseHex samples env pm+ MacroDescriptor+ { _md_source = "[0-9a-fA-F]+"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseHex"+ , _md_description = "a string of one or more hexadecimal digits"+ }+ where+ samples :: [(String,Int)]+ samples =+ [ (,) "0" 0x0+ , (,) "12345678" 0x12345678+ , (,) "90abcdef" 0x90abcdef+ , (,) "90ABCDEF" 0x90abcdef+ , (,) "00" 0x0+ , (,) "010" 0x10+ ]++ counter_samples =+ [ ""+ , "0x10"+ , "0z"+ , "-1a"+ ]++integer_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+integer_macro rty env pm = Just $ run_tests rty parseInteger samples env pm+ MacroDescriptor+ { _md_source = "-?[0-9]+"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseInteger"+ , _md_description = "a decimal integer"+ }+ where+ samples :: [(String,Int)]+ samples =+ [ (,) "0" 0+ , (,) "1234567890" 1234567890+ , (,) "00" 0+ , (,) "01" 1+ , (,) "-1" $ -1+ , (,) "-0" 0+ ]++ counter_samples =+ [ ""+ , "0A"+ , "+0"+ ]++-- | a digit string macro+decimal_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+decimal_macro rty env pm = Just $ run_tests rty parseDouble samples env pm+ MacroDescriptor+ { _md_source = "-?[0-9]+(?:\\.[0-9]+)?"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseInteger"+ , _md_description = "a decimal integer"+ }+ where+ samples :: [(String,Double)]+ samples =+ [ (,) "0" 0+ , (,) "1234567890" 1234567890+ , (,) "00" 0+ , (,) "01" 1+ , (,) "-1" $ -1+ , (,) "-0" 0+ , (,) "0.1234567890" 0.1234567890+ , (,) "-1.0" $ -1.0+ ]++ counter_samples =+ [ ""+ , "0A"+ , "+0"+ , "0."+ , ".0"+ , "."+ , "-"+ , "-."+ , "-1."+ , "-.1"+ ]++string_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+string_macro PCRE _ _ = Nothing+string_macro rty@TDFA env pm =+ Just $ run_tests rty parseString samples env pm+ MacroDescriptor+ { _md_source = "\"(?:[^\"\\]+|\\\\[\\\"])*\""+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseString"+ , _md_description = "a double-quote string, with simple \\ escapes for \\s and \"s"+ }+ where+ samples :: [(String,String)]+ samples =+ [ (,) "\"\"" ""+ , (,) "\"foo\"" "foo"+ , (,) "\"\\\"\"" "\""+ , (,) "\"\\\"\\\"\"" "\"\""+ , (,) "\"\\\"\\\\\\\"\"" "\"\\\""+ , (,) "\"\\\"foo\\\"\"" "\"foo\""+ , (,) "\"\"" ""+ ]++ counter_samples =+ [ "\""+ , "\"aa"+ ]++string_simple_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+string_simple_macro rty env pm =+ Just $ run_tests rty parseSimpleString samples env pm+ MacroDescriptor+ { _md_source = "\"[^\"[:cntrl:]]*\""+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseSimpleString"+ , _md_description = "a decimal integer"+ }+ where+ samples :: [(String,String)]+ samples =+ [ (,) "\"\"" ""+ , (,) "\"foo\"" "foo"+ , (,) "\"\\\"" "\\"+ , (,) "\"\"" ""+ ]++ counter_samples =+ [ ""+ , "\""+ , "\"\\\"\""+ , "\"\\\"\\\"\""+ , "\"\\\"\\\\\\\"\""+ , "\"\\\"foo\\\"\""+ , "\"aa"+ ]++id_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+id_macro rty env pm =+ Just $ run_tests rty Just samples env pm+ MacroDescriptor+ { _md_source = "_*[a-zA-Z][a-zA-Z0-9_]*"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Nothing+ , _md_description = "a standard C-style alphanumeric identifier (with _s)"+ }+ where+ samples :: [(String,String)]+ samples =+ [ f "a"+ , f "A"+ , f "A1"+ , f "a_"+ , f "a1_B2"+ , f "_abc"+ , f "__abc"+ ]+ where+ f s = (s,s)++ counter_samples =+ [ ""+ , "1"+ , "_"+ , "__"+ , "__1"+ , "1a"+ , "a'"+ ]++id'_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+id'_macro rty env pm =+ Just $ run_tests rty Just samples env pm+ MacroDescriptor+ { _md_source = "_*[a-zA-Z][a-zA-Z0-9_']*"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Nothing+ , _md_description = "a standard Haskell-style alphanumeric identifier (with '_'s and '''s)"+ }+ where+ samples :: [(String,String)]+ samples =+ [ f "a"+ , f "A"+ , f "A1"+ , f "a_"+ , f "a1_B2"+ , f "_abc"+ , f "__abc"+ , f "a'"+ , f "_a'"+ , f "a'b"+ ]+ where+ f s = (s,s)++ counter_samples =+ [ ""+ , "1"+ , "_"+ , "__"+ , "__1"+ , "1a"+ , "'"+ , "'a"+ , "_'"+ , "_1'"+ ]++date_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+date_macro rty env pm =+ Just $ run_tests rty parseDate samples env pm+ MacroDescriptor+ { _md_source = "[0-9]{4}-[0-9]{2}-[0-9]{2}"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseDate"+ , _md_description = "a YYYY-MM-DD format date"+ }+ where+ samples :: [(String,Day)]+ samples =+ [ f "2016-12-31"+ , f "0001-01-01"+ , f "1000-01-01"+ ]+ where+ f s = (s,read s)++ counter_samples =+ [ ""+ , "2016/01/31"+ , "2016-1-31"+ , "2016-01-1"+ , "2016-001-01"+ ]++date_slashes_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+date_slashes_macro rty env pm =+ Just $ run_tests rty parseSlashesDate samples env pm+ MacroDescriptor+ { _md_source = "[0-9]{4}/[0-9]{2}/[0-9]{2}"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseSlashesDate"+ , _md_description = "a YYYY/MM/DD format date"+ }+ where+ samples :: [(String,Day)]+ samples =+ [ f "2016/12/31"+ , f "0001/01/01"+ , f "1000/01/01"+ ]+ where+ f s = (s,read $ map tr s)+ where+ tr '/' = '-'+ tr c = c++ counter_samples =+ [ ""+ , "2016-01-31"+ , "2016/1/31"+ , "2016/01/1"+ , "2016/001/01"+ ]++time_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+time_macro rty env pm =+ Just $ run_tests rty parseTimeOfDay samples env pm+ MacroDescriptor+ { _md_source = "[0-9]{2}:[0-9]{2}:[0-9]{2}(?:[.][0-9]+)?"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseTimeOfDay"+ , _md_description = "a HH:MM:SS[.Q+]"+ }+ where+ samples :: [(String,TimeOfDay)]+ samples =+ [ f "00:00:00" 00 00 0+ , f "23:59:59" 23 59 59000000000000+ , f "00:00:00.1234567890" 00 00 00123456789000+ ]+ where+ f s h m ps = (s,TimeOfDay h m $ toEnum ps)++ counter_samples =+ [ ""+ , "235959"+ , "10:20"+ , "A00:00:00"+ , "00:00:00A"+ , "23:59:59."+ ]++timezone_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+timezone_macro rty env pm =+ Just $ run_tests rty parseTimeZone samples env pm+ MacroDescriptor+ { _md_source = "(?:Z|[+-][0-9]{2}:?[0-9]{2})"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseTimeZone"+ , _md_description = "an IOS-8601 TZ specification"+ }+ where+ samples :: [(String,TimeZone)]+ samples =+ [ f "Z" $ minutesToTimeZone 0+ , f "+00:00" $ minutesToTimeZone 0+ , f "+0000" $ minutesToTimeZone 0+ , f "+0200" $ minutesToTimeZone 120+ , f "-0100" $ minutesToTimeZone $ -60+ ]+ where+ f = (,)++ counter_samples =+ [ ""+ , "00"+ , "A00:00"+ , "UTC"+ , "EST"+ , " EST"+ ]++datetime_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+datetime_macro rty env pm = Just $ run_tests rty parseDateTime samples env pm+ MacroDescriptor+ { _md_source = "@{%date}[ T]@{%time}(?:@{%timezone}| UTC)?"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseDateTime"+ , _md_description = "ISO-8601 format date and time + simple variants"+ }+ where+ samples :: [(String,UTCTime)]+ samples =+ [ f "2016-12-31 23:37:22.525343 UTC" "2016-12-31 23:37:22.525343Z"+ , f "2016-12-31 23:37:22.525343" "2016-12-31 23:37:22.525343Z"+ , f "2016-12-31 23:37:22" "2016-12-31 23:37:22Z"+ , f "2016-12-31T23:37:22+0100" "2016-12-31 23:37:22+0100"+ , f "2016-12-31T23:37:22-01:00" "2016-12-31 23:37:22-0100"+ , f "2016-12-31T23:37:22-23:59" "2016-12-31 23:37:22-2359"+ , f "2016-12-31T23:37:22Z" "2016-12-31 23:37:22Z"+ ]+ where+ f :: String -> String -> (String,UTCTime)+ f s r_s = (s,read r_s)++ counter_samples =+ [ ""+ , "2016-12-31 23:37:22.525343 EST"+ ]++datetime_8601_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+datetime_8601_macro rty env pm =+ Just $ run_tests rty parseDateTime samples env pm+ MacroDescriptor+ { _md_source = "@{%date}T@{%time}@{%timezone}"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseDateTime8601"+ , _md_description = "YYYY-MM-DDTHH:MM:SS[.Q*](Z|[+-]HHMM) format date and time"+ }+ where+ samples :: [(String,UTCTime)]+ samples =+ [ f "2016-12-31T23:37:22.343Z" "2016-12-31 23:37:22.343Z"+ , f "2016-12-31T23:37:22-0100" "2016-12-31 23:37:22-0100"+ , f "2016-12-31T23:37:22+23:59" "2016-12-31 23:37:22+2359"+ ]+ where+ f :: String -> String -> (String,UTCTime)+ f s r_s = (s,read r_s)++ counter_samples =+ [ ""+ , "2016-12-31 23:37:22.525343 EST"+ ]++datetime_clf_macro :: RegexType -> MacroEnv -> PreludeMacro -> Maybe MacroDescriptor+datetime_clf_macro rty env pm =+ Just $ run_tests rty parseDateTimeCLF samples env pm+ MacroDescriptor+ { _md_source = re+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseDateTimeCLF"+ , _md_description = "Common Log Format date+time: %d/%b/%Y:%H:%M:%S %z"+ }+ where+ samples :: [(String,UTCTime)]+ samples =+ [ f "10/Oct/2000:13:55:36 -0700" "2000-10-10 13:55:36-0700"+ , f "10/Oct/2000:13:55:36 +07:00" "2000-10-10 13:55:36+0700"+ ]+ where+ f :: String -> String -> (String,UTCTime)+ f s r_s = (s,read r_s)++ counter_samples =+ [ ""+ , "2016-12-31T23:37+0100"+ , "10/Oct/2000:13:55:36-0700"+ , "10/OCT/2000:13:55:36 -0700"+ , "10/Oct/2000:13:55 -0700"+ , "10/Oct/2000:13:55Z"+ ]++ re = RegexSource $ unwords+ [ "[0-9]{2}/@{%shortmonth}/[0-9]{4}:[0-9]{2}:[0-9]{2}:[0-9]{2}"+ , "[+-][0-9]{2}:?[0-9]{2}"+ ]++shortmonth_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+shortmonth_macro rty env pm =+ Just $ run_tests rty parseShortMonth samples env pm+ MacroDescriptor+ { _md_source = bracketedRegexSource $+ intercalate "|" $ elems shortMonthArray+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseShortMonth"+ , _md_description = "three letter month name: Jan-Dec"+ }+ where+ samples :: [(String,Int)]+ samples =+ [ f "Jan" 1+ , f "Feb" 2+ , f "Dec" 12+ ]+ where+ f = (,)++ counter_samples =+ [ ""+ , "jan"+ , "DEC"+ , "January"+ , "01"+ , "1"+ ]++address_ipv4_macros :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+address_ipv4_macros rty env pm =+ Just $ run_tests rty parseIPv4Address samples env pm+ MacroDescriptor+ { _md_source = "[0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}[.][0-9]{1,3}"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseSyslogSeverity"+ , _md_description = "an a.b.c.d IPv4 address"+ }+ where+ samples :: [(String,IPV4Address)]+ samples =+ [ f "0.0.0.0" ( 0, 0, 0, 0)+ , f "123.45.6.78" (123, 45, 6, 78)+ , f "9.9.9.9" ( 9, 9, 9, 9)+ , f "255.255.255.255" (255,255,255,255)+ ]+ where+ f = (,)++ counter_samples =+ [ ""+ , "foo"+ , "1234.0.0.0"+ , "1.2.3"+ , "1.2.3."+ , "1.2..4"+ , "www.example.com"+ , "2001:0db8:85a3:0000:0000:8a2e:0370:7334"+ ]++syslog_severity_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+syslog_severity_macro rty env pm =+ Just $ run_tests rty parseSyslogSeverity samples env pm+ MacroDescriptor+ { _md_source = re+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Just "parseSyslogSeverity"+ , _md_description = "syslog severity keyword (debug-emerg)"+ }+ where+ samples :: [(String,Priority)]+ samples =+ [ f "emerg" Emergency+ , f "panic" Emergency+ , f "alert" Alert+ , f "crit" Critical+ , f "err" Error+ , f "error" Error+ , f "warn" Warning+ , f "warning" Warning+ , f "notice" Notice+ , f "info" Info+ , f "debug" Debug+ ]+ where+ f = (,)++ counter_samples =+ [ ""+ , "Emergency"+ , "ALERT"+ ]++ re = case rty of+ PCRE -> re_pcre+ TDFA -> re_tdfa++ re_tdfa = bracketedRegexSource $+ intercalate "|" $+ [ kw+ | (kw0,kws) <- map syslogSeverityKeywords [minBound..maxBound]+ , kw <- kw0:kws+ ]++ re_pcre = bracketedRegexSource $+ intercalate "|" $+ [ kw+ | (kw0,kws) <- map syslogSeverityKeywords $+ filter (/=Error) [minBound..maxBound]+ , kw <- kw0:kws+ ] ++ ["err(?:or)?"]++email_simple_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+email_simple_macro rty env pm =+ Just $ run_tests rty Just samples env pm+ MacroDescriptor+ { _md_source = "[a-zA-Z0-9%_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9.-]+"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Nothing+ , _md_description = "an email address"+ }+ where+ samples :: [(String,String)]+ samples =+ [ f "user-name%foo.bar.com@an-example.com"+ ]+ where+ f s = (s,s)++ counter_samples =+ [ ""+ , "not-an-email-address"+ , "@not-an-email-address"+ ]+-- | see https://mathiasbynens.be/demo/url-regex+-- (based on @stephenhay URL)+url_macro :: RegexType+ -> MacroEnv+ -> PreludeMacro+ -> Maybe MacroDescriptor+url_macro rty env pm =+ Just $ run_tests rty Just samples env pm+ MacroDescriptor+ { _md_source = "([hH][tT][tT][pP][sS]?|[fF][tT][pP])://[^[:space:]/$.?#].[^[:space:]]*"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = test_stub pm+ , _md_parser = Nothing+ , _md_description = "a URL"+ }+ where+ samples :: [(String,String)]+ samples =+ [ f "https://mathiasbynens.be/demo/url-regex"+ , f "http://foo.com/blah_blah"+ , f "http://foo.com/blah_blah/"+ , f "http://foo.com/blah_blah_(wikipedia)"+ , f "http://foo.com/blah_blah_(wikipedia)_(again)"+ , f "http://www.example.com/wpstyle/?p=364"+ , f "HTTPS://foo.bar/?q=Test%20URL-encoded%20stuff"+ , f "HTTP://223.255.255.254"+ , f "ftp://223.255.255.254"+ , f "FTP://223.255.255.254"+ ]+ where+ f s = (s,s)++ counter_samples =+ [ ""+ , "http://"+ , "http://."+ , "http://.."+ , "http://../"+ , "http://?"+ , "http://??"+ , "http://foo.bar?q=Spaces should be encoded"+ , "//"+ , "http://##/"+ , "http://##"+ , "http://##/"+ ]++test_stub :: PreludeMacro -> [TestResult]+test_stub pm =+ error $ "test_stub: tests missing: " ++ presentPreludeMacro pm++run_tests :: (Eq a,Show a)+ => RegexType+ -> (String->Maybe a)+ -> [(String,a)]+ -> MacroEnv+ -> PreludeMacro+ -> MacroDescriptor+ -> MacroDescriptor+run_tests rty parser vector env =+ runTests rty parser vector env . prelude_macro_id++bracketedRegexSource :: String -> RegexSource+bracketedRegexSource re_s = RegexSource $ "(?:" ++ re_s ++ ")"++fix :: (a->a) -> a+fix f = f (fix f)
+ Text/RE/Internal/QQ.hs view
@@ -0,0 +1,21 @@+module Text.RE.Internal.QQ where++import Language.Haskell.TH.Quote+++qq0 :: String -> QuasiQuoter+qq0 nm =+ QuasiQuoter+ { quoteExp = const $ error $ oops "an expression"+ , quotePat = const $ error $ oops "a pattern"+ , quoteType = const $ error $ oops "a type"+ , quoteDec = const $ error $ oops "a declaration"+ }+ where+ oops sc = unwords+ [ "`"+ , nm+ , "` QuasiQuoter has been used in"+ , sc+ , "context but it should be used in an expresion context."+ ]
+ Text/RE/IsRegex.lhs view
@@ -0,0 +1,16 @@+\begin{code}+{-# LANGUAGE MultiParamTypeClasses #-}++module Text.RE.IsRegex where++import Text.RE.Capture+import Text.RE.Replace+\end{code}+++\begin{code}+class Replace s => IsRegex re s where+ matchOnce :: re -> s -> Match s+ matchMany :: re -> s -> Matches s+ regexSource :: re -> String+\end{code}
+ Text/RE/LineNo.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Text.RE.LineNo where+++newtype LineNo =+ ZeroBasedLineNo { getZeroBasedLineNo :: Int }+ deriving (Show,Enum)+++firstLine :: LineNo+firstLine = ZeroBasedLineNo 0++getLineNo :: LineNo -> Int+getLineNo = (+1) . getZeroBasedLineNo++lineNo :: Int -> LineNo+lineNo = ZeroBasedLineNo . (\x->x-1)
+ Text/RE/Options.lhs view
@@ -0,0 +1,77 @@+\begin{code}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++module Text.RE.Options where++import Data.Hashable+import qualified Data.HashMap.Strict as HM+import Data.String+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+\end{code}++\begin{code}+data Options_ r c e =+ Options+ { _options_mode :: Mode+ , _options_macs :: Macros r+ , _options_comp :: c+ , _options_exec :: e+ }+ deriving (Show)+\end{code}++\begin{code}+class IsOption o r c e |+ e -> r, c -> e , e -> c, r -> c, c -> r, r -> e where+ makeOptions :: o -> Options_ r c e+\end{code}++\begin{code}+data Mode+ = Simple+ | Block+ deriving (Bounded,Enum,Ord,Eq,Show)+\end{code}++\begin{code}+newtype MacroID =+ MacroID { _MacroID :: String }+ deriving (IsString,Ord,Eq,Show)+\end{code}++\begin{code}+instance Hashable MacroID where+ hashWithSalt i = hashWithSalt i . _MacroID+\end{code}++\begin{code}+type Macros r = HM.HashMap MacroID r+\end{code}++\begin{code}+emptyMacros :: Macros r+emptyMacros = HM.empty+\end{code}++\begin{code}+data SimpleRegexOptions+ = MultilineSensitive+ | MultilineInsensitive+ | BlockSensitive+ | BlockInsensitive+ deriving (Bounded,Enum,Eq,Ord,Show)+\end{code}++\begin{code}+instance Lift SimpleRegexOptions where+ lift sro = case sro of+ MultilineSensitive -> conE 'MultilineSensitive+ MultilineInsensitive -> conE 'MultilineInsensitive+ BlockSensitive -> conE 'BlockSensitive+ BlockInsensitive -> conE 'BlockInsensitive+\end{code}
+ Text/RE/PCRE.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-dodgy-exports #-}++module Text.RE.PCRE+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.PCRE.RE+ , module Text.RE.PCRE.ByteString+ , module Text.RE.PCRE.ByteString.Lazy+ , module Text.RE.PCRE.Sequence+ , module Text.RE.PCRE.String++ ) where+++import qualified Text.Regex.Base as B+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.PCRE.RE+import qualified Text.Regex.PCRE as PCRE+import Text.RE.PCRE.ByteString()+import Text.RE.PCRE.ByteString.Lazy()+import Text.RE.PCRE.Sequence()+import Text.RE.PCRE.String()+++(*=~) :: IsRegex RE s+ => s+ -> RE+ -> Matches s+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ matchMany rex bs++(?=~) :: IsRegex RE s+ => s+ -> RE+ -> Match s+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ matchOnce rex bs++(=~) :: ( B.RegexContext PCRE.Regex s a+ , B.RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption s+ )+ => s+ -> RE+ -> a+(=~) bs rex = B.match (reRegex rex) bs++(=~~) :: ( Monad m+ , B.RegexContext PCRE.Regex s a+ , B.RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption s+ )+ => s+ -> RE+ -> m a+(=~~) bs rex = B.matchM (reRegex rex) bs
+ Text/RE/PCRE/ByteString.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.PCRE.ByteString+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.PCRE.RE+ ) where++import qualified Data.ByteString as B+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.PCRE.RE+import qualified Text.Regex.PCRE as PCRE+++(*=~) :: B.ByteString+ -> RE+ -> Matches B.ByteString+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: B.ByteString+ -> RE+ -> Match B.ByteString+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext PCRE.Regex B.ByteString a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => B.ByteString+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext PCRE.Regex B.ByteString a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => B.ByteString+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE B.ByteString where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/PCRE/ByteString/Lazy.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.PCRE.ByteString.Lazy+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.PCRE.RE+ ) where++import qualified Data.ByteString.Lazy as LBS+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.PCRE.RE+import qualified Text.Regex.PCRE as PCRE+++(*=~) :: LBS.ByteString+ -> RE+ -> Matches LBS.ByteString+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: LBS.ByteString+ -> RE+ -> Match LBS.ByteString+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext PCRE.Regex LBS.ByteString a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => LBS.ByteString+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext PCRE.Regex LBS.ByteString a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => LBS.ByteString+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE LBS.ByteString where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/PCRE/RE.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.PCRE.RE+ ( re+ , reMS+ , reMI+ , reBS+ , reBI+ , reMultilineSensitive+ , reMultilineInsensitive+ , reBlockSensitive+ , reBlockInsensitive+ , re_+ , cp+ , regexType+ , RE+ , reOptions+ , reSource+ , reCaptureNames+ , reRegex+ , Options+ , prelude+ , preludeEnv+ , preludeTestsFailing+ , preludeTable+ , preludeSummary+ , preludeSources+ , preludeSource+ , noPreludeOptions+ , defaultOptions+ , unpackSimpleRegexOptions+ , compileRegex+ ) where++import Control.Applicative+import Data.Bits+import Data.Functor.Identity+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Text.RE+import Text.RE.Internal.NamedCaptures+import Text.RE.Internal.PreludeMacros+import Text.RE.Internal.QQ+import Text.RE.TestBench+import Text.Regex.PCRE+++re+ , reMS+ , reMI+ , reBS+ , reBI+ , reMultilineSensitive+ , reMultilineInsensitive+ , reBlockSensitive+ , reBlockInsensitive+ , re_ :: QuasiQuoter++re = re' $ Just minBound+reMS = reMultilineSensitive+reMI = reMultilineInsensitive+reBS = reBlockSensitive+reBI = reBlockInsensitive+reMultilineSensitive = re' $ Just MultilineSensitive+reMultilineInsensitive = re' $ Just MultilineInsensitive+reBlockSensitive = re' $ Just BlockSensitive+reBlockInsensitive = re' $ Just BlockInsensitive+re_ = re' Nothing++regexType :: RegexType+regexType = PCRE++data RE =+ RE+ { _re_options :: Options+ , _re_source :: String+ , _re_cnames :: CaptureNames+ , _re_regex :: Regex+ }++reOptions :: RE -> Options+reOptions = _re_options++reSource :: RE -> String+reSource = _re_source++reCaptureNames :: RE -> CaptureNames+reCaptureNames = _re_cnames++reRegex :: RE -> Regex+reRegex = _re_regex++type Options = Options_ RE CompOption ExecOption++instance IsOption SimpleRegexOptions RE CompOption ExecOption where+ makeOptions = unpackSimpleRegexOptions++instance IsOption Mode RE CompOption ExecOption where+ makeOptions md = Options md prelude def_comp_option def_exec_option++instance IsOption (Macros RE) RE CompOption ExecOption where+ makeOptions ms = Options minBound ms def_comp_option def_exec_option++instance IsOption CompOption RE CompOption ExecOption where+ makeOptions co = Options minBound prelude co def_exec_option++instance IsOption ExecOption RE CompOption ExecOption where+ makeOptions eo = Options minBound prelude def_comp_option eo++instance IsOption Options RE CompOption ExecOption where+ makeOptions = id++instance IsOption () RE CompOption ExecOption where+ makeOptions _ = unpackSimpleRegexOptions minBound++def_comp_option :: CompOption+def_comp_option = _options_comp defaultOptions++def_exec_option :: ExecOption+def_exec_option = _options_exec defaultOptions++noPreludeOptions :: Options+noPreludeOptions = defaultOptions { _options_macs = emptyMacros }++defaultOptions :: Options+defaultOptions = makeOptions (minBound::SimpleRegexOptions)++unpackSimpleRegexOptions :: SimpleRegexOptions -> Options+unpackSimpleRegexOptions sro =+ Options+ { _options_mode = minBound+ , _options_macs = prelude+ , _options_comp = comp+ , _options_exec = defaultExecOpt+ }+ where+ comp =+ wiggle ml compMultiline $+ wiggle ci compCaseless+ defaultCompOpt++ wiggle True m v = v .|. m+ wiggle False m v = v .&. complement m++ (ml,ci) = case sro of+ MultilineSensitive -> (,) True False+ MultilineInsensitive -> (,) True True+ BlockSensitive -> (,) False False+ BlockInsensitive -> (,) False True++compileRegex :: ( IsOption o RE CompOption ExecOption+ , Functor m+ , Monad m+ )+ => o+ -> String+ -> m RE+compileRegex = compileRegex_ . makeOptions++compileRegex_ :: ( Functor m , Monad m )+ => Options+ -> String+ -> m RE+compileRegex_ os re_s = uncurry mk <$> compileRegex' os re_s+ where+ mk cnms rex =+ RE+ { _re_options = os+ , _re_source = re_s+ , _re_cnames = cnms+ , _re_regex = rex+ }++ Options{..} = os++re' :: Maybe SimpleRegexOptions -> QuasiQuoter+re' mb = case mb of+ Nothing ->+ (qq0 "re_")+ { quoteExp = parse minBound (\rs->[|flip unsafeCompileRegex rs|])+ }+ Just sro ->+ (qq0 "re")+ { quoteExp = parse sro (\rs->[|unsafeCompileRegexSimple sro rs|])+ }+ where+ parse :: SimpleRegexOptions -> (String->Q Exp) -> String -> Q Exp+ parse sro mk rs = either error (\_->mk rs) $ compileRegex_ os rs+ where+ os = unpackSimpleRegexOptions sro++unsafeCompileRegexSimple :: SimpleRegexOptions -> String -> RE+unsafeCompileRegexSimple sro re_s = unsafeCompileRegex os re_s+ where+ os = unpackSimpleRegexOptions sro++unsafeCompileRegex :: IsOption o RE CompOption ExecOption+ => o+ -> String+ -> RE+unsafeCompileRegex = unsafeCompileRegex_ . makeOptions++unsafeCompileRegex_ :: Options -> String -> RE+unsafeCompileRegex_ os = either oops id . compileRegex os+ where+ oops = error . ("unsafeCompileRegex: " ++)++compileRegex' :: (Functor m,Monad m)+ => Options+ -> String+ -> m (CaptureNames,Regex)+compileRegex' Options{..} s0 = do+ (cnms,s2) <- either fail return $ extractNamedCaptures s1+ (,) cnms <$> makeRegexOptsM _options_comp _options_exec s2+ where+ s1 = expandMacros reSource _options_mode _options_macs s0++prelude :: Macros RE+prelude = runIdentity $ preludeMacros mk PCRE ExclCaptures+ where+ mk = Identity . unsafeCompileRegex_ noPreludeOptions++preludeTestsFailing :: [MacroID]+preludeTestsFailing = badMacros preludeEnv++preludeEnv :: MacroEnv+preludeEnv = preludeMacroEnv PCRE++preludeTable :: String+preludeTable = preludeMacroTable PCRE++preludeSummary :: PreludeMacro -> String+preludeSummary = preludeMacroSummary PCRE++preludeSources :: String+preludeSources = preludeMacroSources PCRE++preludeSource :: PreludeMacro -> String+preludeSource = preludeMacroSource PCRE
+ Text/RE/PCRE/Sequence.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.PCRE.Sequence+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.PCRE.RE+ ) where++import qualified Data.Sequence as S+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.PCRE.RE+import qualified Text.Regex.PCRE as PCRE+++(*=~) :: (S.Seq Char)+ -> RE+ -> Matches (S.Seq Char)+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: (S.Seq Char)+ -> RE+ -> Match (S.Seq Char)+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext PCRE.Regex (S.Seq Char) a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => (S.Seq Char)+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext PCRE.Regex (S.Seq Char) a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => (S.Seq Char)+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE (S.Seq Char) where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/PCRE/String.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.PCRE.String+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.PCRE.RE+ ) where+++import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.PCRE.RE+import qualified Text.Regex.PCRE as PCRE+++(*=~) :: String+ -> RE+ -> Matches String+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: String+ -> RE+ -> Match String+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext PCRE.Regex String a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => String+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext PCRE.Regex String a+ , RegexMaker PCRE.Regex PCRE.CompOption PCRE.ExecOption String+ )+ => String+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE String where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/Parsers.hs view
@@ -0,0 +1,156 @@+module Text.RE.Parsers+ ( parseInteger+ , parseHex+ , parseDouble+ , parseString+ , parseSimpleString+ , parseDate+ , parseSlashesDate+ , parseTimeOfDay+ , parseTimeZone+ , parseDateTime+ , parseDateTime8601+ , parseDateTimeCLF+ , parseShortMonth+ , shortMonthArray+ , IPV4Address+ , parseIPv4Address+ , parseSyslogSeverity+ , syslogSeverityKeywords+ ) where++import Data.Array+import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Data.Time+import Data.Word+import System.Posix.Syslog+import Text.Printf+import Text.Read+import Text.RE.Replace+++parseInteger :: Replace a => a -> Maybe Int+parseInteger = readMaybe . unpack_++parseHex :: Replace a => a -> Maybe Int+parseHex = readMaybe . ("0x"++) . unpack_++parseDouble :: Replace a => a -> Maybe Double+parseDouble = readMaybe . unpack_++parseString :: Replace a => a -> Maybe String+parseString = readMaybe . unpack_++parseSimpleString :: Replace a => a -> Maybe String+parseSimpleString = topntail . unpack_+ where+ topntail ('"':t) = topntail' $ reverse t+ topntail _ = Nothing++ topntail' ('"':rt) = Just $ reverse rt+ topntail' _ = Nothing++date_templates, time_templates, timezone_templates,+ date_time_8601_templates, date_time_templates :: [String]+date_templates = ["%F"]+time_templates = ["%H:%M:%S","%H:%M:%S%Q","%H:%M"]+timezone_templates = ["Z","%z"]+date_time_8601_templates =+ [ printf "%sT%s%s" dt tm tz+ | dt <- date_templates+ , tm <- time_templates+ , tz <- timezone_templates+ ]+date_time_templates =+ [ printf "%s%c%s%s" dt sc tm tz+ | dt <- date_templates+ , sc <- ['T',' ']+ , tm <- time_templates+ , tz <- timezone_templates ++ [" UTC",""]+ ]++parseDate :: Replace a => a -> Maybe Day+parseDate = parse_time date_templates++parseSlashesDate :: Replace a => a -> Maybe Day+parseSlashesDate = parse_time ["%Y/%m/%d"]++parseTimeOfDay :: Replace a => a -> Maybe TimeOfDay+parseTimeOfDay = parse_time time_templates++parseTimeZone :: Replace a => a -> Maybe TimeZone+parseTimeZone = parse_time timezone_templates++parseDateTime :: Replace a => a -> Maybe UTCTime+parseDateTime = parse_time date_time_templates++parseDateTime8601 :: Replace a => a -> Maybe UTCTime+parseDateTime8601 = parse_time date_time_8601_templates++parseDateTimeCLF :: Replace a => a -> Maybe UTCTime+parseDateTimeCLF = parse_time ["%d/%b/%Y:%H:%M:%S %z"]++parseShortMonth :: Replace a => a -> Maybe Int+parseShortMonth = flip HM.lookup short_month_hm . unpack_++parse_time :: (ParseTime t,Replace s) => [String] -> s -> Maybe t+parse_time tpls = prs . unpack_+ where+ prs s = listToMaybe $ catMaybes+ [ parseTimeM False defaultTimeLocale fmt s+ | fmt<-tpls+ ]++short_month_hm :: HM.HashMap String Int+short_month_hm = HM.fromList [ (shortMonthArray!i,i) | i<-[1..12] ]++shortMonthArray :: Array Int String+shortMonthArray = listArray (1,12) $+ words "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"++type IPV4Address = (Word8,Word8,Word8,Word8)++parseIPv4Address :: Replace a => a -> Maybe IPV4Address+parseIPv4Address = prs . words_by (=='.') . unpack_+ where+ prs [a_s,b_s,c_s,d_s] = do+ a <- readMaybe a_s+ b <- readMaybe b_s+ c <- readMaybe c_s+ d <- readMaybe d_s+ case all is_o [a,b,c,d] of+ True -> Just (toEnum a,toEnum b,toEnum c,toEnum d)+ False -> Nothing+ prs _ = Nothing++ is_o x = 0 <= x && x <= 255++parseSyslogSeverity :: Replace a => a -> Maybe Priority+parseSyslogSeverity = flip HM.lookup syslog_severity_hm . unpack_++syslog_severity_hm :: HM.HashMap String Priority+syslog_severity_hm = HM.fromList+ [ (kw,pri)+ | pri<-[minBound..maxBound]+ , let (kw0,kws) = syslogSeverityKeywords pri+ , kw <- kw0:kws+ ]++syslogSeverityKeywords :: Priority -> (String,[String])+syslogSeverityKeywords pri = case pri of+ Emergency -> (,) "emerg" ["panic"]+ Alert -> (,) "alert" []+ Critical -> (,) "crit" []+ Error -> (,) "err" ["error"]+ Warning -> (,) "warning" ["warn"]+ Notice -> (,) "notice" []+ Info -> (,) "info" []+ Debug -> (,) "debug" []++words_by :: (Char->Bool) -> String -> [String]+words_by f s = case dropWhile f s of+ "" -> []+ s' -> w : words_by f s''+ where+ (w, s'') = break f s'
+ Text/RE/Replace.lhs view
@@ -0,0 +1,496 @@+\begin{code}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Text.RE.Replace+ ( Replace(..)+ , Replace_(..)+ , replace_+ , Phi(..)+ , Context(..)+ , Location(..)+ , isTopLocation+ , replace+ , replaceAll+ , replaceAllCaptures+ , replaceAllCaptures'+ , replaceAllCaptures_+ , replaceAllCapturesM+ , replaceCaptures+ , replaceCaptures'+ , replaceCaptures_+ , replaceCapturesM+ , expandMacros+ , expandMacros'+ ) where++import Control.Applicative+import Data.Array+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Char+import qualified Data.Foldable as F+import Data.Functor.Identity+import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Data.Monoid+import qualified Data.Sequence as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as LT+import Text.Heredoc+import Text.RE.Capture+import Text.RE.CaptureID+import Text.RE.Options+import Text.Regex.TDFA+import Text.Regex.TDFA.Text()+import Text.Regex.TDFA.Text.Lazy()+\end{code}++\begin{code}+-- | Replace provides the missing methods needed to replace the matched+-- text; length_ is the minimum implementation+class (Extract a,Monoid a) => Replace a where+ -- | length function for a+ length_ :: a -> Int+ -- | inject String into a+ pack_ :: String -> a+ -- | project a onto a String+ unpack_ :: a -> String+ -- | inject into Text+ textify :: a -> T.Text+ -- | project Text onto a+ detextify :: T.Text -> a+ -- | append a newline+ appendNewline :: a -> a+ -- | apply a substitution function to a Capture+ subst :: (a->a) -> Capture a -> a+ -- | convert a template containing $0, $1, etc., in the first+ -- argument, into a 'phi' replacement function for use with+ -- replaceAllCaptures' and replaceCaptures'+ parse_tpl :: a -> Match a -> Location -> Capture a -> Maybe a++ textify = T.pack . unpack_+ detextify = pack_ . T.unpack+ appendNewline = (<> pack_ "\n")++ subst f m@Capture{..} =+ capturePrefix m <> f capturedText <> captureSuffix m+\end{code}++\begin{code}+-- | a selction of the Replace methods can be encapsulated with Replace_+-- for the higher-order replacement functions+data Replace_ a =+ Replace_+ { _r_length :: a -> Int+ , _r_subst :: (a->a) -> Capture a -> a+ }++-- | replace_ encapsulates Replace_ a from a Replace a context+replace_ :: Replace a => Replace_ a+replace_ =+ Replace_+ { _r_length = length_+ , _r_subst = subst+ }+\end{code}++\begin{code}+-- | @Phi@ specifies the substitution function for procesing the substrings+-- captured by the regular expression.+data Phi a =+ Phi+ { _phi_context :: Context -- ^ the context for applying+ -- the substitution+ , _phi_phi :: Location -> a -> a -- ^ the substitution function+ -- takes the location and+ -- the text to be replaced and+ -- returns the replacement+ -- text to be substituted+ }++-- | @Context@ specifies which contexts the substitutions should be applied+data Context+ = TOP -- ^ substitutions should be applied to the top-level only,+ -- the text that matched the whole RE+ | SUB -- ^ substitutions should only be applied to the text+ -- captured by bracketed sub-REs+ | ALL -- ^ the substitution function should be applied to all+ -- captures, the top level and the sub-expression captures+ deriving (Show)++-- | the @Location@ information passed into the substitution function+-- specifies which sub-expression is being substituted+data Location =+ Location+ { _loc_match :: Int -- ^ the zero-based, i-th string to be+ -- matched, when matching all strings,+ -- zero when only the first string is+ -- being matched+ , _loc_capture :: CaptureOrdinal+ -- ^ 0, when matching the top-level+ -- string matched by the whole RE, 1+ -- for the top-most, left-most redex+ -- captured by bracketed sub-REs, etc.+ }+ deriving (Show)+\end{code}++\begin{code}+-- | True iff the location references a complete match+-- (i.e., not a bracketed capture)+isTopLocation :: Location -> Bool+isTopLocation = (==0) . _loc_capture+\end{code}++\begin{code}+-- | replace all with a template, $0 for whole text, $1 for first+-- capture, etc.+replaceAll :: Replace a+ => a+ -> Matches a+ -> a+replaceAll tpl ac = replaceAllCaptures' TOP (parse_tpl tpl) ac+\end{code}++\begin{code}+-- | substitutes the PHI substitutions through the Matches+replaceAllCaptures :: Replace a+ => Phi a+ -> Matches a+ -> a+replaceAllCaptures = mk_phi replaceAllCaptures'+\end{code}++\begin{code}+-- | substitutes using a function that takes the full Match+-- context and returns the same replacement text as the _phi_phi+-- context.+replaceAllCaptures' :: Replace a+ => Context+ -> (Match a->Location->Capture a->Maybe a)+ -> Matches a+ -> a+\end{code}++\begin{code}+replaceAllCaptures' = replaceAllCaptures_ replace_+\end{code}++\begin{code}+-- | replaceAllCaptures_ is like like replaceAllCaptures' but takes the+-- Replace methods through the Replace_ argument+replaceAllCaptures_ :: Extract a+ => Replace_ a+ -> Context+ -> (Match a->Location->Capture a->Maybe a)+ -> Matches a+ -> a+replaceAllCaptures_ s ctx phi ac =+ runIdentity $ replaceAllCapturesM s ctx (lift_phi phi) ac+\end{code}++\begin{code}+-- | replaceAllCapturesM is just a monadically generalised version of+-- replaceAllCaptures_+replaceAllCapturesM :: (Extract a,Monad m)+ => Replace_ a+ -> Context+ -> (Match a->Location->Capture a->m (Maybe a))+ -> Matches a+ -> m a+replaceAllCapturesM r ctx phi_ Matches{..} =+ replaceCapturesM r ALL phi $ Match matchesSource cnms arr+ where+ phi _ (Location _ i) = case arr_c!i of+ Just caps -> phi_ caps . uncurry Location $ arr_i ! i+ Nothing -> const $ return Nothing++ arr_c = listArray bds $+ concat $+ [ repl (rangeSize $ bounds $ matchArray cs) cs+ | cs <- allMatches+ ]++ arr_i = listArray bds j_ks++ arr = listArray bds $+ [ arr_ ! k+ | arr_ <- map matchArray allMatches+ , k <- indices arr_+ ]++ bds = (0,CaptureOrdinal $ length j_ks-1)++ j_ks =+ [ (j,k)+ | (j,arr_) <- zip [0..] $ map matchArray allMatches+ , k <- indices arr_+ ]++ repl 0 _ = []+ repl n x = case ctx of+ TOP -> Just x : replicate (n-1) Nothing+ SUB -> Nothing : replicate (n-1) (Just x)+ ALL -> replicate n $ Just x++ cnms = fromMaybe noCaptureNames $ listToMaybe $ map captureNames allMatches+\end{code}++\begin{code}+-- | replace with a template containing $0 for whole text,+-- $1 for first capture, etc.+replace :: Replace a+ => Match a+ -> a+ -> a+replace c tpl = replaceCaptures' TOP (parse_tpl tpl) c+\end{code}++\begin{code}+-- | substitutes the PHI substitutions through the Match+replaceCaptures :: Replace a+ => Phi a+ -> Match a+ -> a+replaceCaptures = mk_phi replaceCaptures'+\end{code}++\begin{code}+-- | substitutes using a function that takes the full Match+-- context and returns the same replacement text as the _phi_phi+-- context.+replaceCaptures' :: Replace a+ => Context+ -> (Match a->Location->Capture a->Maybe a)+ -> Match a+ -> a+replaceCaptures' = replaceCaptures_ replace_+\end{code}++\begin{code}+-- | replaceCaptures_ is like replaceCaptures' but takes the Replace methods+-- through the Replace_ argument+replaceCaptures_ :: Extract a+ => Replace_ a+ -> Context+ -> (Match a->Location->Capture a->Maybe a)+ -> Match a+ -> a+replaceCaptures_ s ctx phi caps =+ runIdentity $ replaceCapturesM s ctx (lift_phi phi) caps+\end{code}++\begin{code}+-- | replaceCapturesM is just a monadically generalised version of+-- replaceCaptures_+replaceCapturesM :: (Monad m,Extract a)+ => Replace_ a+ -> Context+ -> (Match a->Location->Capture a->m (Maybe a))+ -> Match a+ -> m a+replaceCapturesM Replace_{..} ctx phi_ caps@Match{..} = do+ (hay',_) <- foldr sc (return (matchSource,[])) $+ zip [0..] $ elems matchArray+ return hay'+ where+ sc (i,cap0) act = do+ (hay,ds) <- act+ let ndl = capturedText cap+ cap = adj hay ds cap0+ mb <- phi i cap+ case mb of+ Nothing -> return (hay,ds)+ Just ndl' ->+ return+ ( _r_subst (const ndl') cap+ , (captureOffset cap,len'-len) : ds+ )+ where+ len' = _r_length ndl'+ len = _r_length ndl++ adj hay ds cap =+ Capture+ { captureSource = hay+ , capturedText = before len $ after off0 hay+ , captureOffset = off0+ , captureLength = len+ }+ where+ len = len0 + sum+ [ delta+ | (off,delta) <- ds+ , off < off0 + len0+ ]+ len0 = captureLength cap+ off0 = captureOffset cap++ phi i cap = case ctx of+ TOP | i/=0 -> return Nothing+ SUB | i==0 ->return Nothing+ _ ->+ case not $ hasCaptured cap of+ True -> return Nothing+ False -> phi_ caps (Location 0 i) cap+\end{code}++\begin{code}+-- the Replace instances++instance Replace [Char] where+ length_ = length+ pack_ = id+ unpack_ = id+ textify = T.pack+ detextify = T.unpack+ appendNewline = (<>"\n")+ parse_tpl = parse_tpl_ id++instance Replace B.ByteString where+ length_ = B.length+ pack_ = B.pack+ unpack_ = B.unpack+ textify = TE.decodeUtf8+ detextify = TE.encodeUtf8+ appendNewline = (<>"\n")+ parse_tpl = parse_tpl_ B.unpack++instance Replace LBS.ByteString where+ length_ = fromEnum . LBS.length+ pack_ = LBS.pack+ unpack_ = LBS.unpack+ textify = TE.decodeUtf8 . LBS.toStrict+ detextify = LBS.fromStrict . TE.encodeUtf8+ appendNewline = (<>"\n")+ parse_tpl = parse_tpl_ LBS.unpack++instance Replace (S.Seq Char) where+ length_ = S.length+ pack_ = S.fromList+ unpack_ = F.toList+ parse_tpl = parse_tpl_ F.toList++instance Replace T.Text where+ length_ = T.length+ pack_ = T.pack+ unpack_ = T.unpack+ textify = id+ detextify = id+ appendNewline = (<>"\n")+ parse_tpl = parse_tpl_ T.unpack++instance Replace LT.Text where+ length_ = fromEnum . LT.length+ pack_ = LT.pack+ unpack_ = LT.unpack+ textify = LT.toStrict+ detextify = LT.fromStrict+ appendNewline = (<>"\n")+ parse_tpl = parse_tpl_ LT.unpack+\end{code}++\begin{code}+-- | expand all of the @{..} macros in the RE in the argument String+-- according to the Macros argument, preprocessing the RE String+-- according to the Mode argument (used internally)+expandMacros :: (r->String) -> Mode -> Macros r -> String -> String+expandMacros x_src md hm s0 =+ case HM.null hm of+ True -> s+ False -> expandMacros' (fmap x_src . flip HM.lookup hm) s+ where+ s = case md of+ Simple -> s0+ Block -> concat $ map clean $ lines s0++ clean = reverse . dropWhile isSpace . reverse . dropWhile isSpace+\end{code}++\begin{code}+-- | expand the @{..} macos in the argument string using the given+-- function+expandMacros' :: (MacroID->Maybe String) -> String -> String+expandMacros' lu = fixpoint e_m+ where+ e_m re_s = replaceAllCaptures' TOP phi $ re_s $=~ [here|@(@|\{([^{}]+)\})|]+ where+ phi mtch _ cap = case txt == "@@" of+ True -> Just "@"+ False -> Just $ fromMaybe txt $ lu ide+ where+ txt = capturedText cap+ ide = MacroID $ capturedText $ capture c2 mtch+ c2 = CID_ordinal $ CaptureOrdinal 2+\end{code}++\begin{code}+lift_phi :: Monad m+ => (Match a->Location->Capture a->Maybe a)+ -> (Match a->Location->Capture a->m (Maybe a))+lift_phi phi_ = phi+ where+ phi caps' loc' cap' = return $ phi_ caps' loc' cap'++mk_phi :: (Context->(Match a->Location->Capture a->Maybe a)->b)+ -> Phi a+ -> b+mk_phi f phi@Phi{..} = f _phi_context $ mk_phi' phi++mk_phi' :: Phi a -> Match a -> Location -> Capture a -> Maybe a+mk_phi' Phi{..} _ loc = Just . _phi_phi loc . capturedText+\end{code}++\begin{code}+parse_tpl_ :: ( Replace a+ , RegexContext Regex a (Matches a)+ , RegexMaker Regex CompOption ExecOption String+ )+ => (a->String)+ -> a+ -> Match a+ -> Location+ -> Capture a+ -> Maybe a+parse_tpl_ unpack tpl mtch _ _ =+ Just $ replaceAllCaptures' TOP phi $+ tpl $=~ [here|\$(\$|[0-9]+|\{([^{}]+)\})|]+ where+ phi t_mtch _ _ = case captureMaybe c2 t_mtch of+ Just cap -> this $ CID_name $ CaptureName txt+ where+ txt = T.pack $ unpack $ capturedText cap+ Nothing -> case s == "$" of+ True -> Just t+ False -> this $ CID_ordinal $ CaptureOrdinal $ read s+ where+ s = unpack t+ t = capturedText $ capture c1 t_mtch++ this cid = capturedText <$> captureMaybe cid mtch++ c1 = CID_ordinal $ CaptureOrdinal 1+ c2 = CID_ordinal $ CaptureOrdinal 2+\end{code}++\begin{code}+fixpoint :: (Eq a) => (a->a) -> a -> a+fixpoint f = chk . iterate f+ where+ chk (x:x':_) | x==x' = x+ chk xs = chk $ tail xs+\end{code}++\begin{code}+($=~) :: ( RegexContext Regex source target+ , RegexMaker Regex CompOption ExecOption String+ )+ => source -> String -> target+($=~) = (=~)++\end{code}
+ Text/RE/TDFA.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-dodgy-exports #-}++module Text.RE.TDFA+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ , module Text.RE.TDFA.ByteString+ , module Text.RE.TDFA.ByteString.Lazy+ , module Text.RE.TDFA.Sequence+ , module Text.RE.TDFA.String+ , module Text.RE.TDFA.Text+ , module Text.RE.TDFA.Text.Lazy+ ) where+++import qualified Text.Regex.Base as B+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+import Text.RE.TDFA.ByteString()+import Text.RE.TDFA.ByteString.Lazy()+import Text.RE.TDFA.Sequence()+import Text.RE.TDFA.String()+import Text.RE.TDFA.Text()+import Text.RE.TDFA.Text.Lazy()+++(*=~) :: IsRegex RE s+ => s+ -> RE+ -> Matches s+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ matchMany rex bs++(?=~) :: IsRegex RE s+ => s+ -> RE+ -> Match s+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ matchOnce rex bs++(=~) :: ( B.RegexContext TDFA.Regex s a+ , B.RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption s+ )+ => s+ -> RE+ -> a+(=~) bs rex = B.match (reRegex rex) bs++(=~~) :: ( Monad m+ , B.RegexContext TDFA.Regex s a+ , B.RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption s+ )+ => s+ -> RE+ -> m a+(=~~) bs rex = B.matchM (reRegex rex) bs
+ Text/RE/TDFA/ByteString.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.ByteString+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where++import qualified Data.ByteString as B+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: B.ByteString+ -> RE+ -> Matches B.ByteString+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: B.ByteString+ -> RE+ -> Match B.ByteString+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex B.ByteString a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => B.ByteString+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex B.ByteString a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => B.ByteString+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE B.ByteString where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TDFA/ByteString/Lazy.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.ByteString.Lazy+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where++import qualified Data.ByteString.Lazy.Char8 as LBS+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: LBS.ByteString+ -> RE+ -> Matches LBS.ByteString+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: LBS.ByteString+ -> RE+ -> Match LBS.ByteString+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex LBS.ByteString a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => LBS.ByteString+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex LBS.ByteString a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => LBS.ByteString+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE LBS.ByteString where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TDFA/RE.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.RE+ ( re+ , reMS+ , reMI+ , reBS+ , reBI+ , reMultilineSensitive+ , reMultilineInsensitive+ , reBlockSensitive+ , reBlockInsensitive+ , re_+ , cp+ , regexType+ , RE+ , reOptions+ , reSource+ , reCaptureNames+ , reRegex+ , Options+ , noPreludeOptions+ , defaultOptions+ , prelude+ , preludeEnv+ , preludeTestsFailing+ , preludeTable+ , preludeSummary+ , preludeSources+ , preludeSource+ , unpackSimpleRegexOptions+ , compileRegex+ ) where++import Control.Applicative+import Data.Functor.Identity+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Text.RE+import Text.RE.Internal.NamedCaptures+import Text.RE.Internal.PreludeMacros+import Text.RE.Internal.QQ+import Text.RE.TestBench+import Text.Regex.TDFA+++re+ , reMS+ , reMI+ , reBS+ , reBI+ , reMultilineSensitive+ , reMultilineInsensitive+ , reBlockSensitive+ , reBlockInsensitive+ , re_ :: QuasiQuoter++re = re' $ Just minBound+reMS = reMultilineSensitive+reMI = reMultilineInsensitive+reBS = reBlockSensitive+reBI = reBlockInsensitive+reMultilineSensitive = re' $ Just MultilineSensitive+reMultilineInsensitive = re' $ Just MultilineInsensitive+reBlockSensitive = re' $ Just BlockSensitive+reBlockInsensitive = re' $ Just BlockInsensitive+re_ = re' Nothing++regexType :: RegexType+regexType = TDFA++data RE =+ RE+ { _re_options :: Options+ , _re_source :: String+ , _re_cnames :: CaptureNames+ , _re_regex :: Regex+ }++reOptions :: RE -> Options+reOptions = _re_options++reSource :: RE -> String+reSource = _re_source++reCaptureNames :: RE -> CaptureNames+reCaptureNames = _re_cnames++reRegex :: RE -> Regex+reRegex = _re_regex++type Options = Options_ RE CompOption ExecOption++instance IsOption SimpleRegexOptions RE CompOption ExecOption where+ makeOptions = unpackSimpleRegexOptions++instance IsOption Mode RE CompOption ExecOption where+ makeOptions md = Options md prelude def_comp_option def_exec_option++instance IsOption (Macros RE) RE CompOption ExecOption where+ makeOptions ms = Options minBound ms def_comp_option def_exec_option++instance IsOption CompOption RE CompOption ExecOption where+ makeOptions co = Options minBound prelude co def_exec_option++instance IsOption ExecOption RE CompOption ExecOption where+ makeOptions eo = Options minBound prelude def_comp_option eo++instance IsOption Options RE CompOption ExecOption where+ makeOptions = id++instance IsOption () RE CompOption ExecOption where+ makeOptions _ = unpackSimpleRegexOptions minBound++def_comp_option :: CompOption+def_comp_option = _options_comp defaultOptions++def_exec_option :: ExecOption+def_exec_option = _options_exec defaultOptions++noPreludeOptions :: Options+noPreludeOptions = defaultOptions { _options_macs = emptyMacros }++defaultOptions :: Options+defaultOptions = makeOptions (minBound::SimpleRegexOptions)++unpackSimpleRegexOptions :: SimpleRegexOptions -> Options+unpackSimpleRegexOptions sro =+ Options+ { _options_mode = minBound+ , _options_macs = prelude+ , _options_comp = comp+ , _options_exec = defaultExecOpt+ }+ where+ comp = defaultCompOpt+ { caseSensitive = cs+ , multiline = ml+ }++ (ml,cs) = case sro of+ MultilineSensitive -> (,) True True+ MultilineInsensitive -> (,) True False+ BlockSensitive -> (,) False True+ BlockInsensitive -> (,) False False++compileRegex :: ( IsOption o RE CompOption ExecOption+ , Functor m+ , Monad m+ )+ => o+ -> String+ -> m RE+compileRegex = compileRegex_ . makeOptions++compileRegex_ :: (Functor m,Monad m)+ => Options+ -> String+ -> m RE+compileRegex_ os re_s = uncurry mk <$> compileRegex' os re_s+ where+ mk cnms rx =+ RE+ { _re_options = os+ , _re_source = re_s+ , _re_cnames = cnms+ , _re_regex = rx+ }++ Options{..} = os++re' :: Maybe SimpleRegexOptions -> QuasiQuoter+re' mb = case mb of+ Nothing ->+ (qq0 "re_")+ { quoteExp = parse minBound (\rs->[|flip unsafeCompileRegex rs|])+ }+ Just sro ->+ (qq0 "re")+ { quoteExp = parse sro (\rs->[|unsafeCompileRegexSimple sro rs|])+ }+ where+ parse :: SimpleRegexOptions -> (String->Q Exp) -> String -> Q Exp+ parse sro mk rs = either error (\_->mk rs) $ compileRegex_ os rs+ where+ os = unpackSimpleRegexOptions sro++unsafeCompileRegexSimple :: SimpleRegexOptions -> String -> RE+unsafeCompileRegexSimple sro re_s = unsafeCompileRegex_ os re_s+ where+ os = unpackSimpleRegexOptions sro++unsafeCompileRegex :: IsOption o RE CompOption ExecOption+ => o+ -> String+ -> RE+unsafeCompileRegex = unsafeCompileRegex_ . makeOptions++unsafeCompileRegex_ :: Options -> String -> RE+unsafeCompileRegex_ os = either oops id . compileRegex_ os+ where+ oops = error . ("unsafeCompileRegex: " ++)++compileRegex' :: (Functor m,Monad m)+ => Options+ -> String+ -> m (CaptureNames,Regex)+compileRegex' Options{..} s0 = do+ (cnms,s2) <- either fail return $ extractNamedCaptures s1+ (,) cnms <$> makeRegexOptsM _options_comp _options_exec s2+ where+ s1 = expandMacros reSource _options_mode _options_macs s0++prelude :: Macros RE+prelude = runIdentity $ preludeMacros mk TDFA ExclCaptures+ where+ mk = Identity . unsafeCompileRegex_ noPreludeOptions++preludeEnv :: MacroEnv+preludeEnv = preludeMacroEnv TDFA++preludeTestsFailing :: [MacroID]+preludeTestsFailing = badMacros $ preludeMacroEnv TDFA++preludeTable :: String+preludeTable = preludeMacroTable TDFA++preludeSummary :: PreludeMacro -> String+preludeSummary = preludeMacroSummary TDFA++preludeSources :: String+preludeSources = preludeMacroSources TDFA++preludeSource :: PreludeMacro -> String+preludeSource = preludeMacroSource TDFA
+ Text/RE/TDFA/Sequence.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.Sequence+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where++import qualified Data.Sequence as S+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: (S.Seq Char)+ -> RE+ -> Matches (S.Seq Char)+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: (S.Seq Char)+ -> RE+ -> Match (S.Seq Char)+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex (S.Seq Char) a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => (S.Seq Char)+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex (S.Seq Char) a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => (S.Seq Char)+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE (S.Seq Char) where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TDFA/String.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.String+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where+++import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: String+ -> RE+ -> Matches String+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: String+ -> RE+ -> Match String+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex String a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => String+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex String a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => String+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE String where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TDFA/Text.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.Text+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where++import qualified Data.Text as T+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: T.Text+ -> RE+ -> Matches T.Text+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: T.Text+ -> RE+ -> Match T.Text+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex T.Text a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => T.Text+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex T.Text a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => T.Text+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE T.Text where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TDFA/Text/Lazy.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.RE.TDFA.Text.Lazy+ ( (*=~)+ , (?=~)+ , (=~)+ , (=~~)+ , module Text.RE+ , module Text.RE.TDFA.RE+ ) where++import qualified Data.Text.Lazy as TL+import Text.Regex.Base+import Text.RE+import Text.RE.Internal.AddCaptureNames+import Text.RE.TDFA.RE+import qualified Text.Regex.TDFA as TDFA+++(*=~) :: TL.Text+ -> RE+ -> Matches TL.Text+(*=~) bs rex = addCaptureNamesToMatches (reCaptureNames rex) $ match (reRegex rex) bs++(?=~) :: TL.Text+ -> RE+ -> Match TL.Text+(?=~) bs rex = addCaptureNamesToMatch (reCaptureNames rex) $ match (reRegex rex) bs++(=~) :: ( RegexContext TDFA.Regex TL.Text a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => TL.Text+ -> RE+ -> a+(=~) bs rex = match (reRegex rex) bs++(=~~) :: ( Monad m+ , RegexContext TDFA.Regex TL.Text a+ , RegexMaker TDFA.Regex TDFA.CompOption TDFA.ExecOption String+ )+ => TL.Text+ -> RE+ -> m a+(=~~) bs rex = matchM (reRegex rex) bs++instance IsRegex RE TL.Text where+ matchOnce = flip (?=~)+ matchMany = flip (*=~)+ regexSource = reSource
+ Text/RE/TestBench.lhs view
@@ -0,0 +1,557 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.RE.TestBench+ ( MacroID(..)+ , RegexType(..)+ , MacroEnv+ , WithCaptures(..)+ , MacroDescriptor(..)+ , TestResult(..)+ , RegexSource(..)+ , FunctionID(..)+ , mkMacros+ , testMacroEnv+ , badMacros+ , runTests+ , runTests'+ , formatMacroTable+ , dumpMacroTable+ , formatMacroSummary+ , formatMacroSources+ , formatMacroSource+ , testMacroDescriptors+ , regexSource+ ) where++import Data.Array+import Control.Applicative+import qualified Data.HashMap.Lazy as HML+import Data.List+import Data.Maybe+import Data.Ord+import Data.String+import Text.Printf+import Text.RE.Capture+import Text.RE.Options+import Text.RE.Replace+import qualified Text.Regex.PCRE as PCRE+import qualified Text.Regex.TDFA as TDFA+\end{code}++Types+-----++\begin{code}+-- | what kind of back end will be compiling the RE+data RegexType+ = TDFA -- the TDFA back end+ | PCRE -- the PCRE back end+ deriving (Eq,Ord,Show)++-- | do we need the captures in the RE or whould they be stripped out+-- where possible+data WithCaptures+ = InclCaptures+ | ExclCaptures+ deriving (Eq,Ord,Show)++-- | each macro can reference others, the whole environment being+-- required for each macro, so we use a Lazy HashMap+type MacroEnv = HML.HashMap MacroID MacroDescriptor++-- | describes a macro, giving the text of the RE and a si=ummary+-- description+data MacroDescriptor =+ MacroDescriptor+ { _md_source :: RegexSource -- ^ the RE+ , _md_samples :: [String] -- ^ some sample matches+ , _md_counter_samples :: [String] -- ^ some sample non-matches+ , _md_test_results :: [TestResult] -- ^ validation test results+ , _md_parser :: Maybe FunctionID -- ^ WA, the parser function+ , _md_description :: String -- ^ summary comment+ }+ deriving (Show)++-- | list of failures on a validation run+newtype TestResult =+ TestResult { _TestResult :: String }+ deriving (IsString,Show)++-- | a RE that should work for POSIX and PCRE with open brackets ('(')+-- represented as follows:+-- \( mere symbol+-- (?: used for grouping only, not for captures+-- (}: used for captures only, not for grouping+-- (]: used for captures and grouping+-- ( do not modify+newtype RegexSource =+ RegexSource { _RegexSource :: String }+ deriving (IsString,Show)++-- | name of the Haskell parser function for parsing the text matched+-- by a macro+newtype FunctionID =+ FunctionID { _FunctionID :: String }+ deriving (IsString,Show)++-- | we are only interested in the open parentheses used for+-- grouping and/or capturing; if neither grouping or capturing then+-- there is no initial '(' or '(?:', just the suffic text+data REToken =+ REToken+ { _ret_prefix :: String -- ^ following text optional ( or (?:+ , _ret_fixed :: Bool -- ^ a '(' that is not safe to modify+ , _ret_grouping :: Bool -- ^ is this a grouping group+ , _ret_capturing :: Bool -- ^ is this a capturing group+ }+ deriving (Show)+\end{code}+++mkMacros+--------++\begin{code}+mkMacros :: (Monad m,Functor m)+ => (String->m r)+ -> RegexType+ -> WithCaptures+ -> MacroEnv+ -> m (Macros r)+mkMacros prs rty wc env =+ HML.fromList <$> mapM (uncurry mk) (HML.toList env)+ where+ mk mid md = (,) mid <$> prs (mdRegexSource rty wc env md)+\end{code}+++testMacroEnv, badMacros+-----------------------++\begin{code}+testMacroEnv :: String -> RegexType -> MacroEnv -> IO Bool+testMacroEnv lab rty m_env = case badMacros m_env of+ [] -> return True+ fails -> do+ putStrLn $ lab' ++ " has failing tests for these macros: "+ putStr $ unlines $ [ " "++_MacroID mid | mid<-fails ]+ putStrLn $ "The whole table:"+ putStrLn $ "========================================================"+ putStr $ formatMacroTable rty m_env+ putStrLn $ "========================================================"+ return False+ where+ lab' = lab ++ " [" ++ show rty ++"]"++badMacros :: MacroEnv -> [MacroID]+badMacros m_env =+ [ mid+ | (mid,MacroDescriptor{..}) <- HML.toList m_env+ , not $ null _md_test_results+ ]++runTests :: (Eq a,Show a)+ => RegexType+ -> (String->Maybe a)+ -> [(String,a)]+ -> MacroEnv+ -> MacroID+ -> MacroDescriptor+ -> MacroDescriptor+runTests rty parser = runTests' rty parser'+ where+ parser' caps = fmap capturedText (matchCapture caps) >>= parser++runTests' :: (Eq a,Show a)+ => RegexType+ -> (Match String->Maybe a)+ -> [(String,a)]+ -> MacroEnv+ -> MacroID+ -> MacroDescriptor+ -> MacroDescriptor+runTests' rty parser vector env mid md@MacroDescriptor{..} =+ md { _md_test_results = test_results }+ where+ test_results = concat+ [ concat $ map test vector+ , concat $ map test_neg _md_counter_samples+ ]++ test (src,x) = test' mid rty parser x $ match_ src env md++ test_neg src = test_neg' mid rty parser $ match_ src env md++ match_ = case rty of+ TDFA -> match_tdfa+ PCRE -> match_pcre+\end{code}+++dumpMacroTable, formatMacroTable, formatMacroSummary, formatMacroSources, formatMacroSource+-------------------------------------------------------------------------------------------++\begin{code}+dumpMacroTable :: String -> RegexType -> MacroEnv -> IO ()+dumpMacroTable lab rty m_env = do+ writeFile fp_t $ formatMacroTable rty m_env+ writeFile fp_s $ formatMacroSources rty ExclCaptures m_env+ where+ fp_t = "tables/" ++ lab ++ "-" ++ show rty ++ ".md"+ fp_s = "tables/" ++ lab ++ "-" ++ show rty ++ ".txt"+\end{code}++\begin{code}+formatMacroTable :: RegexType -> MacroEnv -> String+formatMacroTable rty env = unlines $+ format_table macro_table_hdr+ [ macro_table_row rty mid md+ | (mid,md) <- sortBy (comparing fst) $ HML.toList env+ ]+\end{code}++\begin{code}+formatMacroSummary :: RegexType -> MacroEnv -> MacroID -> String+formatMacroSummary rty env mid = maybe oops prep $ HML.lookup mid env+ where+ prep :: MacroDescriptor -> String+ prep md = unlines $ concat $ map (fmt md) [minBound..maxBound]++ fmt :: MacroDescriptor -> Col -> [String]+ fmt md c =+ [ printf "%-15s : %s" (present_col c) ini+ ] ++ map (" "++) lns+ where+ (ini,lns) = case macro_attribute rty mid md c of+ [] -> (,) "" []+ [ln] -> (,) ln []+ lns_ -> (,) "" lns_++ oops = error $ _MacroID mid ++ ": macro not defined in this environment"+\end{code}++\begin{code}+formatMacroSources :: RegexType+ -> WithCaptures+ -> MacroEnv+ -> String+formatMacroSources rty wc env = unlines $+ [ printf "%-20s : %s" (_MacroID mid) $ formatMacroSource rty wc env mid+ | mid <- sort $ HML.keys env+ ]+\end{code}++\begin{code}+formatMacroSource :: RegexType+ -> WithCaptures+ -> MacroEnv+ -> MacroID+ -> String+formatMacroSource rty wc env mid =+ mdRegexSource rty wc env $ fromMaybe oops $ HML.lookup mid env+ where+ oops = error $ "formatMacroSource: not found: " ++ _MacroID mid+\end{code}+++testMacroDescriptors, regexSource+---------------------------------++\begin{code}+testMacroDescriptors :: [MacroDescriptor] -> [TestResult]+testMacroDescriptors = concat . map _md_test_results++regexSource :: RegexType -> WithCaptures -> RegexSource -> String+regexSource rty wc = format_tokens rty wc . scan_re+\end{code}+++Formatting helpers+------------------++\begin{code}+type TableRow = Array Col [String]++data Col+ = C_name+ | C_caps+ | C_regex+ | C_examples+ | C_anti_examples+ | C_fails+ | C_parser+ | C_comment+ deriving (Ix,Bounded,Enum,Ord,Eq,Show)++present_col :: Col -> String+present_col = map tr . drop 2 . show+ where+ tr '_' = '-'+ tr c = c++macro_table_hdr :: TableRow+macro_table_hdr = listArray (minBound,maxBound)+ [ [present_col c]+ | c<-[minBound..maxBound]+ ]++macro_table_row :: RegexType -> MacroID -> MacroDescriptor -> TableRow+macro_table_row rty mid md =+ listArray (minBound,maxBound) $+ map (macro_attribute rty mid md) [minBound..maxBound]++macro_attribute :: RegexType+ -> MacroID+ -> MacroDescriptor+ -> Col+ -> [String]+macro_attribute rty mid MacroDescriptor{..} c =+ case c of+ C_name -> [_MacroID mid]+ C_caps -> [show $ min_captures rty $ scan_re _md_source]+ C_regex -> [regexSource rty ExclCaptures _md_source]+ C_examples -> _md_samples+ C_anti_examples -> _md_counter_samples+ C_fails -> map _TestResult _md_test_results+ C_parser -> [maybe "-" _FunctionID _md_parser]+ C_comment -> [_md_description]++format_table :: TableRow -> [TableRow] -> [String]+format_table hdr rows0 = concat+ [ format_row cws hdr'+ , format_row cws dsh+ , concat $ map (format_row cws) rows+ ]+ where+ dsh = listArray (minBound,maxBound)+ [ [replicate n '-'] | n<-elems cws ]++ hdr' = hdr // [(,) C_regex $ [take n $ concat $ repeat "regex="] ]+ where+ n = min 29 $ cws!C_regex++ cws = widths $ hdr : rows++ rows = map wrap_row rows0++field_width :: Int+field_width = 40++wrap_row :: TableRow -> TableRow+wrap_row = fmap $ concat . map f+ where+ f, g :: String -> [String]++ f cts = (ini ++ ['\\' | not (null rst)]) : g rst+ where+ (ini,rst) = splitAt (1+field_width) cts++ g "" = []+ g cts = ('\\' : ini ++ ['\\' | not (null rst)]) : g rst+ where+ (ini,rst) = splitAt field_width cts+++widths :: [TableRow] -> Array Col Int+widths rows = listArray (minBound,maxBound)+ [ maximum $ concat [ map length $ row!c | row<-rows ]+ | c<-[minBound..maxBound]+ ]++format_row :: Array Col Int -> TableRow -> [String]+format_row cw_arr row =+ [ ("|"++) $ intercalate "|"+ [ field cw_arr row c i | c<-[minBound..maxBound] ]+ | i <- [0..depth-1]+ ]+ where+ depth = maximum [ length $ row!c | c<-[minBound..maxBound] ]++field :: Array Col Int -> TableRow -> Col -> Int -> String+field cws row c i = ljust (cws!c) $ sel i $ row!c++sel :: Int -> [String] -> String+sel i ss = case drop i ss of+ [] -> ""+ s:_ -> s++ljust :: Int -> String -> String+ljust w s = s ++ replicate n ' '+ where+ n = max 0 $ w - length s++min_captures :: RegexType -> [REToken] -> Int+min_captures rty rets = length+ [ ()+ | REToken{..}<-rets+ , _ret_fixed || (_ret_grouping && rty==TDFA)+ ]+\end{code}+++Formatting tokens+-----------------++\begin{code}+format_tokens :: RegexType -> WithCaptures -> [REToken] -> String+format_tokens rty wc = foldr f ""+ where+ f REToken{..} rst = _ret_prefix ++ bra ++ xket rst+ where+ bra = case _ret_fixed of+ True -> "("+ False ->+ case (,) _ret_grouping (_ret_capturing && wc==InclCaptures) of+ (False,False) -> ""+ (True ,False) -> if rty==PCRE then "(?:" else "("+ (False,True ) -> "("+ (True ,True ) -> "("++ xket =+ case not _ret_grouping && _ret_capturing && wc==ExclCaptures of+ True -> delete_ket 0+ False -> id++delete_ket :: Int -> String -> String+delete_ket _ "" = error "delete_ket: end of input"+delete_ket n (c:t) = case c of+ '\\' -> case t of+ "" -> error "delete_ket: end of input"+ c':t' -> c : c' : delete_ket n t'+ ')' -> case n of+ 0 -> t+ _ -> c : delete_ket (n-1) t+ '(' -> c : delete_ket (n+1) t+ _ -> c : delete_ket n t+\end{code}+++scan_re+-------++\begin{code}+scan_re :: RegexSource -> [REToken]+scan_re (RegexSource src0) = loop src0+ where+ loop "" = []+ loop src =+ case rst of+ '\\':t -> case t of+ "" -> REToken (ini++['\\']) False False False : []+ c':t' -> REToken (ini++['\\',c']) False False False : loop t'+ '(' :t -> case t of+ c:':':t'+ | c=='?' -> REToken ini False True False : loop t'+ | c=='}' -> REToken ini False False True : loop t'+ | c==']' -> REToken ini False True True : loop t'+ _ -> REToken ini True True True : loop t+ _ -> [REToken src False False False]+ where+ (ini,rst) = break chk src++ chk '\\' = True+ chk '(' = True+ chk _ = False+\end{code}+++scan_re+-------++\begin{code}+match_tdfa :: String -> MacroEnv -> MacroDescriptor -> Matches String+match_tdfa txt env md = txt TDFA.=~ mdRegexSource TDFA ExclCaptures env md++match_pcre :: String -> MacroEnv -> MacroDescriptor -> Matches String+match_pcre txt env md = txt PCRE.=~ mdRegexSource PCRE ExclCaptures env md+\end{code}+++mdRegexSource+-------------++\begin{code}+mdRegexSource :: RegexType+ -> WithCaptures+ -> MacroEnv+ -> MacroDescriptor+ -> String+mdRegexSource rty wc env md =+ expandMacros' lu $ regexSource rty wc $ _md_source md+ where+ lu = fmap (regexSource rty wc . _md_source) .+ flip HML.lookup env+\end{code}+++test', test_neg'+----------------++\begin{code}+test' :: (Eq a,Show a)+ => MacroID+ -> RegexType+ -> (Match String->Maybe a)+ -> a+ -> Matches String+ -> [TestResult]+test' mid rty prs x Matches{..} = either (:[]) (const []) $ do+ cs <- case allMatches of+ [cs] -> return cs+ _ -> oops "RE failed to parse"+ mtx <- case matchCapture cs of+ Nothing -> oops $ "RE parse failure: " ++ show cs+ Just c -> return $ capturedText c+ case mtx == matchesSource of+ True -> return ()+ False -> oops "RE failed to match the whole text"+ x' <- case prs cs of+ Nothing -> oops "matched text failed to parse"+ Just x' -> return x'+ case x'==x of+ True -> return ()+ False -> oops "parser failed to yield the expected result"+ where+ oops = Left . test_diagnostic mid False rty matchesSource++test_neg' :: MacroID+ -> RegexType+ -> (Match String->Maybe a)+ -> Matches String+ -> [TestResult]+test_neg' mid rty prs Matches{..} = either id (const []) $ do+ case allMatches of+ [] -> return ()+ cz -> case ms of+ [] -> return ()+ _ -> Left [oops "RE parse succeeded"]+ where+ ms =+ [ ()+ | cs <- cz+ , Just c <- [matchCapture cs]+ , let t = capturedText c+ , t == matchesSource+ , isJust $ prs cs+ ]++ where+ oops = test_diagnostic mid True rty matchesSource++test_diagnostic :: MacroID+ -> Bool+ -> RegexType+ -> String+ -> String+ -> TestResult+test_diagnostic mid is_neg rty tst msg =+ TestResult $+ printf "%-20s [%s %s] : %s (%s)" mid_s neg_s rty_s msg tst+ where+ mid_s = _MacroID mid+ neg_s = if is_neg then "-ve" else "+ve" :: String+ rty_s = show rty+\end{code}
+ Text/RE/Tools/Grep.lhs view
@@ -0,0 +1,58 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}++module Text.RE.Tools.Grep+ ( grep+ , grepLines+ , GrepScript+ , grepScript+ ) where++import Control.Applicative+import qualified Data.ByteString.Lazy.Char8 as LBS+import Text.Printf+import Text.RE.Capture+import Text.RE.IsRegex+import Text.RE.LineNo+++data Line =+ Line+ { _ln_no :: LineNo+ , _ln_matches :: Matches LBS.ByteString+ }+ deriving (Show)++grep :: IsRegex re LBS.ByteString => re -> FilePath -> IO ()+grep rex fp = grepLines rex fp >>= putStr . report++grepLines :: IsRegex re LBS.ByteString => re -> FilePath -> IO [Line]+grepLines rex fp =+ grepScript [(rex,mk)] . LBS.lines <$> LBS.readFile fp+ where+ mk i mtchs = Just $ Line i mtchs++type GrepScript re s t = [(re,LineNo -> Matches s -> Maybe t)]++grepScript :: IsRegex re s => GrepScript re s t -> [s] -> [t]+grepScript scr = loop firstLine+ where+ loop _ [] = []+ loop i (ln:lns) = seq i $ choose i ln lns scr++ choose i _ lns [] = loop (succ i) lns+ choose i ln lns ((rex,f):scr') = case f i $ matchMany rex ln of+ Nothing -> choose i ln lns scr'+ Just t -> t : loop (succ i) lns++report :: [Line] -> String+report = unlines . map fmt . lines_matched+ where+ fmt Line{..} =+ printf "%05d %s" (getLineNo _ln_no) $+ LBS.unpack $ matchesSource _ln_matches++lines_matched :: [Line] -> [Line]+lines_matched = filter $ anyMatches . _ln_matches+\end{code}
+ Text/RE/Tools/Lex.lhs view
@@ -0,0 +1,35 @@+\begin{code}+module Text.RE.Tools.Lex where++import Control.Applicative+import Text.RE+++alex :: IsRegex re s => [(re,Match s->Maybe t)] -> t -> s -> [t]+alex = alex' matchOnce++alex' :: Replace s+ => (re->s->Match s)+ -> [(re,Match s->Maybe t)]+ -> t+ -> s+ -> [t]+alex' mo al t_err = loop+ where+ loop s = case length_ s == 0 of+ True -> []+ False -> choose al s++ choose [] _ = [t_err]+ choose ((re,f):al') s = case mb_p of+ Just (s',t) -> t : loop s'+ _ -> choose al' s+ where+ mb_p = do+ cap <- matchCapture mtch+ case captureOffset cap == 0 of+ True -> (,) (captureSuffix cap) <$> f mtch+ False -> Nothing++ mtch = mo re s+\end{code}
+ Text/RE/Tools/Sed.lhs view
@@ -0,0 +1,50 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}++module Text.RE.Tools.Sed+ ( SedScript+ , sed+ , sed'+ ) where++import Control.Applicative+import qualified Data.ByteString.Lazy.Char8 as LBS+import Text.RE.Edit+import Text.RE.LineNo+import Text.RE.IsRegex+++type SedScript re = Edits IO re LBS.ByteString++sed :: IsRegex re LBS.ByteString+ => SedScript re+ -> FilePath+ -> FilePath+ -> IO ()+sed as i_fp o_fp = do+ lns <- LBS.lines <$> read_file i_fp+ lns' <- sequence+ [ applyEdits lno as s+ | (lno,s)<-zip [firstLine..] lns+ ]+ write_file o_fp $ LBS.concat lns'++sed' :: (IsRegex re LBS.ByteString,Monad m,Functor m)+ => Edits m re LBS.ByteString+ -> LBS.ByteString+ -> m LBS.ByteString+sed' as lbs = do+ LBS.concat <$> sequence+ [ applyEdits lno as s+ | (lno,s)<-zip [firstLine..] $ LBS.lines lbs+ ]++read_file :: FilePath -> IO LBS.ByteString+read_file "-" = LBS.getContents+read_file fp = LBS.readFile fp++write_file :: FilePath -> LBS.ByteString ->IO ()+write_file "-" = LBS.putStr+write_file fp = LBS.writeFile fp+\end{code}
+ changelog view
@@ -0,0 +1,4 @@+-*-change-log-*-++0.0.0.1 Chris Dornan <chrisd@irisconnect.co.uk> Feb 2014+ * First public release
+ examples/TestKit.lhs view
@@ -0,0 +1,94 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++module TestKit+ ( Test+ , runTests+ , checkThis+ , test_pp+ ) where++import Control.Exception+import qualified Data.Text as T+import qualified Shelly as SH+import System.Environment+import System.Exit+import System.IO+\end{code}++\begin{code}+data Test =+ Test+ { testLabel :: String+ , testExpected :: String+ , testResult :: String+ , testPassed :: Bool+ }+ deriving (Show)++runTests :: [Test] -> IO ()+runTests tests = do+ as <- getArgs+ case as of+ [] -> return ()+ _ -> do+ pn <- getProgName+ putStrLn $ "usage:\n "++pn++" --help"+ exitWith $ ExitFailure 1+ case filter (not . testPassed) tests of+ [] -> putStrLn $ "All "++show (length tests)++" tests passed."+ fts -> do+ mapM_ (putStr . present_test) fts+ putStrLn $ show (length fts) ++ " tests failed."+ exitWith $ ExitFailure 1++checkThis :: (Show a,Eq a) => String -> a -> a -> Test+checkThis lab ref val =+ Test+ { testLabel = lab+ , testExpected = show ref+ , testResult = show val+ , testPassed = ref == val+ }++present_test :: Test -> String+present_test Test{..} = unlines+ [ "test: " ++ testLabel+ , " expected : " ++ testExpected+ , " result : " ++ testResult+ , " passed : " ++ (if testPassed then "passed" else "**FAILED**")+ ]+\end{code}++\begin{code}+test_pp :: String+ -> (FilePath->FilePath->IO())+ -> FilePath+ -> FilePath+ -> IO ()+test_pp lab loop test_file gold_file = do+ loop test_file tmp_pth+ ok <- cmp (T.pack tmp_pth) (T.pack gold_file)+ case ok of+ True -> return ()+ False -> do+ putStrLn $ lab ++ ": mismatch with " ++ gold_file+ exitWith $ ExitFailure 1+ where+ tmp_pth = "tmp/mod.lhs"+\end{code}++\begin{code}+cmp :: T.Text -> T.Text -> IO Bool+cmp src dst = handle hdl $ do+ _ <- SH.shelly $ SH.verbosely $+ SH.run "cmp" [src,dst]+ return True+ where+ hdl :: SomeException -> IO Bool+ hdl se = do+ hPutStrLn stderr $+ "testing results against model answers failed: " ++ show se+ return False+\end{code}
+ examples/re-gen-modules.lhs view
@@ -0,0 +1,127 @@+\begin{code}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Applicative+import Control.Exception+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Text as T+import qualified Shelly as SH+import System.Directory+import System.Environment+import System.Exit+import System.IO+import Text.RE.TDFA.ByteString.Lazy+import Text.RE.Tools.Sed+++main :: IO ()+main = do+ (pn,as) <- (,) <$> getProgName <*> getArgs+ case as of+ [] -> test+ ["test"] -> test+ ["gen"] -> gen+ _ -> do+ hPutStrLn stderr $ "usage: " ++ pn ++ " [test|gen]"+ exitWith $ ExitFailure 1++test :: IO ()+test = do+ createDirectoryIfMissing False "tmp"+ tdfa_ok <- and <$> mapM test' tdfa_edits+ pcre_ok <- and <$> mapM test' pcre_edits+ case tdfa_ok && pcre_ok of+ True -> return ()+ False -> exitWith $ ExitFailure 1++test' :: (ModPath,SedScript RE) -> IO Bool+test' (mp,scr) = do+ putStrLn mp+ sed scr (mod_filepath source_mp) tmp_pth+ cmp (T.pack tmp_pth) (T.pack $ mod_filepath mp)+ where+ tmp_pth = "tmp/prog.hs"++gen :: IO ()+gen = do+ mapM_ gen' tdfa_edits+ mapM_ gen' pcre_edits++gen' :: (ModPath,SedScript RE) -> IO ()+gen' (mp,scr) = do+ putStrLn mp+ sed scr (mod_filepath source_mp) (mod_filepath mp)++tdfa_edits :: [(ModPath,SedScript RE)]+tdfa_edits =+ [ tdfa_edit "Text.RE.TDFA.ByteString" "B.ByteString" "import qualified Data.ByteString as B"+ , tdfa_edit "Text.RE.TDFA.Sequence" "(S.Seq Char)" "import qualified Data.Sequence as S"+ , tdfa_edit "Text.RE.TDFA.String" "String" ""+ , tdfa_edit "Text.RE.TDFA.Text" "T.Text" "import qualified Data.Text as T"+ , tdfa_edit "Text.RE.TDFA.Text.Lazy" "TL.Text" "import qualified Data.Text.Lazy as TL"+ ]++pcre_edits :: [(ModPath,SedScript RE)]+pcre_edits =+ [ pcre_edit "Text.RE.PCRE.ByteString" "B.ByteString" "import qualified Data.ByteString as B"+ , pcre_edit "Text.RE.PCRE.ByteString.Lazy" "LBS.ByteString" "import qualified Data.ByteString.Lazy as LBS"+ , pcre_edit "Text.RE.PCRE.Sequence" "(S.Seq Char)" "import qualified Data.Sequence as S"+ , pcre_edit "Text.RE.PCRE.String" "String" ""+ ]++tdfa_edit :: ModPath+ -> LBS.ByteString+ -> LBS.ByteString+ -> (ModPath,SedScript RE)+tdfa_edit mp bs_lbs import_lbs =+ (,) mp $ Pipe+ [ (,) module_re $ EDIT_tpl $ LBS.pack mp+ , (,) import_re $ EDIT_tpl import_lbs+ , (,) bs_re $ EDIT_tpl bs_lbs+ ]++pcre_edit :: ModPath+ -> LBS.ByteString+ -> LBS.ByteString+ -> (ModPath,SedScript RE)+pcre_edit mp bs_lbs import_lbs =+ (,) mp $ Pipe+ [ (,) tdfa_re $ EDIT_tpl "PCRE"+ , (,) module_re $ EDIT_tpl $ LBS.pack mp+ , (,) import_re $ EDIT_tpl import_lbs+ , (,) bs_re $ EDIT_tpl bs_lbs+ ]++type ModPath = String++source_mp :: ModPath+source_mp = "Text.RE.TDFA.ByteString.Lazy"++tdfa_re, module_re, import_re, bs_re :: RE+tdfa_re = [re|TDFA|]+module_re = [re|Text.RE.TDFA.ByteString.Lazy|]+import_re = [re|import qualified Data.ByteString.Lazy.Char8 *as LBS|]+bs_re = [re|LBS.ByteString|]++mod_filepath :: ModPath -> FilePath+mod_filepath mp = map tr mp ++ ".hs"+ where+ tr '.' = '/'+ tr c = c++cmp :: T.Text -> T.Text -> IO Bool+cmp src dst = handle hdl $ do+ _ <- SH.shelly $ SH.verbosely $+ SH.run "cmp" [src,dst]+ return True+ where+ hdl :: SomeException -> IO Bool+ hdl se = do+ hPutStrLn stderr $+ "testing results against model answers failed: " ++ show se+ return False+\end{code}
+ examples/re-include.lhs view
@@ -0,0 +1,138 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ ) where++import Control.Applicative+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Maybe+import System.Environment+import TestKit+import Text.RE.Edit+import Text.RE.TDFA.ByteString.Lazy+import Text.RE.Tools.Grep+import Text.RE.Tools.Sed+\end{code}++\begin{code}+main :: IO ()+main = do+ as <- getArgs+ case as of+ [] -> test+ ["test"] -> test+ [fn,fn'] | is_file fn -> loop fn fn'+ _ -> usage+ where+ is_file = not . (== "--") . take 2++ usage = do+ prg <- getProgName+ putStr $ unlines+ [ "usage:"+ , " "++prg++" [test]"+ , " "++prg++" (-|<in-file>) (-|<out-file>)"+ ]+\end{code}+++The Sed Script+--------------++\begin{code}+loop :: FilePath -> FilePath -> IO ()+loop =+ sed $ Select+ [ (,) [re|^%include ${file}(@{%string}) ${rex}(@{%string})$|] $ EDIT_fun TOP include+ , (,) [re|^.*$|] $ EDIT_fun TOP $ \_ _ _ _->return Nothing+ ]+\end{code}++\begin{code}+include :: LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)+include _ mtch _ _ = fmap Just $+ extract fp =<< compileRegex () re_s+ where+ fp = prs_s $ captureText [cp|file|] mtch+ re_s = prs_s $ captureText [cp|rex|] mtch++ prs_s = fromMaybe (error "includeDoc") . parseString+\end{code}+++Extracting a Literate Fragment from a Haskell Program Text+----------------------------------------------------------++\begin{code}+extract :: FilePath -> RE -> IO LBS.ByteString+extract fp rex = extr . LBS.lines <$> LBS.readFile fp+ where+ extr lns =+ case parse $ scan rex lns of+ Nothing -> oops+ Just (lno,n) -> LBS.unlines $ (hdr :) $ (take n $ drop i lns) ++ [ftr]+ where+ i = getZeroBasedLineNo lno++ oops = error $ concat+ [ "failed to locate fragment matching "+ , show $ reSource rex+ , " in file "+ , show fp+ ]++ hdr = "<div class='includedcodeblock'>"+ ftr = "</div>"+\end{code}++\begin{code}+parse :: [Token] -> Maybe (LineNo,Int)+parse [] = Nothing+parse (tk:tks) = case (tk,tks) of+ (Bra b_ln,Hit:Ket k_ln:_) -> Just (b_ln,count_lines_incl b_ln k_ln)+ _ -> parse tks+\end{code}++\begin{code}+count_lines_incl :: LineNo -> LineNo -> Int+count_lines_incl b_ln k_ln =+ getZeroBasedLineNo k_ln + 1 - getZeroBasedLineNo b_ln+\end{code}++\begin{code}+data Token = Bra LineNo | Hit | Ket LineNo deriving (Show)+\end{code}++\begin{code}+scan :: RE -> [LBS.ByteString] -> [Token]+scan rex = grepScript+ [ (,) [re|\\begin\{code\}|] $ \i -> chk $ Bra i+ , (,) rex $ \_ -> chk Hit+ , (,) [re|\\end\{code\}|] $ \i -> chk $ Ket i+ ]+ where+ chk x mtchs = case anyMatches mtchs of+ True -> Just x+ False -> Nothing+\end{code}+++Testing+-------++\begin{code}+test :: IO ()+test = do+ test_pp "include" loop "data/pp-test.lhs" "data/include-result.lhs"+ putStrLn "tests passed"+\end{code}
+ examples/re-nginx-log-processor.lhs view
@@ -0,0 +1,592 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ -- development+ , parse_a+ , parse_e+ ) where++import Control.Applicative+import Control.Exception+import Control.Monad+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.HashMap.Lazy as HML+import Data.Functor.Identity+import Data.Maybe+import Data.String+import qualified Data.Text as T+import Data.Time+import qualified Shelly as SH+import System.Directory+import System.Environment+import System.Posix.Syslog+import System.Exit+import System.IO+import Text.RE.Options+import Text.RE.Parsers+import Text.RE.TestBench+import Text.RE.PCRE.ByteString.Lazy+import qualified Text.RE.PCRE.String as S+import Text.RE.Tools.Sed+import Text.Printf+\end{code}++\begin{code}+main :: IO ()+main = do+ as <- getArgs+ case as of+ ["--macro" ] -> putStr lp_macro_table+ ["--macro",mid_s] -> putStrLn $ lp_macro_summary $ MacroID mid_s+ ["--regex" ] -> putStr lp_macro_sources+ ["--regex",mid_s] -> putStrLn $ lp_macro_source $ MacroID mid_s+ ["--test" ] -> test+ [] -> test+ [in_file ] | is_file in_file -> go True in_file "-"+ [in_file,out_file ] | is_file in_file -> go True in_file out_file+ _ -> usage+ where+ is_file = not . (== "--") . take 2++ usage = do+ pnm <- getProgName+ let prg = ((pnm++" ")++)+ putStr $ unlines+ [ "usage:"+ , prg " --help"+ , prg " --macro"+ , prg " --macro <macro-id>"+ , prg " --regex"+ , prg " --regex <macro-id>"+ , prg "[--test]"+ , prg "(-|<in-file>) [-|<out-fileß>]"+ ]+\end{code}++\begin{code}++--+-- go+--++test :: IO ()+test = do+ putStrLn "============================================================"+ putStrLn "Testing the macro environment."+ putStrLn "nginx-log-processor"+ dumpMacroTable "nginx-log-processor" regexType lp_env+ me_ok <- testMacroEnv "nginx-log-processor" regexType lp_env+ putStrLn "============================================================"+ putStrLn "Testing the log processor on reference data."+ putStrLn ""+ lp_ok <- test_log_processor+ putStrLn "============================================================"+ case me_ok && lp_ok of+ True -> return ()+ False -> exitWith $ ExitFailure 1+++test_log_processor :: IO Bool+test_log_processor = do+ createDirectoryIfMissing False "tmp"+ go False "data/access-errors.log" "tmp/events.log"+ cmp "tmp/events.log" "data/events.log"+\end{code}++\begin{code}++--+-- go+--++go :: Bool -> FilePath -> FilePath -> IO ()+go rprt_flg in_file out_file = do+ ctx <- setup rprt_flg+ sed (script ctx) in_file out_file+\end{code}++\begin{code}+script :: Ctx -> SedScript RE+script ctx = Select+ [ on [re_|@{access}|] Acc parse_access+ , on [re_|@{access_deg}|] AcQ parse_deg_access+ , on [re_|@{error}|] Err parse_error+ , on [re_|.*|] QQQ parse_def+ ]+ where+ on rex src prs =+ (,) (rex lpo) $ EDIT_fun TOP $ process_line ctx src prs++ parse_def = fmap capturedText . matchCapture+\end{code}++\begin{code}+process_line :: IsEvent a+ => Ctx+ -> Source+ -> (Match LBS.ByteString->Maybe a)+ -> LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)+process_line ctx src prs lno cs _ _ = do+ when (event_is_notifiable event) $+ flag_event ctx event+ return $ Just $ presentEvent event+ where+ event = maybe def_event (mkEvent lno src) $ prs cs++ def_event =+ Event+ { _event_line = lno+ , _event_source = src+ , _event_utc = read "1970-01-01 00:00:00"+ , _event_severity = Nothing+ , _event_address = (0,0,0,0)+ , _event_details = ""+ }+++--+-- Ctx, setup, event_is_notifiable, flag_event+--++type Ctx = Bool++setup :: Bool -> IO Ctx+setup = return++event_is_notifiable :: Event -> Bool+event_is_notifiable Event{..} =+ fromEnum (fromMaybe Debug _event_severity) <= fromEnum Error++flag_event :: Ctx -> Event -> IO ()+flag_event False = const $ return ()+flag_event True = LBS.hPutStrLn stderr . presentEvent+++--+-- Event, presentEvent, IsEvent+--++data Event =+ Event+ { _event_line :: LineNo+ , _event_source :: Source+ , _event_utc :: UTCTime+ , _event_severity :: Maybe Priority+ , _event_address :: IPV4Address+ , _event_details :: LBS.ByteString+ }+ deriving (Show)++data Source = Acc | AcQ | Err | QQQ+ deriving (Show,Read)++presentEvent :: Event -> LBS.ByteString+presentEvent Event{..} = LBS.pack $+ printf "%04d %s %s %-7s %3d.%3d.%3d.%3d [%s]"+ (getLineNo _event_line )+ (show _event_source )+ (show _event_utc )+ (maybe "-" svrty_kw _event_severity)+ a b c d+ (LBS.unpack _event_details )+ where+ (a,b,c,d) = _event_address++ svrty_kw = fst . syslogSeverityKeywords++class IsEvent a where+ mkEvent :: LineNo -> Source -> a -> Event++instance IsEvent Access where+ mkEvent lno src Access{..} =+ Event+ { _event_line = lno+ , _event_source = src+ , _event_utc = _a_time_local+ , _event_severity = Nothing+ , _event_address = _a_remote_addr+ , _event_details = LBS.pack $+ printf "%s %d %d %s %s %s"+ _a_request+ _a_status+ _a_body_bytes+ _a_http_referrer+ _a_http_user_agent+ _a_other+ }++instance IsEvent Error where+ mkEvent lno src ERROR{..} =+ Event+ { _event_line = lno+ , _event_source = src+ , _event_utc = UTCTime _e_date $ timeOfDayToTime _e_time+ , _event_severity = Just _e_severity+ , _event_address = (0,0,0,0)+ , _event_details = LBS.pack $ printf "%d#%d: %s" pid tid $ LBS.unpack _e_other+ }+ where+ (pid,tid) = _e_pid_tid++instance IsEvent LBS.ByteString where+ mkEvent lno src lbs =+ Event+ { _event_line = lno+ , _event_source = src+ , _event_utc = read "1970-01-01 00:00:00"+ , _event_severity = Nothing+ , _event_address = (0,0,0,0)+ , _event_details = lbs+ }+++--+-- Options and Prelude+--++lpo :: Options+lpo = makeOptions lp_prelude++lp_prelude :: Macros RE+lp_prelude = runIdentity $ mkMacros mk regexType ExclCaptures lp_env+ where+ mk = maybe oops Identity . compileRegex noPreludeOptions++ oops = error "lp_prelude"++lp_macro_table :: String+lp_macro_table = formatMacroTable regexType lp_env++lp_macro_summary :: MacroID -> String+lp_macro_summary = formatMacroSummary regexType lp_env++lp_macro_sources :: String+lp_macro_sources = formatMacroSources regexType ExclCaptures lp_env++lp_macro_source :: MacroID -> String+lp_macro_source = formatMacroSource regexType ExclCaptures lp_env++lp_env :: MacroEnv+lp_env = preludeEnv `HML.union` HML.fromList+ [ f "user" user_macro+ , f "pid#tid:" pid_tid_macro+ , f "access" access_macro+ , f "access_deg" access_deg_macro+ , f "error" error_macro+ ]+ where+ f mid mk = (mid, mk lp_env mid)+++--+-- The Macro Descriptors+--++user_macro :: MacroEnv -> MacroID -> MacroDescriptor+user_macro env mid =+ runTests regexType parse_user samples env mid+ MacroDescriptor+ { _md_source = "(?:-|[^[:space:]]+)"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = def_test_results+ , _md_parser = Just "parse_user"+ , _md_description = "a user ident (per RFC1413)"+ }+ where+ samples :: [(String,User)]+ samples =+ [ f "joe"+ ]+ where+ f nm = (nm,User $ LBS.pack nm)++ counter_samples =+ [ "joe user"+ ]++pid_tid_macro :: MacroEnv -> MacroID -> MacroDescriptor+pid_tid_macro env mid =+ runTests regexType parse_pid_tid samples env mid+ MacroDescriptor+ { _md_source = "(?:@{%natural})#(?:@{%natural}):"+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = def_test_results+ , _md_parser = Just "parse_pid_tid"+ , _md_description = "<PID>#<TID>:"+ }+ where+ samples :: [(String,(Int,Int))]+ samples =+ [ f "1378#0:" (1378,0)+ ]+ where+ f = (,)++ counter_samples =+ [ ""+ , "24#:"+ , "24.365:"+ ]++access_macro :: MacroEnv -> MacroID -> MacroDescriptor+access_macro env mid =+ runTests' regexType (parse_access . fmap LBS.pack) samples env mid+ MacroDescriptor+ { _md_source = access_re+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = def_test_results+ , _md_parser = Just "parse_a"+ , _md_description = "an Nginx access log file line"+ }+ where+ samples :: [(String,Access)]+ samples =+ [ (,) "192.168.100.200 - - [12/Jan/2016:12:08:36 +0000] \"GET / HTTP/1.1\" 200 3700 \"-\" \"My Agent\" \"-\""+ Access+ { _a_remote_addr = (192,168,100,200)+ , _a_remote_user = "-"+ , _a_time_local = read "2016-01-12 12:08:36 UTC"+ , _a_request = "GET / HTTP/1.1"+ , _a_status = 200+ , _a_body_bytes = 3700+ , _a_http_referrer = "-"+ , _a_http_user_agent = "My Agent"+ , _a_other = "-"+ }+ ]++ counter_samples =+ [ ""+ , " - [] \"\" \"\" \"\" \"\""+ ]++access_deg_macro :: MacroEnv -> MacroID -> MacroDescriptor+access_deg_macro env mid =+ runTests' regexType (parse_deg_access . fmap LBS.pack) samples env mid+ MacroDescriptor+ { _md_source = " - \\[\\] \"\" \"\" \"\" \"\""+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = def_test_results+ , _md_parser = Nothing+ , _md_description = "a degenerate Nginx access log file line"+ }+ where+ samples :: [(String,Access)]+ samples =+ [ (,) " - [] \"\" \"\" \"\" \"\"" deg_access+ ]++ counter_samples =+ [ ""+ , "foo"+ ]++error_macro :: MacroEnv -> MacroID -> MacroDescriptor+error_macro env mid =+ runTests' regexType (parse_error . fmap LBS.pack) samples env mid+ MacroDescriptor+ { _md_source = error_re+ , _md_samples = map fst samples+ , _md_counter_samples = counter_samples+ , _md_test_results = def_test_results+ , _md_parser = Just "parse_e"+ , _md_description = "an Nginx error log file line"+ }+ where+ samples :: [(String,Error)]+ samples =+ [ (,) "2016/12/21 11:53:35 [emerg] 1378#0: foo"+ ERROR+ { _e_date = read "2016-12-21"+ , _e_time = read "11:53:35"+ , _e_severity = Emergency+ , _e_pid_tid = (1378,0)+ , _e_other = " foo"+ }+ , (,) "2017/01/04 05:40:19 [error] 31623#0: *1861296 no \"ssl_certificate\" is defined in server listening on SSL port while SSL handshaking, client: 192.168.31.38, server: 0.0.0.0:80"+ ERROR+ { _e_date = read "2017-01-04"+ , _e_time = read "05:40:19"+ , _e_severity = Error+ , _e_pid_tid = (31623,0)+ , _e_other = " *1861296 no \"ssl_certificate\" is defined in server listening on SSL port while SSL handshaking, client: 192.168.31.38, server: 0.0.0.0:80"+ }+ ]++ counter_samples =+ [ ""+ , "foo"+ ]++def_test_results :: [TestResult]+def_test_results = error "def_test_results"+\end{code}++\begin{code}++--+-- Access, access_re, deg_access, parse_deg_access, parse_access+--++data Access =+ Access+ { _a_remote_addr :: IPV4Address+ , _a_remote_user :: User+ , _a_time_local :: UTCTime+ , _a_request :: String+ , _a_status :: Int+ , _a_body_bytes :: Int+ , _a_http_referrer :: String+ , _a_http_user_agent :: String+ , _a_other :: String+ }+ deriving (Eq,Show)+\end{code}++\begin{code}+access_re :: RegexSource+access_re = RegexSource $ unwords+ [ "(@{%address.ipv4})"+ , "-"+ , "(@{user})"+ , "\\[(@{%datetime.clf})\\]"+ , "(@{%string.simple})"+ , "(@{%natural})"+ , "(@{%natural})"+ , "(@{%string.simple})"+ , "(@{%string.simple})"+ , "(@{%string.simple})"+ ]+\end{code}++\begin{code}+deg_access :: Access+deg_access =+ Access+ { _a_remote_addr = (0,0,0,0)+ , _a_remote_user = "-"+ , _a_time_local = read "1970-01-01 00:00:00"+ , _a_request = ""+ , _a_status = 0+ , _a_body_bytes = 0+ , _a_http_referrer = ""+ , _a_http_user_agent = ""+ , _a_other = ""+ }++parse_deg_access :: Match LBS.ByteString -> Maybe Access+parse_deg_access Match{..} =+ case matchSource == " - [] \"\" \"\" \"\" \"\"" of+ True -> Just deg_access+ False -> Nothing++parse_a :: LBS.ByteString -> Maybe Access+parse_a lbs = parse_access $ lbs ?=~ [re_|@{access}|] lpo++parse_access :: Match LBS.ByteString -> Maybe Access+parse_access cs =+ Access+ <$> f parseIPv4Address [cp|1|]+ <*> f parse_user [cp|2|]+ <*> f parseDateTimeCLF [cp|3|]+ <*> f parseSimpleString [cp|4|]+ <*> f parseInteger [cp|5|]+ <*> f parseInteger [cp|6|]+ <*> f parseSimpleString [cp|7|]+ <*> f parseSimpleString [cp|8|]+ <*> f parseSimpleString [cp|9|]+ where+ f psr i = psr $ capturedText $ capture i cs+++--+-- Error, error_re, parse_error+--++data Error =+ ERROR+ { _e_date :: Day+ , _e_time :: TimeOfDay+ , _e_severity :: Priority+ , _e_pid_tid :: (Int,Int)+ , _e_other :: LBS.ByteString+ }+ deriving (Eq,Show)++error_re :: RegexSource+error_re = RegexSource $ unwords+ [ "(@{%date.slashes})"+ , "(@{%time})"+ , "\\[(@{%syslog.severity})\\]"+ , "(@{pid#tid:})(.*)"+ ]++parse_e :: LBS.ByteString -> Maybe Error+parse_e lbs = parse_error $ lbs ?=~ [re_|@{error}|] lpo++parse_error :: Match LBS.ByteString -> Maybe Error+parse_error cs =+ ERROR+ <$> f parseSlashesDate [cp|1|]+ <*> f parseTimeOfDay [cp|2|]+ <*> f parseSyslogSeverity [cp|3|]+ <*> f parse_pid_tid [cp|4|]+ <*> f Just [cp|5|]+ where+ f psr i = psr $ capturedText $ capture i cs+++--+-- User, parseUser+--++newtype User =+ User { _User :: LBS.ByteString }+ deriving (IsString,Ord,Eq,Show)++parse_user :: Replace a => a -> Maybe User+parse_user = Just . User . LBS.pack . unpack_+++--+-- parse_pid_tid+--++parse_pid_tid :: Replace a => a -> Maybe (Int,Int)+parse_pid_tid x = case allMatches $ unpack_ x S.*=~ [re|@{%natural}|] of+ [cs,cs'] -> (,) <$> p cs <*> p cs'+ _ -> Nothing+ where+ p cs = matchCapture cs >>= parseInteger . capturedText+++--+-- cmp+--++cmp :: T.Text -> T.Text -> IO Bool+cmp src dst = handle hdl $ do+ _ <- SH.shelly $ SH.verbosely $+ SH.run "cmp" [src,dst]+ return True+ where+ hdl :: SomeException -> IO Bool+ hdl se = do+ hPutStrLn stderr $+ "testing results against model answers failed: " ++ show se+ return False+\end{code}
+ examples/re-pp.lhs view
@@ -0,0 +1,459 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ ) where++import Control.Applicative+import Control.Monad+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.IORef+import Data.Maybe+import Data.Monoid+import qualified Data.Text as T+import qualified Shelly as SH+import System.Directory+import System.Environment+import TestKit+import Text.Printf+import Text.RE.Edit+import Text.RE.TDFA.ByteString.Lazy+import Text.RE.TDFA.Text as T+import Text.RE.Tools.Grep+import Text.RE.Tools.Sed+\end{code}++\begin{code}+main :: IO ()+main = do+ as <- getArgs+ case as of+ [] -> test+ ["test"] -> test+ ["doc",fn,fn'] | is_file fn -> doc fn fn'+ ["gen",fn,fn'] | is_file fn -> gen fn fn'+ ["all"] -> gen_all+ _ -> usage+ where+ is_file = not . (== "--") . take 2++ doc fn fn' = docMode >>= \dm -> loop dm fn fn'+ gen fn fn' = genMode >>= \gm -> loop gm fn fn'++ usage = do+ pnm <- getProgName+ let prg = ((pnm++" ")++)+ putStr $ unlines+ [ "usage:"+ , " "++prg "--help"+ , " "++prg "[test]"+ , " "++prg "all"+ , " "++prg "doc (-|<in-file>) (-|<out-file>)"+ , " "++prg "gen (-|<in-file>) (-|<out-file>)"+ ]+\end{code}+++The Sed Script+--------------++\begin{code}+-- | the MODE determines whether we are generating documentation+-- or a Haskell testsuite and includes any IO-accessible state+-- needed by the relevant processor+data MODE+ = Doc DocState -- ^ document-generation state+ | Gen GenState -- ^ adjusting-the-program-for-testing state+\end{code}++The `DocState` is initialised to `Outside` and flips though the different+states as it traverses a code block, so that we can wrap code+blocks in special <div class="replcodeblock"> blocks when their+first line indicates that it contains a REPL calculation, which the+style sheet can pick up and present accordingly.++\begin{code}+data DocMode+ = Outside -- not inside a begin{code} ... \end{code} block+ | Beginning -- at the start of a begin{code} ... \end{code} block+ | InsideRepl -- inside a REPL code block+ | InsideProg -- inside a non-REPL code block+ deriving (Eq,Show)++type DocState = IORef DocMode++genMode :: IO MODE+genMode = Gen <$> newIORef []+\end{code}++\begin{code}+-- | the state is the accumulated test function identifiers for+-- generating the list of them gets added to the end of the programme+type GenState = IORef [String]++docMode :: IO MODE+docMode = Doc <$> newIORef Outside+\end{code}+++\begin{code}+loop :: MODE -> FilePath -> FilePath -> IO ()+loop mode =+ sed $ Select+ [ (,) [re|^%include ${file}(@{%string}) ${rex}(@{%string})$|] $ EDIT_fun TOP $ include mode+ , (,) [re|^%main ${arg}(top|bottom)$|] $ EDIT_gen $ main_ mode+ , (,) [re|^\\begin\{code\}$|] $ EDIT_gen $ begin mode+ , (,) [re|^${fn}(evalme@{%id}) = checkThis ${arg}(@{%string}).*$|] $ EDIT_fun TOP $ evalme mode+ , (,) [re|^\\end\{code\}$|] $ EDIT_fun TOP $ end mode+ , (,) [re|^.*$|] $ EDIT_fun TOP $ other mode+ ]+\end{code}++\begin{code}+include, evalme, end,+ other :: MODE+ -> LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)++main_,+ begin :: MODE+ -> LineNo+ -> Matches LBS.ByteString+ -> IO (LineEdit LBS.ByteString)++include (Doc _ ) = includeDoc+include (Gen _ ) = passthru++main_ (Doc _ ) = mainDoc+main_ (Gen gs) = mainGen gs++begin (Doc ds) = beginDoc ds+begin (Gen _ ) = passthru_g++evalme (Doc ds) = evalmeDoc ds+evalme (Gen gs) = evalmeGen gs++end (Doc ds) = endDoc ds+end (Gen _ ) = passthru++other (Doc ds) = otherDoc ds+other (Gen _ ) = passthru++passthru :: LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)+passthru _ _ _ _ = return Nothing++passthru_g :: LineNo+ -> Matches LBS.ByteString+ -> IO (LineEdit LBS.ByteString)+passthru_g _ _ = return NoEdit+\end{code}+++Script to Generate All Tutorial Tests and Docs+----------------------------------------------++\begin{code}+gen_all :: IO ()+gen_all = do+ -- prepare HTML docs for the (literate) tools+ pd "re-gen-modules"+ pd "re-include"+ pd "re-nginx-log-processor"+ pd "re-pp"+ pd "re-tests"+ pd "TestKit"+ pd "RE/Capture"+ pd "RE/Edit"+ pd "RE/IsRegex"+ pd "RE/Options"+ pd "RE/Replace"+ pd "RE/TestBench"+ pd "RE/Tools/Grep"+ pd "RE/Tools/Lex"+ pd "RE/Tools/Sed"+ pd "RE/Internal/NamedCaptures"+ -- render the tutorial in HTML+ dm <- docMode+ loop dm "examples/re-tutorial-master.lhs" "tmp/re-tutorial.lhs"+ createDirectoryIfMissing False "tmp"+ pandoc'+ "re-tutorial.lhs"+ "examples/re-tutorial.lhs"+ "tmp/re-tutorial.lhs"+ "docs/re-tutorial.html"+ -- generate the tutorial-based tests+ gm <- genMode+ loop gm "examples/re-tutorial-master.lhs" "examples/re-tutorial.lhs"+ putStrLn ">> examples/re-tutorial.lhs"+ where+ pd fnm = case captureTextMaybe [cp|mnm|] $ fnm T.?=~ [re|^RE/(Tools/|Internal/)?${mnm}(@{%id})|] of+ Just mnm -> pandoc fnm ("Text/"<>fnm<>".lhs") ("docs/"<>mnm<>".html")+ Nothing -> pandoc fnm ( "examples/"<>fnm<>".lhs") ("docs/"<>fnm<>".html")+\end{code}+++Generating the Tutorial+-----------------------++\begin{code}+includeDoc :: LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)+includeDoc _ mtch _ _ = fmap Just $+ extract fp =<< compileRegex () re_s+ where+ fp = prs_s $ captureText [cp|file|] mtch+ re_s = prs_s $ captureText [cp|rex|] mtch++ prs_s = fromMaybe (error "includeDoc") . parseString+\end{code}++\begin{code}+mainDoc :: LineNo+ -> Matches LBS.ByteString+ -> IO (LineEdit LBS.ByteString)+mainDoc _ _ = return Delete+\end{code}++\begin{code}+beginDoc :: DocState+ -> LineNo+ -> Matches LBS.ByteString+ -> IO (LineEdit LBS.ByteString)+beginDoc ds _ _ = writeIORef ds Beginning >> return Delete+\end{code}++\begin{code}+evalmeDoc, endDoc, otherDoc :: DocState+ -> LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)++evalmeDoc ds lno _ _ _ = do+ dm <- readIORef ds+ when (dm/=Beginning) $+ bad_state "evalme" lno dm+ writeIORef ds InsideRepl+ return $ Just $ "<div class=\"replcodeblock\">\n"<>begin_code++endDoc ds lno _ _ _ = do+ dm <- readIORef ds+ case dm of+ Outside -> bad_state "end" lno dm+ Beginning -> return $ Just $ begin_code <> "\n" <> end_code+ InsideRepl -> return $ Just $ end_code <> "\n</div>"+ InsideProg -> return Nothing++otherDoc ds _ mtch _ _ = do+ dm <- readIORef ds+ case dm of+ Beginning -> do+ writeIORef ds InsideProg+ return $ Just $ begin_code <> "\n" <> matchSource mtch+ _ -> return Nothing++bad_state :: String -> LineNo -> DocMode -> IO a+bad_state lab lno dm = error $+ printf "Bad document syntax: %s: %d: %s" lab (getLineNo lno) $ show dm+\end{code}+++Generating the Tests+--------------------++\begin{code}+evalmeGen :: GenState+ -> LineNo+ -> Match LBS.ByteString+ -> Location+ -> Capture LBS.ByteString+ -> IO (Maybe LBS.ByteString)+evalmeGen gs _ mtch0 _ _ = Just <$>+ replaceCapturesM replace_ ALL f mtch0+ where+ f mtch loc cap = case _loc_capture loc of+ 2 -> do+ modifyIORef gs (ide:)+ return $ Just $ LBS.pack $ show ide+ where+ ide = LBS.unpack $ captureText [cp|fn|] mtch+ _ -> return $ Just $ capturedText cap+\end{code}++How are we doing?++\begin{code}+mainGen :: GenState+ -> LineNo+ -> Matches LBS.ByteString+ -> IO (LineEdit LBS.ByteString)+mainGen gs _ mtchs = case allMatches mtchs of+ [mtch] ->+ case captureText [cp|arg|] $ mtch of+ "top" -> return $ ReplaceWith $ LBS.unlines $+ [ begin_code+ , "module Main(main) where"+ , end_code+ , ""+ , "*********************************************************"+ , "*"+ , "* WARNING: this is generated from pp-tutorial-master.lhs "+ , "*"+ , "*********************************************************"+ ]+ "bottom" -> do+ fns <- readIORef gs+ return $ ReplaceWith $ LBS.unlines $+ [ begin_code+ , "main :: IO ()"+ , "main = runTests"+ ] ++ mk_list fns +++ [ end_code+ ]+ _ -> error "mainGen (b)"+ _ -> error "mainGen (a)"+\end{code}++We cannot place these strings inline without confusing pandoc so we+use these definitions instead.++\begin{code}+begin_code, end_code :: LBS.ByteString+begin_code = "\\"<>"begin{code}"+end_code = "\\"<>"end{code}"+\end{code}++++\begin{code}+mk_list :: [String] -> [LBS.ByteString]+mk_list [] = ["[]"]+mk_list (ide0:ides) = f "[" ide0 $ foldr (f ",") [" ]"] ides+ where+ f pfx ide t = (" "<>pfx<>" "<>LBS.pack ide) : t+\end{code}+++Extracting a Literate Fragment from a Haskell Program Text+----------------------------------------------------------++\begin{code}+extract :: FilePath -> RE -> IO LBS.ByteString+extract fp rex = extr . LBS.lines <$> LBS.readFile fp+ where+ extr lns =+ case parse $ scan rex lns of+ Nothing -> oops+ Just (lno,n) -> LBS.unlines $ (hdr :) $ (take n $ drop i lns) ++ [ftr]+ where+ i = getZeroBasedLineNo lno++ oops = error $ concat+ [ "failed to locate fragment matching "+ , show $ reSource rex+ , " in file "+ , show fp+ ]++ hdr = "<div class='includedcodeblock'>"+ ftr = "</div>"+\end{code}++\begin{code}+parse :: [Token] -> Maybe (LineNo,Int)+parse [] = Nothing+parse (tk:tks) = case (tk,tks) of+ (Bra b_ln,Hit:Ket k_ln:_) -> Just (b_ln,count_lines_incl b_ln k_ln)+ _ -> parse tks+\end{code}++\begin{code}+count_lines_incl :: LineNo -> LineNo -> Int+count_lines_incl b_ln k_ln =+ getZeroBasedLineNo k_ln + 1 - getZeroBasedLineNo b_ln+\end{code}++\begin{code}+data Token = Bra LineNo | Hit | Ket LineNo deriving (Show)+\end{code}++\begin{code}+scan :: RE -> [LBS.ByteString] -> [Token]+scan rex = grepScript+ [ (,) [re|\\begin\{code\}|] $ \i -> chk $ Bra i+ , (,) rex $ \_ -> chk Hit+ , (,) [re|\\end\{code\}|] $ \i -> chk $ Ket i+ ]+ where+ chk x mtchs = case anyMatches mtchs of+ True -> Just x+ False -> Nothing+\end{code}+++pandoc+------++\begin{code}+pandoc :: T.Text -> T.Text -> T.Text -> IO ()+pandoc title in_file = pandoc' title in_file in_file++pandoc' :: T.Text -> T.Text -> T.Text -> T.Text -> IO ()+pandoc' title repo_path in_file out_file = do+ writeFile "tmp/bc.html" bc+ fmap (const ()) $+ SH.shelly $ SH.verbosely $+ SH.run "pandoc"+ [ "-f", "markdown+lhs+grid_tables"+ , "-t", "html"+ , "-s"+ , "-B", "tmp/bc.html"+ , "-c", "lib/styles.css"+ , "-c", "lib/bs.css"+ , "-o", out_file+ , in_file+ ]+ where+ bc = concat+ [ "<ol class='breadcrumb'><li><a href='.' title='Home'>"+ , "Home</a></li> > <a title='source file' href='"+ , repo_url+ , "'>"+ , T.unpack title+ , "</a></ol>"+ ]++ repo_url = concat+ [ "https://github.com/iconnect/regex/blob/master/"+ , T.unpack repo_path+ ]+\end{code}++testing+-------++\begin{code}+test :: IO ()+test = do+ dm <- docMode+ test_pp "pp-doc" (loop dm) "data/pp-test.lhs" "data/pp-result-doc.lhs"+ gm <- genMode+ test_pp "pp-gen" (loop gm) "data/pp-test.lhs" "data/pp-result-gen.lhs"+ putStrLn "tests passed"+\end{code}
+ examples/re-tests.lhs view
@@ -0,0 +1,257 @@+\begin{code}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Main (main) where++import Control.Applicative+import Data.Array+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Foldable+import Data.Monoid+import qualified Data.Sequence as S+import Data.String+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Test.Tasty+import Test.Tasty.HUnit+import Text.RE+import Text.RE.Internal.NamedCaptures+import qualified Text.RE.PCRE as PCRE+import Text.RE.TDFA as TDFA+import Text.RE.TestBench++import Text.RE.TDFA.String()+++main :: IO ()+main = defaultMain $+ testGroup "Tests"+ [ prelude_tests+ , parsing_tests+ , core_tests+ , replace_tests+ , options_tests+ , namedCapturesTestTree+ ]++prelude_tests :: TestTree+prelude_tests = testGroup "Prelude"+ [ tc TDFA TDFA.preludeEnv+ , tc PCRE PCRE.preludeEnv+ ]+ where+ tc rty m_env =+ testCase (show rty) $ do+ dumpMacroTable "prelude" rty m_env+ assertBool "testMacroEnv" =<< testMacroEnv "prelude" rty m_env++str, str' :: String+str = "a bbbb aa b"+str' = "foo"++regex_, regex_alt :: RE+regex_ = [re|(a+) (b+)|]+regex_alt = [re|(a+)|(b+)|]++regex_str_matches :: Matches String+regex_str_matches =+ Matches+ { matchesSource = "a bbbb aa b"+ , allMatches =+ [ regex_str_match+ , regex_str_match_2+ ]+ }++regex_str_match :: Match String+regex_str_match =+ Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "a bbbb", captureOffset = 0, captureLength = 6})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "a" , captureOffset = 0, captureLength = 1})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb" , captureOffset = 2, captureLength = 4})+ ]+ }++regex_str_match_2 :: Match String+regex_str_match_2 =+ Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "aa b", captureOffset = 7 , captureLength = 4})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "aa" , captureOffset = 7 , captureLength = 2})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "b" , captureOffset = 10, captureLength = 1})+ ]+ }++regex_alt_str_matches :: Matches String+regex_alt_str_matches =+ Matches+ { matchesSource = "a bbbb aa b"+ , allMatches =+ [ Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "a", captureOffset = 0, captureLength = 1})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "a", captureOffset = 0, captureLength = 1})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "", captureOffset = -1, captureLength = 0})+ ]+ }+ , Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb", captureOffset = 2 , captureLength = 4})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "" , captureOffset = -1, captureLength = 0})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "bbbb", captureOffset = 2 , captureLength = 4})+ ]+ }+ , Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "aa", captureOffset = 7 , captureLength = 2})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "aa", captureOffset = 7 , captureLength = 2})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "" , captureOffset = -1, captureLength = 0})+ ]+ }+ , Match+ { matchSource = "a bbbb aa b"+ , captureNames = noCaptureNames+ , matchArray = array (0,2)+ [ (0,Capture {captureSource = "a bbbb aa b", capturedText = "b", captureOffset = 10, captureLength = 1})+ , (1,Capture {captureSource = "a bbbb aa b", capturedText = "" , captureOffset = -1, captureLength = 0})+ , (2,Capture {captureSource = "a bbbb aa b", capturedText = "b", captureOffset = 10, captureLength = 1})+ ]+ }+ ]+ }++parsing_tests :: TestTree+parsing_tests = testGroup "Parsing"+ [ testCase "complete check (matchM/ByteString)" $ do+ r <- compileRegex () $ reSource regex_+ assertEqual "Match" (B.pack <$> regex_str_match) $ B.pack str ?=~ r+ , testCase "matched (matchM/Text)" $ do+ r <- compileRegex () $ reSource regex_+ assertEqual "matched" True $ matched $ T.pack str ?=~ r+ ]++core_tests :: TestTree+core_tests = testGroup "Match"+ [ testCase "text (=~~Text.Lazy)" $ do+ txt <- LT.pack str =~~ [re|(a+) (b+)|] :: IO (LT.Text)+ assertEqual "text" txt "a bbbb"+ , testCase "multi (=~~/String)" $ do+ let sm = str =~ regex_ :: Match String+ m = capture [cp|0|] sm+ assertEqual "captureSource" "a bbbb aa b" $ captureSource m+ assertEqual "capturedText" "a bbbb" $ capturedText m+ assertEqual "capturePrefix" "" $ capturePrefix m+ assertEqual "captureSuffix" " aa b" $ captureSuffix m+ , testCase "complete (=~~/ByteString)" $ do+ mtch <- B.pack str =~~ regex_ :: IO (Match B.ByteString)+ assertEqual "Match" mtch $ B.pack <$> regex_str_match+ , testCase "complete (all,String)" $ do+ let mtchs = str =~ regex_ :: Matches String+ assertEqual "Matches" mtchs regex_str_matches+ , testCase "complete (all,reg_alt)" $ do+ let mtchs = str =~ regex_alt :: Matches String+ assertEqual "Matches" mtchs regex_alt_str_matches+ , testCase "complete (=~~,all)" $ do+ mtchs <- str =~~ regex_ :: IO (Matches String)+ assertEqual "Matches" mtchs regex_str_matches+ , testCase "fail (all)" $ do+ let mtchs = str' =~ regex_ :: Matches String+ assertEqual "not.anyMatches" False $ anyMatches mtchs+ ]++replace_tests :: TestTree+replace_tests = testGroup "Replace"+ [ testCase "String/single" $ do+ let m = str =~ regex_ :: Match String+ r = replaceCaptures' ALL fmt m+ assertEqual "replaceCaptures'" r "(0:0:(0:1:a) (0:2:bbbb)) aa b"+ , testCase "String/alt" $ do+ let ms = str =~ regex_ :: Matches String+ r = replaceAllCaptures' ALL fmt ms+ chk r+ , testCase "String" $ do+ let ms = str =~ regex_ :: Matches String+ r = replaceAllCaptures' ALL fmt ms+ chk r+ , testCase "ByteString" $ do+ let ms = B.pack str =~ regex_ :: Matches B.ByteString+ r = replaceAllCaptures' ALL fmt ms+ chk r+ , testCase "LBS.ByteString" $ do+ let ms = LBS.pack str =~ regex_ :: Matches LBS.ByteString+ r = replaceAllCaptures' ALL fmt ms+ chk r+ , testCase "Seq Char" $ do+ let ms = S.fromList str =~ regex_ :: Matches (S.Seq Char)+ f = \_ (Location i j) Capture{..} -> Just $ S.fromList $+ "(" <> show i <> ":" <> show_co j <> ":" <>+ toList capturedText <> ")"+ r = replaceAllCaptures' ALL f ms+ assertEqual "replaceAllCaptures'" r $+ S.fromList "(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"+ , testCase "Text" $ do+ let ms = T.pack str =~ regex_ :: Matches T.Text+ r = replaceAllCaptures' ALL fmt ms+ chk r+ , testCase "LT.Text" $ do+ let ms = LT.pack str =~ regex_ :: Matches LT.Text+ r = replaceAllCaptures' ALL fmt ms+ chk r+ ]+ where+ chk r =+ assertEqual+ "replaceAllCaptures'"+ r+ "(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"++ fmt :: (IsString s,Replace s) => a -> Location -> Capture s -> Maybe s+ fmt _ (Location i j) Capture{..} = Just $ "(" <> pack_ (show i) <> ":" <>+ pack_ (show_co j) <> ":" <> capturedText <> ")"++ show_co (CaptureOrdinal j) = show j++options_tests :: TestTree+options_tests = testGroup "Simple Options"+ [ testGroup "TDFA Simple Options"+ [ testCase "default (MultilineSensitive)" $ assertEqual "#" 2 $+ countMatches $ s TDFA.*=~ [TDFA.re|[0-9a-f]{2}$|]+ , testCase "MultilineSensitive" $ assertEqual "#" 2 $+ countMatches $ s TDFA.*=~ [TDFA.reMultilineSensitive|[0-9a-f]{2}$|]+ , testCase "MultilineInsensitive" $ assertEqual "#" 4 $+ countMatches $ s TDFA.*=~ [TDFA.reMultilineInsensitive|[0-9a-f]{2}$|]+ , testCase "BlockSensitive" $ assertEqual "#" 0 $+ countMatches $ s TDFA.*=~ [TDFA.reBlockSensitive|[0-9a-f]{2}$|]+ , testCase "BlockInsensitive" $ assertEqual "#" 1 $+ countMatches $ s TDFA.*=~ [TDFA.reBlockInsensitive|[0-9a-f]{2}$|]+ ]+ , testGroup "PCRE Simple Options"+ [ testCase "default (MultilineSensitive)" $ assertEqual "#" 2 $+ countMatches $ s PCRE.*=~ [PCRE.re|[0-9a-f]{2}$|]+ , testCase "MultilineSensitive" $ assertEqual "#" 2 $+ countMatches $ s PCRE.*=~ [PCRE.reMultilineSensitive|[0-9a-f]{2}$|]+ , testCase "MultilineInsensitive" $ assertEqual "#" 4 $+ countMatches $ s PCRE.*=~ [PCRE.reMultilineInsensitive|[0-9a-f]{2}$|]+ , testCase "BlockSensitive" $ assertEqual "#" 0 $+ countMatches $ s PCRE.*=~ [PCRE.reBlockSensitive|[0-9a-f]{2}$|]+ , testCase "BlockInsensitive" $ assertEqual "#" 1 $+ countMatches $ s PCRE.*=~ [PCRE.reBlockInsensitive|[0-9a-f]{2}$|]+ ]+ ]+ where+ s = "0a\nbb\nFe\nA5" :: String+\end{code}
+ examples/re-tutorial.lhs view
@@ -0,0 +1,859 @@+The Regex Tutorial+==================++This is a literate Haskell programme lightly processed to produce this+web presentation and also to generate a test suite that verifies that+each of the example calculations are generating the expected results.+You can load it into ghci and try out the examples either by running+_ghci_ itself from the root folder of the regex package:+```bash+ghci examples/re-tutorial.lhs+```+or using `cabal repl`:+```+cabal configure --enable-tests+cabal repl examples/re-tutorial.lhs+```++Depending upon how you have configured and run `ghci` you may need to+set one of _ghci_'s interctive settings — the topic of the next+section.+++Setting Up: The Pragmas+-----------------------++Haskell programs typically start with a few compiler pragmas to switch+on the language extensions needed by the module. Because regex uses+Template Haskell to check regular expressions at compile time `QuasiQuotes`+should be enabled.++\begin{code}+{-# LANGUAGE QuasiQuotes #-}+\end{code}++Use this command to configure ghci accordingly (not necessary if you+have launched ghci with `cabal repl`):+```+:seti -XQuasiQuotes+```++[Overloaded string+literals](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/guide-to-ghc-extensions/basic-syntax-extensions#overloadedstrings)+are usually enabled in modern Haskell and we do so here.+\begin{code}+{-# LANGUAGE OverloadedStrings #-}+\end{code}++Because we are mimicking the REPL in this tutorial we will leave off the type+signatures on the example calculations and disable the compiler+warnings about missing type signatures.+\begin{code}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+\end{code}+++Loading Up: The Imports+-----------------------++\begin{code}+module Main(main) where+\end{code}++*********************************************************+*+* WARNING: this is generated from pp-tutorial-master.lhs +*+*********************************************************++We have two things to consider in the import to access the regex+goodies, which will take the form:+```haskell+import Text.RE.<regex-flavour>.<text-type>?+```++ * Which [flavour of regular expressions](https://wiki.haskell.org/Regular_expressions) do I need?+ + `PCRE` : [Perl-style](https://en.wikibooks.org/wiki/Regular_Expressions/Perl-Compatible_Regular_Expressions) regular expressions;+ + `TDFA`: [Posix-style](https://en.wikipedia.org/wiki/Regular_expression#POSIX_extended) regular expressions.++ * And which type of text am I matching?+ + `String` : low-performing, classic Haskell strings;+ + `ByteString` : raw bytestrings;+ + `ByteString.Lazy` : raw lazy bytestrings;+ + `Text`: efficient text (currently available for `TDFA` only);+ + `Text.Lazy` : efficient, lazy text (currently available for+ `TDFA` only);+ + polymorphic: if you need matching operators that work with all+ available text types then do not specify the `<text-type>` in+ the import path.++For this tutorial we will use classic Haskell strings but any application+dealing with bulk text will probably want to choose one of the other+options.+\begin{code}+import Text.RE.TDFA.String+\end{code}+If you are predominantly matching against a single type in your module+then you will probably find it more convenient to use the relevant module+rather than than the more polymorphic opertors but it is really a+matter of convenience.++We will also need access to a small selection of common libraries for+our examples.+\begin{code}+import Control.Applicative+import Data.Maybe+import qualified Data.Text as T+import Text.Printf+\end{code}++And finally we will import a small specail toolkit will be used to help+manage the example calculations.+\begin{code}+import TestKit+\end{code}+This allows simple calculations to be defined stylistically+in the source program, presented as calculations when rendered+in HTML and tested that they have the expected result.+\begin{code}+evalme_LOA_00 = checkThis "evalme_LOA_00" 0 $+ length []+\end{code}+This trivial example calculation will be tested for equality to 0.+++Matching with the regex-base Operators+--------------------------------------++regex supports the regex-base polymorphic match operators. Used in a+`Bool` context `=~` will evaluate to True iff the string on the left matches+the RE on the right.+\begin{code}+evalme_TRD_00 = checkThis "evalme_TRD_00" True $+ ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Bool)+\end{code}+Note that we enclose the RE itself in `[re|` ... `|]` quasi quote brackets,+allowing the compiler to run some regex code at compile time to verify that+the RE conforms to the correct syntax for the chosen RE flavour of choice+(`TDFA` in this case). The above expression should evaluate to `True` as the+string contains a matching sub-string.++Used in an `Int` context `=~` will count the number of matches in the target string.+\begin{code}+evalme_TRD_01 = checkThis "evalme_TRD_01" 2 $+ ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Int)+\end{code}++To determine the string that has matched the modaic `=~~` operator can be used+in a `Maybe` context.+\begin{code}+evalme_TRD_02 = checkThis "evalme_TRD_02" (Just "2016-01-09") $+ ("2016-01-09 2015-12-5 2015-10-05" =~~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: Maybe String)+\end{code}+This should evaluate to `Just "2016-01-09"`.++A `=~` in a `[[String]]` extracts all of the matched substrings:+\begin{code}+evalme_TRD_04 = checkThis "evalme_TRD_04" [["2016-01-09"],["2015-10-05"]] $+ ("2016-01-09 2015-12-5 2015-10-05" =~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|] :: [[String]])+\end{code}+yields `[["2016-01-09"],["2015-10-05"]]`.++regex provides special operators and types for extracting the first+match or all of the non-overlapping substrings matching a regular expression+which provide a little more structure that the flexible, venerable regex-base+match operators.+++Single Matches with `?=~`+-------------------------++regex also provides two matching operators: one for looking for the first+match in its search string and the other for finding all of the matches. The+first-match operator, `?=~`, yields the result of attempting to find the first+match. (It's result type will be explained below.) The boolean `matched`+function can be used to test whether a match was found.+\begin{code}+evalme_SGL_01 = checkThis "evalme_SGL_01" True $+ matched $ "2016-01-09 2015-12-5 2015-10-05" ?=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]+\end{code}+This should yield `True`.++To get the matched text use `matchText`, which returns `Nothing` if no match was+found in the search string.+\begin{code}+evalme_SGL_02 = checkThis "evalme_SGL_02" (Just "2016-01-09") $+ matchedText $ "2016-01-09 2015-12-5 2015-10-05" ?=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]+\end{code}+This should yield `Just "2016-01-09"`.+++Multiple Matches with `*=~`+---------------------------++Use `*=~` to locate all of the non-overlapping substrings that matches a RE.+`anyMatches` will return `True` iff any matches are found (and they will be).+\begin{code}+evalme_MLT_01 = checkThis "evalme_MLT_01" True $+ anyMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]+\end{code}++`countMatches` will tell us how many sub-strings matched (2).+\begin{code}+evalme_MLT_02 = checkThis "evalme_MLT_02" 2 $+ countMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]+\end{code}++`matches` will return all of the matches.+\begin{code}+evalme_MLT_03 = checkThis "evalme_MLT_03" ["2016-01-09","2015-10-05"] $+ matches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|[0-9]{4}-[0-9]{2}-[0-9]{2}|]+\end{code}+This should yield `["2016-01-09","2015-10-05"]`.+++Simple Text Replacement+-----------------------++regex supports the replacement of matched text with alternative text. This+section will cover replacement text specified with templates. More flexible+tools that allow functions calculate the replacement text are covered below.++_Capture_ sub-expressions, whose matched text can be inserted into the+replacement template, can be specified as follows:++ * `$(` ... `)` identifies a capture that can be identified by its+ left-to-right position relative to the other captures in the replacement+ template, with `$1` being used to represent the leftmost capture, `$2` the+ next leftmost capture, and so on;++ * `${foo}(` ... `)` can be used to identify a capture by name. Such captures+ can be identified either by their left-to-right position in the regular+ expression or by `${foo}` in the template.++A function to convert ISO format dates into a UK-format date could be written+thus:+\begin{code}+uk_dates :: String -> String+uk_dates src =+ replaceAll "${d}/${m}/${y}" $ src *=~ [re|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|]+\end{code}+with+\begin{code}+evalme_RPL_01 = checkThis "evalme_RPL_01" "09/01/2016 2015-12-5 05/10/2015" $+ uk_dates "2016-01-09 2015-12-5 2015-10-05"+\end{code}+yielding `"09/01/2016 2015-12-5 05/10/2015"`.++The same function written with numbered captures:+\begin{code}+uk_dates' :: String -> String+uk_dates' src =+ replaceAll "$3/$2/$1" $ src *=~ [re|$([0-9]{4})-$([0-9]{2})-$([0-9]{2})|]+\end{code}+with+\begin{code}+evalme_RPL_02 = checkThis "evalme_RPL_02" "09/01/2016 2015-12-5 05/10/2015" $+ uk_dates' "2016-01-09 2015-12-5 2015-10-05"+\end{code}+yielding the same result.++(Most regex conventions use plain parentheses, `(` ... `)`, to mark+captures but we would like to reserve those exclusively for grouping+in regex REs.)+++Matches/Match/Capture+---------------------++The types returned by the `?=~` and `*=~` form the foundations of the+package. Understandingv these simple types is the key to understanding+the package.++The type of `*=~` in this module (imported from+`Text.RE.TDFA.String`) is:+<div class='inlinecodeblock'>+```+(*=~) :: String -> RE -> Matches String+```+</div>+with `Matches` defined in `Text.RE.Capture` thus:++%include "Text/RE/Capture.lhs" "^data Matches "++The critical component of the `Matches` type is the `[Match a]` in+`allMatches`, containing the details all of each substring matched by+the RE. The `matchSource` component also retains a copy of the original+search string but the critical information is in `allmatches`.++The type of `?=~` in this module (imported from+`Text.RE.TDFA.String`) is:+<div class='inlinecodeblock'>+```+(?=~) :: String -> RE -> Match String+```+</div>+with `Match` (referenced in the definition of `Matches` above) defined+in `Text.RE.Capture` thus:++%include "Text/RE/Capture.lhs" "^data Match "++Like `matchesSource` above, `matchSource` retains the original search+string, but also a `CaptureNames` field listing all of the capture+names in the RE (needed by the text replacemnt tools).++But the 'real' content of `Match` is to be found in the `MatchArray`,+enumerating all of the substrings captured by this match, starting with+`0` for the substring captured by the whole RE, `1` for the leftmost+explicit capture in the RE, `2` for the next leftmost capture, and so+on.++Each captured substring is represented by the following `Capture` type:++%include "Text/RE/Capture.lhs" "^data Capture "++Here we list the whole original search string in `captureSource` and+the text of the sub-string captured in `capturedText`. `captureOffset`+contains the number of characters preceding the captured substring, or+is negative if no substring was captured (which is a different+situation from epsilon, the empty string, being captured).+`captureLength` gives the length of the captured string in+`capturedText`.++The test suite in [examples/re-tests.lhs](re-tests.html) contains extensive+worked-out examples of these `Matches`/`Match`/`Capture` types.+++Simple Options+--------------++By default regular expressions are of the multi-line case-sensitive+variety so this query+\begin{code}+evalme_SOP_01 = checkThis "evalme_SOP_01" 2 $+ countMatches $ "0a\nbb\nFe\nA5" *=~ [re|[0-9a-f]{2}$|]+\end{code}+finds 2 matches, the '$' anchor matching each of the newlines, but only+the first two lowercase hex numbers matching the RE. The case sensitivity+and multiline-ness can be controled by selecting alternative parsers.+++--------------------------+-------------+-----------+----------------++| long name | short forms | multiline | case sensitive |++==========================+=============+===========+================++| reMultilineSensitive | reMS, re | yes | yes |++--------------------------+-------------+-----------+----------------++| reMultilineInsensitive | reMI | yes | no |++--------------------------+-------------+-----------+----------------++| reBlockSensitive | reBS | no | yes |++--------------------------+-------------+-----------+----------------++| reBlockInsensitive | reBI | no | no |++--------------------------+-------------+-----------+----------------+++So while the default setup+\begin{code}+evalme_SOP_02 = checkThis "evalme_SOP_02" 2 $+ countMatches $ "0a\nbb\nFe\nA5" *=~ [reMultilineSensitive|[0-9a-f]{2}$|]+\end{code}+finds 2 matches, a case-insensitive RE+\begin{code}+evalme_SOP_03 = checkThis "evalme_SOP_03" 4 $+ countMatches $ "0a\nbb\nFe\nA5" *=~ [reMultilineInsensitive|[0-9a-f]{2}$|]+\end{code}+finds 4 matches, while a non-multiline RE+\begin{code}+evalme_SOP_04 = checkThis "evalme_SOP_04" 0 $+ countMatches $ "0a\nbb\nFe\nA5" *=~ [reBlockSensitive|[0-9a-f]{2}$|]+\end{code}+finds no matches but a non-multiline, case-insensitive match+\begin{code}+evalme_SOP_05 = checkThis "evalme_SOP_05" 1 $+ countMatches $ "0a\nbb\nFe\nA5" *=~ [reBlockInsensitive|[0-9a-f]{2}$|]+\end{code}+finds the final match.++For the hard of typing the shortforms are available.+\begin{code}+evalme_SOP_06 = checkThis "evalme_SOP_06" True $+ matched $ "SuperCaliFragilisticExpialidocious" ?=~ [reMI|supercalifragilisticexpialidocious|]+\end{code}+++Using Functions to Replace Text+-------------------------------++Sometimes you will need to process each string captured by an RE with a+function. `replaceAllCaptures` takes a `Phi` and a `Matches` and+applies the function to each captured substring according to the+`Context` specified in `Phi`, as we can see in the following example function+to clean up all of the mis-formatted dates in the argument string,+\begin{code}+fixup_dates :: String -> String+fixup_dates src =+ replaceAllCaptures phi $ src *=~ [re|([0-9]+)-([0-9]+)-([0-9]+)|]+ where+ phi = Phi SUB $ \loc s -> case _loc_capture loc of+ 1 -> printf "%04d" (read s :: Int)+ 2 -> printf "%02d" (read s :: Int)+ 3 -> printf "%02d" (read s :: Int)+ _ -> error "fixup_date"+\end{code}+which will fix up our running example+\begin{code}+evalme_RPF_01 = checkThis "evalme_RPF_01" "2016-01-09 2015-12-05 2015-10-05" $+ fixup_dates "2016-01-09 2015-12-5 2015-10-05"+\end{code}+returning `"2016-01-09 2015-12-05 2015-10-05"`.++The `Phi`, `Context` and `Location` types are defined in+`Text.RE.Replace` as follows.++%include "Text/RE/Replace.lhs" "^data Phi"++The processing function gets applied to the captures specified by the+`Context`, which can be directed to process `ALL` of the captures,+including the substring captured by the whole RE and all of the+subsidiary capture, or just the `TOP`, `0` capture that the whole RE+matches, or just the `SUB` (subsidiary) captures, as was the case above.++If this doesn't provide enough flexibility, the `replaceAllCaptures'`+function accepts a processing function that takes the full `Match`+context for each capture along with the `Location` and the `Capture`+itself.++%include "Text/RE/Replace.lhs" "replaceAllCaptures' ::"++The above fixup function can be extended to enclose whole date in+square brackets and rewritten with the above more general replacement+function.+\begin{code}+fixup_and_reformat_dates :: String -> String+fixup_and_reformat_dates src =+ replaceAllCaptures' ALL f $ src *=~ [re|([0-9]+)-([0-9]+)-([0-9]+)|]+ where+ f _ loc cap = Just $ case _loc_capture loc of+ 0 -> printf "[%s]" txt+ 1 -> printf "%04d" (read txt :: Int)+ 2 -> printf "%02d" (read txt :: Int)+ 3 -> printf "%02d" (read txt :: Int)+ _ -> error "fixup_date"+ where+ txt = capturedText cap+\end{code}+The `fixup_and_reformat_dates` applied to our running example,+\begin{code}+evalme_RPF_02 = checkThis "evalme_RPF_02" "[2016-01-09] [2015-12-05] [2015-10-05]" $+ fixup_and_reformat_dates "2016-01-09 2015-12-5 2015-10-05"+\end{code}+yields `"[2016-01-09] [2015-12-05] [2015-10-05]"`.++`Text.RE.Replace` provides analagous functions for replacing the+test of a single `Match` returned from `?=~`.+++Macros and Parsers+------------------++regex supports macros in regular expressions. There are a bunch of+standard macros and you can define your own.++RE macros are enclosed in `@{` ... '}'. By convention the macros in+the standard environment start with a '%'. `@{%date}` will match an+ISO 8601 date, this+\begin{code}+evalme_MAC_00 = checkThis "evalme_MAC_00" 2 $+ countMatches $ "2016-01-09 2015-12-5 2015-10-05" *=~ [re|@{%date}|]+\end{code}+picking out the two dates.++See the tables listing the standard macros in the tables folder of+the distribution.++See the log-processor example and the `Text.RE.TestBench` for+more on how you can develop, document and test RE macros with the+regex test bench.+++Compiling REs with the Complete Options+---------------------------------------++Each type of RE — TDFA and PCRE — has it own complile-time+options and execution-time options, called in each case `CompOption` and+`ExecOption`. The above simple options selected with the RE+parser (`reMultilineSensitive`, etc.) configures the RE backend+accordingly so that you don't have to, but you may need full access to+you chosen back end's options, or you may need to supply a different+set of macros to those provided in the standard environment. In which+case you will need to know about the `Options` type, defined by each of+the back ends in terms of the `Options_` type of `Text.RE.Options`+as follows.+<div class='inlinecodeblock'>+```+type Options = Options_ RE CompOption ExecOption+```+</div>+(Bear in mind that `CompOption` and `ExecOption` will be different+types for each back end.)++The `Options_` type is defined in `Text.RE.Options` as follows:++%include "Text/RE/Options.lhs" "data Options_"++ * `_options_mode` is an experimental feature that controls the RE+ parser.++ * `_options_macs` contains the macro definitions used to compile+ the REs (see above Macros section);++ * `_options_comp` contains the back end compile-time options;++ * `_options_exec` contains the back end execution-time options.++(For more information on the options provided by the back ends see the+decumentation for `regex-tdfa` and `regex-pcre` as apropriate.)++Each backend provides a function to compile REs from some options and a+string containing the RE as follows:+<div class='inlinecodeblock'>+```+compileRegex :: ( IsOption o RE CompOption ExecOption+ , Functor m+ , Monad m+ )+ => o+ -> String+ -> m RE+```+</div>+where `o` is some type that is recognised as a type that can configure+REs. Your configuration-type options are:++ * `()` (the unit type) means just use the default multi-line+ case-sensitive that we get with the `re` parser.++ * `SimpleRegexOptions` this is just a simple enum type that we use to+ encode the standard options:++%include "Text/RE/Options.lhs" "^data SimpleRegexOptions"++ * `Mode`: you can specify the parser mode;++ * `Macros RE`: you can specify the macros use instead of the standard+ environment;++ * `CompOption`: you can specify the compile-time options for the back+ end;++ * `ExecOption`: you can specify the execution-time options for the+ back end;++ * `Options`: you can specify all of the options.++The compilation may fail so it is expressed monadically. For the+following examples we will use the following helper to just `error`+the failure.+\begin{code}+check_for_failure :: Either String a -> a+check_for_failure = either error id+\end{code}++\begin{code}+evalme_OPT_00 = checkThis "evalme_OPT_00" 2 $+ countMatches $+ "2016-01-09 2015-12-5 2015-10-05" *=~+ check_for_failure+ (compileRegex () "@{%date}")+\end{code}+\begin{code}+evalme_OPT_01 = checkThis "evalme_OPT_01" 1 $+ countMatches $+ "0a\nbb\nFe\nA5" *=~+ check_for_failure+ (compileRegex BlockInsensitive "[0-9a-f]{2}$")+\end{code}++This will allow you to compile regular expressions when the either the+text to be compiled or the options have been dynamically determined.+++Specifying Options with `re_`+-----------------------------++If you just need to specify some non-standard options while statically+checking the validity of the RE (with the default options) then you can+use the `re_` parser:+\begin{code}+evalme_REU_01 = checkThis "evalme_REU_01" 1 $+ countMatches $+ "0a\nbb\nFe\nA5" *=~ [re_|[0-9a-f]{2}$|] BlockInsensitive+\end{code}+Any option `o` such that `IsOption o RE CompOption ExecOption` (i.e.,+any option type accepted by `compileRegex` above) can be used with+`[re_` ..`|]`.+++The Tools: 'grep', 'lex' and 'sed'+----------------------------------++The classic tools assocciated with regular expressions have inspired some+regex conterparts.++ * [Text.RE.Tools.Grep}(Grep.html): takes a regular expression and a+ file or lazy ByteString (depending upon the variant) and returns all of the+ matching lines. (Used in the [include](re-include.html) example.)++ * [Text.RE.Tools.Lex}(Lex.html): takes an association list of REs and+ token-generating functions and the input text and returns a list of tokens.+ This should never be used where performance is important (use Alex),+ except as a development prototype (used internally in+ [Text.RE.Internal.NamedCaptures](NamedCaptures.html)).++ * [Text.RE.Tools.Lex}(Sed.html) using [Text.RE.Edit](Edit.html):+ takes an association list of regular expressions and substitution actions,+ some input text and invokes the associated action on each line of the file+ that matches one of the REs, substituting the text returned from the action+ in the output stream. (Used in the [include](re-include.html),+ [gen-modules](re-gen-modules.html),+ [log-processor](re-nginx-log-processor.html) and [tutorial-pp](re-pp)+ examples.)+++The Examples+------------++The remaining sections have been given over to various standalone+examples. All bar the first are taken from the package itself, each+contributing to either the API or the tools used to prepare the+documentation and test suites.+++Example: log processor: development with macros+-----------------------------------------------++To test regex at scale — which is to say, developing with+relatively complex REs —+[a preprocessor](re-nginx-log-processor.html) for parsing NGINX access+and error logs has been written. Each line of input may be either a line+from an NGINX access log or the event log, producing a standard-format+event log on the output.++As a taster, here is the main script, where each type of line is+recognised by a high-level macro.++%include "examples/re-nginx-log-processor.lhs" "script ::"++Thes macros are based on the standard macros, using+`Text.RE.TestBench` to build the up into the above high-level+scanners with the apropriate+[tests and documentation](https://github.com/iconnect/regex/tree/master/tables).++The RE for recognising the access-log lines is built up here.++%include "examples/re-nginx-log-processor.lhs" "access_re ::"++(N.B., The Test Bench currently requires that we write our REs in Haskell+strings.)++See [the log-processor program sources](re-nginx-log-processor.html) for details.+++Example: Scanning REs: Named Captures+-------------------------------------++This package needs to recognise all captures in a regular expression so+that it can associate the named captures with their cature ordinal.++Here is the prototype scanner.++%include "Text/RE/Internal/NamedCaptures.lhs" "scan ::"++Once the package has stabilised it should be rewritten with Alex.++See [Text.RE.Internal.NamedCaptures](NamedCaptures.html) for+details.+++Anti-Example: Scanning REs in the TestBench+-------------------------------------------++The [Text.RE.TestBench](TestBench.html) contains an almost+identical parser to the above, written with recursive functions.++%include "Text/RE/TestBench.lhs" "scan_re ::"++Once some technical issues have been ersolved it will use the above+scanner in [Text.RE.Internal.NamedCaptures](NamedCaptures.html).+++Example: filename analysis+--------------------------++The preprocessor used to prepare the literate programs for this+package's website uses the following 'gen_all' diriver which uses+REs to analyse file paths.++%include "examples/re-pp.lhs" "^gen_all ::"++See [examples/re-pp.lhs](re-pp.html)+++Example: parsing RE macros+--------------------------++The regex RE macros are parsed with code that looks similar to+this.++\begin{code}+-- | expand the @{..} macos in the argument string using the given+-- function+expandMacros_ :: (MacroID->Maybe String) -> String -> String+expandMacros_ lu = fixpoint e_m+ where+ e_m re_s =+ replaceAllCaptures' TOP phi $ re_s *=~ [re|@$(@|\{${name}([^{}]+)\})|]++ phi mtch _ cap = case txt == "@@" of+ True -> Just "@"+ False -> Just $ fromMaybe txt $ lu ide+ where+ txt = capturedText cap+ ide = MacroID $ capturedText $ capture [cp|name|] mtch++fixpoint :: (Eq a) => (a->a) -> a -> a+fixpoint f = chk . iterate f+ where+ chk (x:x':_) | x==x' = x+ chk xs = chk $ tail xs+\end{code}++For example:+\begin{code}+evalme_PMC_00 = checkThis "evalme_PMC_00" "foo MacroID {_MacroID = \"bar\"} baz" $+ expandMacros_ (Just . show) "foo @{bar} baz"+\end{code}++See [Text.RE.Replace](Replace.html) for details.+++Example: Parsing Replace Templates+----------------------------------++The regex replacement templates are parsed with code similar to this.++\begin{code}+type Template = String++parse_tpl_ :: Template+ -> Match String+ -> Location+ -> Capture String+ -> Maybe String+parse_tpl_ tpl mtch _ _ =+ Just $ replaceAllCaptures' TOP phi $+ tpl *=~ [re|\$${arg}(\$|[0-9]+|\{${name}([^{}]+)\})|]+ where+ phi t_mtch _ _ = case captureMaybe [cp|name|] t_mtch of+ Just cap -> this $ CID_name $ CaptureName txt+ where+ txt = T.pack $ capturedText cap+ Nothing -> case t == "$" of+ True -> Just t+ False -> this $ CID_ordinal $ CaptureOrdinal $ read t+ where+ t = capturedText $ capture [cp|arg|] t_mtch++ this cid = capturedText <$> captureMaybe cid mtch++my_replace :: RE -> Template-> String -> String+my_replace rex tpl src = replaceAllCaptures' TOP (parse_tpl_ tpl) $ src *=~ rex+\end{code}++It can be tested with our date-reformater example.++\begin{code}+date_reformat :: String -> String+date_reformat = my_replace [re|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|] "${y}/${m}/${d}"+\end{code}++This should yield `"2016/01/11"`:++\begin{code}+evalme_TPL_00 = checkThis "evalme_TPL_00" "2016/01/11" $+ date_reformat "2016-01-11"+\end{code}++See [Text.RE.Replace](Replace.html)+++Example: include preprocessor+-----------------------------++The 'include' preprocessor for extracting literate programming fragments+(used in this and most of the other sections of the tutorial) has been+lifted out of the main preprocessor into its own example.++Here is sed script that makes up the main loop.++%include "examples/re-include.lhs" "loop ::"++The `extract` action takes the path to the file containing the fragment+and the RE that will match a line in the fragment and returns the text+of the fragment (wrapped in a simple styling div).++%include "examples/re-include.lhs" "extract ::"++And here is the scanner for recognising the literate fragments.++%include "examples/re-include.lhs" "scan ::"++See [examples/re-include.lhs](re-include.html)+++Example: literate preprocessor+------------------------------++The preprocessor that converts this literate Haskell program into a web+page and a test suite that makes plenty of use of regex is in+[examples/re-pp.lhs](re-pp.html).+++Example: gen-modules+--------------------++The many TDFA and PCRE API modules (but _not_ the `RE` modules) are all+generated from `Text.RE.TDFA.ByteString.Lazy` with+[examples/re-gen-modules.lhs](re-gen-modules.html) which is also an+application of regex.+++\begin{code}+main :: IO ()+main = runTests+ [ evalme_TPL_00+ , evalme_PMC_00+ , evalme_REU_01+ , evalme_OPT_01+ , evalme_OPT_00+ , evalme_MAC_00+ , evalme_RPF_02+ , evalme_RPF_01+ , evalme_SOP_06+ , evalme_SOP_05+ , evalme_SOP_04+ , evalme_SOP_03+ , evalme_SOP_02+ , evalme_SOP_01+ , evalme_RPL_02+ , evalme_RPL_01+ , evalme_MLT_03+ , evalme_MLT_02+ , evalme_MLT_01+ , evalme_SGL_02+ , evalme_SGL_01+ , evalme_TRD_04+ , evalme_TRD_02+ , evalme_TRD_01+ , evalme_TRD_00+ , evalme_LOA_00+ ]+\end{code}+
+ regex.cabal view
@@ -0,0 +1,317 @@+Name: regex+Version: 0.0.0.1+Synopsis: A Regular Expression Toolkit for regex-base+Description: A Regular Expression Toolkit for regex-base with+ Compile-time checking of RE syntax, data types for+ matches and captures, a text replacement toolkit,+ portable options, high-level Awk-like tools+ for building text processing apps, regular expression+ macros and test bench, a tutorial and copious examples.+Homepage: https://iconnect.github.io/regex+Author: Chris Dornan+License: BSD3+license-file: LICENSE+Maintainer: chris.dornan@irisconnect.co.uk+Copyright: Chris Dornan+Category: Text+Build-type: Simple+Stability: rfc+Extra-source-files: changelog+bug-reports: https://github.com/iconnect/regex/issues++Cabal-version: >= 1.14++Source-repository head+ type: git+ location: git://github.com/iconnect/regex.git++Source-Repository this+ Type: git+ Location: git://github.com/iconnect/regex.git+ Tag: 0.0.0.1++Library+ Exposed-modules:+ Text.RE+ Text.RE.Capture+ Text.RE.CaptureID+ Text.RE.Edit+ Text.RE.Internal.NamedCaptures+ Text.RE.IsRegex+ Text.RE.LineNo+ Text.RE.Options+ Text.RE.Parsers+ Text.RE.PCRE+ Text.RE.PCRE.ByteString+ Text.RE.PCRE.ByteString.Lazy+ Text.RE.PCRE.RE+ Text.RE.PCRE.Sequence+ Text.RE.PCRE.String+ Text.RE.Replace+ Text.RE.TDFA+ Text.RE.TDFA.ByteString+ Text.RE.TDFA.ByteString.Lazy+ Text.RE.TDFA.RE+ Text.RE.TDFA.Sequence+ Text.RE.TDFA.String+ Text.RE.TDFA.Text+ Text.RE.TDFA.Text.Lazy+ Text.RE.TestBench+ Text.RE.Tools.Grep+ Text.RE.Tools.Lex+ Text.RE.Tools.Sed++ Other-modules:+ Text.RE.Internal.AddCaptureNames+ Text.RE.Internal.PreludeMacros+ Text.RE.Internal.QQ++ Build-depends:+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ containers >= 0.4 ,+ hashable >= 1.2.3.3 ,+ heredoc >= 0.2.0.0 ,+ hsyslog >= 2 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.1 ,+ regex-tdfa-text >= 1.0.0.3 ,+ regex-pcre-builtin >= 0.94.4.8.8.35 ,+ smallcheck >= 1.1.1 ,+ tasty >= 0.10.1.2 ,+ tasty-hunit >= 0.9.2 ,+ tasty-smallcheck >= 0.8.1 ,+ template-haskell >= 2.7 ,+ transformers >= 0.2.2 ,+ text >= 1.2.1.3 ,+ time >= 1.5.0.1 ,+ unordered-containers >= 0.2.5.1++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs+++Executable re-gen-modules+ Hs-Source-Dirs: examples++ Main-is: re-gen-modules.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 ,+ directory >= 1.2.1.0 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.0 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Executable re-include+ Hs-Source-Dirs: examples++ Main-is: re-include.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Test-Suite re-include-test+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples++ Main-is: re-include.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ bytestring >= 0.10.2.0 ,+ base >= 4 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Test-Suite re-gen-modules-test+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples++ Main-is: re-gen-modules.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ directory >= 1.2.1.0 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.0 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Test-Suite re-nginx-log-processor+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples++ Main-is: re-nginx-log-processor.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ directory >= 1.2.1.0 ,+ hsyslog >= 2.0 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.0 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3 ,+ time >= 1.5.0.1 ,+ transformers >= 0.3.0.0 ,+ unordered-containers >= 0.2.5.1+++Executable re-pp+ Hs-Source-Dirs: examples++ Main-is: re-pp.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Other-modules:+ TestKit++ Build-depends:+ regex ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ directory >= 1.2.1.0 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Test-Suite re-pp-test+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples++ Main-is: re-pp.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Other-modules:+ TestKit++ Build-depends:+ regex ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ directory >= 1.2.1.0 ,+ shelly >= 1.6.3.4 ,+ text >= 1.2.1.3+++Test-Suite re-tests+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples++ Main-is: re-tests.lhs++ Default-Language: Haskell2010+ GHC-Options:+ -Wall+ -fwarn-tabs++ Other-modules:+ TestKit++ Build-depends:+ regex ,+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ containers >= 0.4 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.0 ,+ regex-tdfa-text >= 1.0.0.3 ,+ regex-pcre-builtin >= 0.94.4.8.8.35 ,+ tasty >= 0.10.1.2 ,+ tasty-hunit >= 0.9.2 ,+ text >= 1.2.1.3+++Test-Suite re-tutorial+ type: exitcode-stdio-1.0+ Hs-Source-Dirs: examples .++ Main-is: re-tutorial.lhs++ Other-modules:+ TestKit++ Default-Language: Haskell2010+ Default-Extensions: QuasiQuotes+ GHC-Options:+ -Wall+ -fwarn-tabs++ Build-depends:+ regex ,+ array >= 0.4 ,+ bytestring >= 0.10.2.0 ,+ base >= 4 && < 5 ,+ containers >= 0.4 ,+ hashable >= 1.2.3.3 ,+ heredoc >= 0.2.0.0 ,+ hsyslog >= 2 ,+ regex-base >= 0.93.2 ,+ regex-tdfa >= 1.2.1 ,+ regex-tdfa-text >= 1.0.0.3 ,+ regex-pcre-builtin >= 0.94.4.8.8.35 ,+ shelly >= 1.6.3.4 ,+ smallcheck >= 1.1.1 ,+ tasty >= 0.10.1.2 ,+ tasty-hunit >= 0.9.2 ,+ tasty-smallcheck >= 0.8.1 ,+ template-haskell >= 2.7 ,+ transformers >= 0.2.2 ,+ text >= 1.2.1.3 ,+ time >= 1.5.0.1 ,+ unordered-containers >= 0.2.5.1