{-# LANGUAGE BangPatterns, EmptyDataDecls, ScopedTypeVariables #-}

-- |
-- Module      : Data.Text.ICU.Regex.Pure
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Regular expression support for Unicode, implemented as bindings to
-- the International Components for Unicode (ICU) libraries.
--
-- The functions in this module are pure and hence thread safe, but
-- may not be as fast or as flexible as those in the
-- "Data.Text.ICU.Regex" module.
--
-- The syntax and behaviour of ICU regular expressions are Perl-like.
-- For complete details, see the ICU User Guide entry at
-- <http://userguide.icu-project.org/strings/regexp>.

module Data.Text.ICU.Regex.Pure
    (
    -- * Types
      MatchOption(..)
    , ParseError(errError, errLine, errOffset)
    , Match
    , Regex
    , Regular
    -- * Functions
    -- ** Construction
    , regex
    , regex'
    -- ** Inspection
    , pattern
    -- ** Searching
    , find
    , findAll
    -- ** Match groups
    -- $group
    , groupCount
    , unfold
    , span
    , group
    , prefix
    , suffix
    ) where

import qualified Control.Exception as E
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Foreign as T
import Data.Text.ICU.Internal (TextI, fromUCharPtr, lengthWord, withUTextPtrText, utextPtrLength)
import Data.Text.ICU.Error.Internal (ParseError(..), handleError)
import qualified Data.Text.ICU.Regex as IO
import Data.Text.ICU.Regex.Internal hiding (Regex(..), regex)
import qualified Data.Text.ICU.Regex.Internal as Internal
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (advancePtr)
import Foreign.Storable (peek)
import Prelude hiding (span)
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)

-- | A compiled regular expression.
--
-- 'Regex' values are usually constructed using the 'regex' or
-- 'regex'' functions.  This type is also an instance of 'IsString',
-- so if you have the @OverloadedStrings@ language extension enabled,
-- you can construct a 'Regex' by simply writing the pattern in
-- quotes (though this does not allow you to specify any 'Option's).
newtype Regex = Regex {
      Regex -> Regex
reRe :: Internal.Regex
    }

instance Show Regex where
    show :: Regex -> String
show Regex
re = String
"Regex " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall r. Regular r => r -> Text
pattern Regex
re)

instance IsString Regex where
    fromString :: String -> Regex
fromString = [MatchOption] -> Text -> Regex
regex [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | A match for a regular expression.
data Match = Match {
      Match -> Regex
matchRe :: Internal.Regex
    , Match -> TextI
_matchPrev :: TextI
    }

instance Show Match where
    show :: Match -> String
show Match
m = String
"Match " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ((Int -> Match -> Maybe Text) -> Match -> [Text]
unfold Int -> Match -> Maybe Text
group Match
m)

-- | A typeclass for functions common to both 'Match' and 'Regex'
-- types.
class Regular r where
    regRe :: r -> Internal.Regex

    regFp :: r -> ForeignPtr URegularExpression
    regFp = Regex -> ForeignPtr URegularExpression
Internal.reRe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Regular r => r -> Regex
regRe
    {-# INLINE regFp #-}

instance Regular Match where
    regRe :: Match -> Regex
regRe = Match -> Regex
matchRe

instance Regular Regex where
    regRe :: Regex -> Regex
regRe = Regex -> Regex
reRe

-- | Compile a regular expression with the given options.  This
-- function throws a 'ParseError' if the pattern is invalid, so it is
-- best for use when the pattern is statically known.
regex :: [MatchOption] -> Text -> Regex
regex :: [MatchOption] -> Text -> Regex
regex [MatchOption]
opts Text
pat = Regex -> Regex
Regex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ [MatchOption] -> Text -> IO Regex
IO.regex [MatchOption]
opts Text
pat

-- | Compile a regular expression with the given options.  This is
-- safest to use when the pattern is constructed at run time.
regex' :: [MatchOption] -> Text -> Either ParseError Regex
regex' :: [MatchOption] -> Text -> Either ParseError Regex
regex' [MatchOption]
opts Text
pat = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
  ((forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> Regex
Regex) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [MatchOption] -> Text -> IO Regex
Internal.regex [MatchOption]
opts Text
pat) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
  \(ParseError
err::ParseError) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left ParseError
err)

-- | Return the source form of the pattern used to construct this
-- regular expression or match.
pattern :: Regular r => r -> Text
pattern :: forall r. Regular r => r -> Text
pattern r
r = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall r. Regular r => r -> ForeignPtr URegularExpression
regFp r
r) forall a b. (a -> b) -> a -> b
$ \Ptr URegularExpression
rePtr ->
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
lenPtr -> do
    Ptr Word16
