{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.RE.PCRE.RE
( -- * RE Type
RE
, regexType
, reOptions
, reSource
, reCaptureNames
, reRegex
-- * REOptions Type
, REOptions
, defaultREOptions
, noPreludeREOptions
-- * Compiling Regular Expressions
, compileRegex
, compileRegexWith
, compileRegexWithOptions
-- * Compiling Search-Replace Templates
, compileSearchReplace
, compileSearchReplaceWith
, compileSearchReplaceWithREOptions
-- * Escaping String
, escape
, escapeWith
, escapeWithOptions
, escapeREString
-- * Macros Standard Environment
, prelude
, preludeEnv
, preludeTestsFailing
, preludeTable
, preludeSummary
, preludeSources
, preludeSource
, unpackSimpleREOptions
-- * The Quasi Quoters
, re
, reMS
, reMI
, reBS
, reBI
, reMultilineSensitive
, reMultilineInsensitive
, reBlockSensitive
, reBlockInsensitive
, re_
-- , ed
-- , edMS
-- , edMI
-- , edBS
-- , edBI
-- , edMultilineSensitive
-- , edMultilineInsensitive
-- , edBlockSensitive
-- , edBlockInsensitive
-- , ed_
, cp
) where
import Data.Bits
import Data.Functor.Identity
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Prelude.Compat
import Text.RE.Internal.EscapeREString
import Text.RE.Internal.NamedCaptures
import Text.RE.Internal.PreludeMacros
import Text.RE.Internal.QQ
import Text.RE.Internal.SearchReplace
import Text.RE.SearchReplace
import Text.RE.TestBench
import Text.RE.Types.CaptureID
import Text.RE.Types.IsRegex
import Text.RE.Types.REOptions
import Text.RE.Types.Replace
import Text.Regex.PCRE
-- | the RE type for this back end representing a well-formed, compiled
-- RE
data RE =
RE
{ _re_options :: !REOptions
, _re_source :: !String
, _re_cnames :: !CaptureNames
, _re_regex :: !Regex
}
-- | some functions in the "Text.RE.TestBench" need the back end to
-- be passed dynamically as a 'RegexType' parameters: use 'regexType'
-- fpr this backend
regexType :: RegexType
regexType =
mkPCRE $ \txt env md -> txt =~ mdRegexSource regexType ExclCaptures env md
-- | extract the 'REOptions' from the @RE@
reOptions :: RE -> REOptions
reOptions = _re_options
-- | extract the RE source string from the @RE@
reSource :: RE -> String
reSource = _re_source
-- | extract the 'CaptureNames' from the @RE@
reCaptureNames :: RE -> CaptureNames
reCaptureNames = _re_cnames
-- | extract the back end compiled 'Regex' type from the @RE@
reRegex :: RE -> Regex
reRegex = _re_regex
------------------------------------------------------------------------
-- REOptions
------------------------------------------------------------------------
-- | and the REOptions for this back end (see "Text.RE.Types.REOptions"
-- for details)
type REOptions = REOptions_ RE CompOption ExecOption
instance IsOption SimpleREOptions RE CompOption ExecOption where
makeREOptions = unpackSimpleREOptions
instance IsOption (Macros RE) RE CompOption ExecOption where
makeREOptions ms = REOptions ms def_comp_option def_exec_option
instance IsOption CompOption RE CompOption ExecOption where
makeREOptions co = REOptions prelude co def_exec_option
instance IsOption ExecOption RE CompOption ExecOption where
makeREOptions eo = REOptions prelude def_comp_option eo
instance IsOption REOptions RE CompOption ExecOption where
makeREOptions = id
instance IsOption () RE CompOption ExecOption where
makeREOptions _ = unpackSimpleREOptions minBound
-- | the default 'REOptions'
defaultREOptions :: REOptions
defaultREOptions = makeREOptions (minBound::SimpleREOptions)
-- | the default 'REOptions' but with no RE macros defined
noPreludeREOptions :: REOptions
noPreludeREOptions = defaultREOptions { optionsMacs = emptyMacros }
-- | convert a universal 'SimpleReOptions' into the 'REOptions' used
-- by this back end
unpackSimpleREOptions :: SimpleREOptions -> REOptions
unpackSimpleREOptions sro =
REOptions
{ optionsMacs = prelude
, optionsComp = comp
, optionsExec = 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
------------------------------------------------------------------------
-- Compiling Regular Expressions
------------------------------------------------------------------------
-- | compile a 'String' into a 'RE' with the default options,
-- generating an error if the RE is not well formed
compileRegex :: (Functor m,Monad m) => String -> m RE
compileRegex = compileRegexWithOptions ()
-- | compile a 'String' into a 'RE' using the given @SimpleREOptions@,
-- generating an error if the RE is not well formed
compileRegexWith :: (Functor m,Monad m) => SimpleREOptions -> String -> m RE
compileRegexWith = compileRegexWithOptions
-- | compile a 'String' into a 'RE' using the given @SimpleREOptions@,
-- generating an error if the RE is not well formed
compileRegexWithOptions :: ( IsOption o RE CompOption ExecOption
, Functor m
, Monad m
)
=> o
-> String
-> m RE
compileRegexWithOptions = compileRegex_ . makeREOptions
------------------------------------------------------------------------
-- Compiling Search Replace Templates
------------------------------------------------------------------------
-- | compile a SearchReplace template generating errors if the RE or
-- the template are not well formed -- all capture references being checked
compileSearchReplace :: (Monad m,Functor m,IsRegex RE s)
=> String
-> String
-> m (SearchReplace RE s)
compileSearchReplace = compileSearchReplaceWith minBound
-- | compile a SearchReplace template, with simple options, generating
-- errors if the RE or the template are not well formed -- all capture
-- references being checked
compileSearchReplaceWith :: (Monad m,Functor m,IsRegex RE s)
=> SimpleREOptions
-> String
-> String
-> m (SearchReplace RE s)
compileSearchReplaceWith sro = compileSearchAndReplace_ packR $ compileRegexWith sro
-- | compile a SearchReplace template, with general options, generating
-- errors if the RE or the template are not well formed -- all capture
-- references being checked
compileSearchReplaceWithREOptions :: (Monad m,Functor m,IsRegex RE s)
=> REOptions
-> String
-> String
-> m (SearchReplace RE s)
compileSearchReplaceWithREOptions os = compileSearchAndReplace_ packR $ compileRegexWithOptions os
------------------------------------------------------------------------
-- Escaping Strings
------------------------------------------------------------------------
-- | convert a string into a RE that matches that string, and apply it
-- to an argument continuation function to make up the RE string to be
-- compiled
escape :: (Functor m,Monad m)
=> (String->String)
-> String
-> m RE
escape = escapeWith minBound
-- | convert a string into a RE that matches that string, and apply it
-- to an argument continuation function to make up the RE string to be
-- compiled with the default options
escapeWith :: (Functor m,Monad m)
=> SimpleREOptions
-> (String->String)
-> String
-> m RE
escapeWith = escapeWithOptions
-- | convert a string into a RE that matches that string, and apply it
-- to an argument continuation function to make up the RE string to be
-- compiled the given options
escapeWithOptions :: ( IsOption o RE CompOption ExecOption
, Functor m
, Monad m
)
=> o
-> (String->String)
-> String
-> m RE
escapeWithOptions o f = compileRegexWithOptions o . f . escapeREString
------------------------------------------------------------------------
-- Macro Standard Environment
------------------------------------------------------------------------
prelude :: Macros RE
prelude = runIdentity $ preludeMacros mk regexType ExclCaptures
where
mk = Identity . unsafeCompileRegex_ noPreludeREOptions
preludeTestsFailing :: [MacroID]
preludeTestsFailing = badMacros preludeEnv
preludeEnv :: MacroEnv
preludeEnv = preludeMacroEnv regexType
preludeTable :: String
preludeTable = preludeMacroTable regexType
preludeSummary :: PreludeMacro -> String
preludeSummary = preludeMacroSummary regexType
preludeSources :: String
preludeSources = preludeMacroSources regexType
preludeSource :: PreludeMacro -> String
preludeSource = preludeMacroSource regexType
------------------------------------------------------------------------
-- Quasi Quoters
------------------------------------------------------------------------
-- | the @[re| ... |]@ and @[ed| ... /// ... |]@ quasi quoters
re
, reMS
, reMI
, reBS
, reBI
, reMultilineSensitive
, reMultilineInsensitive
, reBlockSensitive
, reBlockInsensitive
, re_ :: QuasiQuoter
-- , ed
-- , edMS
-- , edMI
-- , edBS
-- , edBI
-- , edMultilineSensitive
-- , edMultilineInsensitive
-- , edBlockSensitive
-- , edBlockInsensitive
-- , ed_ :: 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
-- ed = ed' $ Just minBound
-- edMS = edMultilineSensitive
-- edMI = edMultilineInsensitive
-- edBS = edBlockSensitive
-- edBI = edBlockInsensitive
-- edMultilineSensitive = ed' $ Just MultilineSensitive
-- edMultilineInsensitive = ed' $ Just MultilineInsensitive
-- edBlockSensitive = ed' $ Just BlockSensitive
-- edBlockInsensitive = ed' $ Just BlockInsensitive
-- ed_ = ed' Nothing
------------------------------------------------------------------------
-- re Helpers
------------------------------------------------------------------------
re' :: Maybe SimpleREOptions -> 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 :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp
parse sro mk rs = either error (\_->mk rs) $ compileRegex_ os rs
where
os = unpackSimpleREOptions sro
unsafeCompileRegexSimple :: SimpleREOptions -> String -> RE
unsafeCompileRegexSimple sro re_s = unsafeCompileRegex os re_s
where
os = unpackSimpleREOptions sro
unsafeCompileRegex :: IsOption o RE CompOption ExecOption
=> o
-> String
-> RE
unsafeCompileRegex = unsafeCompileRegex_ . makeREOptions
unsafeCompileRegex_ :: REOptions -> String -> RE
unsafeCompileRegex_ os = either oops id . compileRegexWithOptions os
where
oops = error . ("unsafeCompileRegex: " ++)
compileRegex' :: (Functor m,Monad m)
=> REOptions
-> String
-> m (CaptureNames,Regex)
compileRegex' REOptions{..} s0 = do
((_,cnms),s2) <- either fail return $ extractNamedCaptures s1
(,) cnms <$> makeRegexOptsM optionsComp optionsExec s2
where
s1 = expandMacros reSource optionsMacs s0
compileRegex_ :: ( Functor m , Monad m )
=> REOptions
-> 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
}
------------------------------------------------------------------------
-- ed Helpers
------------------------------------------------------------------------
-- edS :: QuasiQuoter
-- edS = cast_ed [|\x -> x :: SearchReplace RE String|] $ Just minBound
--
-- edS_ :: QuasiQuoter
-- edS_ = cast_ed [|\x -> x :: SimpleREOptions -> SearchReplace RE String|] Nothing
--
-- cast_ed :: Q Exp -> Maybe SimpleREOptions -> QuasiQuoter
-- cast_ed qe mb = case mb of
-- Nothing ->
-- (qq0 "ed'")
-- { quoteExp = parse minBound $ \rs -> AppE <$> qe <*> [|flip unsafe_compile_sr rs|]
-- }
-- Just sro ->
-- (qq0 "ed'")
-- { quoteExp = parse sro $ \rs -> AppE <$> qe <*> [|unsafe_compile_sr_simple sro rs|]
-- }
-- where
-- parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp
-- parse sro mk ts = either error (\_->mk ts) ei
-- where
-- ei :: Either String (SearchReplace RE String)
-- ei = compileSearchReplace_ id (compileRegexWith sro) ts
--
-- ed' :: Maybe SimpleREOptions -> QuasiQuoter
-- ed' mb = case mb of
-- Nothing ->
-- (qq0 "ed'")
-- { quoteExp = parse minBound (\rs->[|flip unsafe_compile_sr rs|])
-- }
-- Just sro ->
-- (qq0 "ed'")
-- { quoteExp = parse sro (\rs->[|unsafe_compile_sr_simple sro rs|])
-- }
-- where
-- parse :: SimpleREOptions -> (String->Q Exp) -> String -> Q Exp
-- parse sro mk ts = either error (\_->mk ts) ei
-- where
-- ei :: Either String (SearchReplace RE String)
-- ei = compileSearchReplace_ id (compileRegexWith sro) ts
--
-- unsafe_compile_sr_simple :: IsRegex RE s
-- => SimpleREOptions
-- -> String
-- -> SearchReplace RE s
-- unsafe_compile_sr_simple sro =
-- unsafe_compile_sr $ unpackSimpleREOptions sro
--
-- unsafe_compile_sr :: ( IsOption o RE CompOption ExecOption
-- , IsRegex RE s
-- )
-- => o
-- -> String
-- -> SearchReplace RE s
-- unsafe_compile_sr os =
-- unsafeCompileSearchReplace_ packR $ compileRegexWithOptions os
def_comp_option :: CompOption
def_comp_option = optionsComp defaultREOptions
def_exec_option :: ExecOption
def_exec_option = optionsExec defaultREOptions