@@ -22,7 +22,9 @@ main = do
22
22
Left msg -> SI. hPutStrLn SI. stderr msg
23
23
Right registry -> do
24
24
printTokens api registry
25
- printFunctions api registry
25
+ let sigMap = signatureMap registry
26
+ printForeign sigMap
27
+ printFunctions api registry sigMap
26
28
printExtensions api registry
27
29
CM. forM_ [" 1.0" , " 1.1" , " 1.2" , " 1.3" , " 1.4" , " 1.5" , " 2.0" , " 2.1" ] $ \ v ->
28
30
printFeature api (read v) (ProfileName " version" ) registry
@@ -62,24 +64,34 @@ signatureMap registry = fst $ M.foldl' step (M.empty, 0) (commands registry)
62
64
(newMap, maybe notFound (const found) maybeValue)
63
65
where (maybeValue, newMap) = M. insertLookupWithKey (\ _ _ s -> s) key value map
64
66
65
- printFunctions :: API -> Registry -> IO ()
66
- printFunctions api registry = do
67
+ printForeign :: M. Map String String -> IO ()
68
+ printForeign sigMap = do
69
+ let comment = [" All foreign imports." ]
70
+ startModule Nothing [" Foreign" ] (Just " {-# LANGUAGE CPP #-}" ) comment $ \ moduleName h -> do
71
+ SI. hPutStrLn h $ " module " ++ moduleName ++ " where"
72
+ SI. hPutStrLn h " "
73
+ SI. hPutStrLn h " import Foreign.C.Types"
74
+ SI. hPutStrLn h " import Foreign.Ptr"
75
+ SI. hPutStrLn h " import Graphics.Rendering.OpenGL.Raw.Types"
76
+ SI. hPutStrLn h " "
77
+ mapM_ (SI. hPutStrLn h . uncurry makeImportDynamic) (M. assocs sigMap)
78
+
79
+ printFunctions :: API -> Registry -> M. Map String String -> IO ()
80
+ printFunctions api registry sigMap = do
67
81
let comment =
68
82
[" All raw functions from the" ,
69
83
" <http://www.opengl.org/registry/ OpenGL registry>." ]
70
- startModule Nothing [" Functions" ] ( Just " {-# LANGUAGE CPP #-} " ) comment $ \ moduleName h -> do
84
+ startModule Nothing [" Functions" ] Nothing comment $ \ moduleName h -> do
71
85
SI. hPutStrLn h $ " module " ++ moduleName ++ " ("
72
- SI. hPutStrLn h . separate unCommandName . M. keys . commands $ registry
86
+ SI. hPutStrLn h . separate unCommandName . M. keys . commands $ registry
73
87
SI. hPutStrLn h " ) where"
74
88
SI. hPutStrLn h " "
75
- SI. hPutStrLn h " -- Make the foreign imports happy."
76
- SI. hPutStrLn h " import Foreign.C.Types"
77
- SI. hPutStrLn h " "
78
89
SI. hPutStrLn h " import Control.Monad.IO.Class ( MonadIO(..) )"
79
90
SI. hPutStrLn h " import Foreign.Marshal.Error ( throwIf )"
80
91
SI. hPutStrLn h " import Foreign.Ptr ( Ptr, FunPtr, nullFunPtr )"
81
92
SI. hPutStrLn h " import System.IO.Unsafe ( unsafePerformIO )"
82
93
SI. hPutStrLn h " "
94
+ SI. hPutStrLn h " import Graphics.Rendering.OpenGL.Raw.Foreign"
83
95
SI. hPutStrLn h " import Graphics.Rendering.OpenGL.Raw.GetProcAddress ( getProcAddress )"
84
96
SI. hPutStrLn h " import Graphics.Rendering.OpenGL.Raw.Types"
85
97
SI. hPutStrLn h " "
@@ -90,9 +102,6 @@ printFunctions api registry = do
90
102
SI. hPutStrLn h " throwIfNullFunPtr :: String -> IO (FunPtr a) -> IO (FunPtr a)"
91
103
SI. hPutStrLn h " throwIfNullFunPtr = throwIf (== nullFunPtr) . const"
92
104
SI. hPutStrLn h " "
93
- let sigMap = signatureMap registry
94
- mapM_ (SI. hPutStrLn h . uncurry makeImportDynamic) (M. assocs sigMap)
95
- SI. hPutStrLn h " "
96
105
mapM_ (SI. hPutStrLn h . showCommand api sigMap) (M. elems (commands registry))
97
106
98
107
printExtensions :: API -> Registry -> IO ()
0 commit comments