module Data.Text.ICU.Regex.Pure
(
MatchOption(..)
, ParseError(errError, errLine, errOffset)
, Match
, Regex
, Regular
, regex
, regex'
, pattern
, find
, findAll
, 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.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)
newtype Regex = Regex {
reRe :: Internal.Regex
}
instance Show Regex where
show re = "Regex " ++ show (pattern re)
instance IsString Regex where
fromString = regex [] . T.pack
data Match = Match {
matchRe :: Internal.Regex
, _matchPrev :: T.I16
}
instance Show Match where
show m = "Match " ++ show (unfold group m)
class Regular r where
regRe :: r -> Internal.Regex
regFp :: r -> ForeignPtr URegularExpression
regFp = Internal.reRe . regRe
instance Regular Match where
regRe = matchRe
instance Regular Regex where
regRe = reRe
regex :: [MatchOption] -> Text -> Regex
regex opts pat = Regex . unsafePerformIO $ IO.regex opts pat
regex' :: [MatchOption] -> Text -> Either ParseError Regex
regex' opts pat = unsafePerformIO $
((Right . Regex) `fmap` Internal.regex opts pat) `E.catch`
\(err::ParseError) -> return (Left err)
pattern :: Regular r => r -> Text
pattern r = unsafePerformIO . withForeignPtr (regFp r) $ \rePtr ->
alloca $ \lenPtr -> do
textPtr <- handleError $ uregex_pattern rePtr lenPtr
(T.fromPtr textPtr . fromIntegral) =<< peek lenPtr
find :: Regex -> Text -> Maybe Match
find re0 haystack = unsafePerformIO .
matching re0 haystack $ \re -> do
m <- IO.findNext re
return $! if m then Just (Match re 0) else Nothing
findAll :: Regex -> Text -> [Match]
findAll re0 haystack = unsafePerformIO . unsafeInterleaveIO $ go 0
where
len = fromIntegral . T.lengthWord16 $ haystack
go !n | n >= len = return []
| otherwise = matching re0 haystack $ \re -> do
found <- IO.find re n
if found
then do
n' <- IO.end_ re 0
(Match re n:) `fmap` go n'
else return []
matching :: Regex -> Text -> (IO.Regex -> IO a) -> IO a
matching (Regex re0) haystack act = do
re <- IO.clone re0
IO.setText re haystack
act re
groupCount :: Regular r => r -> Int
groupCount = unsafePerformIO . IO.groupCount . regRe
unfold :: (Int -> Match -> Maybe Text) -> Match -> [Text]
unfold f m = go 0
where go !n = case f n m of
Nothing -> []
Just z -> z : go (n+1)
group :: Int -> Match -> Maybe Text
group n m = grouping n m $ \re -> do
let n' = fromIntegral n
start <- fromIntegral `fmap` IO.start_ re n'
end <- fromIntegral `fmap` IO.end_ re n'
(fp,_) <- IO.getText re
withForeignPtr fp $ \ptr ->
T.fromPtr (ptr `advancePtr` fromIntegral start) (end start)
prefix :: Int -> Match -> Maybe Text
prefix n m = grouping n m $ \re -> do
start <- fromIntegral `fmap` IO.start_ re n
(fp,_) <- IO.getText re
withForeignPtr fp (`T.fromPtr` start)
span :: Match -> Text
span (Match re p) = unsafePerformIO $ do
start <- IO.start_ re 0
(fp,_) <- IO.getText re
withForeignPtr fp $ \ptr ->
T.fromPtr (ptr `advancePtr` fromIntegral p) (start p)
suffix :: Int -> Match -> Maybe Text
suffix n m = grouping n m $ \re -> do
end <- fromIntegral `fmap` IO.end_ re n
(fp,len) <- IO.getText re
withForeignPtr fp $ \ptr -> do
T.fromPtr (ptr `advancePtr` fromIntegral end) (len end)
grouping :: Int -> Match -> (Internal.Regex -> IO a) -> Maybe a
grouping n (Match m _) act = unsafePerformIO $ do
count <- IO.groupCount m
let n' = fromIntegral n
if n' == 0 || (n' >= 0 && n' <= count)
then Just `fmap` act m
else return Nothing