{-# OPTIONS_GHC -Wno-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 Prelude
  ( Bool
  , Maybe
  , String
  , ($), (.), id, fst, snd, seq, read
  , (+), (-)
  , (++), drop, fmap, map, null, take
  )
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 :: [Char] -> Regex
mkRegex [Char]
s = CompOption -> ExecOption -> [Char] -> 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 [Char]
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 :: [Char] -> Bool -> Bool -> Regex
mkRegexWithOpts [Char]
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 -> [Char] -> 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 [Char]
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 -> [Char] -> Maybe [[Char]]
matchRegex Regex
p [Char]
str = (([Char], [Char], [Char], [[Char]]) -> [[Char]])
-> Maybe ([Char], [Char], [Char], [[Char]]) -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([Char]
_,[Char]
_,[Char]
_,[[Char]]
str) -> [[Char]]
str) (Regex -> [Char] -> Maybe ([Char], [Char], [Char], [[Char]])
matchRegexAll Regex
p [Char]
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 -> [Char] -> Maybe ([Char], [Char], [Char], [[Char]])
matchRegexAll Regex
p [Char]
str = Regex -> [Char] -> Maybe ([Char], [Char], [Char], [[Char]])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
forall (m :: * -> *).
MonadFail m =>
Regex -> [Char] -> m ([Char], [Char], [Char], [[Char]])
matchM Regex
p [Char]
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 -> [Char] -> [Char] -> [Char]
subRegex Regex
_ [Char]
"" [Char]
_ = [Char]
""
subRegex Regex
regexp [Char]
inp [Char]
repl =
  let compile :: Int
-> [Char]
-> [([Char], (Int, Int))]
-> Array i ([Char], b)
-> [Char]
-> [Char]
compile Int
_i [Char]
str [] = \ Array i ([Char], b)
_m ->  ([Char]
str[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
      compile Int
i [Char]
str (([Char]
"\\",(Int
off,Int
len)):[([Char], (Int, Int))]
rest) =
        let i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            pre :: [Char]
pre = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
            str' :: [Char]
str' = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
        in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str' then \ Array i ([Char], b)
_m -> ([Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
             else \  Array i ([Char], b)
m -> ([Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [Char]
-> [([Char], (Int, Int))]
-> Array i ([Char], b)
-> [Char]
-> [Char]
compile Int
i' [Char]
str' [([Char], (Int, Int))]
rest Array i ([Char], b)
m
      compile Int
i [Char]
str (([Char]
xstr,(Int
off,Int
len)):[([Char], (Int, Int))]
rest) =
        let i' :: Int
i' = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
            pre :: [Char]
pre = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
            str' :: [Char]
str' = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
            x :: i
x = [Char] -> i
forall a. Read a => [Char] -> a
read [Char]
xstr
        in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str' then \ Array i ([Char], b)
m -> ([Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], b) -> [Char]
forall a b. (a, b) -> a
fst (Array i ([Char], b)
m Array i ([Char], b) -> i -> ([Char], b)
forall i e. Ix i => Array i e -> i -> e
! i
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
             else \ Array i ([Char], b)
m -> ([Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], b) -> [Char]
forall a b. (a, b) -> a
fst (Array i ([Char], b)
m Array i ([Char], b) -> i -> ([Char], b)
forall i e. Ix i => Array i e -> i -> e
! i
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [Char]
-> [([Char], (Int, Int))]
-> Array i ([Char], b)
-> [Char]
-> [Char]
compile Int
i' [Char]
str' [([Char], (Int, Int))]
rest Array i ([Char], b)
m
      compiled :: MatchText String -> String -> String
      compiled :: MatchText [Char] -> [Char] -> [Char]
compiled = Int
-> [Char]
-> [([Char], (Int, Int))]
-> MatchText [Char]
-> [Char]
-> [Char]
forall {i} {b}.
(Ix i, Read i) =>
Int
-> [Char]
-> [([Char], (Int, Int))]
-> Array i ([Char], b)
-> [Char]
-> [Char]
compile Int
0 [Char]
repl [([Char], (Int, Int))]
findrefs where
        -- bre matches a backslash then capture either a backslash or some digits
        bre :: Regex
bre = [Char] -> Regex
mkRegex [Char]
"\\\\(\\\\|[0-9]+)"
        findrefs :: [([Char], (Int, Int))]
findrefs = (MatchText [Char] -> ([Char], (Int, Int)))
-> [MatchText [Char]] -> [([Char], (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (\MatchText [Char]
m -> (([Char], (Int, Int)) -> [Char]
forall a b. (a, b) -> a
fst (MatchText [Char]
m MatchText [Char] -> Int -> ([Char], (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
1), ([Char], (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd (MatchText [Char]
m MatchText [Char] -> Int -> ([Char], (Int, Int))
forall i e. Ix i => Array i e -> i -> e
! Int
0))) (Regex -> [Char] -> [MatchText [Char]]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
bre [Char]
repl)
      go :: Int -> [Char] -> [MatchText [Char]] -> [Char]
go Int
_i [Char]
str [] = [Char]
str
      go Int
i [Char]
str (MatchText [Char]
m:[MatchText [Char]]
ms) =
        let ([Char]
_, (Int
off, Int
len)) = MatchText [Char]
m MatchText [Char] -> Int -> ([Char], (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 :: [Char]
pre = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
            str' :: [Char]
str' = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
        in if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str' then [Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (MatchText [Char] -> [Char] -> [Char]
compiled MatchText [Char]
m [Char]
"")
             else [Char]
pre [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (MatchText [Char] -> [Char] -> [Char]
compiled MatchText [Char]
m (Int -> [Char] -> [MatchText [Char]] -> [Char]
go Int
i' [Char]
str' [MatchText [Char]]
ms))
  in Int -> [Char] -> [MatchText [Char]] -> [Char]
go Int
0 [Char]
inp (Regex -> [Char] -> [MatchText [Char]]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
regexp [Char]
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 -> [Char] -> [[Char]]
splitRegex Regex
_ [] = []
splitRegex Regex
delim [Char]
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 -> [Char] -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll Regex
delim [Char]
strIn)
      go :: Int -> [Char] -> [(Int, Int)] -> [[Char]]
go Int
_i [Char]
str [] = [Char]
str [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: []
      go Int
i [Char]
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 :: [Char]
firstline = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
            remainder :: [Char]
remainder = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) [Char]
str
        in Int -> [[Char]] -> [[Char]]
forall a b. a -> b -> b
seq Int
i' ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
           if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
remainder then [[Char]
firstline,[Char]
""]
             else [Char]
firstline [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [(Int, Int)] -> [[Char]]
go Int
i' [Char]
remainder [(Int, Int)]
rest
  in Int -> [Char] -> [(Int, Int)] -> [[Char]]
go Int
0 [Char]
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

-}