{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
This exports instances of the high level API and the medium level
API of 'compile','execute', and 'regexec'.
-}
{- Copyright   :  (c) Chris Kuklewicz 2007 -}
module Text.Regex.PCRE.String(
  -- ** Types
  Regex,
  MatchOffset,
  MatchLength,
  CompOption(CompOption),
  ExecOption(ExecOption),
  ReturnCode,
  WrapError,
  -- ** Miscellaneous
  unusedOffset,
  getVersion,
  -- ** Medium level API functions
  compile,
  execute,
  regexec,
  -- ** Constants for CompOption
  compBlank,
  compAnchored,
  compAutoCallout,
  compCaseless,
  compDollarEndOnly,
  compDotAll,
  compExtended,
  compExtra,
  compFirstLine,
  compMultiline,
  compNoAutoCapture,
  compUngreedy,
  compUTF8,
  compNoUTF8Check,
  -- ** Constants for ExecOption
  execBlank,
  execAnchored,
  execNotBOL,
  execNotEOL,
  execNotEmpty,
  execNoUTF8Check,
  execPartial
  ) where

import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(fail))

import Text.Regex.PCRE.Wrap -- all
import Foreign.C.String(withCStringLen,withCString)
import Data.Array(Array,listArray)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchLength,MatchOffset)
import Text.Regex.Base.Impl(polymatch,polymatchM)

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

unwrap :: (Show e) => Either e v -> IO v
unwrap :: Either e v -> IO v
unwrap Either e v
x = case Either e v
x of Left e
err -> String -> IO v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.PCRE.String died: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
err)
                     Right v
v -> v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v

instance RegexMaker Regex CompOption ExecOption String where
  makeRegexOpts :: CompOption -> ExecOption -> String -> Regex
makeRegexOpts CompOption
c ExecOption
e String
pattern = IO Regex -> Regex
forall a. IO a -> a
unsafePerformIO (IO Regex -> Regex) -> IO Regex -> Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> String -> IO (Either (MatchOffset, String) Regex)
compile CompOption
c ExecOption
e String
pattern IO (Either (MatchOffset, String) Regex)
-> (Either (MatchOffset, String) Regex -> IO Regex) -> IO Regex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (MatchOffset, String) Regex -> IO Regex
forall e v. Show e => Either e v -> IO v
unwrap
  makeRegexOptsM :: CompOption -> ExecOption -> String -> m Regex
makeRegexOptsM CompOption
c ExecOption
e String
pattern = ((MatchOffset, String) -> m Regex)
-> (Regex -> m Regex)
-> Either (MatchOffset, 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(String -> m Regex)
-> ((MatchOffset, String) -> String)
-> (MatchOffset, String)
-> m Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MatchOffset, String) -> String
forall a. Show a => a -> String
show) Regex -> m Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (MatchOffset, String) Regex -> m Regex)
-> Either (MatchOffset, String) Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ IO (Either (MatchOffset, String) Regex)
-> Either (MatchOffset, String) Regex
forall a. IO a -> a
unsafePerformIO (IO (Either (MatchOffset, String) Regex)
 -> Either (MatchOffset, String) Regex)
-> IO (Either (MatchOffset, String) Regex)
-> Either (MatchOffset, String) Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> String -> IO (Either (MatchOffset, String) Regex)
compile CompOption
c ExecOption
e String
pattern

instance RegexLike Regex String where
  matchTest :: Regex -> String -> Bool
matchTest Regex
regex String
str = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    String
-> (CStringLen -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (MatchOffset -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest MatchOffset
0 Regex
regex) IO (Either WrapError Bool)
-> (Either WrapError Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Bool -> IO Bool
forall e v. Show e => Either e v -> IO v
unwrap
  matchOnce :: Regex -> String -> Maybe MatchArray
matchOnce Regex
regex String
str = IO (Maybe MatchArray) -> Maybe MatchArray
forall a. IO a -> a
unsafePerformIO (IO (Maybe MatchArray) -> Maybe MatchArray)
-> IO (Maybe MatchArray) -> Maybe MatchArray
forall a b. (a -> b) -> a -> b
$
    Regex -> String -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex String
str IO (Either WrapError (Maybe MatchArray))
-> (Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray))
-> IO (Maybe MatchArray)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray)
forall e v. Show e => Either e v -> IO v
unwrap
  matchAll :: Regex -> String -> [MatchArray]
matchAll Regex
regex String
str = IO [MatchArray] -> [MatchArray]
forall a. IO a -> a
unsafePerformIO (IO [MatchArray] -> [MatchArray])
-> IO [MatchArray] -> [MatchArray]
forall a b. (a -> b) -> a -> b
$ 
    String
-> (CStringLen -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) IO (Either WrapError [MatchArray])
-> (Either WrapError [MatchArray] -> IO [MatchArray])
-> IO [MatchArray]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError [MatchArray] -> IO [MatchArray]
forall e v. Show e => Either e v -> IO v
unwrap
  matchCount :: Regex -> String -> MatchOffset
