    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}

    -- | A 'Context' is used to define the capabilities of the Template Haskell code
    -- that handles the inline C code. See the documentation of the data type for
    -- more details.
    --
    -- In practice, a 'Context' will have to be defined for each library that
    -- defines new C types, to allow the TemplateHaskell code to interpret said
    -- types correctly.

    module Language.C.Inline.Context
      ( -- * 'TypesTable'
        TypesTable
      , Purity(..)
      , convertType
      , CArray
      , typeNamesFromTypesTable

        -- * 'AntiQuoter'
      , AntiQuoter(..)
      , AntiQuoterId
      , SomeAntiQuoter(..)
      , AntiQuoters

        -- * 'Context'
      , Context(..)
      , baseCtx
      , fptrCtx
      , funCtx
      , vecCtx
      , VecCtx(..)
      , bsCtx
      ) where

    import           Control.Applicative ((<|>))
    import           Control.Monad (mzero, forM)
    import           Control.Monad.Trans.Class (lift)
    import           Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Unsafe as BS
    import           Data.Coerce
    import           Data.Int (Int8, Int16, Int32, Int64)
    import qualified Data.Map as Map
    import           Data.Typeable (Typeable)
    import qualified Data.Vector.Storable as V
    import qualified Data.Vector.Storable.Mutable as VM
    import           Data.Word (Word8, Word16, Word32, Word64)
    import           Foreign.C.Types
    import           Foreign.ForeignPtr (withForeignPtr)
    import           Foreign.Ptr (Ptr, FunPtr, freeHaskellFunPtr)
    import           Foreign.Storable (Storable)
    import qualified Language.Haskell.TH as TH
    import qualified Language.Haskell.TH.Syntax as TH
    import qualified Text.Parser.Token as Parser
    import qualified Data.HashSet as HashSet

    #if MIN_VERSION_base(4,9,0)
    import           Data.Semigroup (Semigroup, (<>))
    #else
    import           Data.Monoid ((<>))
    #endif

    #if __GLASGOW_HASKELL__ < 710
    import           Data.Monoid (Monoid(..))
    import           Data.Traversable (traverse)
    #endif

    import           Language.C.Inline.FunPtr
    import qualified Language.C.Types as C
    import           Language.C.Inline.HaskellIdentifier

    -- | A mapping from 'C.TypeSpecifier's to Haskell types.  Needed both to
    -- parse C types, and to convert them to Haskell types.
    type TypesTable = Map.Map C.TypeSpecifier TH.TypeQ

    -- | A data type to indicate whether the user requested pure or IO
    -- function from Haskell
    data Purity
      = Pure
      | IO
      deriving (Purity -> Purity -> Bool
    (Purity -> Purity -> Bool)
    -> (Purity -> Purity -> Bool) -> Eq Purity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Purity -> Purity -> Bool
    == :: Purity -> Purity -> Bool
    $c/= :: Purity -> Purity -> Bool
    /= :: Purity -> Purity -> Bool
    Eq, Int -> Purity -> ShowS
    [Purity] -> ShowS
    Purity -> [Char]
    (Int -> Purity -> ShowS)
    -> (Purity -> [Char]) -> ([Purity] -> ShowS) -> Show Purity
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Purity -> ShowS
    showsPrec :: Int -> Purity -> ShowS
    $cshow :: Purity -> [Char]
    show :: Purity -> [Char]
    $cshowList :: [Purity] -> ShowS
    showList :: [Purity] -> ShowS
    Show)

    -- | Specifies how to parse and process an antiquotation in the C code.
    --
    -- All antiquotations (apart from plain variable capture) have syntax
    --
    -- @
    -- $XXX:YYY
    -- @
    --
    -- Where @XXX@ is the name of the antiquoter and @YYY@ is something
    -- parseable by the respective 'aqParser'.
    data AntiQuoter a = AntiQuoter
      { forall a.
    AntiQuoter a
    -> forall (m :: * -> *).
       CParser HaskellIdentifier m =>
       m (CIdentifier, Type CIdentifier, a)
    aqParser :: forall m. C.CParser HaskellIdentifier m => m (C.CIdentifier, C.Type C.CIdentifier, a)
        -- ^ Parses the body of the antiquotation, returning a hint for the name to
        -- assign to the variable that will replace the anti-quotation, the type of
        -- said variable, and some arbitrary data which will then be fed to
        -- 'aqMarshaller'.
        --
        -- The 'C.Type' has 'Void' as an identifier type to make sure that
        -- no names appear in it.
      , forall a.
    AntiQuoter a
    -> Purity -> TypesTable -> Type CIdentifier -> a -> Q (Type, Exp)
    aqMarshaller :: Purity -> TypesTable -> C.Type C.CIdentifier -> a -> TH.Q (TH.Type, TH.Exp)
        -- ^ Takes the requested purity, the current 'TypesTable', and the
        -- type and the body returned by 'aqParser'.
        --
        -- Returns the Haskell type for the parameter, and the Haskell expression
        -- that will be passed in as the parameter.
        --
        -- If the the type returned is @ty@, the 'TH.Exp' __must__ have type @forall
        -- a. (ty -> IO a) -> IO a@. This allows to do resource handling when
        -- preparing C values.
        --
        -- Care must be taken regarding 'Purity'. Specifically, the generated IO
        -- computation must be idempotent to guarantee its safety when used in pure
        -- code. We cannot prevent the IO computation from being inlined, hence
        -- potentially duplicated. If non-idempotent marshallers are required (e.g.
        -- if an update to some global state is needed), it is best to throw an
        -- error when 'Purity' is 'Pure' (for example "you cannot use context X with
        -- @pure@"), which will show up at compile time.
      }

    -- | An identifier for a 'AntiQuoter'.
    type AntiQuoterId = String

    -- | Existential wrapper around 'AntiQuoter'.
    data SomeAntiQuoter = forall a. (Eq a, Typeable a) => SomeAntiQuoter (AntiQuoter a)

    type AntiQuoters = Map.Map AntiQuoterId SomeAntiQuoter

    -- | A 'Context' stores various information needed to produce the files with
    -- the C code derived from the inline C snippets.
    --
    -- 'Context's can be composed with their 'Monoid' instance, where 'mappend' is
    -- right-biased -- in @'mappend' x y@ @y@ will take precedence over @x@.
    data Context = Context
      { Context -> TypesTable
    ctxTypesTable :: TypesTable
        -- ^ Needed to convert C types to Haskell types.
      , Context -> AntiQuoters
    ctxAntiQuoters :: AntiQuoters
        -- ^ Needed to parse and process antiquotations.
      , Context -> Maybe ShowS
    ctxOutput :: Maybe (String -> String)
        -- ^ This function is used to post-process the functions generated
        -- from the C snippets.  Currently just used to specify C linkage
        -- when generating C++ code.
      , Context -> Maybe ForeignSrcLang
    ctxForeignSrcLang :: Maybe TH.ForeignSrcLang
        -- ^ TH.LangC by default
      , Context -> Bool
    ctxEnableCpp :: Bool
        -- ^ Compile source code to raw object.
      , Context -> Maybe ([Char] -> Q [Char])
    ctxRawObjectCompile :: Maybe (String -> TH.Q FilePath)
      }

    #if MIN_VERSION_base(4,9,0)
    instance Semigroup Context where
      Context
    ctx2 <> :: Context -> Context -> Context
    <> Context
    ctx1 = Context
        { ctxTypesTable :: TypesTable
    ctxTypesTable = Context -> TypesTable
    ctxTypesTable Context
    ctx1 TypesTable -> TypesTable -> TypesTable
    forall a. Semigroup a => a -> a -> a
    <> Context -> TypesTable
    ctxTypesTable Context
    ctx2
        , ctxAntiQuoters :: AntiQuoters
    ctxAntiQuoters = Context -> AntiQuoters
    ctxAntiQuoters Context
    ctx1 AntiQuoters -> AntiQuoters -> AntiQuoters
    forall a. Semigroup a => a -> a -> a
    <> Context -> AntiQuoters
    ctxAntiQuoters Context
    ctx2
        , ctxOutput :: Maybe ShowS
    ctxOutput = Context -> Maybe ShowS
    ctxOutput Context
    ctx1 Maybe ShowS -> Maybe ShowS -> Maybe ShowS
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Context -> Maybe ShowS
    ctxOutput Context
    ctx2
        , ctxForeignSrcLang :: Maybe ForeignSrcLang
    ctxForeignSrcLang = Context -> Maybe ForeignSrcLang
    ctxForeignSrcLang Context
    ctx1 Maybe ForeignSrcLang
    -> Maybe ForeignSrcLang -> Maybe ForeignSrcLang
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Context -> Maybe ForeignSrcLang
    ctxForeignSrcLang Context
    ctx2
        , ctxEnableCpp :: Bool
    ctxEnableCpp = Context -> Bool
    ctxEnableCpp Context
    ctx1 Bool -> Bool -> Bool
    || Context -> Bool
    ctxEnableCpp Context
    ctx2
        , ctxRawObjectCompile :: Maybe ([Char] -> Q [Char])
    ctxRawObjectCompile = Context -> Maybe ([Char] -> Q [Char])
    ctxRawObjectCompile Context
    ctx1 Maybe ([Char] -> Q [Char])
    -> Maybe ([Char] -> Q [Char]) -> Maybe ([Char] -> Q [Char])
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Context -> Maybe ([Char] -> Q [Char])
    ctxRawObjectCompile Context
    ctx2
        }
    #endif

    instance Monoid Context where
      mempty :: Context
    mempty = Context
        { ctxTypesTable :: TypesTable
    ctxTypesTable = TypesTable
    forall a. Monoid a => a
    mempty
        , ctxAntiQuoters :: AntiQuoters
    ctxAntiQuoters = AntiQuoters
    forall a. Monoid a => a
    mempty
        , ctxOutput :: Maybe ShowS
    ctxOutput = Maybe ShowS
    forall a. Maybe a
    Nothing
        , ctxForeignSrcLang :: Maybe ForeignSrcLang
    ctxForeignSrcLang = Maybe ForeignSrcLang
    forall a. Maybe a
    Nothing
        , ctxEnableCpp :: Bool
    ctxEnableCpp = Bool
    False
        , ctxRawObjectCompile :: Maybe ([Char] -> Q [Char])
    ctxRawObjectCompile = Maybe ([Char] -> Q [Char])
    forall a. Maybe a
    Nothing
        }

    #if !MIN_VERSION_base(4,11,0)
      mappend ctx2 ctx1 = Context
        { ctxTypesTable = ctxTypesTable ctx1 <> ctxTypesTable ctx2
        , ctxAntiQuoters = ctxAntiQuoters ctx1 <> ctxAntiQuoters ctx2
        , ctxOutput = ctxOutput ctx1 <|> ctxOutput ctx2
        , ctxForeignSrcLang = ctxForeignSrcLang ctx1 <|> ctxForeignSrcLang ctx2
        , ctxEnableCpp = ctxEnableCpp ctx1 || ctxEnableCpp ctx2
        , ctxRawObjectCompile = ctxRawObjectCompile ctx1 <|> ctxRawObjectCompile ctx2
        }
    #endif

    -- | Context useful to work with vanilla C. Used by default.
    --
    -- 'ctxTypesTable': converts C basic types to their counterparts in
    -- "Foreign.C.Types".
    --
    -- No 'ctxAntiQuoters'.
    baseCtx :: Context
    baseCtx :: Context
    baseCtx = Context
    forall a. Monoid a => a
    mempty
      { ctxTypesTable = baseTypesTable
      }

    baseTypesTable :: Map.Map C.TypeSpecifier TH.TypeQ
    baseTypesTable :: TypesTable
    baseTypesTable = [(TypeSpecifier, TypeQ)] -> TypesTable
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
      [ (TypeSpecifier
    C.Void, [t| () |])
      -- Types from Foreign.C.Types in the order in which they are presented there,
      -- along with its documentation's section headers.
      --
      -- Integral types
      , (TypeSpecifier
    C.Bool, [t| CBool |])
      , (Maybe Sign -> TypeSpecifier
    C.Char Maybe Sign
    forall a. Maybe a
    Nothing, [t| CChar |])
      , (Maybe Sign -> TypeSpecifier
    C.Char (Sign -> Maybe Sign
    forall a. a -> Maybe a
    Just Sign
    C.Signed), [t| CSChar |])
      , (Maybe Sign -> TypeSpecifier
    C.Char (Sign -> Maybe Sign
    forall a. a -> Maybe a
    Just Sign
    C.Unsigned), [t| CUChar |])
      , (Sign -> TypeSpecifier
    C.Short Sign
    C.Signed, [t| CShort |])
      , (Sign -> TypeSpecifier
    C.Short Sign
    C.Unsigned, [t| CUShort |])
      , (Sign -> TypeSpecifier
    C.Int Sign
    C.Signed, [t| CInt |])
      , (Sign -> TypeSpecifier
    C.Int Sign
    C.Unsigned, [t| CUInt |])
      , (Sign -> TypeSpecifier
    C.Long Sign
    C.Signed, [t| CLong |])
      , (Sign -> TypeSpecifier
    C.Long Sign
    C.Unsigned, [t| CULong |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "ptrdiff_t", [t| CPtrdiff |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "size_t", [t| CSize |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "wchar_t", [t| CWchar |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "sig_atomic_t", [t| CSigAtomic |])
      , (Sign -> TypeSpecifier
    C.LLong Sign
    C.Signed, [t| CLLong |])
      , (Sign -> TypeSpecifier
    C.LLong Sign
    C.Unsigned, [t| CULLong |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "intptr_t", [t| CIntPtr |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uintptr_t", [t| CUIntPtr |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "intmax_t", [t| CIntMax |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uintmax_t", [t| CUIntMax |])
      -- Numeric types
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "clock_t", [t| CClock |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "time_t", [t| CTime |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "useconds_t", [t| CUSeconds |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "suseconds_t", [t| CSUSeconds |])
      -- Floating types
      , (TypeSpecifier
    C.Float, [t| CFloat |])
      , (TypeSpecifier
    C.Double, [t| CDouble |])
      -- Other types
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "FILE", [t| CFile |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "fpos_t", [t| CFpos |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "jmp_buf", [t| CJmpBuf |])
      -- Types from stdint.h that can be statically mapped to their Haskell
      -- equivalents. Excludes int_fast*_t and int_least*_t and the corresponding
      -- unsigned types, since their sizes are platform-specific.
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "int8_t", [t| Int8 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "int16_t", [t| Int16 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "int32_t", [t| Int32 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "int64_t", [t| Int64 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uint8_t", [t| Word8 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uint16_t", [t| Word16 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uint32_t", [t| Word32 |])
      , (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    "uint64_t", [t| Word64 |])
      ]

    -- | An alias for 'Ptr'.
    type CArray = Ptr

    ------------------------------------------------------------------------
    -- Type conversion

    -- | Given a 'Context', it uses its 'ctxTypesTable' to convert
    -- arbitrary C types.
    convertType
      :: Purity
      -> TypesTable
      -> C.Type C.CIdentifier
      -> TH.Q (Maybe TH.Type)
    convertType :: Purity -> TypesTable -> Type CIdentifier -> Q (Maybe Type)
    convertType Purity
    purity TypesTable
    cTypes = MaybeT Q Type -> Q (Maybe Type)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT Q Type -> Q (Maybe Type))
    -> (Type CIdentifier -> MaybeT Q Type)
    -> Type CIdentifier
    -> Q (Maybe Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type CIdentifier -> MaybeT Q Type
    go
      where
        goDecl :: ParameterDeclaration CIdentifier -> MaybeT Q Type
    goDecl = Type CIdentifier -> MaybeT Q Type
    go (Type CIdentifier -> MaybeT Q Type)
    -> (ParameterDeclaration CIdentifier -> Type CIdentifier)
    -> ParameterDeclaration CIdentifier
    -> MaybeT Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParameterDeclaration CIdentifier -> Type CIdentifier
    forall i. ParameterDeclaration i -> Type i
    C.parameterDeclarationType

        go :: C.Type C.CIdentifier -> MaybeT TH.Q TH.Type
        go :: Type CIdentifier -> MaybeT Q Type
    go Type CIdentifier
    cTy = do
         case Type CIdentifier
    cTy of
          C.TypeSpecifier Specifiers
    _specs (C.Template CIdentifier
    ident' [TypeSpecifier]
    cTys) -> do
    --        let symbol = TH.LitT (TH.StrTyLit (C.unCIdentifier ident'))
            symbol <- case TypeSpecifier -> TypesTable -> Maybe TypeQ
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (CIdentifier -> TypeSpecifier
    C.TypeName CIdentifier
    ident') TypesTable
    cTypes of
              Maybe TypeQ
    Nothing -> MaybeT Q TypeQ
    forall a. MaybeT Q a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
              Just TypeQ
    ty -> TypeQ -> MaybeT Q TypeQ
    forall a. a -> MaybeT Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TypeQ
    ty
            hsTy <- forM cTys $ \TypeSpecifier
    cTys'  -> Type CIdentifier -> MaybeT Q Type
    go (Specifiers -> TypeSpecifier -> Type CIdentifier
    forall i. Specifiers -> TypeSpecifier -> Type i
    C.TypeSpecifier Specifiers
    forall a. HasCallStack => a
    undefined TypeSpecifier
    cTys')
            case hsTy of
              [] -> [Char] -> MaybeT Q Type
    forall a. [Char] -> MaybeT Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> MaybeT Q Type) -> [Char] -> MaybeT Q Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Can not find template parameters."
              (Type
    a:[]) ->
                TypeQ -> MaybeT Q Type
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (TypeQ -> MaybeT Q Type) -> TypeQ -> MaybeT Q Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Type
    TH.AppT (Type -> Type -> Type) -> TypeQ -> Q (Type -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeQ
    symbol Q (Type -> Type) -> TypeQ -> TypeQ
    forall a b. Q (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    a
              [Type]
    other ->
                let tuple :: Type
    tuple = (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Type
    tuple Type
    arg -> Type -> Type -> Type
    TH.AppT Type
    tuple Type
    arg) (Int -> Type
    TH.PromotedTupleT ([Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    other)) [Type]
    other
                in TypeQ -> MaybeT Q Type
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (TypeQ -> MaybeT Q Type) -> TypeQ -> MaybeT Q Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Type
    TH.AppT (Type -> Type -> Type) -> TypeQ -> Q (Type -> Type)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeQ
    symbol Q (Type -> Type) -> TypeQ -> TypeQ
    forall a b. Q (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    tuple
          C.TypeSpecifier Specifiers
    _specs (C.TemplateConst [Char]
    num) -> do
            let n :: Type
    n = (TyLit -> Type
    TH.LitT (Integer -> TyLit
    TH.NumTyLit ([Char] -> Integer
    forall a. Read a => [Char] -> a
    read [Char]
    num)))
            TypeQ -> MaybeT Q Type
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift [t| $(Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    n) |]
          C.TypeSpecifier Specifiers
    _specs (C.TemplatePointer TypeSpecifier
    cSpec) -> do
            case TypeSpecifier -> TypesTable -> Maybe TypeQ
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup TypeSpecifier
    cSpec TypesTable
    cTypes of
              Maybe TypeQ
    Nothing -> MaybeT Q Type
    forall a. MaybeT Q a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
              Just TypeQ
    ty -> TypeQ -> MaybeT Q Type
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift [t| Ptr $(TypeQ
    ty) |]
          C.TypeSpecifier Specifiers
    _specs TypeSpecifier
    cSpec ->
            case TypeSpecifier -> TypesTable -> Maybe TypeQ
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup TypeSpecifier
    cSpec TypesTable
    cTypes of
              Maybe TypeQ
    Nothing -> MaybeT Q Type
    forall a. MaybeT Q a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
              Just TypeQ
    ty -> TypeQ -> MaybeT Q Type
    forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift TypeQ
    ty
          C.Ptr [TypeQualifier]
    _quals (C.Proto Type CIdentifier
    retType [ParameterDeclaration CIdentifier]
    pars) -> do
            hsRetType <- Type CIdentifier -> MaybeT Q Type
    go Type CIdentifier
    retType
            hsPars <- mapM goDecl pars
            lift [t| FunPtr $(buildArr hsPars hsRetType) |]
          C.Ptr [TypeQualifier]
    _quals Type CIdentifier
    cTy' -> do
            hsTy <- Type CIdentifier -> MaybeT Q Type
    go Type CIdentifier
    cTy'
            lift [t| Ptr $(return hsTy) |]
          C.Array ArrayType CIdentifier
    _mbSize Type CIdentifier
    cTy' -> do
            hsTy <- Type CIdentifier -> MaybeT Q Type
    go Type CIdentifier
    cTy'
            lift [t| CArray $(return hsTy) |]
          C.Proto Type CIdentifier
    _retType [ParameterDeclaration CIdentifier]
    _pars -> do
            -- We cannot convert standalone prototypes
            mzero

        buildArr :: [Type] -> Type -> TypeQ
    buildArr [] Type
    hsRetType =
          case Purity
    purity of
            Purity
    Pure -> [t| $(Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsRetType) |]
            Purity
    IO -> [t| IO $(Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsRetType) |]
        buildArr (Type
    hsPar : [Type]
    hsPars) Type
    hsRetType =
          [t| $(Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsPar) -> $([Type] -> Type -> TypeQ
    buildArr [Type]
    hsPars Type
    hsRetType) |]

    typeNamesFromTypesTable :: TypesTable -> C.TypeNames
    typeNamesFromTypesTable :: TypesTable -> TypeNames
    typeNamesFromTypesTable TypesTable
    cTypes = [CIdentifier] -> TypeNames
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    HashSet.fromList
      [ CIdentifier
    id' | C.TypeName CIdentifier
    id' <- TypesTable -> [TypeSpecifier]
    forall k a. Map k a -> [k]
    Map.keys TypesTable
    cTypes ]

    ------------------------------------------------------------------------
    -- Useful contexts

    getHsVariable :: String -> HaskellIdentifier -> TH.ExpQ
    getHsVariable :: [Char] -> HaskellIdentifier -> ExpQ
    getHsVariable [Char]
    err HaskellIdentifier
    s = do
      mbHsName <- [Char] -> Q (Maybe Name)
    TH.lookupValueName ([Char] -> Q (Maybe Name)) -> [Char] -> Q (Maybe Name)
    forall a b. (a -> b) -> a -> b
    $ HaskellIdentifier -> [Char]
    unHaskellIdentifier HaskellIdentifier
    s
      case mbHsName of
        Maybe Name
    Nothing -> [Char] -> ExpQ
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> ExpQ) -> [Char] -> ExpQ
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot capture Haskell variable " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ HaskellIdentifier -> [Char]
    unHaskellIdentifier HaskellIdentifier
    s [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    ", because it's not in scope. (" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
        Just Name
    hsName -> Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    TH.varE Name
    hsName

    convertType_ :: String -> Purity -> TypesTable -> C.Type C.CIdentifier -> TH.Q TH.Type
    convertType_ :: [Char] -> Purity -> TypesTable -> Type CIdentifier -> TypeQ
    convertType_ [Char]
    err Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy = do
      mbHsType <- Purity -> TypesTable -> Type CIdentifier -> Q (Maybe Type)
    convertType Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy
      case mbHsType of
        Maybe Type
    Nothing -> [Char] -> TypeQ
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> TypeQ) -> [Char] -> TypeQ
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot convert C type (" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"
        Just Type
    hsType -> Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsType

    -- | This 'Context' adds support for 'ForeignPtr' arguments. It adds a unique
    -- marshaller called @fptr-ptr@. For example, @$fptr-ptr:(int *x)@ extracts the
    -- bare C pointer out of foreign pointer @x@.
    fptrCtx :: Context
    fptrCtx :: Context
    fptrCtx = Context
    forall a. Monoid a => a
    mempty
      { ctxAntiQuoters = Map.fromList [("fptr-ptr", SomeAntiQuoter fptrAntiQuoter)]
      }

    fptrAntiQuoter :: AntiQuoter HaskellIdentifier
    fptrAntiQuoter :: AntiQuoter HaskellIdentifier
    fptrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    cDeclAqParser
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          hsTy <- [Char] -> Purity -> TypesTable -> Type CIdentifier -> TypeQ
    convertType_ [Char]
    "fptrCtx" Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy
          hsExp <- getHsVariable "fptrCtx" cId
          hsExp' <- [| withForeignPtr (coerce $(return hsExp)) |]
          return (hsTy, hsExp')
      }

    -- | This 'Context' includes a 'AntiQuoter' that removes the need for
    -- explicitely creating 'FunPtr's, named @"fun"@ along with one which
    -- allocates new memory which must be manually freed named @"fun-alloc"@.
    --
    -- For example, we can capture function @f@ of type @CInt -> CInt -> IO
    -- CInt@ in C code using @$fun:(int (*f)(int, int))@.
    --
    -- When used in a @pure@ embedding, the Haskell function will have to be
    -- pure too.  Continuing the example above we'll have @CInt -> CInt ->
    -- IO CInt@.
    --
    -- Does not include the 'baseCtx', since most of the time it's going to
    -- be included as part of larger contexts.
    --
    -- IMPORTANT: When using the @fun@ anti quoter, one must be aware that
    -- the function pointer which is automatically generated is freed when
    -- the code contained in the block containing the anti quoter exits.
    -- Thus, if you need the function pointer to be longer-lived, you must
    -- allocate it and free it manually using 'freeHaskellFunPtr'.
    -- We provide utilities to easily
    -- allocate them (see 'Language.C.Inline.mkFunPtr').
    --
    -- IMPORTANT: When using the @fun-alloc@ anti quoter, one must free the allocated
    -- function pointer. The GHC runtime provides a function to do this,
    -- 'hs_free_fun_ptr' available in the 'HsFFI.h' header.

    funCtx :: Context
    funCtx :: Context
    funCtx = Context
    forall a. Monoid a => a
    mempty
      { ctxAntiQuoters = Map.fromList [("fun", SomeAntiQuoter funPtrAntiQuoter)
                                      ,("fun-alloc", SomeAntiQuoter funAllocPtrAntiQuoter)]
      }

    funPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    funPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    funPtrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    cDeclAqParser
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          hsTy <- [Char] -> Purity -> TypesTable -> Type CIdentifier -> TypeQ
    convertType_ [Char]
    "funCtx" Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy
          hsExp <- getHsVariable "funCtx" cId
          case hsTy of
            TH.AppT (TH.ConT Name
    n) Type
    hsTy' | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''FunPtr -> do
              hsExp' <- [| \cont -> do
                  funPtr <- $(TypeQ -> ExpQ
    mkFunPtr (Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsTy')) $(Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    hsExp)
                  x <- cont funPtr
                  freeHaskellFunPtr funPtr
                  return x
                |]
              return (hsTy, hsExp')
            Type
    _ -> [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "The `fun' marshaller captures function pointers only"
      }

    funAllocPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    funAllocPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    funAllocPtrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    cDeclAqParser
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          hsTy <- [Char] -> Purity -> TypesTable -> Type CIdentifier -> TypeQ
    convertType_ [Char]
    "funCtx" Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy
          hsExp <- getHsVariable "funCtx" cId
          case hsTy of
            TH.AppT (TH.ConT Name
    n) Type
    hsTy' | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''FunPtr -> do
              hsExp' <- [| \cont -> do
                  funPtr <- $(TypeQ -> ExpQ
    mkFunPtr (Type -> TypeQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    hsTy')) $(Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    hsExp)
                  cont funPtr
                |]
              return (hsTy, hsExp')
            Type
    _ -> [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "The `fun-alloc' marshaller captures function pointers only"
      }

    -- | This 'Context' includes two 'AntiQuoter's that allow to easily use
    -- Haskell vectors in C.
    --
    -- Specifically, the @vec-len@ and @vec-ptr@ will get the length and the
    -- pointer underlying mutable ('V.IOVector') and immutable ('V.Vector')
    -- storable vectors.
    --
    -- Note that if you use 'vecCtx' to manipulate immutable vectors you
    -- must make sure that the vector is not modified in the C code.
    --
    -- To use @vec-len@, simply write @$vec-len:x@, where @x@ is something
    -- of type @'V.IOVector' a@ or @'V.Vector' a@, for some @a@.  To use
    -- @vec-ptr@ you need to specify the type of the pointer,
    -- e.g. @$vec-len:(int *x)@ will work if @x@ has type @'V.IOVector'
    -- 'CInt'@.
    vecCtx :: Context
    vecCtx :: Context
    vecCtx = Context
    forall a. Monoid a => a
    mempty
      { ctxAntiQuoters = Map.fromList
          [ ("vec-ptr", SomeAntiQuoter vecPtrAntiQuoter)
          , ("vec-len", SomeAntiQuoter vecLenAntiQuoter)
          ]
      }

    -- | Type class used to implement the anti-quoters in 'vecCtx'.
    class VecCtx a where
      type VecCtxScalar a :: *

      vecCtxLength :: a -> Int
      vecCtxUnsafeWith :: a -> (Ptr (VecCtxScalar a) -> IO b) -> IO b

    instance Storable a => VecCtx (V.Vector a) where
      type VecCtxScalar (V.Vector a) = a

      vecCtxLength :: Vector a -> Int
    vecCtxLength = Vector a -> Int
    forall a. Storable a => Vector a -> Int
    V.length
      vecCtxUnsafeWith :: forall b.
    Vector a -> (Ptr (VecCtxScalar (Vector a)) -> IO b) -> IO b
    vecCtxUnsafeWith = Vector a -> (Ptr a -> IO b) -> IO b
    Vector a -> (Ptr (VecCtxScalar (Vector a)) -> IO b) -> IO b
    forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
    V.unsafeWith

    instance Storable a => VecCtx (VM.IOVector a) where
      type VecCtxScalar (VM.IOVector a) = a

      vecCtxLength :: IOVector a -> Int
    vecCtxLength = IOVector a -> Int
    forall a s. Storable a => MVector s a -> Int
    VM.length
      vecCtxUnsafeWith :: forall b.
    IOVector a -> (Ptr (VecCtxScalar (IOVector a)) -> IO b) -> IO b
    vecCtxUnsafeWith = IOVector a -> (Ptr a -> IO b) -> IO b
    IOVector a -> (Ptr (VecCtxScalar (IOVector a)) -> IO b) -> IO b
    forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
    VM.unsafeWith

    vecPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    vecPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    vecPtrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    cDeclAqParser
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          hsTy <- [Char] -> Purity -> TypesTable -> Type CIdentifier -> TypeQ
    convertType_ [Char]
    "vecCtx" Purity
    purity TypesTable
    cTypes Type CIdentifier
    cTy
          hsExp <- getHsVariable "vecCtx" cId
          hsExp' <- [| vecCtxUnsafeWith $(return hsExp) |]
          return (hsTy, hsExp')
      }

    vecLenAntiQuoter :: AntiQuoter HaskellIdentifier
    vecLenAntiQuoter :: AntiQuoter HaskellIdentifier
    vecLenAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = do
          hId <- m HaskellIdentifier
    forall i (m :: * -> *). CParser i m => m i
    C.parseIdentifier
          useCpp <- C.parseEnableCpp
          let cId = Bool -> HaskellIdentifier -> CIdentifier
    mangleHaskellIdentifier Bool
    useCpp HaskellIdentifier
    hId
          return (cId, C.TypeSpecifier mempty (C.Long C.Signed), hId)
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    _purity TypesTable
    _cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          case Type CIdentifier
    cTy of
            C.TypeSpecifier Specifiers
    _ (C.Long Sign
    C.Signed) -> do
              hsExp <- [Char] -> HaskellIdentifier -> ExpQ
    getHsVariable [Char]
    "vecCtx" HaskellIdentifier
    cId
              hsExp' <- [| fromIntegral (vecCtxLength $(return hsExp)) |]
              hsTy <- [t| CLong |]
              hsExp'' <- [| \cont -> cont $(return hsExp') |]
              return (hsTy, hsExp'')
            Type CIdentifier
    _ -> do
              [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "impossible: got type different from `long' (vecCtx)"
      }

    -- | 'bsCtx' serves exactly the same purpose as 'vecCtx', but only for
    -- 'BS.ByteString'.  @vec-ptr@ becomes @bs-ptr@, and @vec-len@ becomes
    -- @bs-len@.  You don't need to specify the type of the pointer in
    -- @bs-ptr@, it will always be @char*@.
    --
    -- Moreover, @bs-cstr@ works as @bs-ptr@ but it provides a null-terminated
    -- copy of the given 'BS.ByteString'.
    bsCtx :: Context
    bsCtx :: Context
    bsCtx = Context
    forall a. Monoid a => a
    mempty
      { ctxAntiQuoters = Map.fromList
          [ ("bs-ptr", SomeAntiQuoter bsPtrAntiQuoter)
          , ("bs-len", SomeAntiQuoter bsLenAntiQuoter)
          , ("bs-cstr", SomeAntiQuoter bsCStrAntiQuoter)
          ]
      }

    bsPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    bsPtrAntiQuoter :: AntiQuoter HaskellIdentifier
    bsPtrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = do
          hId <- m HaskellIdentifier
    forall i (m :: * -> *). CParser i m => m i
    C.parseIdentifier
          useCpp <- C.parseEnableCpp
          let cId = Bool -> HaskellIdentifier -> CIdentifier
    mangleHaskellIdentifier Bool
    useCpp HaskellIdentifier
    hId
          return (cId, C.Ptr [] (C.TypeSpecifier mempty (C.Char Nothing)), hId)
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    _purity TypesTable
    _cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          case Type CIdentifier
    cTy of
            C.Ptr [TypeQualifier]
    _ (C.TypeSpecifier Specifiers
    _ (C.Char Maybe Sign
    Nothing)) -> do
              hsTy <- [t| Ptr CChar |]
              hsExp <- getHsVariable "bsCtx" cId
              hsExp' <- [| \cont -> BS.unsafeUseAsCString $(return hsExp) $ \ptr -> cont ptr  |]
              return (hsTy, hsExp')
            Type CIdentifier
    _ ->
              [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "impossible: got type different from `char *' (bsCtx)"
      }

    bsLenAntiQuoter :: AntiQuoter HaskellIdentifier
    bsLenAntiQuoter :: AntiQuoter HaskellIdentifier
    bsLenAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = do
          hId <- m HaskellIdentifier
    forall i (m :: * -> *). CParser i m => m i
    C.parseIdentifier
          useCpp <- C.parseEnableCpp
          let cId = Bool -> HaskellIdentifier -> CIdentifier
    mangleHaskellIdentifier Bool
    useCpp HaskellIdentifier
    hId
          return (cId, C.TypeSpecifier mempty (C.Long C.Signed), hId)
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    _purity TypesTable
    _cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          case Type CIdentifier
    cTy of
            C.TypeSpecifier Specifiers
    _ (C.Long Sign
    C.Signed) -> do
              hsExp <- [Char] -> HaskellIdentifier -> ExpQ
    getHsVariable [Char]
    "bsCtx" HaskellIdentifier
    cId
              hsExp' <- [| fromIntegral (BS.length $(return hsExp)) |]
              hsTy <- [t| CLong |]
              hsExp'' <- [| \cont -> cont $(return hsExp') |]
              return (hsTy, hsExp'')
            Type CIdentifier
    _ -> do
              [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "impossible: got type different from `long' (bsCtx)"
      }

    bsCStrAntiQuoter :: AntiQuoter HaskellIdentifier
    bsCStrAntiQuoter :: AntiQuoter HaskellIdentifier
    bsCStrAntiQuoter = AntiQuoter
      { aqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    aqParser = do
          hId <- m HaskellIdentifier
    forall i (m :: * -> *). CParser i m => m i
    C.parseIdentifier
          useCpp <- C.parseEnableCpp
          let cId = Bool -> HaskellIdentifier -> CIdentifier
    mangleHaskellIdentifier Bool
    useCpp HaskellIdentifier
    hId
          return (cId, C.Ptr [] (C.TypeSpecifier mempty (C.Char Nothing)), hId)
      , aqMarshaller :: Purity
    -> TypesTable
    -> Type CIdentifier
    -> HaskellIdentifier
    -> Q (Type, Exp)
    aqMarshaller = \Purity
    _purity TypesTable
    _cTypes Type CIdentifier
    cTy HaskellIdentifier
    cId -> do
          case Type CIdentifier
    cTy of
            C.Ptr [TypeQualifier]
    _ (C.TypeSpecifier Specifiers
    _ (C.Char Maybe Sign
    Nothing)) -> do
              hsTy <- [t| Ptr CChar |]
              hsExp <- getHsVariable "bsCtx" cId
              hsExp' <- [| \cont -> BS.useAsCString $(return hsExp) $ \ptr -> cont ptr  |]
              return (hsTy, hsExp')
            Type CIdentifier
    _ ->
              [Char] -> Q (Type, Exp)
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "impossible: got type different from `char *' (bsCtx)"
      }

    -- Utils
    ------------------------------------------------------------------------

    cDeclAqParser
      :: C.CParser HaskellIdentifier m
      => m (C.CIdentifier, C.Type C.CIdentifier, HaskellIdentifier)
    cDeclAqParser :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    cDeclAqParser = do
      cTy <- m (ParameterDeclaration HaskellIdentifier)
    -> m (ParameterDeclaration HaskellIdentifier)
    forall (m :: * -> *) a. TokenParsing m => m a -> m a
    Parser.parens m (ParameterDeclaration HaskellIdentifier)
    forall i (m :: * -> *).
    (CParser i m, Pretty i) =>
    m (ParameterDeclaration i)
    C.parseParameterDeclaration
      useCpp <- C.parseEnableCpp
      case C.parameterDeclarationId cTy of
        Maybe HaskellIdentifier
    Nothing -> [Char] -> m (CIdentifier, Type CIdentifier, HaskellIdentifier)
    forall a. [Char] -> m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "Every captured function must be named (funCtx)"
        Just HaskellIdentifier
    hId -> do
         let cId :: CIdentifier
    cId = Bool -> HaskellIdentifier -> CIdentifier
    mangleHaskellIdentifier Bool
    useCpp HaskellIdentifier
    hId
         cTy' <- Type HaskellIdentifier -> m (Type CIdentifier)
    forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    Type HaskellIdentifier -> m (Type CIdentifier)
    deHaskellifyCType (Type HaskellIdentifier -> m (Type CIdentifier))
    -> Type HaskellIdentifier -> m (Type CIdentifier)
    forall a b. (a -> b) -> a -> b
    $ ParameterDeclaration HaskellIdentifier -> Type HaskellIdentifier
    forall i. ParameterDeclaration i -> Type i
    C.parameterDeclarationType ParameterDeclaration HaskellIdentifier
    cTy
         return (cId, cTy', hId)

    deHaskellifyCType
      :: C.CParser HaskellIdentifier m
      => C.Type HaskellIdentifier -> m (C.Type C.CIdentifier)
    deHaskellifyCType :: forall (m :: * -> *).
    CParser HaskellIdentifier m =>
    Type HaskellIdentifier -> m (Type CIdentifier)
    deHaskellifyCType = (HaskellIdentifier -> m CIdentifier)
    -> Type HaskellIdentifier -> m (Type CIdentifier)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Type a -> f (Type b)
    traverse ((HaskellIdentifier -> m CIdentifier)
     -> Type HaskellIdentifier -> m (Type CIdentifier))
    -> (HaskellIdentifier -> m CIdentifier)
    -> Type HaskellIdentifier
    -> m (Type CIdentifier)
    forall a b. (a -> b) -> a -> b
    $ \HaskellIdentifier
    hId -> do
      useCpp <- m Bool
    forall i (m :: * -> *). CParser i m => m Bool
    C.parseEnableCpp
      case C.cIdentifierFromString useCpp (unHaskellIdentifier hId) of
        Left [Char]
    err -> [Char] -> m CIdentifier
    forall a. [Char] -> m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> m CIdentifier) -> [Char] -> m CIdentifier
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Illegal Haskell identifier " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ HaskellIdentifier -> [Char]
    unHaskellIdentifier HaskellIdentifier
    hId [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           [Char]
    " in C type:\n" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err
        Right CIdentifier
    x -> CIdentifier -> m CIdentifier
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CIdentifier
    x