textPtr <- forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError forall a b. (a -> b) -> a -> b
$ Ptr URegularExpression
-> Ptr Int32 -> Ptr UErrorCode -> IO (Ptr Word16)
uregex_pattern Ptr URegularExpression
rePtr Ptr Int32
lenPtr
    (Ptr Word16 -> TextI -> IO Text
fromUCharPtr Ptr Word16
textPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
lenPtr

-- | Find the first match for the regular expression in the given text.
find :: Regex -> Text -> Maybe Match
find :: Regex -> Text -> Maybe Match
find Regex
re0 Text
haystack = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. Regex -> Text -> (Regex -> IO a) -> IO a
matching Regex
re0 Text
haystack forall a b. (a -> b) -> a -> b
$ \Regex
re -> do
    Bool
m <- Regex -> IO Bool
IO.findNext Regex
re
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Bool
m then forall a. a -> Maybe a
Just (Regex -> TextI -> Match
Match Regex
re TextI
0) else forall a. Maybe a
Nothing

-- | Lazily find all matches for the regular expression in the given
-- text.
findAll :: Regex -> Text -> [Match]
findAll :: Regex -> Text -> [Match]
findAll Regex
re0 Text
haystack = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ TextI -> IO [Match]
go TextI
0
  where
    len :: TextI
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
lengthWord forall a b. (a -> b) -> a -> b
$ Text
haystack
    go :: TextI -> IO [Match]
go !TextI
n | TextI
n forall a. Ord a => a -> a -> Bool
>= TextI
len  = forall (m :: * -> *) a. Monad m => a -> m a
return []
          | Bool
otherwise = forall a. Regex -> Text -> (Regex -> IO a) -> IO a
matching Regex
re0 Text
haystack forall a b. (a -> b) -> a -> b
$ \Regex
re -> do
      Bool
found <- Regex -> TextI -> IO Bool
IO.find Regex
re TextI
n
      if Bool
found
        then do
          TextI
n' <- Regex -> Int -> IO TextI
IO.end_ Regex
re Int
0
          (Regex -> TextI -> Match
Match Regex
re TextI
nforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TextI -> IO [Match]
go TextI
n'
        else forall (m :: * -> *) a. Monad m => a -> m a
return []

matching :: Regex -> Text -> (IO.Regex -> IO a) -> IO a
matching :: forall a. Regex -> Text -> (Regex -> IO a) -> IO a
matching (Regex Regex
re0) Text
haystack Regex -> IO a
act = do
  Regex
re <- Regex -> IO Regex
IO.clone Regex
re0
  Regex -> Text -> IO ()
IO.setText Regex
re Text
haystack
  Regex -> IO a
act Regex
re

-- $group
--
-- Capturing groups are numbered starting from zero.  Group zero is
-- always the entire matching text.  Groups greater than zero contain
-- the text matching each capturing group in a regular expression.

-- | Return the number of capturing groups in this regular
-- expression or match's pattern.
groupCount :: Regular r => r -> Int
groupCount :: forall r. Regular r => r -> Int
groupCount = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> IO Int
IO.groupCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Regular r => r -> Regex
regRe
{-# INLINE groupCount #-}

-- | A combinator for returning a list of all capturing groups on a
-- 'Match'.
unfold :: (Int -> Match -> Maybe Text) -> Match -> [Text]
unfold :: (Int -> Match -> Maybe Text) -> Match -> [Text]
unfold Int -> Match -> Maybe Text
f Match
m = Int -> [Text]
go Int
0
  where go :: Int -> [Text]
go !Int
n = case Int -> Match -> Maybe Text
f Int
n Match
m of
                  Maybe Text
Nothing -> []
                  Just Text
z  -> Text
z forall a. a -> [a] -> [a]
: Int -> [Text]
go (Int
nforall a. Num a => a -> a -> a
+Int
1)

-- | Return the /n/th capturing group in a match, or 'Nothing' if /n/
-- is out of bounds.
group :: Int -> Match -> Maybe Text
group :: Int -> Match -> Maybe Text
group Int
n Match
m = forall a. Int -> Match -> (Regex -> IO a) -> Maybe a
grouping Int
n Match
m forall a b. (a -> b) -> a -> b
$ \Regex
re -> do
  let n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  TextI
start <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Regex -> Int -> IO TextI
IO.start_ Regex
re Int
n'
  TextI
end <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Regex -> Int -> IO TextI
IO.end_ Regex
re Int
n'
  UTextPtr
ut <- Regex -> IO UTextPtr
IO.getUTextPtr Regex
re
  forall a. UTextPtr -> (Ptr Word16 -> IO a) -> IO a
withUTextPtrText UTextPtr
ut forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptr ->
    Ptr Word16 -> TextI -> IO Text
T.fromPtr (Ptr Word16
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` forall a b. (Integral a, Num b) => a -> b
fromIntegral TextI
start) (TextI
end forall a. Num a => a -> a -> a
- TextI
start)

-- | Return the prefix of the /n/th capturing group in a match (the
-- text from the start of the string to the start of the match), or
-- 'Nothing' if /n/ is out of bounds.
prefix :: Int -> Match -> Maybe Text
prefix :: Int -> Match -> Maybe Text
prefix Int
n Match
m = forall a. Int -> Match -> (Regex -> IO a) -> Maybe a
grouping Int
n Match
m forall a b. (a -> b) -> a -> b
$ \Regex
re -> do
  TextI
start <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Regex -> Int -> IO TextI
IO.start_ Regex
re Int
n
  UTextPtr
ut <- Regex -> IO UTextPtr
IO.getUTextPtr Regex
re
  forall a. UTextPtr -> (Ptr Word16 -> IO a) -> IO a
withUTextPtrText UTextPtr
ut (Ptr Word16 -> TextI -> IO Text
`T.fromPtr` TextI
start)

-- | Return the span of text between the end of the previous match and
-- the beginning of the current match.
span :: Match -> Text
span :: Match -> Text
span (Match Regex
re TextI
p) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  TextI
start <- Regex -> Int -> IO TextI
IO.start_ Regex
re Int
0
  UTextPtr
ut <- Regex -> IO UTextPtr
IO.getUTextPtr Regex
re
  forall a. UTextPtr -> (Ptr Word16 -> IO a) -> IO a
withUTextPtrText UTextPtr
ut forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptr ->
    Ptr Word16 -> TextI -> IO Text
T.fromPtr (Ptr Word16
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` forall a b. (Integral a, Num b) => a -> b
fromIntegral TextI
p) (TextI
start forall a. Num a => a -> a -> a
- TextI
p)

-- | Return the suffix of the /n/th capturing group in a match (the
-- text from the end of the match to the end of the string), or
-- 'Nothing' if /n/ is out of bounds.
suffix :: Int -> Match -> Maybe Text
suffix :: Int -> Match -> Maybe Text
suffix Int
n Match
m = forall a. Int -> Match -> (Regex -> IO a) -> Maybe a
grouping Int
n Match
m forall a b. (a -> b) -> a -> b
$ \Regex
re -> do
  TextI
end <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Regex -> Int -> IO TextI
IO.end_ Regex
re Int
n
  UTextPtr
ut <- Regex -> IO UTextPtr
IO.getUTextPtr Regex
re
  forall a. UTextPtr -> (Ptr Word16 -> IO a) -> IO a
withUTextPtrText UTextPtr
ut forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptr -> do
    Ptr Word16 -> TextI -> IO Text
T.fromPtr (Ptr Word16
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` forall a b. (Integral a, Num b) => a -> b
fromIntegral TextI
end) (UTextPtr -> TextI
utextPtrLength UTextPtr
ut forall a. Num a => a -> a -> a
- TextI
end)

grouping :: Int -> Match -> (Internal.Regex -> IO a) -> Maybe a
grouping :: forall a. Int -> Match -> (Regex -> IO a) -> Maybe a
grouping Int
n (Match Regex
m TextI
_) Regex -> IO a
act = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  Int
count <- Regex -> IO Int
IO.groupCount Regex
m
  let n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
  if Int
n' forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Int
n' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n' forall a. Ord a => a -> a -> Bool
<= Int
count)
    then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Regex -> IO a
act Regex
m
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing