--      RegexPR.hs
--
--      Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--

module Text.RegexPR (
  getbrsRegexPR
, matchRegexPR
, multiMatchRegexPR
, gmatchRegexPR		-- EXPERIMENTAL
, subRegexPR
, subRegexPRBy
, gsubRegexPR
, gsubRegexPRBy
, splitRegexPR
) where

import Hidden.RegexPRCore  ( matchRegexPRVerbose, multiMatchRegexPRVerbose )
import Hidden.RegexPRTypes ( RegexResult, MatchList )
import Data.Char           ( isDigit )
import Data.List           ( sort, nubBy )
import Data.Function       ( on )

getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR reg str
  = case matchRegexPR reg str of
         Nothing                    -> []
	 Just ( (ret, (_, _)), ml ) -> ret : map snd (sort $ nubBy (on (==) fst) ml)

matchRegexPR :: String -> String -> Maybe ( RegexResult, MatchList )
matchRegexPR reg str
  = fmap ( \( (pre, ret, (_, rest)), ml ) -> ( (ret, (pre, rest)), ml ) ) $
         matchRegexPRVerbose reg ("", str)

multiMatchRegexPR :: String -> String -> [ ( RegexResult, MatchList ) ]
multiMatchRegexPR reg str
  = fmap ( \( (pre, ret, (_, rest)), ml ) -> ( (ret, (pre, rest)), ml ) ) $
         multiMatchRegexPRVerbose reg ("", str)

gmatchRegexPR :: String -> String -> [ ( RegexResult, MatchList ) ]
gmatchRegexPR reg str = gmatchRegexPRGen Nothing reg ("", str)

gmatchRegexPRGen ::
  Maybe (String, String) -> String -> (String, String) -> [ ( RegexResult, MatchList ) ]
gmatchRegexPRGen pmp reg str
  = case matchRegexPRVerbose reg str of
      Just ((pre, ret, sp@(p,rest@(~(x:xs)))), ml)
        -> case (pmp, sp) of
                (Just (_, ""), _)  -> [ ( (ret, (pre, rest)), ml ) ]
                _ | Just sp == pmp -> ( (ret, (pre, rest)), ml ) :
                                        gmatchRegexPRGen pmp reg (x:p, xs)
                  | otherwise      -> ( (ret, (pre, rest)), ml ) :
                                        gmatchRegexPRGen (Just sp) reg sp
      Nothing -> []

subRegexPR :: String -> String -> String -> String
subRegexPR reg sub src = subRegexPRBy reg (const sub) src

subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy reg subf src
  = case matchRegexPRVerbose reg ("",src) of
         Just al@((pre, m, sp), _) -> pre ++ subBackRef al (subf m) ++ snd sp
         Nothing                   -> src

gsubRegexPR :: String -> String -> String -> String
gsubRegexPR reg sub src = gsubRegexPRGen Nothing reg (const sub) ("", src)

gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy reg subf src = gsubRegexPRGen Nothing reg subf ("", src)

gsubRegexPRGen ::
  Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen pmp reg fsub src
  = case matchRegexPRVerbose reg src of
      Just al@((pre, match, sp@(~(p,x:xs))), _)
        -> case (pmp, sp) of
                (Just (_, ""), _)  -> ""
                _ | Just sp == pmp -> pre ++ [x] ++
                                      gsubRegexPRGen (Just sp) reg fsub (x:p, xs)
                  | otherwise      -> pre ++ subBackRef al (fsub match) ++
                                      gsubRegexPRGen (Just sp) reg fsub sp
      Nothing -> snd src

subBackRef ::
  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef (_, _) "" = ""
subBackRef al@((_, match, (hasRead,post)), ml) ('\\':str@(c:rest))
  | elem c "&0" = match                                 ++ subBackRef al rest
  | c == '`'    = reverse (drop (length match) hasRead) ++ subBackRef al rest
  | c == '\''   = post                                  ++ subBackRef al rest
  | c == '+'    = snd (head ml)                         ++ subBackRef al rest
  | c == '{'    = maybe "" id (lookup (read $ takeWhile (/='}') rest) ml) ++
                  subBackRef al (tail $ dropWhile (/='}') str)
  | otherwise   = maybe "" id (lookup (read $ takeWhile isDigit str) ml) ++
                  subBackRef al (dropWhile isDigit str)
subBackRef al (c:cs) = c : subBackRef al cs

splitRegexPR :: String -> String -> [String]
splitRegexPR reg str
  = let gmatched = gmatchRegexPR reg str
     in map (fst.snd.fst) gmatched ++ [(snd.snd.fst.last) gmatched]