Flesh out capnpc command-line interface.

c++/Makefile.am

@@ -89,7 +89,7 @@ capnpc_outputs =                                               \
 # around in the generated Makefile a bit but couldn't figure it out.  I give
 # up.  Automake is terrible.
 test_capnpc_middleman:
-	$(CAPNPC) $(capnpc_inputs)
+	$(CAPNPC) -oc++ $(capnpc_inputs)
 	touch test_capnpc_middleman
 
 $(capnpc_outputs): test_capnpc_middleman

c++/src/capnproto/capnpc.ekam-rule

@@ -49,4 +49,4 @@ fi
 
 # When exception stack traces are needed, add: +RTS -xc -RTS
 LD_PRELOAD=$INTERCEPTOR DYLD_FORCE_FLAT_NAMESPACE= DYLD_INSERT_LIBRARIES=$INTERCEPTOR \
-$CAPNPC "$INPUT" 3>&1 4<&0 >&2
+$CAPNPC -oc++ "$INPUT" 3>&1 4<&0 >&2

compiler/capnproto-compiler.cabal

@@ -19,8 +19,8 @@ executable capnpc
                    hastache,
                    array,
                    data-binary-ieee754,
-                   filepath
-  -- When profiling is needed, add: -prof -fprof-auto -osuf p_o -hisuf p_hi
+                   filepath,
+                   directory
   ghc-options:     -Wall -fno-warn-missing-signatures
   other-modules:
                    Lexer,

compiler/src/CxxGenerator.hs

