{- | 
This modules provides 'RegexMaker' and 'RegexLike' instances for using
'String' with the TDFA backend.

This exports instances of the high level API and the medium level
API of 'compile','execute', and 'regexec'.
-}
{- By Chris Kuklewicz, 2009. BSD License, see the LICENSE file. -}
module Text.Regex.TDFA.String(
  -- ** Types
  Regex
 ,MatchOffset
 ,MatchLength
 ,CompOption
 ,ExecOption
  -- ** Medium level API functions
 ,compile
 ,execute
 ,regexec
 ) where

import Text.Regex.Base.Impl(polymatch,polymatchM)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchOffset,MatchLength,MatchArray)
import Text.Regex.TDFA.Common(common_error,Regex(..),CompOption,ExecOption(captureGroups))
import Text.Regex.TDFA.ReadRegex(parseRegex)
import Text.Regex.TDFA.TDFA(patternToRegex)

import Data.Array.IArray((!),elems,amap)
import Data.Maybe(listToMaybe)
import Text.Regex.TDFA.NewDFA.Engine(execMatch)
import Text.Regex.TDFA.NewDFA.Tester as Tester(matchTest)

err :: String -> a
err :: String -> a
err = String -> String -> a
forall a. String -> String -> a
common_error "Text.Regex.TDFA.String"

unwrap :: Either String v -> v
unwrap :: Either String v -> v
unwrap x :: Either String v
x = case Either String v
x of Left msg :: String
msg -> String -> v
forall a. String -> a
err ("Text.Regex.TDFA.String died: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
msg)
                     Right v :: v
v -> v
v

compile  :: CompOption -- ^ Flags (summed together)
         -> ExecOption -- ^ Flags (summed together)
         -> String     -- ^ The regular expression to compile (ASCII only, no null bytes)
         -> Either String Regex -- ^ Returns: the compiled regular expression
compile :: CompOption -> ExecOption -> String -> Either String Regex
compile compOpt :: CompOption
compOpt execOpt :: ExecOption
execOpt source :: String
source =
  case String -> Either ParseError (Pattern, (GroupIndex, DoPa))
parseRegex String
source of
    Left msg :: ParseError
msg -> String -> Either String Regex
forall a b. a -> Either a b
Left ("parseRegex for Text.Regex.TDFA.String failed:"String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseError -> String
forall a. Show a => a -> String
show ParseError
msg)
    Right pattern :: (Pattern, (GroupIndex, DoPa))
pattern -> Regex -> Either String Regex
forall a b. b -> Either a b
Right ((Pattern, (GroupIndex, DoPa)) -> CompOption -> ExecOption -> Regex
patternToRegex (Pattern, (GroupIndex, DoPa))
pattern CompOption
compOpt ExecOption
execOpt)

instance RegexMaker Regex CompOption ExecOption String where
  makeRegexOpts :: CompOption -> ExecOption -> String -> Regex
makeRegexOpts c :: CompOption
c e :: ExecOption
e source :: String
source = Either String Regex -> Regex
forall v. Either String v -> v
unwrap (CompOption -> ExecOption -> String -> Either String Regex
compile CompOption
c ExecOption
e String
source)
  makeRegexOptsM :: CompOption -> ExecOption -> String -> m Regex
makeRegexOptsM c :: CompOption
c e :: ExecOption
e source :: String
source = (String -> m Regex)
-> (Regex -> m Regex) -> Either String Regex -> m Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Regex
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Regex -> m Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Regex -> m Regex) -> Either String Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ CompOption -> ExecOption -> String -> Either String Regex
compile CompOption
c ExecOption
e String
source

execute :: Regex      -- ^ Compiled regular expression
        -> String     -- ^ String to match against
        -> Either String (Maybe MatchArray)
execute :: Regex -> String -> Either String (Maybe MatchArray)
execute r :: Regex
r s :: String
s = Maybe MatchArray -> Either String (Maybe MatchArray)
forall a b. b -> Either a b
Right (Regex -> String -> Maybe MatchArray
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
matchOnce Regex
r String
s)

regexec :: Regex      -- ^ Compiled regular expression
        -> String     -- ^ String to match against
        -> Either String (Maybe (String, String, String, [String]))
regexec :: Regex
-> String
-> Either String (Maybe (String, String, String, [String]))
regexec r :: Regex
r s :: String
s =
  case Regex -> String -> Maybe (String, MatchText String, String)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
r String
s of
    Nothing -> Maybe (String, String, String, [String])
-> Either String (Maybe (String, String, String, [String]))
forall a b. b -> Either a b
Right Maybe (String, String, String, [String])
forall a. Maybe a
Nothing
    Just (pre :: String
pre,mt :: MatchText String
mt,post :: String
post) ->
      let main :: String
main = (String, (GroupIndex, GroupIndex)) -> String
forall a b. (a, b) -> a
fst (MatchText String
mtMatchText String
-> GroupIndex -> (String, (GroupIndex, GroupIndex))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!0)
          rest :: [String]
rest = ((String, (GroupIndex, GroupIndex)) -> String)
-> [(String, (GroupIndex, GroupIndex))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (GroupIndex, GroupIndex)) -> String
forall a b. (a, b) -> a
fst ([(String, (GroupIndex, GroupIndex))]
-> [(String, (GroupIndex, GroupIndex))]
forall a. [a] -> [a]
tail (MatchText String -> [(String, (GroupIndex, GroupIndex))]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems MatchText String
mt)) -- will be []
      in Maybe (String, String, String, [String])
