added programatica support (may remove)

On a whim (and since I randomly ran into Thomas Hallgren on the train
today) I added support for Programatica, via pfesetup.  It doesn't
probably do quite what one would want it to do since it preprocesses
everything and slaps it into dist/tmp, but it may be interesting
nonetheless, and we can clean it up later if anyone thinks we should
keep it around.

It was very easy to add and looks a lot like the haddock command.  Try
it with ./setup pfe.  It doesn't do anything too interesting to the
cabal sources yet since it can't find a bunch of modules.  It would be
great if someone added all the fptools modules to it :)

Distribution/PreProcess.hs

@@ -40,7 +40,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
 module Distribution.PreProcess (preprocessSources, knownSuffixHandlers,
                                 ppSuffixes, PPSuffixHandler, PreProcessor,
                                 removePreprocessed, removePreprocessedPackage,
-                                ppCpp, ppCppHaddock, ppGreenCard, ppC2hs, ppHsc2hs,
+                                ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
 				ppHappy, ppAlex, ppUnlit
                                )
     where
@@ -189,17 +189,16 @@ ppUnlit inFile outFile verbose = do
     return ExitSuccess
 
 ppCpp :: PackageDescription -> BuildInfo -> LocalBuildInfo -> PreProcessor
-ppCpp = ppCppHaddock False
+ppCpp = ppCpp' []
 
-ppCppHaddock :: Bool -> PackageDescription -> BuildInfo -> LocalBuildInfo -> PreProcessor
-ppCppHaddock forHaddock pkg_descr bi lbi
+ppCpp' :: [String] -> PackageDescription -> BuildInfo -> LocalBuildInfo -> PreProcessor
+ppCpp' inputArgs pkg_descr bi lbi
     = maybe (ppNone "cpphs") pp (withCpphs lbi)
   where pp cpphs inFile outFile verbose
 	  = rawSystemVerbose verbose cpphs (extraArgs ++ ["-O" ++ outFile, inFile])
-        extraArgs = "--noline" : compOrHaddock ++ sysDefines ++
-                incOptions ++ ccOptions bi
+        extraArgs = "--noline" :  sysDefines ++
+                incOptions ++ ccOptions bi ++ inputArgs
 	hc = compiler lbi
-        compOrHaddock = if forHaddock then ["-D__HADDOCK__"] else hcDefines hc
         sysDefines =
                 ["-D" ++ os ++ "_" ++ loc ++ "_OS" | loc <- locations] ++
                 ["-D" ++ arch ++ "_" ++ loc ++ "_ARCH" | loc <- locations]

Distribution/Setup.hs

@@ -49,7 +49,7 @@ module Distribution.Setup (--parseArgs,
 #endif
                            parseGlobalArgs, commandList,
                            parseConfigureArgs, parseBuildArgs, parseCleanArgs,
-                           parseHaddockArgs,
+                           parseHaddockArgs, parseProgramaticaArgs,
                            parseInstallArgs, parseSDistArgs, parseRegisterArgs,
                            parseUnregisterArgs, parseCopyArgs
                            ) where
@@ -87,6 +87,7 @@ data Action = ConfigCmd ConfigFlags       -- config
             | CleanCmd                    -- clean
             | CopyCmd (Maybe FilePath)    -- copy
             | HaddockCmd                  -- haddock
+            | ProgramaticaCmd             -- pfesetup
             | InstallCmd Bool -- install (install-prefix) (--user flag)
             | SDistCmd                    -- sdist
             | RegisterCmd Bool            -- register (--user flag)
@@ -173,7 +174,8 @@ data Cmd a = Cmd {
 
 commandList :: [Cmd a]
 commandList = [configureCmd, buildCmd, cleanCmd, installCmd,
-               copyCmd, sdistCmd, haddockCmd, registerCmd, unregisterCmd]
+               copyCmd, sdistCmd, haddockCmd, programaticaCmd,
+               registerCmd, unregisterCmd]
 
 lookupCommand :: String -> [Cmd a] -> Maybe (Cmd a)
 lookupCommand name = find ((==name) . cmdName)
@@ -302,6 +304,18 @@ haddockCmd = Cmd {
         cmdAction      = HaddockCmd
         }
 
+programaticaCmd :: Cmd a
+programaticaCmd = Cmd {
+        cmdName        = "pfe",
+        cmdHelp        = "Generate Programatica Project.",
+        cmdDescription = "",
+        cmdOptions     = [cmd_help, cmd_verbose],
+        cmdAction      = ProgramaticaCmd
+        }
+
+parseProgramaticaArgs :: [String] -> [OptDescr a] -> IO (Int, [a], [String])
+parseProgramaticaArgs  = parseNoArgs programaticaCmd
+
 parseHaddockArgs :: [String] -> [OptDescr a] -> IO (Int, [a], [String])
 parseHaddockArgs  = parseNoArgs haddockCmd
 

