--
-- RegexPR.hs
--
-- Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--
-- This file is part of regexpr library
--
-- regexpr is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or any later version.
--
-- regexpr is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANGY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.

module Text.RegexPR (

  matchRegexPR
, multiMatchRegexPR
, gmatchRegexPR

, getbrsRegexPR
, ggetbrsRegexPR

, subRegexPR
, subRegexPRBy
, gsubRegexPR
, gsubRegexPRBy

, splitRegexPR

) where

import Hidden.RegexPRCore  ( matchRegexPRVerbose,
                             multiMatchRegexPRVerbose          )
import Hidden.RegexPRTypes ( MatchFun   , VerboseMatchFun,
                             RegexResult, VerboseResult  ,
			     MatchList                         )
import Data.Char           ( isDigit                           )
import Data.List           ( sort, nubBy                       )
import Data.Function       ( on                                )
import Data.Maybe          ( fromMaybe                         )
import Control.Arrow       ( first                             )

------------------------------------------------------------

matchRegexPR      :: MatchFun Maybe
matchRegexPR :: MatchFun Maybe
matchRegexPR      = VerboseMatchFun Maybe -> MatchFun Maybe
forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun Maybe
matchRegexPRVerbose

multiMatchRegexPR :: MatchFun []
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR = VerboseMatchFun [] -> MatchFun []
forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun []
multiMatchRegexPRVerbose

gmatchRegexPR :: MatchFun []
gmatchRegexPR :: MatchFun []
gmatchRegexPR String
reg = (String, String) -> [(RegexResult, MatchList)]
baseFun ((String, String) -> [(RegexResult, MatchList)])
-> (String -> (String, String))
-> String
-> [(RegexResult, MatchList)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""
  where
  baseFun :: (String, String) -> [(RegexResult, MatchList)]
baseFun ( String
_, String
"" ) = []
  baseFun (String, String)
pos       = [(RegexResult, MatchList)]
-> (((String, String, (String, String)), MatchList)
    -> [(RegexResult, MatchList)])
-> Maybe ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun (Maybe ((String, String, (String, String)), MatchList)
 -> [(RegexResult, MatchList)])
-> Maybe ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
forall a b. (a -> b) -> a -> b
$ VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String, String)
pos
  justFun :: ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun mr :: ((String, String, (String, String)), MatchList)
mr@( ( String
_, String
r, (String, String)
pos ), MatchList
_ )
    = ((String, String, (String, String)) -> RegexResult)
-> ((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ((String, String, (String, String)), MatchList)
mr (RegexResult, MatchList)
-> [(RegexResult, MatchList)] -> [(RegexResult, MatchList)]
forall a. a -> [a] -> [a]
:
      (String, String) -> [(RegexResult, MatchList)]
baseFun ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then (String, String) -> (String, String)
forall {a}. ([a], [a]) -> ([a], [a])
next (String, String)
pos else (String, String)
pos )
  next :: ([a], [a]) -> ([a], [a])
next ( [a]
p, a
x:[a]
xs ) = ( a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
p, [a]
xs )
  next ([a], [a])
_           = String -> ([a], [a])
forall a. HasCallStack => String -> a
error String
"can not go to next"

simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun :: forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun f
mf String
reg
  = (((String, String, (String, String)), MatchList)
 -> (RegexResult, MatchList))
-> f ((String, String, (String, String)), MatchList)
-> f (RegexResult, MatchList)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( ((String, String, (String, String)) -> RegexResult)
-> ((String, String, (String, String)), MatchList)
-> (RegexResult, MatchList)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ) (f ((String, String, (String, String)), MatchList)
 -> f (RegexResult, MatchList))
-> (String -> f ((String, String, (String, String)), MatchList))
-> String
-> f (RegexResult, MatchList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerboseMatchFun f
mf String
reg ((String, String)
 -> f ((String, String, (String, String)), MatchList))
-> (String -> (String, String))
-> String
-> f ((String, String, (String, String)), MatchList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""

simplifyResult :: VerboseResult -> RegexResult
simplifyResult :: (String, String, (String, String)) -> RegexResult
simplifyResult ( String
pre, String
ret, (String
_, String
rest) ) = ( String
ret, (String
pre, String
rest) )

------------------------------------------------------------

getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR :: String -> String -> [String]
getbrsRegexPR String
reg String
str
  = case MatchFun Maybe
matchRegexPR String
reg String
str of
         Maybe (RegexResult, MatchList)
Nothing
	   -> []
	 Just ( ( String
ret, (String
_, String
_) ), MatchList
ml )
	   -> String
ret String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Int, String) -> String) -> MatchList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd ( MatchList -> MatchList
forall a. Ord a => [a] -> [a]
sort (MatchList -> MatchList) -> MatchList -> MatchList
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> (Int, String) -> Bool) -> MatchList -> MatchList
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ( (Int -> Int -> Bool)
-> ((Int, String) -> Int) -> (Int, String) -> (Int, String) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int, String) -> Int
forall a b. (a, b) -> a
fst ) MatchList
ml )

ggetbrsRegexPR :: String -> String -> [ [ String ] ]
ggetbrsRegexPR :: String -> String -> [[String]]
ggetbrsRegexPR String
reg
  = ((RegexResult, MatchList) -> [String])
