diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-10 22:54:29 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-10 22:54:29 -0400 |
commit | cbadeada6d0f449df9ab708251ece9eddfc5ab70 (patch) | |
tree | 038213af2a062ad5d317c87b2799907d8aa71493 /monkeypatch.hs | |
parent | 4571dcae244b81a4b6aa0acacd773f728be49772 (diff) |
Extract documented enum types.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 48 |
1 files 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 | |||
501 | CTypeSpec (CEnumType (CEnum _ (Just cs) _ _) _) <- xs | 501 | CTypeSpec (CEnumType (CEnum _ (Just cs) _ _) _) <- xs |
502 | return (ni,cs) | 502 | return (ni,cs) |
503 | 503 | ||
504 | lineOfComment (l,_,s) = l + length (lines s) | ||
505 | |||
506 | seekComment :: NodeInfo -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)]) | ||
507 | seekComment ni cs = break (\c -> lineOfComment c>=posRow (posOfNode ni)) cs | ||
508 | |||
509 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace | ||
504 | 510 | ||
505 | -- c2haskell :: Foldable t => C2HaskellOptions -> p -> t String -> CTranslationUnit NodeInfo -> IO () | 511 | -- c2haskell :: Foldable t => C2HaskellOptions -> p -> t String -> CTranslationUnit NodeInfo -> IO () |
506 | c2haskell :: C2HaskellOptions | 512 | c2haskell :: C2HaskellOptions |
@@ -520,7 +526,9 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do | |||
520 | stubsname = "MonkeyPatch/" ++ modname ++ "_patch.c" | 526 | stubsname = "MonkeyPatch/" ++ modname ++ "_patch.c" |
521 | putStrLn $ "writing " ++ fname | 527 | putStrLn $ "writing " ++ fname |
522 | withFile fname WriteMode $ \haskmod -> do | 528 | withFile fname WriteMode $ \haskmod -> do |
529 | hPutStrLn haskmod "{-# LANGUAGE PatternSynonyms #-}" | ||
523 | hPutStrLn haskmod $ "module MonkeyPatch." ++ modname ++" where" | 530 | hPutStrLn haskmod $ "module MonkeyPatch." ++ modname ++" where" |
531 | hPutStrLn haskmod $ "import Foreign.C.Types" | ||
524 | hPutStrLn haskmod $ "import Foreign.Ptr" | 532 | hPutStrLn haskmod $ "import Foreign.Ptr" |
525 | hPutStrLn haskmod $ "import Data.Word" | 533 | hPutStrLn haskmod $ "import Data.Word" |
526 | hPutStrLn haskmod $ "import Data.Int" | 534 | hPutStrLn haskmod $ "import Data.Int" |
@@ -537,16 +545,36 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do | |||
537 | hPutStrLn haskmod "" | 545 | hPutStrLn haskmod "" |
538 | forM_ (uniq $ ts ++ sigs2) $ \(t,ct) -> do | 546 | forM_ (uniq $ ts ++ sigs2) $ \(t,ct) -> do |
539 | case ct >>= (`Map.lookup` syms db) of | 547 | case ct >>= (`Map.lookup` syms db) of |
540 | Just si -> do | 548 | Just si -> case take 1 (symbolSource si) >>= enumCases of |
541 | let symfile :: Maybe FilePath | 549 | [] -> hPutStrLn haskmod $ "data " ++ t |
542 | symfile = (listToMaybe (symbolSource si) >>= fileOfNode) | 550 | (eni,es):_ -> do |
543 | hPutStrLn haskmod $ "-- " ++ show symfile | 551 | let symfile :: Maybe FilePath |
544 | mapM_ (hPutStrLn haskmod . commented . show . pretty) $ symbolSource si | 552 | symfile = (listToMaybe (symbolSource si) >>= fileOfNode) |
545 | cs <- maybe (return []) readComments symfile | 553 | -- hPutStrLn haskmod $ "-- " ++ show symfile |
546 | mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs | 554 | -- mapM_ (hPutStrLn haskmod . commented . show . pretty) $ symbolSource si |
547 | mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si | 555 | cs <- maybe (return []) readComments symfile |
548 | Nothing -> return () | 556 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs |
549 | hPutStrLn haskmod $ "data " ++ t | 557 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si |
558 | let (_,cs') = seekComment eni cs | ||
559 | forM_ (take 1 cs') $ \(_,c,s) -> | ||
560 | when (c==1) $ hPutStr haskmod $ commented $ "| " ++ strip s | ||
561 | hPutStrLn haskmod $ unwords ["newtype",t,"=",t,"CInt"] | ||
562 | forM_ (zip es [0..]) $ \((e,_),n) -> do | ||
563 | let r = posRow . posOfNode . nodeInfo $ e | ||
564 | case seekComment (nodeInfo e) cs' of | ||
565 | (_,(lno,cno,s):_) | lno==r-1 && cno==1 | ||
566 | || cno>1 && lno == r | ||
567 | -> hPutStr haskmod $ commented $ "| " ++ strip s | ||
568 | (_,_:(lno,cno,s):_) | lno==r-1 && cno==1 | ||
569 | || cno>1 && lno == r | ||
570 | -> hPutStr haskmod $ commented $ "| " ++ strip s | ||
571 | (cs,_) | (lno,cno,s):_ <- reverse $ cs | ||
572 | , lno==r-1 && cno==1 | ||
573 | || cno>1 && lno == r | ||
574 | -> hPutStr haskmod $ commented $ "| " ++ strip s | ||
575 | x -> hPutStr haskmod $ commented $ "x="++show x | ||
576 | hPutStrLn haskmod $ unwords ["pattern",identToString e,"=",t,show n] | ||
577 | Nothing -> hPutStrLn haskmod $ "data " ++ t | ||
550 | hPutStrLn haskmod "" | 578 | hPutStrLn haskmod "" |
551 | forM_ sigs $ \(_,(k,hs,d)) -> do | 579 | forM_ sigs $ \(_,(k,hs,d)) -> do |
552 | forM_ hs $ \hdecl -> do | 580 | forM_ hs $ \hdecl -> do |