{-# LANGUAGE NoImplicitPrelude              #-}
{-# LANGUAGE MultiParamTypeClasses          #-}
{-# LANGUAGE FlexibleContexts               #-}
{-# LANGUAGE FlexibleInstances              #-}
{-# OPTIONS_GHC -fno-warn-orphans           #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
{-# LANGUAGE CPP                            #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-unused-imports        #-}
#endif

module Text.RE.TDFA.Text.Lazy
  (
  -- * Tutorial
  -- $tutorial

  -- * The 'Matches' and 'Match' Operators
    (*=~)
  , (?=~)
  -- * The 'SearchReplace' Operators
  , (*=~/)
  , (?=~/)
  -- * The 'Matches' Type
  , Matches
  , matchesSource
  , allMatches
  , anyMatches
  , countMatches
  , matches
  -- * The 'Match' Type
  , Match
  , matchSource
  , matched
  , matchedText
  -- * The Macros and Parsers
  -- $macros
  , module Text.RE.TestBench.Parsers
  -- * The 'RE' Type
  , RE
  , reSource
  -- * Options
  -- $options
  , SimpleREOptions(..)
  -- * Compiling and Escaping REs
  , SearchReplace(..)
  , compileRegex
  , compileRegexWith
  , compileSearchReplace
  , compileSearchReplaceWith
  , escape
  , escapeWith
  , escapeREString
  -- * The Classic regex-base Match Operators
  , (=~)
  , (=~~)
  -- * The re Quasi Quoters
  -- $re
  , re
  , reMultilineSensitive
  , reMultilineInsensitive
  , reBlockSensitive
  , reBlockInsensitive
  , reMS
  , reMI
  , reBS
  , reBI
  , re_
  -- * The Ed Quasi Quoters
  -- $ed
  , edMultilineSensitive
  , edMultilineInsensitive
  , edBlockSensitive
  , edBlockInsensitive
  , ed
  , edMS
  , edMI
  , edBS
  , edBI
  , ed_
  -- * The cp Quasi Quoters
  , cp
  -- * IsRegex
  -- $isregex
  , module Text.RE.Tools.IsRegex
  ) where

import           Control.Monad.Fail
import qualified Data.Text.Lazy                as TL
import           Data.Typeable
import           Prelude.Compat
import           Text.RE.REOptions
import           Text.RE.Replace
import           Text.RE.TestBench.Parsers
import           Text.RE.Tools.IsRegex
import           Text.RE.ZeInternals
import           Text.RE.ZeInternals.SearchReplace.TDFA.Text.Lazy
import           Text.RE.ZeInternals.TDFA
import           Text.Regex.Base
import qualified Text.Regex.TDFA               as TDFA
-- NB regex-base instance imports maybe be needed for for some API modules

-- | find all the matches in the argument text; e.g., to count the number
-- of naturals in s:
--
--   @countMatches $ s *=~ [re|[0-9]+|]@
--
(*=~) :: TL.Text
      -> RE
      -> Matches TL.Text
*=~ :: Text -> RE -> Matches Text
(*=~) Text
bs RE
rex = CaptureNames -> Matches Text -> Matches Text
forall a. CaptureNames -> Matches a -> Matches a
addCaptureNamesToMatches (RE -> CaptureNames
reCaptureNames RE
rex) (Matches Text -> Matches Text) -> Matches Text -> Matches Text
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Matches Text
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (RE -> Regex
reRegex RE
rex) Text
bs

-- | find the first match in the argument text; e.g., to test if there
-- is a natural number in the input text:
--
--   @matched $ s ?=~ [re|[0-9]+|]@
--
(?=~) :: TL.Text
      -> RE
      -> Match TL.Text
?=~ :: Text -> RE -> Match Text
(?=~) Text
bs RE
rex = CaptureNames -> Match Text -> Match Text
forall a. CaptureNames -> Match a -> Match a
addCaptureNamesToMatch (RE -> CaptureNames
reCaptureNames RE
rex) (Match Text -> Match Text) -> Match Text -> Match Text
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> Match Text
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (RE -> Regex
reRegex RE
rex) Text
bs

-- | search and replace all matches in the argument text; e.g., this section
-- will convert every YYYY-MM-DD format date in its argument text into a
-- DD\/MM\/YYYY date:
--
--   @(*=~\/ [ed|${y}([0-9]{4})-0*${m}([0-9]{2})-0*${d}([0-9]{2})\/\/\/${d}\/${m}\/${y}|])@
--
(*=~/) :: TL.Text -> SearchReplace RE TL.Text -> TL.Text
*=~/ :: Text -> SearchReplace RE Text -> Text
(*=~/) = (SearchReplace RE Text -> Text -> Text)
-> Text -> SearchReplace RE Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip SearchReplace RE Text -> Text -> Text
forall re s. IsRegex re s => SearchReplace re s -> s -> s
searchReplaceAll

-- | search and replace the first occurrence only (if any) in the input text
-- e.g., to prefix the first string of four hex digits in the input text,
-- if any, with @0x@:
--
--  @(?=~\/ [ed|[0-9A-Fa-f]{4}\/\/\/0x$0|])@
--
(?=~/) :: TL.Text -> SearchReplace RE TL.Text -> TL.Text
?=~/ :: Text -> SearchReplace RE Text -> Text
(?=~/) = (SearchReplace RE Text -> Text -> Text)
-> Text -> SearchReplace RE Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip SearchReplace RE Text -> Text -> Text
forall re s. IsRegex re s => SearchReplace re s -> s -> s
searchReplaceFirst

-- | the `regex-base` polymorphic match operator
(=~) :: ( Typeable a
        , RegexContext TDFA.Regex TL.Text a
        )
     => TL.Text
     -> RE
     -> a
=~ :: Text -> RE -> a
(=~) Text
bs RE
rex = CaptureNames -> a -> a
forall a. Typeable a => CaptureNames -> a -> a
addCaptureNames (RE -> CaptureNames
reCaptureNames RE
rex) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Regex -> Text -> a
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (RE -> Regex
reRegex RE
rex) Text
bs

-- | the `regex-base` monadic, polymorphic match operator
(=~~) :: ( Monad m, MonadFail m
         , Functor m
         , Typeable a
         , RegexContext TDFA.Regex TL.Text a
         )
      => TL.Text
      -> RE
      -> m a
=~~ :: Text -> RE -> m a
(=~~) Text
bs RE
rex = CaptureNames -> a -> a
forall a. Typeable a => CaptureNames -> a -> a
addCaptureNames (RE -> CaptureNames
reCaptureNames RE
rex) (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> Text -> m a
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM (RE -> Regex
reRegex RE
rex) Text
bs

instance IsRegex RE TL.Text where
  matchOnce :: RE -> Text -> Match Text
matchOnce             = (Text -> RE -> Match Text) -> RE -> Text -> Match Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> RE -> Match Text
(?=~)
  matchMany :: RE -> Text -> Matches Text
matchMany             = (Text -> RE -> Matches Text) -> RE -> Text -> Matches Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> RE -> Matches Text
(*=~)
  makeRegexWith :: SimpleREOptions -> Text -> m RE
makeRegexWith         = \SimpleREOptions
o -> SimpleREOptions -> String -> m RE
forall (m :: * -> *).
(Functor m, Monad m, MonadFail m) =>
SimpleREOptions -> String -> m RE
compileRegexWith SimpleREOptions
o (String -> m RE) -> (Text -> String) -> Text -> m RE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Replace a => a -> String
unpackR
  makeSearchReplaceWith :: SimpleREOptions -> Text -> Text -> m (SearchReplace RE Text)
makeSearchReplaceWith = \SimpleREOptions
o Text
r Text
t -> SimpleREOptions -> String -> String -> m (SearchReplace RE Text)
forall (m :: * -> *) s.
(Monad m, MonadFail m, Functor m, IsRegex RE s) =>
SimpleREOptions -> String -> String -> m (SearchReplace RE s)
compileSearchReplaceWith SimpleREOptions
o (Text -> String
forall a. Replace a => a -> String
unpackR Text
r) (Text -> String
forall a. Replace a => a -> String
unpackR Text
t)
  regexSource :: RE -> Text
regexSource           = String -> Text
forall a. Replace a => String -> a
packR (String -> Text) -> (RE -> String) -> RE -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE -> String
reSource

-- $tutorial
-- We have a regex tutorial at <http://tutorial.regex.uk>.

-- $macros
-- There are a number of RE macros and corresponding Haskell parsers
-- for parsing the matched text into appropriate Haskell types. See
-- the [Macros Tables](http://regex.uk/macros) for details.

-- $options
-- You can specify different compilation options by appending a
-- to the name of an [re| ... |] or [ed| ... \/\/\/ ... |] quasi quoter
-- to select the corresponding compilation option. For example, the
-- section,
--
--  @(?=~/ [edBlockInsensitive|foo$\/\/\/bar|])@
--
-- will replace a @foo@ suffix of the argument text, of any
-- capitalisation, with a (lower case) @bar@. If you need to specify the
-- options dynamically, use the @[re_| ... |]@ and @[ed_| ... \/\/\/ ... |]@
-- quasi quoters, which generate functions that take an 'IsOption' option
-- (e.g., a 'SimpleReOptions' value) and yields a 'RE' or 'SearchReplace'
-- as apropriate. For example if you have a 'SimpleReOptions' value in
-- @sro@ then
--
--  @(?=~/ [ed_|foo$\/\/\/bar|] sro)@
--
-- will compile the @foo$@ RE according to the value of @sro@. For more
-- on specifying RE options see "Text.RE.REOptions".

-- $re
-- The @[re|.*|]@ quasi quoters, with variants for specifing different
-- options to the RE compiler (see "Text.RE.REOptions"), and the
-- specialised back-end types and functions.

-- $ed
-- The @[ed|.*\/\/\/foo|]@ quasi quoters, with variants for specifing different
-- options to the RE compiler (see "Text.RE.REOptions").

-- $ed
-- The -- | the @[ed| ... \/\/\/ ... |]@ quasi quoters; for example,
--
--  @[ed|${y}([0-9]{4})-0*${m}([0-9]{2})-0*${d}([0-9]{2})\/\/\/${d}\/${m}\/${y}|])@
--
-- represents a @SearchReplace@ that will convert a YYYY-MM-DD format date
-- into a DD\/MM\/YYYY format date.
--
-- The only difference betweem these quasi quoters is the RE options that are set,
-- using the same conventions as the @[re| ... |]@ quasi quoters.

-- $isregex
-- The 'IsRegex' class is used to abstact over the different regex back ends and
-- the text types they work with -- see "Text.RE.Tools.IsRegex" for details.