rex 0.4.2 → 0.4.3
raw patch · 2 files changed
+132/−121 lines, 2 filesdep +haskell-src-extsdep −ghcdep −split
Dependencies added: haskell-src-exts
Dependencies removed: ghc, split
Files
- Text/Regex/PCRE/Rex.hs +123/−116
- rex.cabal +9/−5
Text/Regex/PCRE/Rex.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, TupleSections, ViewPatterns #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- |@@ -8,12 +12,12 @@ -- Maintainer : Michael Sloan (mgsloan@gmail.com) -- Stability : unstable -- Portability : unportable--- +-- -- This module provides a template Haskell quasiquoter for regular -- expressions, which provides the following features:--- +-- -- 1) Compile-time checking that the regular expression is valid.--- +-- -- 2) Arity of resulting tuple based on the number of selected capture patterns -- in the regular expression. --@@ -81,12 +85,6 @@ -- > -> Just (y, m, d)) -- ----- Caveat: Since haskell-src-exts does not support parsing view-patterns, the--- above is implemented as a relatively naive split on \"->\". It presumes that--- the last \"->\" in the interpolated pattern seperates the pattern from an--- expression on the left. This allows for lambdas to be present in the--- expression, but prevents nesting view patterns.--- -- There are also a few other inelegances: -- -- 1) PCRE captures, unlike .NET regular expressions, yield the last capture@@ -108,7 +106,7 @@ -- 'QuasiQuoter' - the definitions of the default configurations are as follows: -- -- > rex = rexWithConf $ defaultRexConf--- > brex = rexWithConf $ defaultRexConf { rexByteString = True } +-- > brex = rexWithConf $ defaultRexConf { rexByteString = True } -- > -- > defaultRexConf = RexConf False True "id" [PCRE.extended] [] --@@ -144,28 +142,29 @@ import Control.Applicative ( (<$>) ) import Control.Arrow ( first )-import Control.Monad ( liftM ) import Data.ByteString.Char8 ( pack, unpack, empty )-import Data.List ( find )-import Data.List.Split ( split, onSublist )+import Data.Either ( partitionEithers ) import Data.Maybe ( catMaybes, listToMaybe, fromJust, isJust ) import Data.Char ( isSpace ) import System.IO.Unsafe ( unsafePerformIO ) import Language.Haskell.TH import Language.Haskell.TH.Quote-import Language.Haskell.Meta.Parse+import Language.Haskell.Meta (toExp,toPat)+import Language.Haskell.Exts.Extension (Extension(..), KnownExtension(..))+import Language.Haskell.Exts (parseExpWithMode, parsePatWithMode,+ ParseMode, defaultParseMode, extensions,+ ParseResult(..)) {- TODO:- * Benchmark- * Target Text.Regex.Base ? + * Target Text.Regex.Base ? * Add unit tests -} data RexConf = RexConf { rexByteString :: Bool , rexCompiled :: Bool- , rexView :: String + , rexView :: String , rexPCREOpts :: [PCRE.PCREOption] , rexPCREExecOpts :: [PCRE.PCREExecOption] }@@ -176,135 +175,146 @@ rex = rexWithConf $ defaultRexConf brex = rexWithConf $ defaultRexConf { rexByteString = True } --- | This is a 'QuasiQuoter' transformer, which allows for a whitespace-sensitive--- quasi-quoter to be broken over multiple lines. The default 'rex' and--- 'brex' functions do not need this as they are already whitespace insensitive.--- However, if you create your own configuration, which omits the 'PCRE.extended'--- parameter, then this could be useful. The leading space of each line is--- ignored, and all newlines removed.+-- | This is a 'QuasiQuoter' transformer, which allows for a whitespace-+-- sensitive quasi-quoter to be broken over multiple lines. The default 'rex'+-- and 'brex' functions do not need this as they are already whitespace+-- insensitive. However, if you create your own configuration, which omits the+-- 'PCRE.extended' parameter, then this could be useful. The leading space of+-- each line is ignored, and all newlines removed. makeQuasiMultiline :: QuasiQuoter -> QuasiQuoter-makeQuasiMultiline (QuasiQuoter a b c d)- = QuasiQuoter (a . pre) (b . pre) (c . pre) (d . pre)- where- pre = concat . (\(x:xs) -> x : map (dropWhile isSpace) xs) . lines+makeQuasiMultiline (QuasiQuoter a b c d) =+ QuasiQuoter (a . pre) (b . pre) (c . pre) (d . pre)+ where+ pre = concat . (\(x:xs) -> x : map (dropWhile isSpace) xs) . lines -- | Default rex configuration, which specifies that the regexes operate on--- strings, don't postprocess the matched patterns, and use 'PCRE.extended'.--- This setting causes whitespace to be nonsemantic, and ignores # comments.+-- strings, don't postprocess the matched patterns, and use 'PCRE.extended'.+-- This setting causes whitespace to be nonsemantic, and ignores # comments. defaultRexConf :: RexConf defaultRexConf = RexConf False False "id" [PCRE.extended] [] -- | A configureable regular-expression QuasiQuoter. Takes the options to pass--- to the PCRE engine, along with 'Bool's to flag 'ByteString' usage and--- non-compilation respecively. The provided 'String' indicates which mapping--- function to use, when one is omitted - \"(?{} ...)\".+-- to the PCRE engine, along with 'Bool's to flag 'ByteString' usage and+-- non-compilation respecively. The provided 'String' indicates which mapping+-- function to use, when one is omitted - \"(?{} ...)\". rexWithConf :: RexConf -> QuasiQuoter-rexWithConf conf- = QuasiQuoter- (makeExp conf . parseIt)- (makePat conf . parseIt)- undefined- undefined+rexWithConf conf =+ QuasiQuoter+ (makeExp conf . parseRex)+ (makePat conf . parseRex)+ undefined+ undefined -- Template Haskell Code Generation--------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -- Creates the template haskell Exp which corresponds to the parsed interpolated -- 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 :: RexConf -> ParseChunks -> ExpQ-makeExp conf (cnt, pat, exs) = buildExp conf cnt pat exs'- where- exs' = map (\ix -> liftM (processExp conf . snd) $ find ((==ix) . fst) exs) [0..cnt]- +makeExp conf (cnt, pat, exs) = buildExp conf cnt pat $+ map (fmap $ forceEitherMsg "makeExp" . parseExp conf) exs+ -- Creates the template haskell Pat which corresponds to the parsed interpolated -- regex. As well as handling the aforementioned defaulting considerations, this -- turns per-capture view patterns into a single tuple-resulting view pattern.--- +-- -- E.g. [reg| ... (?{e1 -> v1} ...) ... (?{e2 -> v2} ...) ... |] becomes -- [reg| ... (?{e1} ...) ... (?{e2} ...) ... |] -> (v1, v2) makePat :: RexConf -> ParseChunks -> PatQ makePat conf (cnt, pat, exs) = do- viewExp <- buildExp conf cnt pat $ map (liftM fst) views+ viewExp <- buildExp conf cnt pat $ map (fmap fst) views return . ViewP viewExp- . (\xs -> ConP (mkName "Just") [TupP xs])+ . (\xs -> ConP 'Just [TupP xs]) . map snd $ catMaybes views where views :: [Maybe (Exp, Pat)]- views = map (\ix -> liftM (processView . snd) $ find ((==ix).fst) exs) [0..cnt]+ views = map (fmap processView) exs processView :: String -> (Exp, Pat)- processView xs = case splitFromBack 2 ((split . onSublist) "->" xs) of- (_, [r]) -> onSpace r (error $ "blank pattern in view: " ++ r)- ((processExp conf "",) . processPat)- -- View pattern- (l, [_, r]) -> (processExp conf $ 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+ processView xs = case processPat ("("++xs++")") of+ ParseOk (ParensP (ViewP e p)) -> (e,p)+ ParseOk p -> (forceEitherMsg "impossible" (parseExp conf ""), p)+ ParseFailed _ b -> error b -- 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 :: RexConf -> Int -> String -> [Maybe Exp] -> ExpQ-buildExp conf cnt pat xs =- [| let r = $(get_regex) in- $(process) . (flip $ PCRE.match r) $(liftRS $ rexPCREExecOpts conf)- . $(if rexByteString conf then [| id |] else [| pack |]) |]- where- liftRS x = [| read shown |] where shown = show x+buildExp RexConf{..} cnt pat xs =+ [| let r = $(get_regex) in+ $(process) . (flip $ PCRE.match r) $(liftRS rexPCREExecOpts)+ . $(if rexByteString then [| id |] else [| pack |]) |]+ where+ liftRS x = [| read shown |] where shown = show x - --TODO: make sure this takes advantage of bytestring fusion stuff - is- -- the right pack / unpack. Or use XOverloadedStrings- get_regex - | rexCompiled conf = [| unsafePerformIO (regexFromTable $! $(table_bytes)) |]- | otherwise = [| PCRE.compile (pack pat) $(liftRS pcreOpts) |]- table_bytes = [| pack $(LitE . StringL . unpack <$> runIO table_string) |]- table_string- = forceMaybeMsg "Error while getting PCRE compiled representation\n"- <$> precompile (pack pat) pcreOpts- pcreOpts = rexPCREOpts conf+ --TODO: make sure this takes advantage of bytestring fusion stuff - is+ -- the right pack / unpack. Or use XOverloadedStrings+ get_regex+ | rexCompiled = [| unsafePerformIO (regexFromTable $! $(table_bytes)) |]+ | otherwise = [| PCRE.compile (pack pat) $(liftRS pcreOpts) |]+ table_bytes = [| pack $(LitE . StringL . unpack <$> runIO table_string) |]+ table_string =+ forceMaybeMsg "Error while getting PCRE compiled representation\n" <$>+ precompile (pack pat) pcreOpts+ pcreOpts = rexPCREOpts - process = case (null vs, rexByteString conf) of- (True, _) -> [| liftM ( const () ) |]- (_, False) -> [| liftM ($(return maps) . padRight "" pad . map unpack) |]- (_, True) -> [| liftM ($(return maps) . padRight empty pad) |]- pad = cnt + 2- 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]]+ process = case (null vs, rexByteString) of+ (True, _) -> [| fmap ( const () ) |]+ (_, False) -> [| fmap ($(return maps) . padRight "" pad . map unpack) |]+ (_, True) -> [| fmap ($(return maps) . padRight empty pad) |]+ pad = cnt + 2+ 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 :: RexConf -> String -> Exp-processExp conf xs- = forceEitherMsg ("Error while parsing capture mapper `" ++ xs ++ "'")- . parseExp $ onSpace xs (rexView conf) id+parseExp :: RexConf -> String -> ParseResult Exp+parseExp conf xs+ = fmap toExp+ . parseExpWithMode rexParseMode+ $ onSpace xs (rexView conf) id +-- probably the quasiquote should have access to the pragmas in the current+-- file, but for now just enable some common extensions that do not steal+-- much syntax+rexParseMode :: ParseMode+rexParseMode = defaultParseMode { extensions = map EnableExtension exts }+ where+ exts =+ [ ViewPatterns+ , ImplicitParams+ , RecordPuns+ , RecordWildCards+ , ScopedTypeVariables+ , TupleSections+ , TypeFamilies+ , TypeOperators+ ]+ -- Parse a Haskell pattern match into a template Haskell Pat, yielding Nothing -- for patterns which consist of just whitespace.-processPat :: String -> Pat-processPat xs- = forceEitherMsg ("Error while parsing capture pattern `" ++ xs ++ "'")- $ parsePat xs+processPat :: String -> ParseResult Pat+processPat xs = fmap toPat $ parsePatWithMode rexParseMode xs -- Parsing--------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -type ParseChunk = Either String (Int, String)-type ParseChunks = (Int, String, [(Int, String)])+type ParseChunk = Either String (Maybe String)+type ParseChunks = (Int, String, [Maybe String]) -- Postprocesses the results of the chunk-wise parse output, into the pattern to--- be pased to the regex engine, and the interpolated -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)+-- be pased to the regex engine, with the interpolated patterns / expressions.+parseRex :: String -> ParseChunks+parseRex xs = (cnt, concat chunks, quotes)+ where+ (chunks, quotes) = partitionEithers results+ (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.@@ -325,40 +335,37 @@ -- Anti-quote for processing a capture group. ('(':'?':'{':xs) -> mapSnd ((Left $ reverse ('(':s)) :)- $ parseHaskell xs "" (ix + 1)+ $ parseAntiquote xs "" (ix + 1) -- Keep track of how many capture groups we've seen.- ('(':xs) -> parseRegex xs ('(':s) (ix + 1)+ ('(':xs) -> mapSnd (Right Nothing :)+ $ parseRegex xs ('(':s) (ix + 1) -- Consume the regular expression contents. (x:xs) -> parseRegex xs (x:s) ix [] -> (ix, [Left $ reverse s]) -parseHaskell :: String -> String -> Int -> (Int, [ParseChunk])-parseHaskell inp s ix = case inp of+parseAntiquote :: String -> String -> Int -> (Int, [ParseChunk])+parseAntiquote inp s ix = case inp of -- Escape } in the Haskell splice using a backslash.- ('\\':'}':xs) -> parseHaskell xs ('}':s) ix+ ('\\':'}':xs) -> parseAntiquote xs ('}':s) ix -- Capture accumulated antiquote, and continue parsing regex literal.- ('}':xs) -> mapSnd ((Right (ix, reverse s)):)+ ('}':xs) -> mapSnd ((Right (Just (reverse s))):) $ parseRegex xs "" ix -- Consume the antiquoute contents, appending to a reverse accumulator.- (x:xs) -> parseHaskell xs (x:s) ix+ (x:xs) -> parseAntiquote xs (x:s) ix [] -> error "Rex haskell splice terminator, }, never found" -- Utils--------------------------------------------------------------------------------+-------------------------------------------------------------------------------- -- | A possibly useful utility function - yields 'Just' x when there is a -- valid parse, and 'Nothing' otherwise. maybeRead :: (Read a) => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads -splitFromBack :: Int -> [a] -> ([a], [a])-splitFromBack i xs = (reverse b, reverse a)- where (a, b) = splitAt i $ reverse xs- onSpace :: String -> a -> (String -> a) -> a onSpace s x f | all isSpace s = x | otherwise = f s@@ -382,6 +389,6 @@ forceMaybeMsg _ (Just x) = x {- | Like 'forceEither', but can raise a specific message with the error. -}-forceEitherMsg :: Show e => String -> Either e a -> a-forceEitherMsg msg (Left x) = error $ msg ++ ": " ++ show x-forceEitherMsg _ (Right x) = x+forceEitherMsg :: String -> ParseResult a -> a+forceEitherMsg msg (ParseFailed x _) = error $ msg ++ ": " ++ show x+forceEitherMsg _ (ParseOk x) = x
rex.cabal view
@@ -1,10 +1,10 @@ Name: rex-Version: 0.4.2+Version: 0.4.3 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,- representing the results of the captures. Allows the user - to specify parsers for captures as inline Haskell. Can + representing the results of the captures. Allows the user+ to specify parsers for captures as inline Haskell. Can also be used to provide typeful pattern matching in function definitions and pattern matches. Also, it precompiles the regular expressions into a PCRE@@ -30,7 +30,11 @@ Library Extensions: TemplateHaskell, QuasiQuotes, TupleSections, ViewPatterns Exposed-modules: Text.Regex.PCRE.Rex, Text.Regex.PCRE.Precompile- Build-depends: base >= 3.0 && < 6, bytestring, containers, ghc >= 7.0,- haskell-src-meta >= 0.5, pcre-light, split,+ Build-depends: base >= 3.0 && < 6,+ bytestring,+ containers,+ haskell-src-exts >= 1.14,+ haskell-src-meta >= 0.5,+ pcre-light, template-haskell >= 2.5.0.0 Ghc-options: -Wall