{-# LINE 1 "Bindings/APR/StrMatch.hsc" #-}

{-# LINE 2 "Bindings/APR/StrMatch.hsc" #-}

{-# LINE 3 "Bindings/APR/StrMatch.hsc" #-}

module Bindings.APR.StrMatch where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 6 "Bindings/APR/StrMatch.hsc" #-}
import Bindings.APR
import Bindings.APR.Pools

data C'apr_strmatch_pattern = C'apr_strmatch_pattern{
{-# LINE 10 "Bindings/APR/StrMatch.hsc" #-}

  c'apr_strmatch_pattern'compare :: FunPtr (Ptr C'apr_strmatch_pattern -> Ptr CChar -> C'apr_size_t -> IO (Ptr CChar))
{-# LINE 11 "Bindings/APR/StrMatch.hsc" #-}
,
  c'apr_strmatch_pattern'pattern :: Ptr CChar
{-# LINE 12 "Bindings/APR/StrMatch.hsc" #-}
,
  c'apr_strmatch_pattern'length :: C'apr_size_t
{-# LINE 13 "Bindings/APR/StrMatch.hsc" #-}
,
  c'apr_strmatch_pattern'context :: Ptr ()
{-# LINE 14 "Bindings/APR/StrMatch.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'apr_strmatch_pattern where
  sizeOf _ = 16
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    return $ C'apr_strmatch_pattern v0 v1 v2 v3
  poke p (C'apr_strmatch_pattern v0 v1 v2 v3) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    return ()

{-# LINE 15 "Bindings/APR/StrMatch.hsc" #-}

foreign import ccall "inline_apr_strmach" c'apr_strmach
  :: Ptr C'apr_strmatch_pattern -> Ptr CChar -> C'apr_size_t -> IO (Ptr CChar)

{-# LINE 17 "Bindings/APR/StrMatch.hsc" #-}

foreign import ccall "apr_strmatch_precompile" c'apr_strmatch_precompile
  :: Ptr C'apr_pool_t -> Ptr CChar -> CInt -> IO (Ptr C'apr_strmatch_pattern)
foreign import ccall "&apr_strmatch_precompile" p'apr_strmatch_precompile
  :: FunPtr (Ptr C'apr_pool_t -> Ptr CChar -> CInt -> IO (Ptr C'apr_strmatch_pattern))

{-# LINE 19 "Bindings/APR/StrMatch.hsc" #-}