{- copyright (c) sreservoir.
   license bsd three-clause. -}

module Text.Regex.Less ((=~),truth,yank,base,subst,backref,unjust) where

import qualified Data.ByteString.Char8 as B
import qualified Text.Regex.PCRE.Light as R
import Data.List
import Text.Regex.Less.Quackers

type Result = (String,Maybe [String])

-- standard usage:
  --  "" =~ ""
  --  "" =~ "" << RECOpts
  --  "" =~ "" << REEOpts
  --  "" =~ "" << RECOpts << REEOpts
-- value suitable for use below.
infixl 6 =~
(=~) :: QLR a => String -> a -> Result
a =~ b =
  case R.match (compile b) (B.pack a) (runopts b) of
    Just c -> (a,Just (map B.unpack c))
    Nothing -> (a,Nothing)

-- success/failure of a regex.
truth :: Result -> Bool
truth (_,a) =
  case a of
    Just _ -> True
    Nothing -> False

-- yanks out the matches.
yank :: Result -> [String]
yank (_,a) = unjust a

-- returns the original string.
base :: Result -> String
base (a,_) = a

-- substitutes the matched part.
-- does backrefs with derefs.
subst :: Result -> String -> String
subst a b = subst' (base a) b (yank a)
  where subst' [] _ _ = []
        subst' _ _ [] = []
        subst' ca@(c:cs) d es@(e:_)
          | e `isPrefixOf` ca = derefs es d ++ unjust (stripPrefix e ca)
          | otherwise = c : subst' cs d es

-- dereferences backrefs with ^ .
derefs :: [String] -> String -> String
derefs a ('^':'^':bs) = '^' : derefs a bs
derefs a ('^':bs) =
  case reads bs of
    [(c,d)] -> a !! c ++ derefs a d
    _       -> error "there's nothing here."
derefs a (b:bs) = b : derefs a bs
derefs _ [] = []

-- takes the backrefs of a match.
  -- backref 0 is the whole match.
backref :: Result -> Int -> String
backref a b = yank a !! b

-- takes a Maybe(Just)'s value.
-- fails with [] on Nothing.
unjust :: Maybe a -> a
unjust (Just a) = a
unjust Nothing  = error "not unjustifiable."