{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Regex
-- Copyright   :  (c) Chris Kuklewicz 2006, derived from (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  hvr@gnu.org
-- Stability   :  experimental
-- Portability :  non-portable (regex-base needs MPTC+FD)
--
-- Regular expression matching.  Uses the POSIX regular expression
-- interface in "Text.Regex.Posix".
--
---------------------------------------------------------------------------

--
-- Modified by Chris Kuklewicz to be a thin layer over the regex-posix
-- package, and moved into a regex-compat package.
--
module Text.Regex (
    -- * Regular expressions
    Regex,
    mkRegex,
    mkRegexWithOpts,
    matchRegex,
    matchRegexAll,
    subRegex,
    splitRegex
  ) where

import Data.Array((!))
import Data.Bits((.|.))
import Text.Regex.Base(RegexMaker(makeRegexOpts),defaultExecOpt,RegexLike(matchAll,matchAllText),RegexContext(matchM),MatchText)
import Text.Regex.Posix(Regex,compNewline,compIgnoreCase,compExtended)

-- | Makes a regular expression with the default options (multi-line,
-- case-sensitive).  The syntax of regular expressions is
-- otherwise that of @egrep@ (i.e. POSIX \"extended\" regular
-- expressions).
mkRegex :: String -> Regex
mkRegex :: String -> Regex
mkRegex String
s = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
opt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt String
s
  where opt :: CompOption
opt = CompOption
compExtended CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|. CompOption
compNewline

-- | Makes a regular expression, where the multi-line and
-- case-sensitive options can be changed from the default settings.
mkRegexWithOpts
   :: String  -- ^ The regular expression to compile.
   -> Bool    -- ^ 'True' iff @\'^\'@ and @\'$\'@ match the beginning and
              -- end of individual lines respectively, and @\'.\'@ does /not/
              -- match the newline character.
   -> Bool    -- ^ 'True' iff matching is case-sensitive.
   -> Regex   -- ^ Returns: the compiled regular expression.

mkRegexWithOpts :: String -> Bool -> Bool -> Regex
mkRegexWithOpts String
s Bool
single_line Bool
case_sensitive
  = let opt :: CompOption
opt = (if Bool
single_line then (CompOption
compNewline CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|.) else CompOption -> CompOption
forall a. a -> a
id) (CompOption -> CompOption)
-> (CompOption -> CompOption) -> CompOption -> CompOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (if Bool
case_sensitive then CompOption -> CompOption
forall a. a -> a
id else (CompOption
compIgnoreCase CompOption -> CompOption -> CompOption
forall a. Bits a => a -> a -> a
.|.)) (CompOption -> CompOption) -> CompOption -> CompOption
forall a b. (a -> b) -> a -> b
$
              CompOption
compExtended
    in CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
opt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt String
s

-- | Match a regular expression against a string.
matchRegex
   :: Regex     -- ^ The regular expression.
   -> String    -- ^ The string to match against.
   -> Maybe [String]    -- ^ Returns: @'Just' strs@ if the match succeeded
                        -- (and @strs@ is the list of subexpression matches),
                        -- or 'Nothing' otherwise.
matchRegex :: Regex -> String -> Maybe [String]
matchRegex Regex
p String
str = ((String, String, String, [String]) -> [String])
-> Maybe (String, String, String, [String]) -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
_,String
_,String
_,[String]
str) -> [String]
str) (Regex -> String -> Maybe (String, String, String, [String])
matchRegexAll Regex
p String
str)

-- | Match a regular expression against a string, returning more information
-- about the match.
matchRegexAll
   :: Regex     -- ^ The regular expression.
   -> String    -- ^ The string to match against.
   -> Maybe ( String, String, String, [String] )
                -- ^ Returns: 'Nothing' if the match failed, or:
                --
                -- >  Just ( everything before match,
                -- >         portion matched,
                -- >         everything after the match,
                -- >         subexpression matches )

matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
matchRegexAll Regex
p String
str = Regex -> String -> Maybe (String, String, String, [String])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
p String
str

{- | Replaces every occurrence of the given regexp with the replacement string.

In the replacement string, @\"\\1\"@ refers to the first substring;
@\"\\2\"@ to the second, etc; and @\"\\0\"@ to the entire match.
@\"\\\\\\\\\"@ will insert a literal backslash.

This does not advance if the regex matches an empty string.  This
misfeature is here to match the behavior of the original
@Text.Regex@ API.
-}

subRegex :: Regex                          -- ^ Search pattern
         -> String                         -- ^ Input string
         -> String                         -- ^ Replacement text
         -> String                         -- ^ Output string
subRegex :: Regex -> String -> String -> String
subRegex Regex
_ String
"" String
_ = String
""
subRegex Regex
regexp String
inp String
repl =
  let compile :: Int
-> String
-> [(String, (Int, Int))]
-> Array i (String, b)
-> String
-> String
compile Int
_i String
str [] = \ Array i (String, b)
_m ->  (String
strString -> String -> String
forall a. [a] -> [a] -> [a]
++)
      compile Int
i String
str ((String
"\\",(Int
off,Int
len)):[(String, (Int, Int))]
rest) =
        let i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
        in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then \ Array i (String, b)
_m -> (String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:)
             else \  Array i (String, b)
