content: module LLVM.C.API
    ( Context
    , Module
    , TargetData
    , Type
    , mkContext
    , mkModule
    , mkTargetData
    , setTargetData
    , getTargetData
    , sizeOfType
  
    , getTypeByName
    , mkVoidType
    , mkIntType
    , mkPointerType
    , mkArrayType
    , mkFunctionType
    , mkAnonStructType
    , mkOpaqueStructType
    , setNamedStructBody
    ) where
  
  import Data.Word
  import Foreign.C
  import Foreign.Ptr
  import Foreign.ForeignPtr
  import Foreign.Marshal.Array
  import Control.Exception
  import Data.Text (Text)
  import qualified Data.Text as T
  import LLVM.C.Bindings
  import LLVM.Codegen.Name
  import LLVM.Codegen.Flag
  import qualified LLVM.Codegen.Type as LLVMType
  
  
  mkVoidType :: ForeignPtr Context -> IO (Ptr Type)
  mkVoidType ctx = withForeignPtr ctx llvmVoidTypeInContext
  
  mkIntType :: ForeignPtr Context -> Word32 -> IO (Ptr Type)
  mkIntType ctx bits = withForeignPtr ctx $ \c ->
    case bits of
      1 -> llvmI1TypeInContext c
      8 -> llvmI8TypeInContext c
      16 -> llvmI16TypeInContext c
      32 -> llvmI32TypeInContext c
      64 -> llvmI64TypeInContext c
      _ -> llvmIntTypeInContext c (CUInt bits)
  
  mkPointerType :: Ptr Type -> IO (Ptr Type)
  mkPointerType pointeeTy =
    llvmPointerTypeInContext pointeeTy 0
  
  mkAnonStructType :: ForeignPtr Context -> [Ptr Type] -> Flag LLVMType.Packed -> IO (Ptr Type)
  mkAnonStructType ctx tys packed =
    withForeignPtr ctx $ \c ->
      withArray tys $ \tyArray -> do
        let count = CUInt $ fromIntegral $ length tys
            packed' = CBool (if packed == On then 1 else 0)
        llvmStructTypeInContext c tyArray count packed'
  
  -- NOTE: can be used to forward declare a struct type
  mkOpaqueStructType :: ForeignPtr Context -> Name -> IO (Ptr Type)
  mkOpaqueStructType ctx name =
    withForeignPtr ctx $ \c ->
      withNameAsCString name $ \nm ->
        llvmNamedStructTypeInContext c nm
  
  withNameAsCString :: Name -> (CString -> IO a) -> IO a
  withNameAsCString name  =
    withCString (T.unpack $ unName name)
  
  -- NOTE: call this on a Type returned by 'mkOpaqueStructType' to define the struct body of that type.
  setNamedStructBody :: Ptr Type -> [Ptr Type] -> Flag LLVMType.Packed -> IO ()
  setNamedStructBody structTy tys packed =
    withArray tys $ \tyArray -> do
      let count = CUInt $ fromIntegral $ length tys
          packed' = CBool (if packed == On then 1 else 0)
      llvmNamedStructSetBody structTy tyArray count packed'
  
  mkArrayType :: Ptr Type -> Word32 -> IO (Ptr Type)
  mkArrayType elemTy count =
    llvmArrayTypeInContext elemTy (CUInt count)
  
  mkFunctionType :: Ptr Type -> [Ptr Type] -> IO (Ptr Type)
  mkFunctionType retTy argTys =
    withArray argTys $ \argTyArray -> do
      let argCount = CUInt $ fromIntegral $ length argTys
          isVarArg = CBool 0
      llvmFunctionTypeInContext retTy argTyArray argCount isVarArg
  
  getTypeByName :: ForeignPtr Context -> Name -> IO (Ptr Type)
  getTypeByName ctx name =
    withForeignPtr ctx $ \c ->
      withCString (T.unpack $ unName name) $ \str ->
        llvmGetTypeByNameInContext c str
  
  mkContext :: IO (ForeignPtr Context)
  mkContext = mask_ $ do
    ctx <- llvmContextCreate
    newForeignPtr llvmContextDispose ctx
  
  mkModule :: ForeignPtr Context -> Text -> IO (ForeignPtr Module)
  mkModule ctx name =
    withCString (T.unpack name) $ \name' -> do
      withForeignPtr ctx $ \c -> mask_ $ do
        llvmModule <- llvmCreateModuleWithName name' c
        -- TODO next line causes segfault? is this because some other field needs to get set first? or auto-cleaned up in context?
        -- newForeignPtr llvmDisposeModule llvmModule
        -- TODO: no longer need foreignptr wrapper then?
        newForeignPtr_  llvmModule
  
  -- NOTE: no checks are made against the datalayout
  mkTargetData :: String -> IO (ForeignPtr TargetData)
  mkTargetData dl = mask_ $ do
    withCString dl $ \dlStr -> do
      td <- llvmCreateTargetData dlStr
      newForeignPtr llvmDisposeTargetData td
  
  setTargetData :: ForeignPtr Module -> ForeignPtr TargetData -> IO ()
  setTargetData llvmModule targetData = do
    withForeignPtr llvmModule $ \m ->
      withForeignPtr targetData $ \td ->
        llvmSetTargetData m td
  
  getTargetData :: ForeignPtr Module -> IO (Ptr TargetData)
  getTargetData llvmModule =
    withForeignPtr llvmModule llvmGetTargetData
  
  sizeOfType :: Ptr TargetData -> Ptr Type -> IO Word64
  sizeOfType td ty = do
    CSize byteSize <- llvmSizeOfType td ty
    pure byteSize
  