    {-# LINE 1 "Data/Text/ICU/Regex/Internal.hsc" #-}
    {-# LANGUAGE BangPatterns, DeriveDataTypeable, EmptyDataDecls,
        ForeignFunctionInterface, MagicHash, RecordWildCards,
        ScopedTypeVariables #-}

    -- |
    -- Module      : Data.Text.ICU.Regex.Internal
    -- 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 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.Internal
        (
        -- * Types
          MatchOption(..)
        , Regex(..)
        , URegularExpression
        -- * Functions
        , regex
        , uregex_clone
        , uregex_close
        , uregex_end
        , uregex_find
        , uregex_findNext
        , uregex_getText
        , uregex_group
        , uregex_groupCount
        , uregex_pattern
        , uregex_setUText
        , uregex_start
        ) where

    import Control.Monad (when)
    import Data.IORef (IORef, newIORef)
    import Data.Int (Int32)
    import Data.Text (Text)
    import Data.Text.ICU.Internal (UBool, UChar, UTextPtr, UText, useAsUCharPtr, withUTextPtr, emptyUTextPtr, newICUPtr)
    import Data.Text.ICU.Error (isRegexError)
    import Data.Text.ICU.Error.Internal (UParseError, UErrorCode,
                                         handleError, handleParseError)
    import Data.Typeable (Typeable)
    import Data.Word (Word32)
    import Foreign.ForeignPtr (ForeignPtr)
    import Foreign.Ptr (FunPtr, Ptr)

    -- | Options for controlling matching behaviour.
    data MatchOption
        = CaseInsensitive
        -- ^ Enable case insensitive matching.
        | Comments
        -- ^ Allow comments and white space within patterns.
        | DotAll
        -- ^ If set, @\'.\'@ matches line terminators. Otherwise @\'.\'@
        -- matching stops at line end.
        | Literal
        -- ^ If set, treat the entire pattern as a literal string.
        --  Metacharacters or escape sequences in the input sequence will
        --  be given no special meaning.
        --
        --  The option 'CaseInsensitive' retains its meanings on matching
        --  when used in conjunction with this option.  Other options
        --  become superfluous.
        | Multiline
        -- ^ Control behaviour of @\'$\'@ and @\'^\'@. If set, recognize
        -- line terminators within string, Otherwise, match only at start
        -- and end of input string.
        | HaskellLines
        -- ^ Haskell-only line endings.  When this mode is enabled, only
        -- @\'\\n\'@ is recognized as a line ending in the behavior of
        -- @\'.\'@, @\'^\'@, and @\'$\'@.
        | UnicodeWord
        -- ^ Unicode word boundaries.  If set, @\'\\\\b\'@ uses the
        -- Unicode TR 29 definition of word boundaries.
        --
        -- /Warning/: Unicode word boundaries are quite different from
        -- traditional regular expression word boundaries.  See
        -- <http://unicode.org/reports/tr29/#Word_Boundaries>.
        | ErrorOnUnknownEscapes
        -- ^ Throw an error on unrecognized backslash escapes.  If set,
        -- fail with an error on patterns that contain backslash-escaped
        -- ASCII letters without a known special meaning.  If this flag is
        -- not set, these escaped letters represent themselves.
        | WorkLimit Int
        -- ^ Set a processing limit for match operations.
        --
        -- Some patterns, when matching certain strings, can run in
        -- exponential time.  For practical purposes, the match operation
        -- may appear to be in an infinite loop.  When a limit is set a
        -- match operation will fail with an error if the limit is
        -- exceeded.
        --
        -- The units of the limit are steps of the match engine.
        -- Correspondence with actual processor time will depend on the
        -- speed of the processor and the details of the specific pattern,
        -- but will typically be on the order of milliseconds.
        --
        -- By default, the matching time is not limited.
        | StackLimit Int
        -- ^ Set the amount of heap storage available for use by the match
        -- backtracking stack.
        --
        -- ICU uses a backtracking regular expression engine, with the
        -- backtrack stack maintained on the heap.  This function sets the
        -- limit to the amount of memory that can be used for this
        -- purpose.  A backtracking stack overflow will result in an error
        -- from the match operation that caused it.
        --
        -- A limit is desirable because a malicious or poorly designed
        -- pattern can use excessive memory, potentially crashing the
        -- process.  A limit is enabled by default.
          deriving (MatchOption -> MatchOption -> Bool
    (MatchOption -> MatchOption -> Bool)
    -> (MatchOption -> MatchOption -> Bool) -> Eq MatchOption
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MatchOption -> MatchOption -> Bool
    == :: MatchOption -> MatchOption -> Bool
    $c/= :: MatchOption -> MatchOption -> Bool
    /= :: MatchOption -> MatchOption -> Bool
    Eq, Int -> MatchOption -> ShowS
    [MatchOption] -> ShowS
    MatchOption -> String
    (Int -> MatchOption -> ShowS)
    -> (MatchOption -> String)
    -> ([MatchOption] -> ShowS)
    -> Show MatchOption
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> MatchOption -> ShowS
    showsPrec :: Int -> MatchOption -> ShowS
    $cshow :: MatchOption -> String
    show :: MatchOption -> String
    $cshowList :: [MatchOption] -> ShowS
    showList :: [MatchOption] -> ShowS
    Show, Typeable)

    -- | 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).
    data Regex = Regex {
          Regex -> ForeignPtr URegularExpression
    reRe :: ForeignPtr URegularExpression
        , Regex -> IORef UTextPtr
    reText :: IORef UTextPtr
        }

    -- | Compile a regular expression with the given options.  This
    -- function throws a 'ParseError' if the pattern is invalid.
    --
    -- The 'Regex' is initialized with empty text to search against.
    regex :: [MatchOption] -> Text -> IO Regex
    regex :: [MatchOption] -> Text -> IO Regex
    regex [MatchOption]
    opts Text
    pat = Text -> (Ptr UChar -> I16 -> IO Regex) -> IO Regex
    forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
    useAsUCharPtr Text
    pat ((Ptr UChar -> I16 -> IO Regex) -> IO Regex)
    -> (Ptr UChar -> I16 -> IO Regex) -> IO Regex
    forall a b. (a -> b) -> a -> b
    $ \Ptr UChar
    pptr I16
    plen ->
      (ForeignPtr URegularExpression -> IORef UTextPtr -> Regex)
    -> FinalizerPtr URegularExpression
    -> IO (Ptr URegularExpression)
    -> IO (IORef UTextPtr -> Regex)
    forall a i.
    (ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
    newICUPtr ForeignPtr URegularExpression -> IORef UTextPtr -> Regex
    Regex FinalizerPtr URegularExpression
    uregex_close (do
        ptr <- (ICUError -> Bool)
    -> (Ptr UParseError
        -> Ptr UErrorCode -> IO (Ptr URegularExpression))
    -> IO (Ptr URegularExpression)
    forall a.
    (ICUError -> Bool)
    -> (Ptr UParseError -> Ptr UErrorCode -> IO a) -> IO a
    handleParseError ICUError -> Bool
    isRegexError ((Ptr UParseError -> Ptr UErrorCode -> IO (Ptr URegularExpression))
     -> IO (Ptr URegularExpression))
    -> (Ptr UParseError
        -> Ptr UErrorCode -> IO (Ptr URegularExpression))
    -> IO (Ptr URegularExpression)
    forall a b. (a -> b) -> a -> b
    $
               Ptr UChar
    -> Int32
    -> URegexpFlag
    -> Ptr UParseError
    -> Ptr UErrorCode
    -> IO (Ptr URegularExpression)
    uregex_open Ptr UChar
    pptr (I16 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral I16
    plen) URegexpFlag
    flags
        withUTextPtr hayfp $ \Ptr UText
    hayPtr -> (Ptr UErrorCode -> IO ()) -> IO ()
    forall a. (Ptr UErrorCode -> IO a) -> IO a
    handleError ((Ptr UErrorCode -> IO ()) -> IO ())
    -> (Ptr UErrorCode -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Ptr URegularExpression -> Ptr UText -> Ptr UErrorCode -> IO ()
    uregex_setUText Ptr URegularExpression
    ptr Ptr UText
    hayPtr
        when (workLimit > -1) .
          handleError $ uregex_setTimeLimit ptr (fromIntegral workLimit)
        when (stackLimit > -1) .
          handleError $ uregex_setStackLimit ptr (fromIntegral stackLimit)
        return ptr)
      IO (IORef UTextPtr -> Regex) -> IO (IORef UTextPtr) -> IO Regex
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> UTextPtr -> IO (IORef UTextPtr)
    forall a. a -> IO (IORef a)
    newIORef UTextPtr
    hayfp
      where (URegexpFlag
    flags,Int
    workLimit,Int
    stackLimit) = [MatchOption] -> (URegexpFlag, Int, Int)
    toURegexpOpts [MatchOption]
    opts
            hayfp :: UTextPtr
    hayfp = UTextPtr
    emptyUTextPtr

    data URegularExpression

    type URegexpFlag = Word32

    toURegexpOpts :: [MatchOption] -> (URegexpFlag,Int,Int)
    toURegexpOpts :: [MatchOption] -> (URegexpFlag, Int, Int)
    toURegexpOpts = ((URegexpFlag, Int, Int) -> MatchOption -> (URegexpFlag, Int, Int))
    -> (URegexpFlag, Int, Int)
    -> [MatchOption]
    -> (URegexpFlag, Int, Int)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (URegexpFlag, Int, Int) -> MatchOption -> (URegexpFlag, Int, Int)
    forall {a}. Num a => (a, Int, Int) -> MatchOption -> (a, Int, Int)
    go (URegexpFlag
    0,-Int
    1,-Int
    1)
      where
        go :: (a, Int, Int) -> MatchOption -> (a, Int, Int)
    go (!a
    flag,Int
    work,Int
    stack) MatchOption
    opt = (a
    flaga -> a -> a
    forall a. Num a => a -> a -> a
    +a
    flag',Int
    work',Int
    stack')
         where
          flag' :: a
    flag' = case MatchOption
    opt of
                    MatchOption
    CaseInsensitive       -> a
    2
    {-# LINE 167 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    Comments              -> a
    4
    {-# LINE 168 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    DotAll                -> a
    32
    {-# LINE 169 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    Literal               -> a
    16
    {-# LINE 170 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    Multiline             -> a
    8
    {-# LINE 171 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    HaskellLines          -> a
    1
    {-# LINE 172 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    UnicodeWord           -> a
    256
    {-# LINE 173 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    ErrorOnUnknownEscapes -> a
    512
    {-# LINE 174 "Data/Text/ICU/Regex/Internal.hsc" #-}
                    MatchOption
    _                     -> a
    0
          work' :: Int
    work' = case MatchOption
    opt of
                    WorkLimit Int
    limit       -> Int
    limit
                    MatchOption
    _                     -> Int
    work
          stack' :: Int
    stack' = case MatchOption
    opt of
                     StackLimit Int
    limit     -> Int
    limit
                     MatchOption
    _                    -> Int
    stack

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_open" uregex_open
        :: Ptr UChar -> Int32 -> Word32 -> Ptr UParseError -> Ptr UErrorCode
        -> IO (Ptr URegularExpression)

    foreign import ccall unsafe "hs_text_icu.h &__hs_uregex_close" uregex_close
        :: FunPtr (Ptr URegularExpression -> IO ())

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_clone" uregex_clone
        :: Ptr URegularExpression -> Ptr UErrorCode
        -> IO (Ptr URegularExpression)

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_pattern" uregex_pattern
        :: Ptr URegularExpression -> Ptr Int32 -> Ptr UErrorCode
        -> IO (Ptr UChar)

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_setUText" uregex_setUText
        :: Ptr URegularExpression -> Ptr UText -> Ptr UErrorCode -> IO ()

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_getText" uregex_getText
        :: Ptr URegularExpression -> Ptr Int32 -> Ptr UErrorCode -> IO (Ptr UChar)

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_find" uregex_find
        :: Ptr URegularExpression -> Int32 -> Ptr UErrorCode -> IO UBool

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_findNext" uregex_findNext
        :: Ptr URegularExpression -> Ptr UErrorCode -> IO UBool

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_start" uregex_start
        :: Ptr URegularExpression -> Int32 -> Ptr UErrorCode -> IO Int32

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_end" uregex_end
        :: Ptr URegularExpression -> Int32 -> Ptr UErrorCode -> IO Int32

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_groupCount" uregex_groupCount
        :: Ptr URegularExpression -> Ptr UErrorCode -> IO Int32

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_group" uregex_group
        :: Ptr URegularExpression -> Int32 -> Ptr UChar -> Int32 -> Ptr UErrorCode
        -> IO Int32

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_setTimeLimit" uregex_setTimeLimit
        :: Ptr URegularExpression -> Int32 -> Ptr UErrorCode -> IO ()

    foreign import ccall unsafe "hs_text_icu.h __hs_uregex_setStackLimit" uregex_setStackLimit
        :: Ptr URegularExpression -> Int32 -> Ptr UErrorCode -> IO ()