1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
--
-- 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 = simplifyMatchFun matchRegexPRVerbose
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR = simplifyMatchFun multiMatchRegexPRVerbose
gmatchRegexPR :: MatchFun []
gmatchRegexPR reg = baseFun . (,) ""
where
baseFun ( _, "" ) = []
baseFun pos = maybe [] justFun $ matchRegexPRVerbose reg pos
justFun mr@( ( _, r, pos ), _ )
= first simplifyResult mr :
baseFun ( if null r then next pos else pos )
next ( p, x:xs ) = ( x:p, xs )
next _ = error "can not go to next"
simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun mf reg
= fmap ( first simplifyResult ) . mf reg . (,) ""
simplifyResult :: VerboseResult -> RegexResult
simplifyResult ( pre, ret, (_, rest) ) = ( ret, (pre, rest) )
------------------------------------------------------------
getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR reg str
= case matchRegexPR reg str of
Nothing
-> []
Just ( ( ret, (_, _) ), ml )
-> ret : map snd ( sort $ nubBy ( on (==) fst ) ml )
ggetbrsRegexPR :: String -> String -> [ [ String ] ]
ggetbrsRegexPR reg
= map ( \( (m, _), bl ) ->
m : map snd ( sort $ nubBy (on (==) fst) bl ) )
. gmatchRegexPR reg
------------------------------------------------------------
splitRegexPR :: String -> String -> [String]
splitRegexPR reg str
= case gmatched of
[ ] -> [ ]
_ -> map ( fst.snd.fst ) gmatched ++ [ (snd.snd.fst.last) gmatched ]
where gmatched = gmatchRegexPR reg str
------------------------------------------------------------
subRegexPR :: String -> String -> String -> String
subRegexPR reg sub = subRegexPRBy reg (const sub)
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))
| c `elem` "&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 == '{' = fromMaybe "" (lookup (read $ takeWhile (/='}') rest) ml) ++
subBackRef al (tail $ dropWhile (/='}') str)
| otherwise = fromMaybe "" (lookup (read $ takeWhile isDigit str) ml) ++
subBackRef al (dropWhile isDigit str)
subBackRef al (c:cs) = c : subBackRef al cs
|
