From 3fd1f5652a3af22e90a040a821d244a91a3553a0 Mon Sep 17 00:00:00 2001
From: bjorn <bjorn@bringert.net>
Date: Wed, 28 May 2008 15:10:36 +0000
Subject: Switch to new options handling.

This changes lots of stuff, let me know if it broke anything.

Comments:

- We use a local hacked version of GetOpt that allows long forms of commands to start with a single dash. This breaks other parts of GetOpt. For example, arguments to short options now require a =, and does not allo pace after the option character.

- The new command parsing is currently only used for the program command line, pragmas and the arguments for the 'i' shell command.

- I made a quick hack for the options for showTerm, which currently makes it impossible to use the print style flags for cc. This will be replaced by a facility for parsing command-specific options.

- The verbosity handling is broken in some places. I will fix that in a later patch.
---
 src-3.0/GFC.hs | 80 +++++++++++++++++++++++-----------------------------------
 1 file changed, 32 insertions(+), 48 deletions(-)

(limited to 'src-3.0/GFC.hs')

diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs
index 12c6e8681..09d01f615 100644
--- a/src-3.0/GFC.hs
+++ b/src-3.0/GFC.hs
@@ -12,56 +12,40 @@ import GF.Infra.Option
 import GF.GFCC.API
 import GF.Data.ErrM
 
+import Data.Maybe
 import System.FilePath
 
-mainGFC :: [String] -> IO ()
-mainGFC xx = do
-  let (opts,fs) = getOptions "-" xx
-  case opts of
-    _ | oElem (iOpt "help") opts -> putStrLn usageMsg
-    _ | oElem (iOpt "-make") opts -> do
-      gfcc <- appIOE (compileToGFCC opts fs) >>= err fail return
-      let gfccFile = targetNameGFCC opts (absname gfcc)
-      outputFile gfccFile (printGFCC gfcc)
-      mapM_ (alsoPrint opts gfcc) printOptions
 
-    -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
-    _ | all ((==".gfcc") . takeExtensions) fs -> do
-      gfccs <- mapM file2gfcc fs
-      let gfcc = foldl1 unionGFCC gfccs
-      let gfccFile = targetNameGFCC opts (absname gfcc)
-      outputFile gfccFile (printGFCC gfcc)
-      mapM_ (alsoPrint opts gfcc) printOptions
-      
-    _ -> do
-      appIOE (mapM_ (batchCompile opts) (map return fs)) >>= err fail return
-      putStrLn "Done."
-
-targetName :: Options -> CId -> String
-targetName opts abs = case getOptVal opts (aOpt "target") of
-  Just n -> n
-  _ -> prCId abs
-
-targetNameGFCC :: Options -> CId -> FilePath
-targetNameGFCC opts abs = targetName opts abs ++ ".gfcc"
-
----- TODO: nicer and richer print options
-
-alsoPrint opts gr (opt,name) = do
-  if oElem (iOpt opt) opts 
-    then outputFile name (prGFCC opt gr)
-    else return ()
-
-outputFile :: FilePath -> String -> IO ()
-outputFile outfile output = 
+mainGFC :: Options -> [FilePath] -> IOE ()
+mainGFC opts fs = 
+    do gr <- batchCompile opts fs
+       let cnc = justModuleName (last fs)
+       if flag optStopAfterPhase opts == Compile 
+         then return ()
+         else do gfcc <- link opts cnc gr
+                 writeOutputs opts gfcc
+
+writeOutputs :: Options -> GFCC -> IOE ()
+writeOutputs opts gfcc = mapM_ (\fmt -> writeOutput opts fmt gfcc) (flag optOutputFormats opts)
+
+writeOutput :: Options -> OutputFormat-> GFCC -> IOE ()
+writeOutput opts fmt gfcc =
+    do let path = outputFilePath opts fmt (prCId (absname gfcc))
+           s = prGFCC fmt gfcc
+       writeOutputFile path s
+
+outputFilePath :: Options -> OutputFormat -> String -> FilePath
+outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt
+  where name = fromMaybe name0 (moduleFlag optName opts)
+        addDir = maybe id (</>) (flag optOutputDir opts)
+
+fmtExtension :: OutputFormat -> String
+fmtExtension FmtGFCC        = "gfcc"
+fmtExtension FmtJavaScript  = "js"
+fmtExtension FmtHaskell     = "hs"
+fmtExtension FmtHaskellGADT = "hs"
+
+writeOutputFile :: FilePath -> String -> IOE ()
+writeOutputFile outfile output = ioeIO $
       do writeFile outfile output
          putStrLn $ "wrote file " ++ outfile
-
-printOptions = [
-  ("haskell","GSyntax.hs"),
-  ("haskell_gadt","GSyntax.hs"),
-  ("js","grammar.js")
-  ]
-
-usageMsg = 
-  "usage: gfc (-h | --make (-noopt) (-noparse) (-target=PREFIX) (-js | -haskell | -haskell_gadt)) (-src) FILES"
-- 
cgit v1.2.3