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

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

import Data.Array((!))
import Text.Regex.Base(RegexMaker(makeRegexOpts),defaultCompOpt,defaultExecOpt,RegexLike(matchAll,matchAllText),RegexContext(matchM),MatchText)
import Text.Regex.TDFA(Regex,caseSensitive,multiline,newSyntax)

-- | 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 = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
opt forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt String
s
  where opt :: CompOption
opt = forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt { newSyntax :: Bool
newSyntax = Bool
True, multiline :: Bool
multiline = Bool
True }

-- | 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' @\<=>@ @\'^\'@ and @\'$\'@ match the beginning and
              -- end of individual lines respectively, and @\'.\'@ does /not/
              -- match the newline character.
   -> Bool    -- ^ 'True' @\<=>@ 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 = forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt
                { multiline :: Bool
multiline    = (if Bool
single_line then Bool
True else Bool
False)
                , caseSensitive :: Bool
caseSensitive = (if Bool
case_sensitive then Bool
True else Bool
False)
                , newSyntax :: Bool
newSyntax     = Bool
True }
    in forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
opt 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 = 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 = forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
p String
str

{- | Replaces every occurance 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 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
strforall a. [a] -> [a] -> [a]
++)
      compile Int
i String
str ((String
"\\",(Int
off,Int
len)):[(String, (Int, Int))]
rest) =
        let i' :: Int
i' = Int
offforall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = forall a. Int -> [a] -> [a]
take (Int
offforall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = forall a. Int -> [a] -> [a]
drop (Int
i'forall a. Num a => a -> a -> a
-Int
i) String
str
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then \ Array i (String, b)
_m -> (String
pre forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\'forall a. a -> [a] -> [a]
:)
             else \  Array i (String, b)
m -> (String
pre forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\\' forall a. a -> [a] -> [a]
:) 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
offforall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = forall a. Int -> [a] -> [a]
take (Int
offforall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = forall a. Int -> [a] -> [a]
drop (Int
i'forall a. Num a => a -> a -> a
-Int
i) String
str
            x :: i
x = forall a. Read a => String -> a
read String
xstr
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then \ Array i (String, b)
m -> (String
preforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a b. (a, b) -> a
fst (Array i (String, b)
mforall i e. Ix i => Array i e -> i -> e
!i
x))forall a. [a] -> [a] -> [a]
++)
             else \ Array i (String, b)
m -> (String
preforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a b. (a, b) -> a
fst (Array i (String, b)
mforall i e. Ix i => Array i e -> i -> e
!i
x))forall a. [a] -> [a] -> [a]
++) 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 = 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 = forall a b. (a -> b) -> [a] -> [b]
map (\MatchText String
m -> (forall a b. (a, b) -> a
fst (MatchText String
mforall i e. Ix i => Array i e -> i -> e
!Int
1),forall a b. (a, b) -> b
snd (MatchText String
mforall i e. Ix i => Array i e -> i -> e
!Int
0))) (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
mforall i e. Ix i => Array i e -> i -> e
!Int
0
            i' :: Int
i' = Int
offforall a. Num a => a -> a -> a
+Int
len
            pre :: String
pre = forall a. Int -> [a] -> [a]
take (Int
offforall a. Num a => a -> a -> a
-Int
i) String
str
            str' :: String
str' = forall a. Int -> [a] -> [a]
drop (Int
i'forall a. Num a => a -> a -> a
-Int
i) String
str
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str' then String
pre forall a. [a] -> [a] -> [a]
++ (MatchText String -> String -> String
compiled MatchText String
m String
"")
             else String
pre 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 (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 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall i e. Ix i => Array i e -> i -> e
! Int
0) (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 forall a. a -> [a] -> [a]
: []
      go Int
i String
str ((Int
off,Int
len):[(Int, Int)]
rest) =
        let i' :: Int
i' = Int
offforall a. Num a => a -> a -> a
+Int
len
            firstline :: String
firstline = forall a. Int -> [a] -> [a]
take (Int
offforall a. Num a => a -> a -> a
-Int
i) String
str
            remainder :: String
remainder = forall a. Int -> [a] -> [a]
drop (Int
i'forall a. Num a => a -> a -> a
-Int
i) String
str
        in seq :: forall a b. a -> b -> b
seq Int
i' forall a b. (a -> b) -> a -> b
$
           if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
remainder then [String
firstline,String
""]
             else String
firstline 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

-}