module Foreign.HacanonLight.Generate
    ( bindWithOptions
    , bind
    , safeBind
    , simpleBind
    , simpleSafeBind
    ) where

import Foreign.HacanonLight.Common
import Foreign.HacanonLight.DIS
import Foreign.HacanonLight.FFIToHs

import Language.Haskell.TH


importD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
importD conv safety s1 s2 t
    = do unQt <- t
         return (ForeignD (ImportF conv safety s1 s2 unQt))

generateFFI :: FFIDecl -> DecQ
generateFFI (FFIDecl unique name typesQ callconv safety _)
    = importD callconv safety name unique t
    where t = createArrowType $ (args ++ [conT (mkName "IO") `appT` retType])
          types = map (disFFIType) typesQ
          args = init types
          retType = last types

generateHs :: HsDecl -> [DecQ]
generateHs (HsDecl name ffi typeQ body pure)
    = [sigD name typeQ
      ,valD (varP name) (normalB body) []]

generate :: String -> FFIDecl -> [DecQ]
generate hsName ffi = generateHs hs ++ [generateFFI ffi]
    where hs = processFFIDecl hsName ffi


bindWithOptions :: String -> String -> [DIS] -> Bool -> Safety -> Callconv -> Q [Dec]
bindWithOptions hsName cName types pure safety callconv
    = sequence (generate hsName ffi)
    where ffiName = mkName (hsName ++ cName)
          ffi = FFIDecl ffiName cName types callconv safety pure

bind :: String -> String -> [DIS] -> Q [Dec]
bind hsName cName types = bindWithOptions hsName cName types False Unsafe CCall

safeBind :: String -> String -> [DIS] -> Q [Dec]
safeBind hsName cName types = bindWithOptions hsName cName types False Safe CCall

simpleBind :: String -> [DIS] -> Q [Dec]
simpleBind name = bind name name

simpleSafeBind :: String -> [DIS] -> Q [Dec]
simpleSafeBind name = safeBind name name