-> Either String (Maybe (String, String, String, [String]))
forall a b. b -> Either a b
Right ((String, String, String, [String])
-> Maybe (String, String, String, [String])
forall a. a -> Maybe a
Just (String
pre,String
main,String
post,[String]
rest))

-- Minimal defintion for now
instance RegexLike Regex String where
  matchOnce :: Regex -> String -> Maybe MatchArray
matchOnce r :: Regex
r s :: String
s = [MatchArray] -> Maybe MatchArray
forall a. [a] -> Maybe a
listToMaybe (Regex -> String -> [MatchArray]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll Regex
r String
s)
  matchAll :: Regex -> String -> [MatchArray]
matchAll r :: Regex
r s :: String
s = Regex -> GroupIndex -> Char -> String -> [MatchArray]
forall text.
Uncons text =>
Regex -> GroupIndex -> Char -> text -> [MatchArray]
execMatch Regex
r 0 '\n' String
s
  matchCount :: Regex -> String -> GroupIndex
matchCount r :: Regex
r s :: String
s = [MatchArray] -> GroupIndex
forall (t :: * -> *) a. Foldable t => t a -> GroupIndex
length (Regex -> String -> [MatchArray]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll Regex
r' String
s)
    where r' :: Regex
r' = Regex
r { regex_execOptions :: ExecOption
regex_execOptions = (Regex -> ExecOption
regex_execOptions Regex
r) {captureGroups :: Bool
captureGroups = Bool
False} }
  matchTest :: Regex -> String -> Bool
matchTest = Regex -> String -> Bool
forall text. Uncons text => Regex -> text -> Bool
Tester.matchTest
  -- matchOnceText
  matchAllText :: Regex -> String -> [MatchText String]
matchAllText r :: Regex
r s :: String
s =
    let go :: GroupIndex
-> [a]
-> [a i (GroupIndex, GroupIndex)]
-> [a i ([a], (GroupIndex, GroupIndex))]
go i :: GroupIndex
i _ _ | GroupIndex
i GroupIndex -> Bool -> Bool
forall a b. a -> b -> b
`seq` Bool
False = [a i ([a], (GroupIndex, GroupIndex))]
forall a. HasCallStack => a
undefined
        go _i :: GroupIndex
_i _t :: [a]
_t [] = []
        go i :: GroupIndex
i t :: [a]
t (x :: a i (GroupIndex, GroupIndex)
x:xs :: [a i (GroupIndex, GroupIndex)]
xs) = let (off0 :: GroupIndex
off0,len0 :: GroupIndex
len0) = a i (GroupIndex, GroupIndex)
xa i (GroupIndex, GroupIndex) -> i -> (GroupIndex, GroupIndex)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!0
                            trans :: (GroupIndex, GroupIndex) -> ([a], (GroupIndex, GroupIndex))
trans pair :: (GroupIndex, GroupIndex)
pair@(off :: GroupIndex
off,len :: GroupIndex
len) = (GroupIndex -> [a] -> [a]
forall a. GroupIndex -> [a] -> [a]
take GroupIndex
len (GroupIndex -> [a] -> [a]
forall a. GroupIndex -> [a] -> [a]
drop (GroupIndex
offGroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
-GroupIndex
i) [a]
t),(GroupIndex, GroupIndex)
pair)
                            t' :: [a]
t' = GroupIndex -> [a] -> [a]
forall a. GroupIndex -> [a] -> [a]
drop (GroupIndex
off0GroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
+GroupIndex
len0GroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
-GroupIndex
i) [a]
t
                        in ((GroupIndex, GroupIndex) -> ([a], (GroupIndex, GroupIndex)))
-> a i (GroupIndex, GroupIndex)
-> a i ([a], (GroupIndex, GroupIndex))
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap (GroupIndex, GroupIndex) -> ([a], (GroupIndex, GroupIndex))
trans a i (GroupIndex, GroupIndex)
x a i ([a], (GroupIndex, GroupIndex))
-> [a i ([a], (GroupIndex, GroupIndex))]
-> [a i ([a], (GroupIndex, GroupIndex))]
forall a. a -> [a] -> [a]
: [a]
-> [a i ([a], (GroupIndex, GroupIndex))]
-> [a i ([a], (GroupIndex, GroupIndex))]
forall a b. a -> b -> b
seq [a]
t' (GroupIndex
-> [a]
-> [a i (GroupIndex, GroupIndex)]
-> [a i ([a], (GroupIndex, GroupIndex))]
go (GroupIndex
off0GroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
+GroupIndex
len0) [a]
t' [a i (GroupIndex, GroupIndex)]
xs)
    in GroupIndex -> String -> [MatchArray] -> [MatchText String]
forall (a :: * -> * -> *) a i.
(IArray a ([a], (GroupIndex, GroupIndex)),
 IArray a (GroupIndex, GroupIndex), Ix i, Num i) =>
GroupIndex
-> [a]
-> [a i (GroupIndex, GroupIndex)]
-> [a i ([a], (GroupIndex, GroupIndex))]
go 0 String
s (Regex -> String -> [MatchArray]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchArray]
matchAll Regex
r String
s)

instance RegexContext Regex String String where
  match :: Regex -> String -> String
match = Regex -> String -> String
forall a b. RegexLike a b => a -> b -> b
polymatch
  matchM :: Regex -> String -> m String
matchM = Regex -> String -> m String
forall a b (m :: * -> *).
(RegexLike a b, MonadFail m) =>
a -> b -> m b
polymatchM