matchCount Regex
regex String
str = IO MatchOffset -> MatchOffset
forall a. IO a -> a
unsafePerformIO (IO MatchOffset -> MatchOffset) -> IO MatchOffset -> MatchOffset
forall a b. (a -> b) -> a -> b
$ 
    String
-> (CStringLen -> IO (Either WrapError MatchOffset))
-> IO (Either WrapError MatchOffset)
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (Regex -> CStringLen -> IO (Either WrapError MatchOffset)
wrapCount Regex
regex) IO (Either WrapError MatchOffset)
-> (Either WrapError MatchOffset -> IO MatchOffset)
-> IO MatchOffset
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError MatchOffset -> IO MatchOffset
forall e v. Show e => Either e v -> IO v
unwrap

-- | Compiles a regular expression
compile :: CompOption -- ^ Flags (summed together)
        -> ExecOption -- ^ Flags (summed together)
        -> String     -- ^ The regular expression to compile
        -> IO (Either (MatchOffset,String) Regex) -- ^ Returns: an error string and offset or the compiled regular expression
compile :: CompOption
-> ExecOption -> String -> IO (Either (MatchOffset, String) Regex)
compile CompOption
c ExecOption
e String
pattern = String
-> (CString -> IO (Either (MatchOffset, String) Regex))
-> IO (Either (MatchOffset, String) Regex)
forall a. String -> (CString -> IO a) -> IO a
withCString String
pattern (CompOption
-> ExecOption -> CString -> IO (Either (MatchOffset, String) Regex)
wrapCompile CompOption
c ExecOption
e)

-- | Matches a regular expression against a string
execute :: Regex      -- ^ Compiled regular expression
        -> String     -- ^ String to match against
        -> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
                -- ^ Returns: 'Nothing' if the regex did not match the
                -- string, or:
                --   'Just' an array of (offset,length) pairs where index 0 is whole match, and the rest are the captured subexpressions.
execute :: Regex -> String -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex String
str = do
  Either WrapError (Maybe [(MatchOffset, MatchOffset)])
maybeStartEnd <- String
-> (CStringLen
    -> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)])))
-> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)]))
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (MatchOffset
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)]))
wrapMatch MatchOffset
0 Regex
regex)
  case Either WrapError (Maybe [(MatchOffset, MatchOffset)])
maybeStartEnd of
    Right Maybe [(MatchOffset, MatchOffset)]
Nothing -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right Maybe MatchArray
forall a. Maybe a
Nothing)
--  Right (Just []) -> fail "got [] back!" -- should never happen
    Right (Just [(MatchOffset, MatchOffset)]
parts) -> 
      Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe MatchArray)
 -> IO (Either WrapError (Maybe MatchArray)))
-> ([(MatchOffset, MatchOffset)]
    -> Either WrapError (Maybe MatchArray))
-> [(MatchOffset, MatchOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right (Maybe MatchArray -> Either WrapError (Maybe MatchArray))
-> ([(MatchOffset, MatchOffset)] -> Maybe MatchArray)
-> [(MatchOffset, MatchOffset)]
-> Either WrapError (Maybe MatchArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchArray -> Maybe MatchArray
forall a. a -> Maybe a
Just (MatchArray -> Maybe MatchArray)
-> ([(MatchOffset, MatchOffset)] -> MatchArray)
-> [(MatchOffset, MatchOffset)]
-> Maybe MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchOffset, MatchOffset)
-> [(MatchOffset, MatchOffset)] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (MatchOffset
0,MatchOffset -> MatchOffset
forall a. Enum a => a -> a
pred ([(MatchOffset, MatchOffset)] -> MatchOffset
forall (t :: * -> *) a. Foldable t => t a -> MatchOffset
length [(MatchOffset, MatchOffset)]
parts))
      ([(MatchOffset, MatchOffset)] -> MatchArray)
-> ([(MatchOffset, MatchOffset)] -> [(MatchOffset, MatchOffset)])
-> [(MatchOffset, MatchOffset)]
-> MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MatchOffset, MatchOffset) -> (MatchOffset, MatchOffset))
-> [(MatchOffset, MatchOffset)] -> [(MatchOffset, MatchOffset)]
forall a b. (a -> b) -> [a] -> [b]
map (\(MatchOffset
s,MatchOffset
e)->(MatchOffset -> MatchOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral MatchOffset
s, MatchOffset -> MatchOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MatchOffset
eMatchOffset -> MatchOffset -> MatchOffset
forall a. Num a => a -> a -> a
-MatchOffset
s))) ([(MatchOffset, MatchOffset)]
 -> IO (Either WrapError (Maybe MatchArray)))
-> [(MatchOffset, MatchOffset)]
-> IO (Either WrapError (Maybe MatchArray))
forall a b. (a -> b) -> a -> b
$ [(MatchOffset, MatchOffset)]
parts
    Left WrapError
err -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError (Maybe MatchArray)
forall a b. a -> Either a b
Left WrapError
err)

