-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Regex/Rure/FFI.chs" #-}
-- | See @rure.h@ for documentation + how to use.
module Regex.Rure.FFI ( -- * Types
                      -- ** Abstract types
                        Rure
                      , RureOptions
                      , RureError
                      , RureCaptures
                      , RureSet
                      , RureIter
                      , RureIterCaptureNames
                      -- ** Integer types
                      , UInt8
                      , UInt32
                      -- ** Types
                      , RureMatch (..)
                      , RureFlags
                      -- ** Pointer types (c2hs)
                      , RurePtr
                      , RureErrorPtr
                      , RureOptionsPtr
                      , RureIterPtr
                      , RureCapturesPtr
                      , RureSetPtr
                      , RureIterCaptureNamesPtr
                      -- * Functions
                      -- ** Allocation
                      , rureOptionsNew
                      , rureOptionsFree
                      , rureErrorNew
                      , rureErrorFree
                      , rureIterNew
                      , rureFree
                      , rureIterFree
                      , rureCapturesNew
                      , rureCapturesFree
                      , rureSetFree
                      , rureIterCaptureNamesNew
                      , rureIterCaptureNamesFree
                      -- ** Options
                      , rureOptionsSizeLimit
                      , rureOptionsDfaSizeLimit
                      , rureErrorMessage
                      -- ** Compilation
                      , rureCompile
                      , rureCompileMust
                      , rureCompileSet
                      -- ** Matching
                      , rureIsMatch
                      , rureFind
                      , rureIterNext
                      , rureIterNextCaptures
                      , rureCapturesAt
                      , rureCapturesLen
                      , rureFindCaptures
                      , rureShortestMatch
                      , rureCaptureNameIndex
                      , rureSetIsMatch
                      , rureSetMatches
                      , rureSetLen
                      , rureIterCaptureNamesNext
                      -- ** Flags
                      , rureFlagCaseI
                      , rureFlagMulti
                      , rureFlagDotNL
                      , rureFlagSwapGreed
                      , rureFlagSpace
                      , rureFlagUnicode
                      , rureDefaultFlags
                      -- ** String utilities
                      , rureEscapeMust
                      , rureCstringFree
                      ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.Bits (Bits, (.|.), shift)
import Data.Coerce (coerce)
import Data.Int (Int32)
import Data.Semigroup (Semigroup (..))
import Foreign.C.String (CString)
import Foreign.C.Types (CBool, CSize)
import Foreign.Ptr (Ptr, castPtr)





type UInt8 = (C2HSImp.CUChar)
{-# LINE 86 "src/Regex/Rure/FFI.chs" #-}


{-# LINE 87 "src/Regex/Rure/FFI.chs" #-}

 -- TODO: bytestring?

type UInt32 = (C2HSImp.CUInt)
{-# LINE 90 "src/Regex/Rure/FFI.chs" #-}


newtype RureFlags = RureFlags UInt32

instance Semigroup RureFlags where
    (<>) (RureFlags x) (RureFlags y) = RureFlags (x .|. y)

data Rure

data RureOptions

data RureMatch = RureMatch { RureMatch -> CSize
start :: !CSize, RureMatch -> CSize
end :: !CSize } deriving (RureMatch -> RureMatch -> Bool
(RureMatch -> RureMatch -> Bool)
-> (RureMatch -> RureMatch -> Bool) -> Eq RureMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RureMatch -> RureMatch -> Bool
$c/= :: RureMatch -> RureMatch -> Bool
== :: RureMatch -> RureMatch -> Bool
$c== :: RureMatch -> RureMatch -> Bool
Eq, Int -> RureMatch -> ShowS
[RureMatch] -> ShowS
RureMatch -> String
(Int -> RureMatch -> ShowS)
-> (RureMatch -> String)
-> ([RureMatch] -> ShowS)
-> Show RureMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RureMatch] -> ShowS
$cshowList :: [RureMatch] -> ShowS
show :: RureMatch -> String
$cshow :: RureMatch -> String
showsPrec :: Int -> RureMatch -> ShowS
$cshowsPrec :: Int -> RureMatch -> ShowS
Show)

data RureError

data RureIter

data RureCaptures

data RureIterCaptureNames

data RureSet

(<<) :: Bits a => a -> Int -> a
a
m << :: forall a. Bits a => a -> Int -> a
<< Int
n = a
m a -> Int -> a
forall a. Bits a => a -> Int -> a
`shift` Int
n

rureFlagCaseI :: RureFlags
rureFlagCaseI :: RureFlags
rureFlagCaseI = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
0)

rureFlagMulti :: RureFlags
rureFlagMulti :: RureFlags
rureFlagMulti = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
1)

rureFlagDotNL :: RureFlags
rureFlagDotNL :: RureFlags
rureFlagDotNL = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
2)

