Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: camhac
Fetching contributors…

Cannot retrieve contributors at this time

88 lines (71 sloc) 2.534 kB
module Main where
import System.Console.GetOpt
import System.Exit
import System.IO (hPutStr, hPutStrLn, stderr)
import qualified Data.Map as M
--import Graphics.UI.Gtk
import System.Glib.Initialize
import System.Glib.GError
import GI.API (loadAPI)
import GI.Code (Config(..), codeToString, runCodeGen')
import GI.CodeGen (genModule)
data Mode = GenerateCode | Dump | Help
deriving Show
data Options = Options {
optMode :: Mode,
optRenames :: [(String, String)],
optPrefixes :: [(String, String)] }
deriving Show
defaultOptions = Options {
optMode = GenerateCode,
optRenames = [],
optPrefixes = [] }
parseKeyValue s =
let (a, ('=':b)) = break (=='=') s
in (a, b)
optDescrs :: [OptDescr (Options -> Options)]
optDescrs = [
Option "h" ["help"] (NoArg $ \opt -> opt { optMode = Help })
"print this gentle help text",
Option "d" ["dump"] (NoArg $ \opt -> opt { optMode = Dump })
"dump internal representation instead of generating code",
Option "p" ["prefix"] (ReqArg
(\arg opt ->
let (a, b) = parseKeyValue arg
in opt { optPrefixes = (a, b) : optPrefixes opt }) "A=B")
"specify the prefix for a particular namespace",
Option "r" ["rename"] (ReqArg
(\arg opt ->
let (a, b) = parseKeyValue arg
in opt { optRenames = (a, b) : optRenames opt }) "A=B")
"specify a Haskell name for a C name"]
showHelp = concat $ map optAsLine optDescrs
where optAsLine (Option flag (long:_) _ desc) =
" -" ++ flag ++ "|--" ++ long ++ "\t" ++ desc ++ "\n"
optAsLine _ = error "showHelp"
printGError = handleGError (\(GError _dom _code msg) -> putStrLn msg)
processAPI options name = do
apis <- loadAPI name
let cfg = Config {
prefixes = M.fromList (optPrefixes options),
names = M.fromList (optRenames options) }
case optMode options of
GenerateCode ->
putStrLn $ codeToString $ runCodeGen' cfg $ genModule name apis
Dump -> mapM_ print apis
Help -> putStr showHelp
main = printGError $ do
args <- initArgs
let (actions, nonOptions, errors) = getOpt RequireOrder optDescrs args
options = foldl (.) id actions defaultOptions
case errors of
[] -> return ()
_ -> do
mapM_ (hPutStr stderr) errors
exitFailure
case nonOptions of
[name] -> processAPI options name
_ -> do
hPutStrLn stderr "usage: haskell-gi [options] package"
hPutStr stderr showHelp
exitFailure
Jump to Line
Something went wrong with that request. Please try again.