diff --git a/Text/Regex/PCRE/Precompile.hs b/Text/Regex/PCRE/Precompile.hs --- a/Text/Regex/PCRE/Precompile.hs +++ b/Text/Regex/PCRE/Precompile.hs @@ -32,6 +32,8 @@ import Text.Regex.PCRE.Light import Text.Regex.PCRE.Light.Base +-- | A type synonym indicating which ByteStrings represent PCRE-format compiled +-- data. type CompiledBytes = B.ByteString -- | Compiles the given regular expression, and assuming nothing bad diff --git a/Text/Regex/PCRE/Rex.hs b/Text/Regex/PCRE/Rex.hs --- a/Text/Regex/PCRE/Rex.hs +++ b/Text/Regex/PCRE/Rex.hs @@ -20,10 +20,10 @@ -- 3) Allows for the inline interpolation of mapping functions :: String -> a. -- -- 4) Precompiles the regular expression at compile time, by calling into the --- PCRE library and storing a ByteString literal representation of its state. +-- PCRE library and storing a 'B.ByteString' literal representation of its state. -- -- 5) Compile-time configurable to use different PCRE options, turn off --- precompilation, or use ByteStrings. +-- precompilation, use 'B.ByteString's, or set a default mapping expression. -- -- Since this is a quasiquoter library that generates code using view patterns, -- the following extensions are required: @@ -51,10 +51,10 @@ -- 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 match. If the contents of the ?{ ... } is omitted, then 'id' is assumed: -- --- parsePair :: String -> Maybe (String, String) --- parsePair = [rex|^<\s* (?{ }[^\s,>]+) \s*,\s* (?{ }[^\s,>]+) \s*>$|] +-- > 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 @@ -106,24 +106,25 @@ -- -- 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 +-- 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. The \"brex\" --- QuasiQuoter is provided for this purpose. You can also define your own --- QuasiQuoter - the definitions of the default configurations are as follows: +-- 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 +-- > rex = rexConf False True "id" rexPCREOptions [] +-- > brex = rexConf True True "id" rexPCREOptions [] -- --- As mentioned, the other Bool determines whether precompilation is used. +-- As mentioned, the other Bool determines whether precompilation is used. The +-- string following is the default mapping expression, used when omitted. -- 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: +-- Inspired by Matt Morrow's regexqq package: -- -- -- And code from Erik Charlebois's interpolatedstring-qq package: @@ -132,22 +133,22 @@ ----------------------------------------------------------------------------- module Text.Regex.PCRE.Rex ( - rex, brex, maybeRead, padRight, rexConf, rexPCREOpts, rexPCREExecOpts) where + rex, brex, rexConf, rexPCREOptions, + maybeRead, padRight, makeQuasiMultiline) 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) +import Control.Arrow (first) import Control.Monad (liftM) import qualified Data.ByteString.Char8 as B import Data.Either.Utils (forceEitherMsg) -import Data.List (groupBy, sortBy) +import Data.List (find) import Data.List.Split (split, onSublist) import Data.Maybe (catMaybes, listToMaybe, fromJust, isJust) import Data.Maybe.Utils (forceMaybeMsg) -import Data.Ord (comparing) import Data.Char (isSpace) import Language.Haskell.TH @@ -162,41 +163,50 @@ * Provide a variant which allows splicing in an expression that evaluates to regex string. * Add unit tests + * Consider allowing passing arity lists in to configuration -} type ParseChunk = Either String (Int, String) type ParseChunks = (Int, String, [(Int, String)]) -type Config = (Bool, Bool, [PCRE.PCREOption], [PCRE.PCREExecOption]) +type Config = (Bool, Bool, String, [PCRE.PCREOption], [PCRE.PCREExecOption]) --- | Default regular expression quasiquoter for Strings, and ByteStrings. +-- | Default regular expression quasiquoter for 'String's and 'B.ByteString's, +-- respectively. rex, brex :: QuasiQuoter -rex = rexConf False True rexPCREOpts rexPCREExecOpts -brex = rexConf True True rexPCREOpts rexPCREExecOpts +rex = rexConf False True "id" rexPCREOptions [] +brex = rexConf True True "id" rexPCREOptions [] +-- | 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 -rexPCREOpts :: [PCRE.PCREOption] -rexPCREOpts = - [ PCRE.extended - , PCRE.multiline ] +-- | Default compilation time PCRE options. The default is 'PCRE.extended', +-- which causes whitespace to be nonsemantic, and ignores # comments. +rexPCREOptions :: [PCRE.PCREOption] +rexPCREOptions = [ PCRE.extended ] -- , dotall, caseless, utf8 -- , newline_any, PCRE.newline_crlf ] -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 +-- to the PCRE engine, along with 'Bool's to flag 'B.ByteString' usage and +-- non-compilation respecively. The provided 'String' indicates which mapping +-- function to use, when one is omitted - \"(?{} ...)\". +rexConf :: Bool -> Bool -> String -> [PCRE.PCREOption] -> [PCRE.PCREExecOption] + -> QuasiQuoter +rexConf bs pc d os eos = QuasiQuoter (makeExp conf . parseIt) (makePat conf . parseIt) undefined undefined where - conf = (bs, pc, [PCRE.combineOptions os], [PCRE.combineExecOptions eos]) + conf = (bs, pc, d, [PCRE.combineOptions os], [PCRE.combineExecOptions eos]) -- Template Haskell Code Generation ------------------------------------------------------------------------------- @@ -206,10 +216,9 @@ -- default for captures which lack a parser definition, and defaulting to making -- the parser that doesn't exist 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]] +makeExp conf (cnt, pat, exs) = buildExp conf cnt pat exs' + where + exs' = map (\ix -> liftM (processExp conf . snd) $ find ((==ix).fst) exs) [0..cnt] -- Creates the template haskell Pat which corresponds to the parsed interpolated -- regex. As well as handling the aforementioned defaulting considerations, this @@ -225,15 +234,14 @@ . map snd $ catMaybes views where views :: [Maybe (Exp, Pat)] - views = map (floatSnd . processView . snd . head) - . groupSortBy (comparing fst) $ exs + views = map (\ix -> liftM (processView . snd) $ find ((==ix).fst) exs) [0..cnt] - processView :: String -> (Exp, Maybe Pat) + processView :: String -> (Exp, Pat) processView xs = case splitFromBack 2 ((split . onSublist) "->" xs) of (_, [r]) -> onSpace r (error $ "blank pattern in view: " ++ r) - ((processExp "",) . processPat) + ((processExp conf "",) . processPat) -- View pattern - (l, [_, r]) -> (processExp $ concat l, processPat r) + (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 @@ -242,13 +250,11 @@ -- 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 :: Config -> Int -> String -> [Maybe Exp] -> ExpQ -buildExp (bs, nc, pcreOpts, pcreExecOpts) cnt pat xs = +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 - liftRS x = [| read shown |] where shown = show x @@ -266,6 +272,7 @@ (True, _) -> [| liftM ( const () ) |] (_, False) -> [| liftM (($(return maps)) . padRight "" pad . map B.unpack) |] (_, True) -> [| liftM (($(return maps)) . padRight B.empty pad) |] + pad = cnt + 2 maps = LamE [ListP . (WildP:) $ map VarP vs] . TupE . map (uncurry AppE) -- filter out all "Nothing" exprs @@ -275,18 +282,17 @@ vs = [mkName $ "v" ++ show i | i <- [0..cnt]] -- Parse a Haskell expression into a template Haskell Exp -processExp :: String -> Exp -processExp xs +processExp :: Config -> String -> Exp +processExp (_, _, d, _, _) xs = forceEitherMsg ("Error while parsing capture mapper `" ++ xs ++ "'") - . parseExp $ onSpace xs "id" id + . parseExp $ onSpace xs d 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 xs Nothing - $ Just - . forceEitherMsg ("Error while parsing capture pattern `" ++ xs ++ "'") - . parsePat +processPat :: String -> Pat +processPat xs + = forceEitherMsg ("Error while parsing capture pattern `" ++ xs ++ "'") + $ parsePat xs -- Parsing ------------------------------------------------------------------------------- @@ -308,7 +314,7 @@ parseRegex inp s ix = case inp of -- Disallow branch-reset capture. ('(':'?':'|':_) -> - error "Branch reset pattern (?| not allowed in fancy quasi-quoted regex." + error "Branch reset pattern (?| not allowed in quasi-quoted regex." -- Ignore non-capturing parens / handle backslash escaping. ('\\':'\\' :xs) -> parseRegex xs ("\\\\" ++ s) ix @@ -338,23 +344,16 @@ -- Consume the antiquoute contents, appending to a reverse accumulator. (x:xs) -> parseHaskell xs (x:s) ix - [] -> error "Regular-expression Haskell splice is never terminated with a trailing }" + [] -> 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. +-- | 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 --- TODO: allow for a bundle of parameters to be passed in at the beginning --- of the quasiquote. Would also be a juncture for informing arity / --- extension information. - -groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] -groupSortBy f = groupBy (\x -> (==EQ) . f x) . sortBy f - splitFromBack :: Int -> [a] -> ([a], [a]) splitFromBack i xs = (reverse b, reverse a) where (a, b) = splitAt i $ reverse xs @@ -370,30 +369,5 @@ padRight v i [] = replicate i v padRight v i (x:xs) = x : padRight v (i-1) xs -mapLeft :: (a -> a') -> Either a b -> Either a' b -mapLeft f = either (Left . f) Right - -mapSnd :: (b -> c) -> (a, b) -> (a, c) +mapSnd :: (t -> t2) -> (t1, t) -> (t1, t2) mapSnd f (x, y) = (x, f y) - -floatSnd :: (Functor f) => (a, f b) -> f (a, b) -floatSnd (x, y) = fmap (x,) y - -{- for completeness: - -mapRight :: (b -> b') -> Either a b -> Either a b' -mapRight f = either Left (Right . f) - -mapFst :: (a -> c) -> (a, b) -> (c, b) -mapFst f (x, y) = (f x, y) - -floatFst :: (Functor f) => (f a, b) -> f (a, b) -floatFst (x, y) = fmap (,y) x - -floatBoth :: (Monad m) => (m a, m b) -> m (a, b) -floatBoth (x, y) = do - x' <- x - y' <- y - return (x', y') - --} diff --git a/rex.cabal b/rex.cabal --- a/rex.cabal +++ b/rex.cabal @@ -1,5 +1,5 @@ Name: rex -Version: 0.2 +Version: 0.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,