rex 0.1 → 0.2
raw patch · 4 files changed
+166/−132 lines, 4 filesdep ~ghc
Dependency ranges changed: ghc
Files
- Test.hs +14/−12
- Text/Regex/PCRE/Precompile.hs +7/−6
- Text/Regex/PCRE/Rex.hs +141/−110
- rex.cabal +4/−4
Test.hs view
@@ -3,31 +3,31 @@ module Test where import Text.Regex.PCRE.Rex-import Data.Maybe (catMaybes) --- main = interact (unlines . map (show . math) . lines)+import qualified Data.ByteString.Char8 as B+import Data.Maybe (catMaybes, isJust) math x = mathl x 0 mathl [] x = x-mathl [rex|^ \s*(?{ y }\d+)\s*(?{ id -> s }.*)$|] x = mathl s y-mathl [rex|^\+\s*(?{ y }\d+)\s*(?{ id -> s }.*)$|] x = mathl s $ x + y-mathl [rex|^ -\s*(?{ y }\d+)\s*(?{ id -> s }.*)$|] x = mathl s $ x - y-mathl [rex|^\*\s*(?{ y }\d+)\s*(?{ id -> s }.*)$|] x = mathl s $ x * y-mathl [rex|^ /\s*(?{ y }\d+)\s*(?{ id -> s }.*)$|] x = mathl s $ x / y+mathl [rex|^ \s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s y+mathl [rex|^\+\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x + y+mathl [rex|^ -\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x - y+mathl [rex|^\*\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x * y+mathl [rex|^ /\s*(?{ read -> y }\d+)\s*(?{ s }.*)$|] x = mathl s $ x / y mathl str x = error str peano :: String -> Maybe Int peano = [rex|^(?{ length . filter (=='S') } \s* (?:S\s+)*Z)\s*$|] -vect2d :: String -> Maybe (Int, Int)-vect2d = [rex|^<\s* (?{}\d+) \s*,\s* (?{}\d+) \s*>$|]+parsePair :: String -> Maybe (String, String)+parsePair = [rex|^<\s* (?{ }[^\s,>]+) \s*,\s* (?{ }[^\s,>]+) \s*>$|] -- From http://www.regular-expressions.info/dates.html parseDate :: String -> Maybe (Int, Int, Int)-parseDate [rex|^(?{ y }(?:19|20)\d\d)[- /.]- (?{ m }0[1-9]|1[012])[- /.]- (?{ d }0[1-9]|[12][0-9]|3[01])$|]+parseDate [rex|^(?{ read -> y }(?:19|20)\d\d)[- /.]+ (?{ read -> m }0[1-9]|1[012])[- /.]+ (?{ read -> d }0[1-9]|[12][0-9]|3[01])$|] | (d > 30 && (m `elem` [4, 6, 9, 11])) || (m == 2 && (d ==29 && not (mod y 4 == 0 && (mod y 100 /= 0 || mod y 400 == 0)))@@ -44,3 +44,5 @@ | (?{nonNull $ Just . head -> b} ..) | (?{nonNull $ Just . last -> c} ...))$|] = head $ catMaybes [a, b, c]++btest = [brex|(?{}hello)|] (B.pack "hello") == Just (B.pack "hello")
Text/Regex/PCRE/Precompile.hs view
@@ -32,15 +32,16 @@ import Text.Regex.PCRE.Light import Text.Regex.PCRE.Light.Base +type CompiledBytes = B.ByteString+ -- | Compiles the given regular expression, and assuming nothing bad -- happens, yields the bytestring filled with PCRE's compiled -- representation.-precompile :: B.ByteString -> [PCREOption] -> IO (Maybe B.ByteString)+precompile :: B.ByteString -> [PCREOption] -> IO (Maybe CompiledBytes) precompile pat opts = regexToTable $ compile pat opts --- | Takes a compiled regular expression adn yields its bytestring--- representation.-regexToTable :: Regex -> IO (Maybe B.ByteString)+-- | Takes a compiled regular expression, and yields .+regexToTable :: Regex -> IO (Maybe CompiledBytes) regexToTable (Regex p _) = withForeignPtr p $ \pcre -> alloca $ \res -> do success <- c_pcre_fullinfo pcre nullPtr info_size res@@ -49,8 +50,8 @@ then withForeignPtr p (liftM Just . unsafePackCStringLen . (, len) . castPtr) else return Nothing --- | Creates a regular expression-regexFromTable :: B.ByteString -> IO Regex+-- | Creates a regular expression from the compiled representation.+regexFromTable :: CompiledBytes -> IO Regex regexFromTable bytes = unsafeUseAsCString bytes $ \cstr -> do ptr <- newForeignPtr_ (castPtr cstr) return $ Regex ptr bytes
Text/Regex/PCRE/Rex.hs view
@@ -17,14 +17,19 @@ -- 2) Arity of resulting tuple based on the number of selected capture patterns -- in the regular expression. ----- 3) By default utilizes type inference to determine how to parse capture--- patterns - uses the 'read' function's return-type polymorphism------ 4) Allows for the inline interpolation of a mapping function String -> a.+-- 3) Allows for the inline interpolation of mapping functions :: String -> a. ----- 5) Precompiles the regular expression at compile time, by calling into the+-- 4) Precompiles the regular expression at compile time, by calling into the -- PCRE library and storing a ByteString literal representation of its state. --+-- 5) Compile-time configurable to use different PCRE options, turn off+-- precompilation, or use ByteStrings.+--+-- Since this is a quasiquoter library that generates code using view patterns,+-- the following extensions are required:+--+-- > {-# LANGUAGE TemplateHaskell, QuasiQuotes, ViewPatterns #-}+-- -- Here's a silly example which parses peano numbers of the form Z, S Z, -- S S Z, etc. The \s+ means that it is not sensitive to the quantity or type -- of seperating whitespace. (these examples can also be found in Test.hs)@@ -43,40 +48,38 @@ -- > *Main> peano "invalid" -- > Nothing ----- The token \"(?{\" introduces a capture group which has a mapping applied to the--- result - in this case \"length . filter (=='S')\". If an expression is omitted, --- e.g. \"(?{} ... )\", then there is an implicit usage of the read function.--- --- If the ?{ ... } are omitted, then the capture group is not taken as part of--- the results of the match.--- --- > vect2d :: String -> Maybe (Int, Int)--- > vect2d = [rex|^<\s* (?{}\d+) \s*,\s* (?{}\d+) \s*>$|]+-- The token \"(?{\" introduces a capture group which has a mapping applied to+-- the -- result - in this case \"length . filter (=='S')\". If the ?{ ... }+-- are omitted, then the capture group is not taken as part of the results of+-- the match. If the contents of the ?{ ... } is omitted, then "id" is assumed: ----- The following example is derived from http://www.regular-expressions.info/dates.html+-- parsePair :: String -> Maybe (String, String)+-- parsePair = [rex|^<\s* (?{ }[^\s,>]+) \s*,\s* (?{ }[^\s,>]+) \s*>$|] --+-- The following example is derived from+-- http://www.regular-expressions.info/dates.html+-- -- > parseDate :: String -> Maybe (Int, Int, Int)--- > parseDate [rex|^(?{ y }(?:19|20)\d\d)[- /.]--- > (?{ m }0[1-9]|1[012])[- /.]--- > (?{ d }0[1-9]|[12][0-9]|3[01])$|]+-- > parseDate [rex|^(?{ read -> y }(?:19|20)\d\d)[- /.]+-- > (?{ read -> m }0[1-9]|1[012])[- /.]+-- > (?{ read -> d }0[1-9]|[12][0-9]|3[01])$|] -- > | (d > 30 && (m `elem` [4, 6, 9, 11])) -- > || (m == 2 &&--- > (d == 29 && not (mod y 4 == 0 && (mod y 100 /= 0 || mod y 400 == 0)))+-- > (d == 29 && not (mod y 4 == 0 && (mod y 100 /= 0 || mod y 400 == 0))) -- > || (d > 29)) = Nothing -- > | otherwise = Just (y, m, d) -- > parseDate _ = Nothing -- -- The above example makes use of the regex quasi-quoter as a pattern matcher. -- The interpolated Haskell patterns are used to construct an implicit view--- pattern. The above pattern is expanded to the equivalent:+-- pattern out of the inlined ones. The above pattern is expanded to the+-- equivalent: ----- > parseDate ([rex|^(?{}(?:19|20)\d\d)[- /.]--- > (?{}0[1-9]|1[012])[- /.]--- > (?{}0[1-9]|[12][0-9]|3[01])$|]+-- > parseDate ([rex|^(?{ read }(?:19|20)\d\d)[- /.]+-- > (?{ read }0[1-9]|1[012])[- /.]+-- > (?{ read }0[1-9]|[12][0-9]|3[01])$|] -- > -> Just (y, m, d)) ----- In order to provide a capture-mapper along with a pattern, use view-patterns--- inside the interpolation brackets. -- -- Caveat: Since haskell-src-exts does not support parsing view-patterns, the -- above is implemented as a relatively naive split on \"->\". It presumes that@@ -84,7 +87,7 @@ -- expression on the left. This allows for lambdas to be present in the -- expression, but prevents nesting view patterns. ----- There are a few other inelegances:+-- There are also a few other inelegances: -- -- 1) PCRE captures, unlike .NET regular expressions, yield the last capture -- made by a particular pattern. So, for example, (...)*, will only yield one@@ -96,14 +99,30 @@ -- a single variable / pattern, preferring the first non-empty option. The -- general logic for this is a bit complicated, and postponed for a later -- release.+-- +-- 3) While this error is believed to no longer exist, the following error+-- +-- > <interactive>: out of memory (requested 17584491593728 bytes) --+-- Used to occur when evaluating in GHCi, due to a bug in the way precompilation+-- worked. If this happens, please report it, and as a temporary work around,+-- make your own quasiquoter using \"rexConf _ False _ _\" to disable+-- pre-compilation.+-- -- Since pcre-light is a wrapper over a C API, the most efficient interface is -- ByteStrings, as it does not natively speak Haskell lists. The [rex| ... ] -- quasiquoter implicitely packs the input into a bystestring, and unpacks the--- results to strings before providing them to your mappers. Use [brex| ... ]--- to bypass this, and process raw ByteStrings. In order to preserve the--- same default behavior, \"read . unpack\" is the default mapper for brex.+-- results to strings before providing them to your mappers. The \"brex\"+-- QuasiQuoter is provided for this purpose. You can also define your own+-- QuasiQuoter - the definitions of the default configurations are as follows: --+-- > rex = rexConf False True rexPCREOpts rexPCREExecOpts+-- > brex = rexConf True True rexPCREOpts rexPCREExecOpts+--+-- As mentioned, the other Bool determines whether precompilation is used.+-- Due to GHC staging restrictions, your configuration will need to be in a+-- different module than its usage.+-- -- Inspired by / copy-modified from Matt Morrow's regexqq package: -- <http://hackage.haskell.org/packages/archive/regexqq/latest/doc/html/src/Text-Regex-PCRE-QQ.html> --@@ -112,9 +131,11 @@ -- ----------------------------------------------------------------------------- -module Text.Regex.PCRE.Rex (rex, brex, maybeRead, padRight) where+module Text.Regex.PCRE.Rex (+ rex, brex, maybeRead, padRight, rexConf, rexPCREOpts, rexPCREExecOpts) where import qualified Text.Regex.PCRE.Light as PCRE+import qualified Text.Regex.PCRE.Light.Base as PCRE import Text.Regex.PCRE.Precompile import Control.Arrow (first, second)@@ -135,29 +156,47 @@ import System.IO.Unsafe (unsafePerformIO) +{- TODO:+ * Fix mentioned caveats+ * Target Text.Regex.Base ? + * Provide a variant which allows splicing in an expression that evaluates to+ regex string.+ * Add unit tests+-}+ type ParseChunk = Either String (Int, String) type ParseChunks = (Int, String, [(Int, String)])+type Config = (Bool, Bool, [PCRE.PCREOption], [PCRE.PCREExecOption]) -{- TODO: idea - provide a variant which allows splicing in an expression- that evaluates to regex string. The tricky thing here is that this- splice might contain capture groups - thus, the parser here would need to- be referenced in order to dispatch --}+-- | Default regular expression quasiquoter for Strings, and ByteStrings.+rex, brex :: QuasiQuoter+rex = rexConf False True rexPCREOpts rexPCREExecOpts+brex = rexConf True True rexPCREOpts rexPCREExecOpts -{- TODO: target Text.Regex.Base -} --- | The regular expression quasiquoter for strings.-rex, brex :: QuasiQuoter-rex = QuasiQuoter- (makeExp False . parseIt)- (makePat False . parseIt)- undefined undefined+rexPCREOpts :: [PCRE.PCREOption]+rexPCREOpts =+ [ PCRE.extended+ , PCRE.multiline ]+ -- , dotall, caseless, utf8+ -- , newline_any, PCRE.newline_crlf ] --- | The regular expression quasiquoter for Data.ByteString.Char8.-brex = QuasiQuoter- (makeExp True . parseIt)- (makePat True . parseIt)+rexPCREExecOpts :: [PCRE.PCREExecOption]+rexPCREExecOpts = []+ -- [ PCRE.exec_newline_crlf+ -- , exec_newline_any, PCRE.exec_notempty+ -- , PCRE.exec_notbol, PCRE.exec_noteol ]++-- | A configureable regular-expression QuasiQuoter. Takes the options to pass+-- to the PCRE engine, along with Bools to flag ByteString usage and+-- non-compilation respecively.+rexConf :: Bool -> Bool -> [PCRE.PCREOption] -> [PCRE.PCREExecOption] -> QuasiQuoter+rexConf bs pc os eos = QuasiQuoter+ (makeExp conf . parseIt)+ (makePat conf . parseIt) undefined undefined+ where+ conf = (bs, pc, [PCRE.combineOptions os], [PCRE.combineExecOptions eos]) -- Template Haskell Code Generation -------------------------------------------------------------------------------@@ -166,9 +205,9 @@ -- regex. This particular code mainly just handles making "read" the -- default for captures which lack a parser definition, and defaulting to making -- the parser that doesn't exist-makeExp :: Bool -> ParseChunks -> ExpQ-makeExp bs (cnt, pat, exs) = buildExp bs cnt pat- . map (liftM (processExp bs) . snd . head)+makeExp :: Config -> ParseChunks -> ExpQ+makeExp conf (cnt, pat, exs) = buildExp conf cnt pat+ . map (liftM processExp . snd . head) . groupSortBy (comparing fst) $ map (second Just) exs ++ [(i, Nothing) | i <- [0..cnt]] @@ -178,24 +217,23 @@ -- -- E.g. [reg| ... (?{e1 -> v1} ...) ... (?{e2 -> v2} ...) ... |] becomes -- [reg| ... (?{e1} ...) ... (?{e2} ...) ... |] -> (v1, v2)-makePat :: Bool -> ParseChunks -> PatQ-makePat bs (cnt, pat, exs) = do- viewExp <- buildExp bs cnt pat $ map (liftM fst) views+makePat :: Config -> ParseChunks -> PatQ+makePat conf (cnt, pat, exs) = do+ viewExp <- buildExp conf cnt pat $ map (liftM fst) views return . ViewP viewExp . (\xs -> ConP (mkName "Just") [TupP xs]) . map snd $ catMaybes views where views :: [Maybe (Exp, Pat)] views = map (floatSnd . processView . snd . head)- . groupSortBy (comparing fst)- $ exs ++ [(i, "") | i <- [0..cnt]]+ . groupSortBy (comparing fst) $ exs processView :: String -> (Exp, Maybe Pat) processView xs = case splitFromBack 2 ((split . onSublist) "->" xs) of- (_, [r]) -> onSpace (error $ "blank pattern in: " ++ r)- ((processExp bs "",) . processPat) r+ (_, [r]) -> onSpace r (error $ "blank pattern in view: " ++ r)+ ((processExp "",) . processPat) -- View pattern- (l, [_, r]) -> (processExp bs $ concat l, processPat r)+ (l, [_, r]) -> (processExp $ concat l, processPat r) -- Included so that Haskell doesn't warn about non-exhaustive patterns -- (even though the above are exhaustive in this context) _ -> undefined@@ -203,45 +241,52 @@ -- Here's where the main meat of the template haskell is generated. Given the -- number of captures, the pattern string, and a list of capture expressions, -- yields the template Haskell Exp which parses a string into a tuple.-buildExp :: Bool -> Int -> String -> [Maybe Exp] -> ExpQ-buildExp bs cnt pat xs = if bs- then [| let r = unsafePerformIO (regexFromTable $! $(table_bytes)) in - liftM ( $(return maps) . padRight B.empty pad )- . (flip $ PCRE.match r) pcreExecOpts |]- else [| let r = unsafePerformIO (regexFromTable $! $(table_bytes)) in- liftM ( $(return maps) . padRight "" pad . map B.unpack )- . flip (PCRE.match r) pcreExecOpts . B.pack |]- where pad = cnt + 2- --TODO: make sure this takes advantage of bytestring fusion stuff - is- -- the right pack / unpack. Or use XOverloadedStrings- table_bytes = [| B.pack $(runIO table_string) |]- table_string = precompile (B.pack pat) pcreOpts >>= - return . LitE . StringL . B.unpack . - forceMaybeMsg "Error while getting PCRE compiled representation\n"- vs = [mkName $ "v" ++ show i | i <- [0..cnt]]- maps = LamE [ListP . (WildP:) $ map VarP vs]- (TupE . map (uncurry AppE)- -- filter out all "Nothing" exprs- . map (first fromJust) . filter (isJust . fst)- -- [(Expr, Variable applied to)]- . zip xs $ map VarE vs)+buildExp :: Config -> Int -> String -> [Maybe Exp] -> ExpQ+buildExp (bs, nc, pcreOpts, pcreExecOpts) cnt pat xs =+ [| let r = $(get_regex) in+ $(process) . (flip $ PCRE.match r) $(liftRS pcreExecOpts)+ . $(if bs then [| id |] else [| B.pack |]) |]+ where+ pad = cnt + 2 --- Default parsers, one for the bytestring case and one for the string.-defaultExp :: Bool -> String-defaultExp True = "read . unpack"-defaultExp False = "read"+ liftRS x = [| read shown |]+ where shown = show x --- Parse a Haskell expression into a template Haskell Exp, yielding the--- default for strings which just consist of whitespace.-processExp :: Bool -> String -> Exp-processExp bs xs = forceEitherMsg ("Error while parsing capture mapper " ++ xs)- . parseExp . onSpace (defaultExp bs) id $ xs+ --TODO: make sure this takes advantage of bytestring fusion stuff - is+ -- the right pack / unpack. Or use XOverloadedStrings+ get_regex = if nc+ then [| unsafePerformIO (regexFromTable $! $(table_bytes)) |]+ else [| PCRE.compile (B.pack pat) $(liftRS pcreOpts)|]+ table_bytes = [| B.pack $(runIO table_string) |]+ table_string = precompile (B.pack pat) pcreOpts >>= + return . LitE . StringL . B.unpack . + forceMaybeMsg "Error while getting PCRE compiled representation\n" --- Parse a Haskell pattern match into a template Haskell Pat, yielding Nothing for--- strings which just consist of whitespace.+ process = case (null vs, bs) of+ (True, _) -> [| liftM ( const () ) |]+ (_, False) -> [| liftM (($(return maps)) . padRight "" pad . map B.unpack) |]+ (_, True) -> [| liftM (($(return maps)) . padRight B.empty pad) |]+ maps = LamE [ListP . (WildP:) $ map VarP vs]+ . TupE . map (uncurry AppE)+ -- filter out all "Nothing" exprs+ . map (first fromJust) . filter (isJust . fst)+ -- [(Expr, Variable applied to)]+ . zip xs $ map VarE vs+ vs = [mkName $ "v" ++ show i | i <- [0..cnt]]++-- Parse a Haskell expression into a template Haskell Exp+processExp :: String -> Exp+processExp xs+ = forceEitherMsg ("Error while parsing capture mapper `" ++ xs ++ "'")+ . parseExp $ onSpace xs "id" id++-- Parse a Haskell pattern match into a template Haskell Pat, yielding Nothing+-- for patterns which consist of just whitespace. processPat :: String -> Maybe Pat-processPat xs = onSpace Nothing- (Just . forceEitherMsg ("Error while parsing capture pattern " ++ xs) . parsePat) xs+processPat xs = onSpace xs Nothing+ $ Just + . forceEitherMsg ("Error while parsing capture pattern `" ++ xs ++ "'")+ . parsePat -- Parsing -------------------------------------------------------------------------------@@ -251,7 +296,8 @@ parseIt :: String -> ParseChunks parseIt xs = ( cnt, concat [x | Left x <- results] , [(i, x) | Right (i, x) <- results])- where (cnt, results) = parseRegex (filter (`notElem` "\r\n") xs) "" (-1)+ where+ (cnt, results) = parseRegex (filter (`notElem` "\r\n") xs) "" (-1) -- A pair of mutually-recursive functions, one for processing the quotation -- and the other for the anti-quotation.@@ -294,8 +340,6 @@ (x:xs) -> parseHaskell xs (x:s) ix [] -> error "Regular-expression Haskell splice is never terminated with a trailing }" --- TODO: provide bytestring variant.- -- Utils ------------------------------------------------------------------------------- @@ -308,19 +352,6 @@ -- of the quasiquote. Would also be a juncture for informing arity / -- extension information. -pcreOpts :: [PCRE.PCREOption]-pcreOpts =- [ PCRE.extended- , PCRE.multiline ]- -- , dotall, caseless, utf8- -- , newline_any, PCRE.newline_crlf ]--pcreExecOpts :: [PCRE.PCREExecOption]-pcreExecOpts = []- -- [ PCRE.exec_newline_crlf- -- , exec_newline_any, PCRE.exec_notempty- -- , PCRE.exec_notbol, PCRE.exec_noteol ]- groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] groupSortBy f = groupBy (\x -> (==EQ) . f x) . sortBy f @@ -328,8 +359,8 @@ splitFromBack i xs = (reverse b, reverse a) where (a, b) = splitAt i $ reverse xs -onSpace :: a -> (String -> a) -> String -> a-onSpace x f s | all isSpace s = x+onSpace :: String -> a -> (String -> a) -> a+onSpace s x f | all isSpace s = x | otherwise = f s -- | Given a desired list-length, if the passed list is too short, it is padded
rex.cabal view
@@ -1,5 +1,5 @@ Name: rex-Version: 0.1+Version: 0.2 Synopsis: A quasi-quoter for typeful results of regex captures. Description: Provides a quasi-quoter for regular expressions which yields a tuple, of appropriate arity and types,@@ -29,7 +29,7 @@ Library Extensions: TemplateHaskell, QuasiQuotes, TupleSections, ViewPatterns Exposed-modules: Text.Regex.PCRE.Rex, Text.Regex.PCRE.Precompile- Build-depends: base >= 3.0 && < 6, template-haskell >= 2.5.0.0,- haskell-src-meta, MissingH, bytestring, pcre-light,- split, containers, ghc >= 7+ Build-depends: base >= 3.0 && < 6, bytestring, containers, ghc >= 7.0,+ haskell-src-meta, MissingH, pcre-light, split,+ template-haskell >= 2.5.0.0 Ghc-options: -Wall