{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Regex.Lens
( MatchPart(..)
, matchedString
, captures
, regex
, regex'
, matched
, matched'
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid
#endif
import Control.Lens
import qualified Data.Array as A
import Text.Regex.Base
type RegexResult text = [RegexPartialResult text]
type RegexPartialResult text = Either text (MatchPart text)
data MatchPart text = MatchPart
{ MatchPart text -> text
_matchedString :: text
, MatchPart text -> [text]
_captures :: [text]
} deriving Int -> MatchPart text -> ShowS
[MatchPart text] -> ShowS
MatchPart text -> String
(Int -> MatchPart text -> ShowS)
-> (MatchPart text -> String)
-> ([MatchPart text] -> ShowS)
-> Show (MatchPart text)
forall text. Show text => Int -> MatchPart text -> ShowS
forall text. Show text => [MatchPart text] -> ShowS
forall text. Show text => MatchPart text -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchPart text] -> ShowS
$cshowList :: forall text. Show text => [MatchPart text] -> ShowS
show :: MatchPart text -> String
$cshow :: forall text. Show text => MatchPart text -> String
showsPrec :: Int -> MatchPart text -> ShowS
$cshowsPrec :: forall text. Show text => Int -> MatchPart text -> ShowS
Show
makeLensesFor [("_matchedString", "matchedString")] ''MatchPart
makeLensesWith (lensRulesFor [("_captures", "captures")] & generateUpdateableOptics .~ False) ''MatchPart
regex :: (RegexLike regex text, Monoid text)
=> regex
-> IndexedTraversal' Int text (MatchPart text)
regex :: regex -> IndexedTraversal' Int text (MatchPart text)
regex regex
pat = regex -> Lens' text (RegexResult text)
forall regex text.
(RegexLike regex text, Monoid text) =>
regex -> Lens' text (RegexResult text)
regex' regex
pat ((RegexResult text -> f (RegexResult text)) -> text -> f text)
-> (p (MatchPart text) (f (MatchPart text))
-> RegexResult text -> f (RegexResult text))
-> p (MatchPart text) (f (MatchPart text))
-> text
-> f text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (MatchPart text) (f (MatchPart text))
-> RegexResult text -> f (RegexResult text)
forall (p :: * -> * -> *) (f :: * -> *) text.
(Indexable Int p, Applicative f) =>
p (MatchPart text) (f (MatchPart text))
-> RegexResult text -> f (RegexResult text)
matched
regex' :: (RegexLike regex text, Monoid text) => regex -> Lens' text (RegexResult text)
regex' :: regex -> Lens' text (RegexResult text)
regex' regex
pat RegexResult text -> f (RegexResult text)
f text
target = RegexResult text -> text
forall text. Monoid text => RegexResult text -> text
fromRegexResult (RegexResult text -> text) -> f (RegexResult text) -> f text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegexResult text -> f (RegexResult text)
f (regex -> text -> RegexResult text
forall regex text.
RegexLike regex text =>
regex -> text -> RegexResult text
toRegexResult regex
pat text
target)
matched :: (Indexable Int p, Applicative f)
=> p (MatchPart text) (f (MatchPart text)) -> RegexResult text -> f (RegexResult text)
matched :: p (MatchPart text) (f (MatchPart text))
-> RegexResult text -> f (RegexResult text)
matched = ((p ~ (->)) =>
(MatchPart text -> f (MatchPart text))
-> RegexResult text -> f (RegexResult text))
-> (p (MatchPart text) (f (MatchPart text))
-> RegexResult text -> f (RegexResult text))
-> p (MatchPart text) (f (MatchPart text))
-> RegexResult text
-> f (RegexResult text)
forall (p :: * -> * -> *) (q :: * -> * -> *) a b r.
Conjoined p =>
((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined (p ~ (->)) =>
(MatchPart text -> f (MatchPart text))
-> RegexResult text -> f (RegexResult text)
forall text. Traversal' (RegexResult text) (MatchPart text)
matched' (((MatchPart text -> Indexing f (MatchPart text))
-> RegexResult text -> Indexing f (RegexResult text))
-> p (MatchPart text) (f (MatchPart text))
-> RegexResult text
-> f (RegexResult text)
forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing (MatchPart text -> Indexing f (MatchPart text))
-> RegexResult text -> Indexing f (RegexResult text)
forall text. Traversal' (RegexResult text) (MatchPart text)
matched')
matched' :: Traversal' (RegexResult text) (MatchPart text)
matched' :: (MatchPart text -> f (MatchPart text))
-> RegexResult text -> f (RegexResult text)
matched' MatchPart text -> f (MatchPart text)
f RegexResult text
target = RegexResult text -> f (RegexResult text)
forall a.
[Either a (MatchPart text)] -> f [Either a (MatchPart text)]
go RegexResult text
target
where
go :: [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
go [] = [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
go ((Left a
x):[Either a (MatchPart text)]
xs) = ((a -> Either a (MatchPart text)
forall a b. a -> Either a b
Left a
x)Either a (MatchPart text)
-> [Either a (MatchPart text)] -> [Either a (MatchPart text)]
forall a. a -> [a] -> [a]
:) ([Either a (MatchPart text)] -> [Either a (MatchPart text)])
-> f [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
go [Either a (MatchPart text)]
xs
go ((Right MatchPart text
x):[Either a (MatchPart text)]
xs) = (:) (Either a (MatchPart text)
-> [Either a (MatchPart text)] -> [Either a (MatchPart text)])
-> f (Either a (MatchPart text))
-> f ([Either a (MatchPart text)] -> [Either a (MatchPart text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MatchPart text -> Either a (MatchPart text)
forall a b. b -> Either a b
Right (MatchPart text -> Either a (MatchPart text))
-> f (MatchPart text) -> f (Either a (MatchPart text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatchPart text -> f (MatchPart text)
f MatchPart text
x) f ([Either a (MatchPart text)] -> [Either a (MatchPart text)])
-> f [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Either a (MatchPart text)] -> f [Either a (MatchPart text)]
go [Either a (MatchPart text)]
xs
toRegexResult :: RegexLike regex text => regex -> text -> (RegexResult text)
toRegexResult :: regex -> text -> RegexResult text
toRegexResult regex
pat text
target = Int -> [Array Int (Int, Int)] -> RegexResult text
forall i.
(Ix i, Num i) =>
Int -> [Array i (Int, Int)] -> RegexResult text
go Int
0 ([Array Int (Int, Int)] -> RegexResult text)
-> [Array Int (Int, Int)] -> RegexResult text
forall a b. (a -> b) -> a -> b
$ regex -> text -> [Array Int (Int, Int)]
forall regex source.
RegexLike regex source =>
regex -> source -> [Array Int (Int, Int)]
matchAll regex
pat text
target
where
go :: Int -> [Array i (Int, Int)] -> RegexResult text
go Int
pos [] = [text -> Either text (MatchPart text)
forall a b. a -> Either a b
Left (Int -> text -> text
forall source. Extract source => Int -> source -> source
after Int
pos text
target)]
go Int
pos (Array i (Int, Int)
m:[Array i (Int, Int)]
ms) =
if Int
posDiff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then text -> Either text (MatchPart text)
forall a b. a -> Either a b
Left ((Int, Int) -> text -> text
forall source. Extract source => (Int, Int) -> source -> source
extract (Int
pos, Int
posDiff) text
target) Either text (MatchPart text)
-> RegexResult text -> RegexResult text
forall a. a -> [a] -> [a]
: RegexResult text
cont
else RegexResult text
cont
where
(Int
pos', Int
len) = Array i (Int, Int)
m Array i (Int, Int) -> i -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
A.! i
0
posDiff :: Int
posDiff = Int
pos' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos
(text
ms0:[text]
mss) = ((Int, Int) -> text) -> [(Int, Int)] -> [text]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int) -> text -> text) -> text -> (Int, Int) -> text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Int) -> text -> text
forall source. Extract source => (Int, Int) -> source -> source
extract text
target) ([(Int, Int)] -> [text]) -> [(Int, Int)] -> [text]
forall a b. (a -> b) -> a -> b
$ Array i (Int, Int) -> [(Int, Int)]
forall i e. Array i e -> [e]
A.elems Array i (Int, Int)
m
cont :: RegexResult text
cont = MatchPart text -> Either text (MatchPart text)
forall a b. b -> Either a b
Right (text -> [text] -> MatchPart text
forall text. text -> [text] -> MatchPart text
MatchPart text
ms0 [text]
mss) Either text (MatchPart text)
-> RegexResult text -> RegexResult text
forall a. a -> [a] -> [a]
: Int -> [Array i (Int, Int)] -> RegexResult text
go (Int
pos' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) [Array i (Int, Int)]
ms
fromRegexResult :: Monoid text => (RegexResult text) -> text
fromRegexResult :: RegexResult text -> text
fromRegexResult = [text] -> text
forall a. Monoid a => [a] -> a
mconcat ([text] -> text)
-> (RegexResult text -> [text]) -> RegexResult text -> text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either text (MatchPart text) -> text)
-> RegexResult text -> [text]
forall a b. (a -> b) -> [a] -> [b]
map Either text (MatchPart text) -> text
forall p. Either p (MatchPart p) -> p
toStr
where
toStr :: Either p (MatchPart p) -> p
toStr (Right (MatchPart p
s [p]
_)) = p
s
toStr (Left p
s) = p
s