-> [(RegexResult, MatchList)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ( \( (String
m, (String, String)
_), MatchList
bl ) ->
            String
m String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Int, String) -> String) -> MatchList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd ( MatchList -> MatchList
forall a. Ord a => [a] -> [a]
sort (MatchList -> MatchList) -> MatchList -> MatchList
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> (Int, String) -> Bool) -> MatchList -> MatchList
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((Int -> Int -> Bool)
-> ((Int, String) -> Int) -> (Int, String) -> (Int, String) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int, String) -> Int
forall a b. (a, b) -> a
fst) MatchList
bl ) )
    ([(RegexResult, MatchList)] -> [[String]])
-> (String -> [(RegexResult, MatchList)]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchFun []
gmatchRegexPR String
reg

------------------------------------------------------------

splitRegexPR :: String -> String -> [String]
splitRegexPR :: String -> String -> [String]
splitRegexPR String
reg String
str
  = case [(RegexResult, MatchList)]
gmatched of
         [ ] -> [ ]
         [(RegexResult, MatchList)]
_   -> ((RegexResult, MatchList) -> String)
-> [(RegexResult, MatchList)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ( (String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> ((RegexResult, MatchList) -> (String, String))
-> (RegexResult, MatchList)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RegexResult -> (String, String)
forall a b. (a, b) -> b
snd(RegexResult -> (String, String))
-> ((RegexResult, MatchList) -> RegexResult)
-> (RegexResult, MatchList)
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RegexResult, MatchList) -> RegexResult
forall a b. (a, b) -> a
fst ) [(RegexResult, MatchList)]
gmatched [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ ((String, String) -> String
forall a b. (a, b) -> b
snd((String, String) -> String)
-> ([(RegexResult, MatchList)] -> (String, String))
-> [(RegexResult, MatchList)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RegexResult -> (String, String)
forall a b. (a, b) -> b
snd(RegexResult -> (String, String))
-> ([(RegexResult, MatchList)] -> RegexResult)
-> [(RegexResult, MatchList)]
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RegexResult, MatchList) -> RegexResult
forall a b. (a, b) -> a
fst((RegexResult, MatchList) -> RegexResult)
-> ([(RegexResult, MatchList)] -> (RegexResult, MatchList))
-> [(RegexResult, MatchList)]
-> RegexResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(RegexResult, MatchList)] -> (RegexResult, MatchList)
forall a. HasCallStack => [a] -> a
last) [(RegexResult, MatchList)]
gmatched ]
  where gmatched :: [(RegexResult, MatchList)]
gmatched = MatchFun []
gmatchRegexPR String
reg String
str

------------------------------------------------------------

subRegexPR :: String -> String -> String -> String
subRegexPR :: String -> String -> String -> String
subRegexPR String
reg String
sub = String -> (String -> String) -> String -> String
subRegexPRBy String
reg (String -> String -> String
forall a b. a -> b -> a
const String
sub)

subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy String
reg String -> String
subf String
src
  = case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String
"",String
src) of
         Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
m, (String, String)
sp), MatchList
_) -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
subf String
m) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
sp
         Maybe ((String, String, (String, String)), MatchList)
Nothing                   -> String
src

gsubRegexPR :: String -> String -> String -> String
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR String
reg String
sub String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
forall a. Maybe a
Nothing String
reg (String -> String -> String
forall a b. a -> b -> a
const String
sub) (String
"", String
src)

gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy String
reg String -> String
subf String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
forall a. Maybe a
Nothing String
reg String -> String
subf (String
"", String
src)

gsubRegexPRGen ::
  Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen :: Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
pmp String
reg String -> String
fsub (String, String)
src
  = case VerboseMatchFun Maybe
matchRegexPRVerbose String
reg (String, String)
src of
      Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
match, sp :: (String, String)
sp@(~(String
p,Char
x:String
xs))), MatchList
_)
        -> case (Maybe (String, String)
pmp, (String, String)
sp) of
                (Just (String
_, String
""), (String, String)
_)  -> String
""
                (Maybe (String, String), (String, String))
_ | (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp Maybe (String, String) -> Maybe (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (String, String)
pmp -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
p, String
xs)
                  | Bool
otherwise      -> String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
fsub String
match) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (String, String)
sp
      Maybe ((String, String, (String, String)), MatchList)
Nothing -> (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
src

subBackRef ::
  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef :: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String))
_, MatchList
_) String
"" = String
""
subBackRef al :: ((String, String, (String, String)), MatchList)
al@((String
_, String
match, (String
hasRead,String
post)), MatchList
ml) (Char
'\\':str :: String
str@(Char
c:String
rest))
  | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"&0" = String
match                                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'    = String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
match) String
hasRead) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''   = String
post                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'    = (Int, String) -> String
forall a b. (a, b) -> b
snd (MatchList -> (Int, String)
forall a. HasCallStack => [a] -> a
head MatchList
ml)                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'    = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Int -> MatchList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
rest) MatchList
ml) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
forall a. HasCallStack => [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') String
str)
  | Bool
otherwise   = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Int -> MatchList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
str) MatchList
ml) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit String
str)
subBackRef ((String, String, (String, String)), MatchList)
al (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
cs