rureFlagSwapGreed :: RureFlags
rureFlagSwapGreed :: RureFlags
rureFlagSwapGreed = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
3)

rureFlagSpace :: RureFlags
rureFlagSpace :: RureFlags
rureFlagSpace = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
4)

rureFlagUnicode :: RureFlags
rureFlagUnicode :: RureFlags
rureFlagUnicode = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
5)

rureDefaultFlags :: RureFlags
rureDefaultFlags :: RureFlags
rureDefaultFlags = UInt32 -> RureFlags
RureFlags (UInt32
1 UInt32 -> Int -> UInt32
forall a. Bits a => a -> Int -> a
<< Int
5)

type RurePtr = C2HSImp.ForeignPtr (Rure)
{-# LINE 137 "src/Regex/Rure/FFI.chs" #-}

type RureOptionsPtr = C2HSImp.ForeignPtr (RureOptions)
{-# LINE 138 "src/Regex/Rure/FFI.chs" #-}

type RureErrorPtr = C2HSImp.ForeignPtr (RureError)
{-# LINE 139 "src/Regex/Rure/FFI.chs" #-}

type RureIterPtr = C2HSImp.ForeignPtr (RureIter)
{-# LINE 140 "src/Regex/Rure/FFI.chs" #-}

type RureCapturesPtr = C2HSImp.ForeignPtr (RureCaptures)
{-# LINE 141 "src/Regex/Rure/FFI.chs" #-}

type RureSetPtr = C2HSImp.ForeignPtr (RureSet)
{-# LINE 142 "src/Regex/Rure/FFI.chs" #-}

type RureIterCaptureNamesPtr = C2HSImp.ForeignPtr (RureIterCaptureNames)
{-# LINE 143 "src/Regex/Rure/FFI.chs" #-}


rureCompileMust :: (CString) -> IO ((Ptr Rure))
rureCompileMust :: CString -> IO (Ptr Rure)
rureCompileMust CString
a1 =
  (((CString -> IO (Ptr Rure)) -> CString -> IO (Ptr Rure))
-> CString -> (CString -> IO (Ptr Rure)) -> IO (Ptr Rure)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CString -> IO (Ptr Rure)) -> CString -> IO (Ptr Rure)
forall a b. (a -> b) -> a -> b
($)) CString
a1 ((CString -> IO (Ptr Rure)) -> IO (Ptr Rure))
-> (CString -> IO (Ptr Rure)) -> IO (Ptr Rure)
forall a b. (a -> b) -> a -> b
$ \CString
a1' -> 
  CString -> IO (Ptr Rure)
rureCompileMust'_ CString
a1' IO (Ptr Rure) -> (Ptr Rure -> IO (Ptr Rure)) -> IO (Ptr Rure)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr Rure
res ->
  let {res' :: Ptr Rure
res' = Ptr Rure -> Ptr Rure
forall a. a -> a
id Ptr Rure
res} in
  Ptr Rure -> IO (Ptr Rure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Rure
res')

{-# LINE 145 "src/Regex/Rure/FFI.chs" #-}

rureCompile :: (Ptr UInt8) -> (CSize) -> (RureFlags) -> (RureOptionsPtr) -> (RureErrorPtr) -> IO ((Ptr Rure))
rureCompile a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = coerce a2} in 
  let {a3' = coerce a3} in 
  C2HSImp.withForeignPtr a4 $ \a4' -> 
  C2HSImp.withForeignPtr a5 $ \a5' -> 
  rureCompile'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 152 "src/Regex/Rure/FFI.chs" #-}

rureIsMatch :: (RurePtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> IO ((Bool))
rureIsMatch a1 a2 a3 a4 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  rureIsMatch'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 153 "src/Regex/Rure/FFI.chs" #-}

rureFind :: (RurePtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> (Ptr RureMatch) -> IO ((Bool))
rureFind a1 a2 a3 a4 a5 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  let {a5' = castPtr a5} in 
  rureFind'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 160 "src/Regex/Rure/FFI.chs" #-}

rureFindCaptures :: (RurePtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> (RureCapturesPtr) -> IO ((Bool))
rureFindCaptures a1 a2 a3 a4 a5 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  C2HSImp.withForeignPtr a5 $ \a5' -> 
  rureFindCaptures'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 167 "src/Regex/Rure/FFI.chs" #-}

rureShortestMatch :: (RurePtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> (Ptr CSize) -> IO ((Bool))
rureShortestMatch a1 a2 a3 a4 a5 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  let {a5' = castPtr a5} in 
  rureShortestMatch'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 174 "src/Regex/Rure/FFI.chs" #-}

rureCaptureNameIndex :: (RurePtr) -> (CString) -> IO ((Int32))
rureCaptureNameIndex a1 a2 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  (flip ($)) a2 $ \a2' -> 
  rureCaptureNameIndex'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 178 "src/Regex/Rure/FFI.chs" #-}

rureIterCaptureNamesNew :: (RurePtr) -> IO ((Ptr RureIterCaptureNames))
rureIterCaptureNamesNew a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureIterCaptureNamesNew'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 179 "src/Regex/Rure/FFI.chs" #-}

rureIterCaptureNamesNext :: (RureIterCaptureNamesPtr) -> (Ptr CString) -> IO ((Bool))
rureIterCaptureNamesNext a1 a2 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  rureIterCaptureNamesNext'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 180 "src/Regex/Rure/FFI.chs" #-}

rureIterNew :: (RurePtr) -> IO ((Ptr RureIter))
rureIterNew a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureIterNew'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 181 "src/Regex/Rure/FFI.chs" #-}

rureIterNext :: (RureIterPtr) -> (Ptr UInt8) -> (CSize) -> (Ptr RureMatch) -> IO ((Bool))
rureIterNext a1 a2 a3 a4 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = castPtr a4} in 
  rureIterNext'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 187 "src/Regex/Rure/FFI.chs" #-}

rureIterNextCaptures :: (RureIterPtr) -> (Ptr UInt8) -> (CSize) -> (RureCapturesPtr) -> IO ((Bool))
rureIterNextCaptures a1 a2 a3 a4 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  C2HSImp.withForeignPtr a4 $ \a4' -> 
  rureIterNextCaptures'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 193 "src/Regex/Rure/FFI.chs" #-}

rureCapturesNew :: (RurePtr) -> IO ((Ptr RureCaptures))
rureCapturesNew a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureCapturesNew'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 194 "src/Regex/Rure/FFI.chs" #-}

rureCapturesAt :: (RureCapturesPtr) -> (CSize) -> (Ptr RureMatch) -> IO ((Bool))
rureCapturesAt a1 a2 a3 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = coerce a2} in 
  let {a3' = castPtr a3} in 
  rureCapturesAt'_ a1' a2' a3' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 195 "src/Regex/Rure/FFI.chs" #-}

rureCapturesLen :: (RureCapturesPtr) -> IO ((CSize))
rureCapturesLen a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureCapturesLen'_ a1' >>= \res ->
  let {res' = coerce res} in
  return (res')

{-# LINE 196 "src/Regex/Rure/FFI.chs" #-}

rureOptionsNew :: IO ((Ptr RureOptions))
rureOptionsNew =
  rureOptionsNew'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 197 "src/Regex/Rure/FFI.chs" #-}

rureOptionsSizeLimit :: (RureOptionsPtr) -> (CSize) -> IO ()
rureOptionsSizeLimit a1 a2 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = coerce a2} in 
  rureOptionsSizeLimit'_ a1' a2' >>
  return ()

{-# LINE 198 "src/Regex/Rure/FFI.chs" #-}

rureOptionsDfaSizeLimit :: (RureOptionsPtr) -> (CSize) -> IO ()
rureOptionsDfaSizeLimit a1 a2 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = coerce a2} in 
  rureOptionsDfaSizeLimit'_ a1' a2' >>
  return ()

{-# LINE 199 "src/Regex/Rure/FFI.chs" #-}

rureCompileSet :: (Ptr (Ptr UInt8)) -> (Ptr CSize) -> (CSize) -> (RureFlags) -> (RureOptionsPtr) -> (RureErrorPtr) -> IO ((Ptr RureSet))
rureCompileSet a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = castPtr a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  C2HSImp.withForeignPtr a5 $ \a5' -> 
  C2HSImp.withForeignPtr a6 $ \a6' -> 
  rureCompileSet'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 207 "src/Regex/Rure/FFI.chs" #-}

rureSetIsMatch :: (RureSetPtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> IO ((Bool))
rureSetIsMatch a1 a2 a3 a4 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  rureSetIsMatch'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 213 "src/Regex/Rure/FFI.chs" #-}

rureSetMatches :: (RureSetPtr) -> (Ptr UInt8) -> (CSize) -> (CSize) -> (Ptr CBool) -> IO ((Bool))
rureSetMatches a1 a2 a3 a4 a5 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  let {a2' = id a2} in 
  let {a3' = coerce a3} in 
  let {a4' = coerce a4} in 
  let {a5' = castPtr a5} in 
  rureSetMatches'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 220 "src/Regex/Rure/FFI.chs" #-}

rureSetLen :: (RureSetPtr) -> IO ((CSize))
rureSetLen a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureSetLen'_ a1' >>= \res ->
  let {res' = coerce res} in
  return (res')

{-# LINE 221 "src/Regex/Rure/FFI.chs" #-}

rureErrorNew :: IO ((Ptr RureError))
rureErrorNew =
  rureErrorNew'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 222 "src/Regex/Rure/FFI.chs" #-}

rureErrorMessage :: (RureErrorPtr) -> IO ((String))
rureErrorMessage a1 =
  C2HSImp.withForeignPtr a1 $ \a1' -> 
  rureErrorMessage'_ a1' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 223 "src/Regex/Rure/FFI.chs" #-}

rureEscapeMust :: (CString) -> IO ((CString))
rureEscapeMust a1 =
  (flip ($)) a1 $ \a1' -> 
  rureEscapeMust'_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 224 "src/Regex/Rure/FFI.chs" #-}

rureCstringFree :: (CString) -> IO ()
rureCstringFree a1 =
  (flip ($)) a1 $ \a1' -> 
  rureCstringFree'_ a1' >>
  return ()

{-# LINE 225 "src/Regex/Rure/FFI.chs" #-}


foreign import ccall "Regex/Rure/FFI.chs.h &rure_free"
  rureFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_options_free"
  rureOptionsFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_error_free"
  rureErrorFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_iter_free"
  rureIterFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_captures_free"
  rureCapturesFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_set_free"
  rureSetFree :: C2HSImp.FinalizerPtr ()

foreign import ccall "Regex/Rure/FFI.chs.h &rure_iter_capture_names_free"
  rureIterCaptureNamesFree :: C2HSImp.FinalizerPtr ()

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_compile_must"
  rureCompileMust'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr (Rure))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_compile"
  rureCompile'_ :: ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (RureOptions)) -> ((C2HSImp.Ptr (RureError)) -> (IO (C2HSImp.Ptr (Rure))))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_is_match"
  rureIsMatch'_ :: ((C2HSImp.Ptr (Rure)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CUChar{-bool-})))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_find"
  rureFind'_ :: ((C2HSImp.Ptr (Rure)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar{-bool-}))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_find_captures"
  rureFindCaptures'_ :: ((C2HSImp.Ptr (Rure)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr (RureCaptures)) -> (IO C2HSImp.CUChar{-bool-}))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_shortest_match"
  rureShortestMatch'_ :: ((C2HSImp.Ptr (Rure)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO C2HSImp.CUChar{-bool-}))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_capture_name_index"
  rureCaptureNameIndex'_ :: ((C2HSImp.Ptr (Rure)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_iter_capture_names_new"
  rureIterCaptureNamesNew'_ :: ((C2HSImp.Ptr (Rure)) -> (IO (C2HSImp.Ptr (RureIterCaptureNames))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_iter_capture_names_next"
  rureIterCaptureNamesNext'_ :: ((C2HSImp.Ptr (RureIterCaptureNames)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CUChar{-bool-})))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_iter_new"
  rureIterNew'_ :: ((C2HSImp.Ptr (Rure)) -> (IO (C2HSImp.Ptr (RureIter))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_iter_next"
  rureIterNext'_ :: ((C2HSImp.Ptr (RureIter)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar{-bool-})))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_iter_next_captures"
  rureIterNextCaptures'_ :: ((C2HSImp.Ptr (RureIter)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (RureCaptures)) -> (IO C2HSImp.CUChar{-bool-})))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_captures_new"
  rureCapturesNew'_ :: ((C2HSImp.Ptr (Rure)) -> (IO (C2HSImp.Ptr (RureCaptures))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_captures_at"
  rureCapturesAt'_ :: ((C2HSImp.Ptr (RureCaptures)) -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar{-bool-}))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_captures_len"
  rureCapturesLen'_ :: ((C2HSImp.Ptr (RureCaptures)) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_options_new"
  rureOptionsNew'_ :: (IO (C2HSImp.Ptr (RureOptions)))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_options_size_limit"
  rureOptionsSizeLimit'_ :: ((C2HSImp.Ptr (RureOptions)) -> (C2HSImp.CULong -> (IO ())))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_options_dfa_size_limit"
  rureOptionsDfaSizeLimit'_ :: ((C2HSImp.Ptr (RureOptions)) -> (C2HSImp.CULong -> (IO ())))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_compile_set"
  rureCompileSet'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr UInt8)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CULong -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (RureOptions)) -> ((C2HSImp.Ptr (RureError)) -> (IO (C2HSImp.Ptr (RureSet)))))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_set_is_match"
  rureSetIsMatch'_ :: ((C2HSImp.Ptr (RureSet)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CUChar{-bool-})))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h __c2hs_wrapped__rure_set_matches"
  rureSetMatches'_ :: ((C2HSImp.Ptr (RureSet)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CUChar{-bool-}) -> (IO C2HSImp.CUChar{-bool-}))))))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_set_len"
  rureSetLen'_ :: ((C2HSImp.Ptr (RureSet)) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_error_new"
  rureErrorNew'_ :: (IO (C2HSImp.Ptr (RureError)))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_error_message"
  rureErrorMessage'_ :: ((C2HSImp.Ptr (RureError)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_escape_must"
  rureEscapeMust'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall unsafe "Regex/Rure/FFI.chs.h rure_cstring_free"
  rureCstringFree'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ()))