{-# 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

-- $setup
-- >>> import Text.Regex.Quote
-- >>> import Text.Regex.Posix
-- >>> :set -XQuasiQuotes

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

-- | An indexed Traversal for matched part with regexp.
--
-- >>> "foo bar baz" ^? regex [r|b.*r|]
-- Just (MatchPart {_matchedString = "bar", _captures = []})
--
-- >>> "foo bar baz" ^? regex [r|hoge|]
-- Nothing
--
-- You can access to the matched string by using `matchedString`:
--
-- >>> "foo bar baz" ^? regex [r|b.*r|] . matchedString
-- Just "bar"
--
-- Multiple result:
--
-- >>> "foo bar baz" ^.. regex [r|b[^ ]+|] . matchedString
-- ["bar","baz"]
--
-- Replace:
--
-- >>> "foo bar baz" & regex [r|b[^ ]+|] . matchedString .~ "nya"
-- "foo nya nya"
--
-- Indexing:
--
-- >>> "foo bar baz" ^.. regex [r|b[^ ]+|] . index 1 . matchedString
-- ["baz"]
--
-- >>> "foo bar baz" & regex [r|b[^ ]+|] . index 1 . matchedString .~ "nya"
-- "foo bar nya"
--
-- Captures:
--
-- >>> "foo00 bar01 baz02" ^.. regex [r|([a-z]+)([0-9]+)|] . captures
-- [["foo","00"],["bar","01"],["baz","02"]]
--
-- >>> "foo00 bar01 baz02" ^.. regex [r|([a-z]+)([0-9]+)|] . captures . traversed . index 1
-- ["00","01","02"]
--
-- /Note/: This is /not/ a legal Traversal, unless you are very careful not to invalidate the predicate on the target.
-- For example, if you replace the matched part with a string which is not match with the regex, the second 'Traversal' law is violated.
--
-- @
-- let l = regex [r|t.*t|] . matchedString
-- 'Control.Lens.Setter.over' l (++ "peta") '.' 'Control.Lens.Setter.over' l (++ "nya") '/=' 'Control.Lens.Setter.over' l ((++ "peta") . (++ "nya"))
-- 'Control.Lens.Setter.over' l (++ "put") '.' 'Control.Lens.Setter.over' l (++ "hot") '==' 'Control.Lens.Setter.over' l ((++ "put") . (++ "hot"))
-- @
regex :: (RegexLike regex text, Monoid text)
      => regex -- ^ compiled regular expression
      -> 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