From cbadeada6d0f449df9ab708251ece9eddfc5ab70 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sun, 10 Mar 2019 22:54:29 -0400
Subject: Extract documented enum types.

---
 monkeypatch.hs | 48 ++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 38 insertions(+), 10 deletions(-)

diff --git a/monkeypatch.hs b/monkeypatch.hs
index cfa9011..fc26093 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -501,6 +501,12 @@ enumCases (CDeclExt (CDecl xs _ ni)) = do
     CTypeSpec (CEnumType (CEnum _ (Just cs) _ _) _) <- xs
     return (ni,cs)
 
+lineOfComment (l,_,s) = l + length (lines s)
+
+seekComment :: NodeInfo -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)])
+seekComment ni cs = break (\c -> lineOfComment c>=posRow (posOfNode ni)) cs
+
+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 
 -- c2haskell :: Foldable t => C2HaskellOptions -> p -> t String -> CTranslationUnit NodeInfo -> IO ()
 c2haskell :: C2HaskellOptions
@@ -520,7 +526,9 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do
               stubsname = "MonkeyPatch/" ++ modname ++ "_patch.c"
           putStrLn $ "writing " ++ fname
           withFile fname  WriteMode $ \haskmod -> do
+          hPutStrLn haskmod "{-# LANGUAGE PatternSynonyms #-}"
           hPutStrLn haskmod $ "module MonkeyPatch." ++ modname ++" where"
+          hPutStrLn haskmod $ "import Foreign.C.Types"
           hPutStrLn haskmod $ "import Foreign.Ptr"
           hPutStrLn haskmod $ "import Data.Word"
           hPutStrLn haskmod $ "import Data.Int"
@@ -537,16 +545,36 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do
           hPutStrLn haskmod ""
           forM_ (uniq $ ts ++ sigs2) $ \(t,ct) -> do
             case ct >>= (`Map.lookup` syms db) of
-                Just si -> do
-                    let symfile :: Maybe FilePath
-                        symfile = (listToMaybe (symbolSource si) >>= fileOfNode)
-                    hPutStrLn haskmod $ "-- " ++ show symfile
-                    mapM_ (hPutStrLn haskmod . commented . show . pretty) $ symbolSource si
-                    cs <- maybe (return []) readComments symfile
-                    mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs
-                    mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si
-                Nothing -> return ()
-            hPutStrLn haskmod $ "data " ++ t
+                Just si -> case take 1 (symbolSource si) >>= enumCases of
+                    [] -> hPutStrLn haskmod $ "data " ++ t
+                    (eni,es):_ -> do
+                        let symfile :: Maybe FilePath
+                            symfile = (listToMaybe (symbolSource si) >>= fileOfNode)
+                        -- hPutStrLn haskmod $ "-- " ++ show symfile
+                        -- mapM_ (hPutStrLn haskmod . commented . show . pretty) $ symbolSource si
+                        cs <- maybe (return []) readComments symfile
+                        -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs
+                        -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si
+                        let (_,cs') = seekComment eni cs
+                        forM_ (take 1 cs') $ \(_,c,s) ->
+                            when (c==1) $ hPutStr haskmod $ commented $ "| " ++ strip s
+                        hPutStrLn haskmod $ unwords ["newtype",t,"=",t,"CInt"]
+                        forM_ (zip es [0..]) $ \((e,_),n) -> do
+                            let r = posRow . posOfNode . nodeInfo $ e
+                            case seekComment (nodeInfo e) cs' of
+                                (_,(lno,cno,s):_) | lno==r-1 && cno==1
+                                                    || cno>1 && lno == r
+                                  -> hPutStr haskmod $ commented $ "| " ++ strip s
+                                (_,_:(lno,cno,s):_) | lno==r-1 && cno==1
+                                                    || cno>1 && lno == r
+                                  -> hPutStr haskmod $ commented $ "| " ++ strip s
+                                (cs,_) | (lno,cno,s):_ <- reverse $ cs
+                                       , lno==r-1 && cno==1
+                                           || cno>1 && lno == r
+                                  -> hPutStr haskmod $ commented $ "| " ++ strip s
+                                x -> hPutStr haskmod $ commented $ "x="++show x
+                            hPutStrLn haskmod $ unwords ["pattern",identToString e,"=",t,show n]
+                Nothing -> hPutStrLn haskmod $ "data " ++ t
           hPutStrLn haskmod ""
           forM_ sigs $ \(_,(k,hs,d)) -> do
             forM_ hs $ \hdecl -> do
-- 
cgit v1.2.3