CEnumToHsc2HsEnum.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Main where

import           Control.Monad
import           Data.ByteString       (ByteString)
import qualified Data.ByteString       as B
import           Data.Char
import           Data.List

import           Language.C
import           Language.C.Data.Ident

main :: IO ()
main = do
  str <- readInputStream "foo.c"
  dumpEnum (parseC str nopos)

dumpEnum :: Either ParseError CTranslUnit -> IO ()
dumpEnum (Left e) = print e
dumpEnum ll@(Right (CTranslUnit decls _)) =
  forM_ decls $ \(CDeclExt (CDecl specs _ _)) ->
    forM_ specs $ \(CTypeSpec (CEnumType (CEnum (Just name) (Just idents) _ _) _ )) -> do
      putStrLn $ "newtype " <> getName name <> " = " <> getName name <> " Int deriving (Show, Eq, Num)"
      fields <- forM idents $ \(Ident n _ _, _) -> do
        pure (n, underscoreToCamel n)
      print $ EnumInfo (getName name) fields

data EnumInfo
  = EnumInfo
  { enumName :: String
  , enumTypes :: [(String, String)]
  }

instance Show EnumInfo where
  show = showEnum

showEnum :: EnumInfo -> String
showEnum (EnumInfo name fields) = do
  intercalate "\n" [ "#{enum " <> name <> ", " <> name
                   , intercalate "\n" (go <$> fields)
                   , "}"
                   ]
    where
      go :: (String, String) -> String
      go (x,y) = intercalate " " [ ","
                                 , y
                                 , "="
                                 , x
                                 ]

underscoreToCamel [] = []
underscoreToCamel ('_':(x:xs)) = toUpper x : underscoreToCamel xs
underscoreToCamel (x:xs) = toLower x : underscoreToCamel xs

getName :: Ident -> String
getName (Ident name _ _) = name