Can generate working netcdf.dll w/ stdcall & cdecl

mkstdcall.hs

@@ -11,16 +11,19 @@ import Language.C.System.GCC
 import Data.Maybe (catMaybes, listToMaybe, mapMaybe)
 import Data.List (isPrefixOf)
 import System.Console.CmdArgs hiding (name)
+import System.IO (IOMode(..), withFile, hGetContents)
 
 ------------------------------------------------------------------------
 
 data MkStdcall = MkStdcall
     { path :: FilePath
+    , exclude :: FilePath
     } deriving (Data, Typeable, Show)
 
 defaultArgs :: MkStdcall
 defaultArgs = MkStdcall
-    { path = "netcdf.h" &= args &= typ "PATH"
+    { path    = "netcdf.h"      &= typ "PATH" &= args
+    , exclude = "netcdf.ignore" &= typ "PATH" &= help "File containing functions to exclude"
     } &=
     help "Create stdcall wrappers for a C header file" &=
     summary "mkstdcall v0.1" &=
@@ -31,17 +34,24 @@ defaultArgs = MkStdcall
 main :: IO ()
 main = do
     args <- cmdArgs defaultArgs
+    exclusions <- lines <$> readFile (exclude args)
     (CTranslUnit extDecls _) <- parseFile (path args)
+    putStrLn "#include \"netcdf.h\""
     mapM_ print'
         $ map ncsPrefix
         $ map wrapWithStdcall
         $ filter (not . isVariadic)
-        $ filter (maybe False ("nc_" `isPrefixOf`) . name)
+        $ filter (maybe False (shouldWrap exclusions) . name)
         $ filter isExtern extDecls
 
   where
-    -- prefixes the function with ncs_ instead of nc_
-    ncsPrefix = rename $ ("ncs" ++) . drop 2
+    -- Prefixes the function with ncs_ instead of nc_.
+    -- The extra underscore at the start is to achieve the
+    -- name mangling windows expects for a stdcall function
+    ncsPrefix = rename $ ("_ncs" ++) . drop 2
+
+    shouldWrap :: [String] -> String -> Bool
+    shouldWrap exs fn = "nc_" `isPrefixOf` fn && not (fn `elem` exs)
 
 
 ------------------------------------------------------------------------
@@ -57,7 +67,7 @@ wrapWithStdcallD (CDecl ss ds n) = do
     origFun <- fmap var (name declr)
     let origArgs = map var (funArgs declr)
     return $ CFunDef
-        (stdcall ss) declr []
+        (stdcall $ dllexport ss) declr []
         (block $ call origFun origArgs) n
   where
     -- gets the first declarator
@@ -113,10 +123,16 @@ ident nam = Ident nam 0 undefNode
 -- | Changes any declaration or definition which is marked
 -- as 'extern' to use the 'stdcall' calling convention.
 stdcall :: Data a => a -> a
-stdcall = everywhere (mkT add)
+stdcall = addAttr "stdcall"
+
+dllexport :: Data a => a -> a
+dllexport = addAttr "dllexport"
+
+addAttr :: Data a => String -> a -> a
+addAttr x = everywhere (mkT add)
   where
     add :: [CDeclSpec] -> [CDeclSpec]
-    add xs | isExtern xs = attr "stdcall" : xs
+    add xs | isExtern xs = attr x : xs
            | otherwise   = xs
 
 -- | Creates a attribute type qualification with the

netcdf.ignore

@@ -0,0 +1,70 @@
+nc_inq_ncid
+nc_inq_grps
+nc_inq_grpname
+nc_inq_grpname_full
+nc_inq_grpname_len
+nc_inq_grp_parent
+nc_inq_grp_ncid
+nc_inq_grp_full_ncid
+nc_inq_varids
+nc_inq_dimids
+nc_inq_typeids
+nc_inq_type_equal
+nc_def_grp
+nc_def_compound
+nc_insert_compound
+nc_insert_array_compound
+nc_inq_typeid
+nc_inq_compound
+nc_inq_compound_name
+nc_inq_compound_size
+nc_inq_compound_nfields
+nc_inq_compound_field
+nc_inq_compound_fieldname
+nc_inq_compound_fieldindex
+nc_inq_compound_fieldoffset
+nc_inq_compound_fieldtype
+nc_inq_compound_fieldndims
+nc_inq_compound_fielddim_sizes
+nc_def_vlen
+nc_inq_vlen
+nc_free_vlen
+nc_free_vlens
+nc_put_vlen_element
+nc_get_vlen_element
+nc_free_string
+nc_inq_user_type
+nc_def_enum
+nc_insert_enum
+nc_inq_enum
+nc_inq_enum_member
+nc_inq_enum_ident
+nc_def_opaque
+nc_inq_opaque
+nc_def_var_deflate
+nc_inq_var_deflate
+nc_inq_var_szip
+nc_def_var_fletcher32
+nc_inq_var_fletcher32
+nc_def_var_chunking
+nc_inq_var_chunking
+nc_def_var_fill
+nc_inq_var_fill
+nc_def_var_endian
+nc_inq_var_endian
+nc_set_chunk_cache
+nc_get_chunk_cache
+nc_set_var_chunk_cache
+nc_get_var_chunk_cache
+nc_inq_unlimdims
+nc_put_var1_string
+nc_get_var1_string
+nc_put_vara_string
+nc_get_vara_string
+nc_put_vars_string
+nc_get_vars_string
+nc_put_varm_string
+nc_get_varm_string
+nc_put_var_string
+nc_get_var_string
+nc_show_metadata