Write output files.

1 files changed, 31 insertions, 15 deletions

diff --git a/c2haskell.hs b/c2haskell.hs
index df97487..0e857a9 100644
--- a/c2haskell.hs
+++ b/c2haskell.hs
@@ -28,6 +28,7 @@ import Language.Haskell.Exts.Syntax as HS
 import Language.Haskell.TH
 import Language.Haskell.TH.Ppr
 import Language.Haskell.TH.Syntax   as TH
+import System.Directory
 import System.Environment
 import System.IO
 import System.Process
@@ -390,10 +391,16 @@ c2haskell opts cs missings (CTranslUnit edecls _) = do
         es = Map.filter (\d -> symbolLocal d && not (symbolStatic d)) (syms db)
     case selectFunction opts of
         Nothing -> do
-          putStrLn $ "module T where"
-          putStrLn $ "import Foreign.Ptr"
-          putStrLn $ "import Data.Word"
-          putStrLn $ "import Data.Int"
+          createDirectoryIfMissing False "MonkeyPatch"
+          let fname = ("MonkeyPatch/" ++ modname ++ ".hs")
+              modname = "T" -- todo
+              stubsname = "MonkeyPatch/t_stubs.c" -- todo
+          putStrLn $ "writing " ++ fname
+          withFile fname  WriteMode $ \haskmod -> do
+          hPutStrLn haskmod $ "module MonkeyPatch." ++ modname ++" where"
+          hPutStrLn haskmod $ "import Foreign.Ptr"
+          hPutStrLn haskmod $ "import Data.Word"
+          hPutStrLn haskmod $ "import Data.Int"
           putStrLn $ "-- " ++ show (fmap (fmap (fmap (const ()))) <$> Map.lookup "ip_is_lan" (syms db))
           let sigs = concatMap getsig (Map.toList es)
               sigs2 = concatMap (\s -> do
@@ -407,7 +414,7 @@ c2haskell opts cs missings (CTranslUnit edecls _) = do
           putStrLn $ "-- ip_is_lan `elem` db = " ++ show (length . symbolSource <$> Map.lookup "ip_is_lan" (syms db))
           putStrLn $ "-- ip_is_lan `elem` sigs2 = " ++ show (elem "ip_is_lan" sigs2)
           forM_ (uniq $ ts ++ sigs2) $ \t -> do
-            putStrLn $ "data " ++ t
+            hPutStrLn haskmod $ "data " ++ t
           forM_ sigs $ \(_,(k,hs)) -> do
             forM_ hs $ \hdecl -> do
                 {-
@@ -423,11 +430,11 @@ c2haskell opts cs missings (CTranslUnit edecls _) = do
                         htyp -> -- putStr $ commented $ "Unsupported haskell type: " ++ HS.prettyPrint htyp
                             -}
                 let htyp = makeFunctionUseIO $ extractType hdecl
-                putStrLn $ (if isAcceptableImport htyp then id else commented)
+                hPutStrLn haskmod $ (if isAcceptableImport htyp then id else commented)
                          $ HS.prettyPrint $ (HS.ForImp () (HS.CCall ()) Nothing (Just k)
                                                      (HS.Ident () k)
                                                      htyp)
-          forM_ missings $ \sym -> goMissing db sym
+          forM_ missings $ \sym -> goMissing haskmod db sym
           {-
           forM_ (Map.lookup sym $ syms db) $ \si -> do
             forM_ (take 1 $ symbolSource si) $ \d -> do
@@ -452,6 +459,15 @@ c2haskell opts cs missings (CTranslUnit edecls _) = do
                 mapM_ (putStr . commented . show . pretty) (mutations (body d))
                 -}
             -}
+          putStrLn $ "writing " ++ stubsname
+          withFile stubsname WriteMode $ \stubsfile -> do
+          forM_ missings $ \sym ->
+              forM_ (Map.lookup sym$ syms db) $ \si -> do
+                forM_ (take 1 $ symbolSource si) $ \d -> do
+                    hPutStrLn stubsfile $ show $ pretty $ makeFunctionPointer d
+                    hPutStrLn stubsfile $ show $ pretty $ makeSetter d
+                    hPutStrLn stubsfile $ show $ pretty $ makeStub d
+
         Just cfun -> do
           forM_ (Map.lookup cfun $ syms db) $ \si -> do
             forM_ (take 1 $ symbolSource si) $ \d -> do
@@ -638,8 +654,8 @@ setterBody name =
 
 
 goMissing :: Show b =>
-                   Transpile [CExternalDeclaration b] -> String -> IO ()
-goMissing db cfun = do
+                   Handle -> Transpile [CExternalDeclaration b] -> String -> IO ()
+goMissing haskmod db cfun = do
       forM_ (Map.lookup cfun $ syms db) $ \si -> do
         forM_ (take 1 $ symbolSource si) $ \d -> do
                 -- putStr $ commented (ppShow (fmap (const ()) d))
@@ -648,16 +664,16 @@ goMissing db cfun = do
                 let ts = filter notKnown $ map tname $ pointers $ concatMap types $ sigf hsTransSig d
                 -- forM_ ts $ \t -> putStrLn $ "data " ++ t
                 forM_ (sigf hsTransSig d) $ \hs -> do
-                putStrLn . HS.prettyPrint $ makeAcceptableDecl hs
+                hPutStrLn haskmod . HS.prettyPrint $ makeAcceptableDecl hs
                 case hs of
                     HS.TypeDecl _ (DHead _ (HS.Ident _ signame)) ftyp  -> do
                         let wrapname = "wrap" ++ drop 3 signame
                             settername = "setf" ++ drop 3 signame
                             funptr = (TyApp () (TyCon () (UnQual () (HS.Ident () "FunPtr")))
                                                (TyCon () (UnQual () (HS.Ident () signame))))
-                        -- putStrLn $ ppShow $ HS.parseDecl "foreign import ccall \"wrapper\" fname :: Spec -> IO (FunPtr Spec)"
-                        -- mapM_ (putStrLn . HS.prettyPrint) (importWrapper $ sigf hsTransSig d)
-                        putStrLn $ HS.prettyPrint $
+                        -- hPutStrLn haskmod $ ppShow $ HS.parseDecl "foreign import ccall \"wrapper\" fname :: Spec -> IO (FunPtr Spec)"
+                        -- mapM_ (hPutStrLn haskmod . HS.prettyPrint) (importWrapper $ sigf hsTransSig d)
+                        hPutStrLn haskmod $ HS.prettyPrint $
                                       (HS.ForImp () (HS.CCall ()) Nothing (Just "wrapper")
                                          (HS.Ident () wrapname)
                                          (TyFun ()
@@ -665,7 +681,7 @@ goMissing db cfun = do
                                             (TyApp ()
                                                (TyCon () (UnQual () (HS.Ident () "IO")))
                                                (TyParen () funptr))))
-                        putStrLn $ HS.prettyPrint $
+                        hPutStrLn haskmod $ HS.prettyPrint $
                                       (HS.ForImp () (HS.CCall ()) Nothing (Just settername)
                                          (HS.Ident () settername)
                                          (TyFun ()
@@ -675,7 +691,7 @@ goMissing db cfun = do
                                                (TyCon () (Special () (UnitCon ()))))))
 
 
-                    htyp -> putStr $ commented $ "Unsupported haskell type: " ++ HS.prettyPrint htyp
+                    htyp -> hPutStr haskmod $ commented $ "Unsupported haskell type: " ++ HS.prettyPrint htyp
 
 
 readComments :: (Num lin, Num col) =>