Distribution/Simple.hs

@@ -61,7 +61,7 @@ module Distribution.Simple (
 -- local
 import Distribution.Package --must not specify imports, since we're exporting moule.
 import Distribution.PackageDescription
-import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCppHaddock,
+import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCpp',
                                 ppUnlit, removePreprocessedPackage, preprocessSources)
 import Distribution.Setup
 
@@ -211,7 +211,7 @@ defaultMainWorker pkg_descr_in action args hooks
                       preprocessSources pkg_descr lbi verbose knownSuffixHandlers
                       inFiles <- sequence [moduleToFilePath [hsSourceDir bi] m ["hs", "lhs"]
                                              | m <- exposedModules lib] >>= return . concat
-                      mapM_ (mockPP pkg_descr bi lbi tmpDir verbose) inFiles
+                      mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles
                       let showPkg = showPackageId (package pkg_descr)
                       let prologName = showPkg ++ "-haddock-prolog.txt"
                       writeFile prologName ((description pkg_descr) ++ "\n")
@@ -230,6 +230,34 @@ defaultMainWorker pkg_descr_in action args hooks
                       removeFile prologName
                       when (code /= ExitSuccess) (exitWith code)
                       return code)
+            ProgramaticaCmd -> do
+                 (verbose, _, args) <- parseProgramaticaArgs args []
+                 pkg_descr <- hookOrInArgs preBuild args verbose
+                 withLib pkg_descr ExitSuccess (\lib ->
+                    do lbi <- getPersistBuildConfig
+                       mPfe <- findProgram "pfesetup" Nothing
+                       when (isNothing mPfe) (error "pfe command not found")
+                       putStrLn $ "using : " ++ fromJust mPfe
+                       let bi = libBuildInfo lib
+                       let mods = exposedModules lib ++ hiddenModules (libBuildInfo lib)
+                       preprocessSources pkg_descr lbi verbose knownSuffixHandlers
+                       inFiles <- sequence [moduleToFilePath [hsSourceDir bi] m ["hs", "lhs"]
+                                              | m <- mods] >>= return . concat
+                       let tmpDir = joinPaths (buildDir lbi) "tmp"
+                       mapM_ (mockPP ["-D__HUGS__"] pkg_descr bi lbi tmpDir verbose) inFiles
+                       setupMessage "Running pfesetup for " pkg_descr
+                       let outFiles = map (joinFileName tmpDir)
+                                      (map ((flip changeFileExt) "hs") inFiles)
+                       code <- rawSystemVerbose verbose (fromJust mPfe)
+--                               (["-h",
+--                                 "-o", targetDir,
+--                                 "-t", showPkg,
+--                                 "-p", prologName]
+                                ((if verbose > 4 then ["-v"] else [])
+                               ++ outFiles)
+                       when (code /= ExitSuccess) (exitWith code)
+                       return code)
+
             CleanCmd -> do
                 (verbose,_, args) <- parseCleanArgs args []
                 pkg_descr <- hookOrInArgs preClean args verbose
@@ -298,14 +326,14 @@ defaultMainWorker pkg_descr_in action args hooks
                  = case hooks of
                     Nothing -> return ExitSuccess
                     Just h  -> f h a localbuildinfo
-        mockPP pkg_descr bi lbi pref verbose file
+        mockPP inputArgs pkg_descr bi lbi pref verbose file
             = do let (filePref, fileName) = splitFileName file
                  let targetDir = joinPaths pref filePref
                  let targetFile = joinFileName targetDir fileName
                  let (targetFileNoext, targetFileExt) = splitFileExt targetFile
                  createDirectoryIfMissing True targetDir
                  if (needsCpp pkg_descr)
-                    then ppCppHaddock True pkg_descr bi lbi file targetFile verbose
+                    then ppCpp' inputArgs pkg_descr bi lbi file targetFile verbose
                     else copyFile file targetFile >> return ExitSuccess
                  when (targetFileExt == "lhs")
                        (ppUnlit targetFile (joinFileExt targetFileNoext "hs") verbose >> return ())

TODO

 * misc
 
+> > Is it sufficient to put License: BSD3 in the package description?
+> > Or should License-File be mandatory, and License just an optional
+> > hint?
+
+* Write semantic checker for package description file.  start w/
+   sanity checker.  give error if buildInfo field given when no
+   exposed or hidden modules for a library.
+
 ** add hooks to haddock cmd
 
 ** make debian watchfile