@@ -23,7 +23,7 @@
 
 {-# LANGUAGE TemplateHaskell #-}
 
-module CxxGenerator(generateCxxHeader, generateCxxSource) where
+module CxxGenerator(generateCxx) where
 
 import qualified Data.ByteString.UTF8 as ByteStringUTF8
 import Data.FileEmbed(embedFile)
@@ -244,3 +244,8 @@ hastacheConfig = MuConfig
 
 generateCxxHeader file = hastacheStr hastacheConfig (encodeStr headerTemplate) (fileContext file)
 generateCxxSource file = hastacheStr hastacheConfig (encodeStr srcTemplate) (fileContext file)
+
+generateCxx file = do
+    header <- generateCxxHeader file
+    source <- generateCxxSource file
+    return [(fileName file ++ ".h", header), (fileName file ++ ".c++", source)]

compiler/src/Main.hs

@@ -25,66 +25,112 @@ module Main ( main ) where
 
 import System.Environment
 import System.Console.GetOpt
+import System.Exit(exitFailure, exitSuccess)
+import System.IO(hPutStr, stderr)
+import System.FilePath(takeDirectory)
+import System.Directory(createDirectoryIfMissing, doesDirectoryExist)
+import Control.Monad
 import Compiler
 import Util(delimit)
 import Text.Parsec.Pos
 import Text.Parsec.Error
 import Text.Printf(printf)
 import qualified Data.List as List
+import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy.Char8 as LZ
-import Data.List
-import Data.Maybe
 import Semantics
 
-import CxxGenerator
+import CxxGenerator(generateCxx)
 
-main::IO()
+type GeneratorFn = FileDesc -> IO [(FilePath, LZ.ByteString)]
+
+generatorFns = Map.fromList [ ("c++", generateCxx) ]
+
+data Opt = OutputOpt String (Maybe GeneratorFn) FilePath
+         | VerboseOpt
+         | HelpOpt
+
+main :: IO ()
 main = do
-    let options = [Option ['o'] ["output"] (ReqArg id "FILE") "Where to send the files"]
+    let optionDescs =
+         [ Option "o" ["output"] (ReqArg parseOutputArg "LANG[:DIR]")
+             ("Generate output for language LANG\n\
+              \to directory DIR (default: current\n\
+              \directory).  LANG may be any of:\n\
+              \  " ++ unwords (Map.keys generatorFns))
+         , Option "v" ["verbose"] (NoArg VerboseOpt) "Write information about parsed files."
+         , Option "h" ["help"] (NoArg HelpOpt) "Print usage info and exit."
+         ]
+    let usage = usageInfo
+         "capnpc [OPTION]... [FILE]...\n\
+         \Generate source code based on Cap'n Proto definition FILEs.\n"
+         optionDescs
     args <- getArgs
-    let tup = getOpt RequireOrder options args
-    let (optionResults, files, _) = tup
-    let langDirs = catMaybes (map splitAtEquals optionResults)
-    handleFilesLangs (generatorFnsFor langDirs) files
+    let (options, files, optErrs) = getOpt Permute optionDescs args
+    let langErrs = map (printf "Unknown output language: %s\n")
+                       [lang | OutputOpt lang Nothing _ <- options]
+    let errs = optErrs ++ langErrs
+    unless (null errs) (do
+        mapM_ (hPutStr stderr) errs
+        hPutStr stderr usage
+        exitFailure)
+
+    when (null options) (do
+        hPutStr stderr "Nothing to do.\n"
+        hPutStr stderr usage
+        exitFailure)
 
-splitAtEquals :: String -> Maybe (String, String)
-splitAtEquals str = do
-    holder <- (elemIndex '=' str)
-    Just((splitAt holder str))
+    let isHelp = not $ null [opt | opt@HelpOpt <- options]
 
-handleFilesLangs eithers files = mapM_ (\x -> handleFiles x files) eithers
+    when isHelp (do
+        putStr usage
+        exitSuccess)
 
-handleFiles (Right fn) files = mapM_ (handleFile fn) files
-handleFiles (Left str) _ = putStrLn str
+    let isVerbose = not $ null [opt | opt@VerboseOpt <- options]
+    let outputs = [(fn, dir) | OutputOpt _ (Just fn) dir <- options]
 
-handleFile generateCode filename = do
+    let verifyDirectoryExists dir = do
+        exists <- doesDirectoryExist dir
+        unless exists (do
+            hPutStr stderr $ printf "no such directory: %s\n" dir
+            exitFailure)
+    mapM_ verifyDirectoryExists [dir | (_, dir) <- outputs]
+
+    mapM_ (handleFile outputs isVerbose) files
+
+parseOutputArg :: String -> Opt
+parseOutputArg str = case List.elemIndex ':' str of
+    Just i -> let (lang, _:dir) = splitAt i str in OutputOpt lang (Map.lookup lang generatorFns) dir
+    Nothing -> OutputOpt str (Map.lookup str generatorFns) "."
+
+handleFile :: [(GeneratorFn, FilePath)] -> Bool -> FilePath -> IO ()
+handleFile outputs isVerbose filename = do
     text <- readFile filename
     case parseAndCompileFile filename text of
         Active desc [] -> do
-            print desc
-            generateCode desc filename
-
-        Active _ e -> mapM_ printError (List.sortBy compareErrors e)
-        Failed e -> mapM_ printError (List.sortBy compareErrors e)
+            when isVerbose (print desc)
 
-generatorFnsFor :: [(String, String)] -> [Either String (FileDesc -> FilePath -> (IO ()))]
-generatorFnsFor langDirs = do
-    map (\langDir -> generatorFnFor (fst langDir) (tail (snd langDir)))langDirs
+            let write dir (name, content) = do
+                let outFilename = dir ++ "/" ++ name
+                createDirectoryIfMissing True $ takeDirectory outFilename
+                LZ.writeFile outFilename content
+            let generate (generatorFn, dir) = do
+                files <- generatorFn desc
+                mapM_ (write dir) files
+            mapM_ generate outputs
 
-generatorFnFor :: String -> String -> Either String (FileDesc -> FilePath -> (IO ()))
-generatorFnFor lang dir = case lang of
-    "c++" -> Right (\desc filename -> do
-       header <- generateCxxHeader desc
-       LZ.writeFile (dir ++ "/" ++ filename ++ ".h") header
-       source <- generateCxxSource desc
-       LZ.writeFile (dir ++ "/" ++ filename ++ ".c++") source)
-    _     -> Left "Only c++ is supported for now"
+        Active _ e -> do
+            mapM_ printError (List.sortBy compareErrors e)
+            exitFailure
+        Failed e -> do
+            mapM_ printError (List.sortBy compareErrors e)
+            exitFailure
 
 compareErrors a b = compare (errorPos a) (errorPos b)
 
 -- TODO:  This is a fairly hacky way to make showErrorMessages' output not suck.  We could do better
 --   by interpreting the error structure ourselves.
-printError e = printf "%s:%d:%d: %s\n" f l c m' where
+printError e = hPutStr stderr $ printf "%s:%d:%d: %s\n" f l c m' where
     pos = errorPos e
     f = sourceName pos
     l = sourceLine pos

compiler/src/Semantics.hs

@@ -389,7 +389,9 @@ data CompiledStatement = CompiledMember Desc
 
 -- TODO:  Print options as well as members.  Will be ugly-ish.
 descToCode :: String -> Desc -> String
-descToCode indent (DescFile desc) = concatMap (statementToCode indent) (fileStatements desc)
+descToCode indent (DescFile desc) = printf "# %s\n%s"
+    (fileName desc)
+    (concatMap (statementToCode indent) (fileStatements desc))
 descToCode indent (DescAlias desc) = printf "%susing %s = %s;\n" indent
     (aliasName desc)
     (descQualifiedName (aliasParent desc) (aliasTarget desc))