-- | execute match and extract substrings rather than just offsets
regexec  :: Regex      -- ^ compiled regular expression
         -> String     -- ^ string to match
         -> IO (Either WrapError (Maybe (String, String,String, [String])))
                      -- ^ Returns: Nothing if no match, else
                      --   (text before match, text after match, array of matches with 0 being the whole match)
regexec :: Regex
-> String
-> IO (Either WrapError (Maybe (String, String, String, [String])))
regexec Regex
regex String
str = do
  let getSub :: (MatchOffset, MatchOffset) -> String
getSub (MatchOffset
start,MatchOffset
stop) | MatchOffset
start MatchOffset -> MatchOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MatchOffset
unusedOffset = String
""
                          | Bool
otherwise = MatchOffset -> String -> String
forall a. MatchOffset -> [a] -> [a]
take (MatchOffset
stopMatchOffset -> MatchOffset -> MatchOffset
forall a. Num a => a -> a -> a
-MatchOffset
start) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchOffset -> String -> String
forall a. MatchOffset -> [a] -> [a]
drop MatchOffset
start (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
str
      matchedParts :: [(MatchOffset, MatchOffset)] -> (String, String, String, [String])
matchedParts [] = (String
"",String
"",String
str,[]) -- no information
      matchedParts (matchedStartStop :: (MatchOffset, MatchOffset)
matchedStartStop@(MatchOffset
start,MatchOffset
stop):[(MatchOffset, MatchOffset)]
subStartStop) = 
        (MatchOffset -> String -> String
forall a. MatchOffset -> [a] -> [a]
take MatchOffset
start String
str
        ,(MatchOffset, MatchOffset) -> String
getSub (MatchOffset, MatchOffset)
matchedStartStop
        ,MatchOffset -> String -> String
forall a. MatchOffset -> [a] -> [a]
drop MatchOffset
stop String
str
        ,((MatchOffset, MatchOffset) -> String)
-> [(MatchOffset, MatchOffset)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (MatchOffset, MatchOffset) -> String
getSub [(MatchOffset, MatchOffset)]
subStartStop)
  Either WrapError (Maybe [(MatchOffset, MatchOffset)])
maybeStartEnd <- String
-> (CStringLen
    -> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)])))
-> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)]))
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str (MatchOffset
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(MatchOffset, MatchOffset)]))
wrapMatch MatchOffset
0 Regex
regex)
  case Either WrapError (Maybe [(MatchOffset, MatchOffset)])
maybeStartEnd of
    Right Maybe [(MatchOffset, MatchOffset)]
Nothing -> Either WrapError (Maybe (String, String, String, [String]))
-> IO (Either WrapError (Maybe (String, String, String, [String])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, String, String, [String])
-> Either WrapError (Maybe (String, String, String, [String]))
forall a b. b -> Either a b
Right Maybe (String, String, String, [String])
forall a. Maybe a
Nothing)
--  Right (Just []) -> fail "got [] back!" -- should never happen
    Right (Just [(MatchOffset, MatchOffset)]
parts) -> Either WrapError (Maybe (String, String, String, [String]))
-> IO (Either WrapError (Maybe (String, String, String, [String])))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe (String, String, String, [String]))
 -> IO
      (Either WrapError (Maybe (String, String, String, [String]))))
-> ([(MatchOffset, MatchOffset)]
    -> Either WrapError (Maybe (String, String, String, [String])))
-> [(MatchOffset, MatchOffset)]
-> IO (Either WrapError (Maybe (String, String, String, [String])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, String, String, [String])
-> Either WrapError (Maybe (String, String, String, [String]))
forall a b. b -> Either a b
Right (Maybe (String, String, String, [String])
 -> Either WrapError (Maybe (String, String, String, [String])))
-> ([(MatchOffset, MatchOffset)]
    -> Maybe (String, String, String, [String]))
-> [(MatchOffset, MatchOffset)]
-> Either WrapError (Maybe (String, String, String, [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String, String, [String])
-> Maybe (String, String, String, [String])
forall a. a -> Maybe a
Just ((String, String, String, [String])
 -> Maybe (String, String, String, [String]))
-> ([(MatchOffset, MatchOffset)]
    -> (String, String, String, [String]))
-> [(MatchOffset, MatchOffset)]
-> Maybe (String, String, String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MatchOffset, MatchOffset)] -> (String, String, String, [String])
matchedParts ([(MatchOffset, MatchOffset)]
 -> IO
      (Either WrapError (Maybe (String, String, String, [String]))))
-> [(MatchOffset, MatchOffset)]
-> IO (Either WrapError (Maybe (String, String, String, [String])))
forall a b. (a -> b) -> a -> b
$ [(MatchOffset, MatchOffset)]
parts
    Left WrapError
err -> Either WrapError (Maybe (String, String, String, [String]))
-> IO (Either WrapError (Maybe (String, String, String, [String])))
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError
-> Either WrapError (Maybe (String, String, String, [String]))
forall a b. a -> Either a b
Left WrapError
err)