m -> (String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> [(String, (Int, Int))]
-> Array i (String, b)
-> String
-> String
compile Int
i' String
str' [(String, (Int, Int))]
rest Array i (String, b)
m
      compile Int
i String
str ((String
xstr,(Int
off,Int
len)):[(String, (Int, Int))]
rest) =
        let i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
            x :: i
x = String -> i
forall a. Read a => String -> a
read String
xstr
        in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then \ Array i (String, b)
m -> (String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, b) -> String
forall a b. (a, b) -> a
fst (Array i (String, b)
m Array i (String, b) -> i -> (String, b)
forall i e. Ix i => Array i e -> i -> e
! i
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
             else \ Array i (String, b)
m -> (String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, b) -> String
forall a b. (a, b) -> a
fst (Array i (String, b)
m Array i (String, b) -> i -> (String, b)
forall i e. Ix i => Array i e -> i -> e
! i
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> [(String, (Int, Int))]
-> Array i (String, b)
-> String
-> String
compile Int
i' String
str' [(String, (Int, Int))]
rest Array i (String, b)
m
      compiled :: MatchText String -> String -> String
      compiled :: MatchText String -> String -> String
compiled = Int
-> String
-> [(String, (Int, Int))]
-> MatchText String
-> String
-> String
forall i b.
(Ix i, Read i) =>
Int
-> String
-> [(String, (Int, Int))]
-> Array i (String, b)
-> String
-> String
compile Int
0 String
repl [(String, (Int, Int))]
findrefs where
        -- bre matches a backslash then capture either a backslash or some digits
        bre :: Regex
bre = String -> Regex
mkRegex String
"\\\\(\\\\|[0-9]+)"
        findrefs :: [(String, (Int, Int))]
findrefs = (MatchText String -> (String, (Int, Int)))
-> [MatchText String] -> [(String, (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (\MatchText String
m -> ((String, (Int, Int)) -> String
forall a b. (a, b) -> a
fst (MatchText String
m MatchText String -> Int -> (String, (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
1), (String, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd (MatchText String
m MatchText String -> Int -> (String, (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
0))) (Regex -> String -> [MatchText String]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
bre String
repl)
      go :: Int -> String -> [MatchText String] -> String
go Int
_i String
str [] = String
str
      go Int
i String
str (MatchText String
m:[MatchText String]
ms) =
        let (String
_, (Int
off, Int
len)) = MatchText String
m MatchText String -> Int -> (String, (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
0
            i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
        in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MatchText String -> String -> String
compiled MatchText String
m String
"")
             else String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MatchText String -> String -> String
compiled MatchText String
m (Int -> String -> [MatchText String] -> String
go Int
i' String
str' [MatchText String]
ms))
  in Int -> String -> [MatchText String] -> String
go Int
0 String
inp (Regex -> String -> [MatchText String]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
regexp String
inp)

{- | Splits a string based on a regular expression.  The regular expression
should identify one delimiter.

This does not advance and produces an infinite list of @[]@ if the regex
matches an empty string.  This misfeature is here to match the
behavior of the original @Text.Regex@ API.
-}

splitRegex :: Regex -> String -> [String]
splitRegex :: Regex -> String -> [String]
splitRegex Regex
_ [] = []
splitRegex Regex
delim String
strIn =
  let matches :: [(Int, Int)]
matches = (Array Int (Int, Int) -> (Int, Int))
-> [Array Int (Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Array Int (Int, Int) -> Int -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! Int
0) (Regex -> String -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll Regex
delim String
strIn)
      go :: Int -> String -> [(Int, Int)] -> [String]
go Int
_i String
str [] = String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
      go Int
i String
str ((Int
off,Int
len):[(Int, Int)]
rest) =
        let i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            firstline :: String
firstline = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
            remainder :: String
remainder = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) String
str
        in Int -> [String] -> [String]
seq Int
i' ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
           if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
remainder then [String
firstline,String
""]
             else String
firstline String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [(Int, Int)] -> [String]
go Int
i' String
remainder [(Int, Int)]
rest
  in Int -> String -> [(Int, Int)] -> [String]
go Int
0 String
strIn [(Int, Int)]
matches

{-

-- These are the older versions which failed on (correct answer:)
-- let r = mkRegex "^(.)" in subRegex2 r "abc\ndef" "|\\1"
-- "|abc\n|def"

subRegex :: Regex                          -- ^ Search pattern
      -> String                         -- ^ Input string
      -> String                         -- ^ Replacement text
      -> String                         -- ^ Output string
subRegex _ "" _ = ""
subRegex regexp inp repl =
  let -- bre matches a backslash then capture either a backslash or some digits
      bre = mkRegex "\\\\(\\\\|[0-9]+)"
      lookup _ [] _ = []
      lookup [] _ _ = []
      lookup match repl groups =
        case matchRegexAll bre repl of
          Nothing -> repl
          Just (lead, _, trail, bgroups) ->
            let newval =
                 if (head bgroups) == "\\"
                   then "\\"
                   else let index :: Int
                            index = (read (head bgroups)) - 1
                        in if index == -1
                             then match
                             else groups !! index
            in lead ++ newval ++ lookup match trail groups
  in case matchRegexAll regexp inp of
       Nothing -> inp
       Just (lead, match, trail, groups) ->
         lead ++ lookup match repl groups ++ (subRegex regexp trail repl)

splitRegex :: Regex -> String -> [String]
splitRegex _ [] = []
splitRegex delim strIn = loop strIn where
  loop str = case matchOnceText delim str of
                Nothing -> [str]
                Just (firstline, _, remainder) ->
                  if null remainder
                    then [firstline,""]
                    else firstline : loop remainder

-}