adding Program abstraction to cabal

Cabal.cabal

@@ -24,6 +24,7 @@ Exposed-Modules:
         Distribution.InstalledPackageInfo,
         Distribution.License,
         Distribution.Make,
+        Distribution.Program,
         Distribution.Package,
         Distribution.PackageDescription,
         Distribution.ParseUtils,

Distribution/Program.hs

@@ -0,0 +1,167 @@
+module Distribution.Program( Program(..)
+                           , ProgramLocation(..)
+                           , ProgramConfiguration
+                           , withProgramFlag
+                           , programOptsFlag
+                           , programOptsField
+                           , defaultProgramConfiguration
+                           , lookupProgram) where
+{-
+                           , ghcProgram
+                           , ghcPkgProgram
+                           , nhcProgram
+                           , hugsProgram
+                           , alexProgram
+                           , hsc2hsProgram
+                           , c2hsProgram
+                           , cpphsProgram
+                           , haddockProgram
+                           , greencardProgram
+                           , ldProgram
+                           , cppProgram
+                           , pfesetupProgram
+-}
+
+import Data.List(find)
+import Distribution.Compat.Directory(findExecutable)
+
+-- |Represents a program which cabal may call.
+data Program
+    = Program { -- |The simple name of the program, eg ghc
+               programName :: String
+                -- |The name of this program's binary, eg ghc-6.4
+              ,programBinName :: String
+                -- |Default command-line args for this program
+              ,programDefaultArgs :: [String]
+                -- |Location of the program.  eg. /usr/bin/ghc-6.4
+              ,programLocation :: ProgramLocation
+              } deriving (Read, Show)
+
+-- |Similar to Maybe, but tells us whether it's specifed by user or
+-- not.
+data ProgramLocation = EmptyLocation
+                     | UserSpecified FilePath
+                     | FoundOnSystem FilePath
+      deriving (Read, Show)
+type ProgramConfiguration = [Program]
+
+defaultProgramConfiguration :: ProgramConfiguration
+defaultProgramConfiguration = [ ghcProgram
+                              , ghcPkgProgram
+                              , nhcProgram
+                              , hugsProgram
+                              , alexProgram
+                              , hsc2hsProgram
+                              , c2hsProgram
+                              , cpphsProgram
+                              , haddockProgram
+                              , greencardProgram
+                              , ldProgram
+                              , cppProgram
+                              , pfesetupProgram
+                              ]
+
+-- |The flag for giving a path to this program.  eg --with-alex=/usr/bin/alex
+withProgramFlag :: Program -> String
+withProgramFlag Program{programName=n} = "with-" ++ n
+
+-- |The flag for giving args for this program.
+--  eg --haddock-options=-s http://foo
+programOptsFlag :: Program -> String
+programOptsFlag Program{programName=n} = n ++ "-options"
+
+-- |The foo.cabal field for  giving args for this program.
+--  eg haddock-options: -s http://foo
+programOptsField :: Program -> String
+programOptsField = programOptsFlag
+
+-- ------------------------------------------------------------
+-- * cabal programs
+-- ------------------------------------------------------------
+
+ghcProgram :: Program
+ghcProgram = simpleProgram "ghc"
+
+ghcPkgProgram :: Program
+ghcPkgProgram = simpleProgram "ghc-pkg"
+
+nhcProgram :: Program
+nhcProgram = simpleProgram "nhc"
+
+hugsProgram :: Program
+hugsProgram = simpleProgram "hugs"
+
+alexProgram :: Program
+alexProgram = simpleProgram "alex"
+
+hsc2hsProgram :: Program
+hsc2hsProgram = simpleProgram "hsc2hs"
+
+c2hsProgram :: Program
+c2hsProgram = simpleProgram "c2hs"
+
+cpphsProgram :: Program
+cpphsProgram = simpleProgram "cpphs"
+
+haddockProgram :: Program
+haddockProgram = simpleProgram "haddock"
+
+greencardProgram :: Program
+greencardProgram = simpleProgram "greencard"
+
+ldProgram :: Program
+ldProgram = simpleProgram "ld"
+
+cppProgram :: Program
+cppProgram = simpleProgram "cpp"
+
+pfesetupProgram :: Program
+pfesetupProgram = simpleProgram "pfesetup"
+
+-- ------------------------------------------------------------
+-- * helpers
+-- ------------------------------------------------------------
+
+-- |Looks up a program in the given configuration.  If the user
+-- provides a location, then we use that location in the returned
+-- program.  If no location is given then we check in the
+-- configuration for a location.  If there's none in the
+-- configuration, then we use IO to look on the system.  Do we want a
+-- way to specify NOT to find it on the system (populate
+-- programLocation).
+
+lookupProgram :: String -- simple name of program
+              -> ProgramConfiguration
+              -> ProgramLocation  -- find location on system in PATH, if EmptyLocation
+              -> IO (Maybe Program) -- the full program
+lookupProgram name conf inLoc =
+  case lookupProgram' name conf of
+    Nothing   -> return Nothing
+    Just p@Program{ programLocation= configLoc
+                  , programBinName = binName}
+        -> do newLoc <- case (inLoc, configLoc) of
+                         (EmptyLocation, EmptyLocation)
+                             -> do maybeLoc <- findExecutable binName
+                                   return $ maybe EmptyLocation FoundOnSystem maybeLoc
+                         (EmptyLocation, a) -> return a
+                         (a, _)             -> return a
+              return $ Just p{programLocation=newLoc}
+
+
+-- |Populate the "programLocation" field in this configuration.
+{-lookupAllPrograms :: ProgramConfiguration
+                  -> CommandLine?
+                  -> IO ProgramConfiguration
+lookupAllPrograms conf = mapM 
+-}
+-- ------------------------------------------------------------
+-- * Internal helpers
+-- ------------------------------------------------------------
+
+-- Export?
+lookupProgram' :: String -> ProgramConfiguration -> Maybe Program
+lookupProgram' name = find (\(Program {programName=n}) -> n == name)
+
+simpleProgram :: String -> Program
+simpleProgram s = Program s s [] EmptyLocation
+

Distribution/Setup.hs

@@ -64,6 +64,8 @@ import HUnit (Test(..))
 
 import Distribution.Compiler (CompilerFlavor(..), Compiler(..))
 import Distribution.Simple.Utils (die)
+import Distribution.Program(ProgramLocation(..), ProgramConfiguration,
+                            defaultProgramConfiguration)
 import Data.List(find)
 import Distribution.GetOpt
 import Distribution.Compat.FilePath (platformPath)
@@ -90,14 +92,14 @@ data Action = ConfigCmd ConfigFlags       -- config
 --             | BDist -- 1.0
 --            | CleanCmd                 -- clean
 --            | NoCmd -- error case?
-    deriving (Show, Eq)
 
 -- | Flags to @configure@ command
 data ConfigFlags = ConfigFlags {
+        configPrograms :: ProgramConfiguration, -- ^All programs that cabal may run
         configHcFlavor :: Maybe CompilerFlavor,
         configHcPath   :: Maybe FilePath, -- ^given compiler location
         configHcPkg    :: Maybe FilePath, -- ^given hc-pkg location
-        configHaddock  :: Maybe FilePath, -- ^Haddock path
+        configHaddock  :: ProgramLocation, -- ^Haddock path
         configHappy    :: Maybe FilePath, -- ^Happy path
         configAlex     :: Maybe FilePath, -- ^Alex path
         configHsc2hs   :: Maybe FilePath, -- ^Hsc2hs path
@@ -111,14 +113,14 @@ data ConfigFlags = ConfigFlags {
 	configUser     :: Bool,		  -- ^--user flag?
 	configGHCiLib  :: Bool            -- ^Enable compiling library for GHCi
     }
-    deriving (Show, Eq)
 
 emptyConfigFlags :: ConfigFlags
 emptyConfigFlags = ConfigFlags {
+        configPrograms = defaultProgramConfiguration,
         configHcFlavor = Nothing,
         configHcPath   = Nothing,
         configHcPkg    = Nothing,
-        configHaddock  = Nothing,
+        configHaddock  = EmptyLocation,
         configHappy    = Nothing,
         configAlex     = Nothing,
         configHsc2hs   = Nothing,
@@ -296,9 +298,9 @@ parseConfigureArgs = parseArgs configureCmd updateCfg
   where updateCfg t GhcFlag              = t { configHcFlavor = Just GHC }
         updateCfg t NhcFlag              = t { configHcFlavor = Just NHC }
         updateCfg t HugsFlag             = t { configHcFlavor = Just Hugs }
+        updateCfg t (WithHaddock path)   = t { configHaddock  = UserSpecified path }
         updateCfg t (WithCompiler path)  = t { configHcPath   = Just path }
         updateCfg t (WithHcPkg path)     = t { configHcPkg    = Just path }
-        updateCfg t (WithHaddock path)   = t { configHaddock  = Just path }
         updateCfg t (WithHappy path)     = t { configHappy    = Just path }
         updateCfg t (WithAlex path)      = t { configAlex     = Just path }
         updateCfg t (WithHsc2hs path)    = t { configHsc2hs   = Just path }

Distribution/Simple.hs

@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Simple
--- Copyright   :  Isaac Jones 2003-2004
+-- Copyright   :  Isaac Jones 2003-2005
 -- 
 -- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
 -- Stability   :  alpha
@@ -67,6 +67,7 @@ module Distribution.Simple (
 import Distribution.Compiler
 import Distribution.Package --must not specify imports, since we're exporting moule.
 import Distribution.PackageDescription
+import Distribution.Program(lookupProgram, Program(..))
 import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCpp',
                                 ppUnlit, removePreprocessedPackage,
                                 preprocessSources, PPSuffixHandler)
@@ -401,7 +402,7 @@ distPref = "dist"
 haddock :: PackageDescription -> LocalBuildInfo -> Int -> [PPSuffixHandler] -> IO ()
 haddock pkg_descr lbi verbose pps =
     withLib pkg_descr () $ \lib -> do
-        mHaddock <- findProgram "haddock" (withHaddock lbi)
+        let mHaddock = withHaddock lbi
         when (isNothing mHaddock) (die "haddock command not found")
         let bi = libBuildInfo lib
         let targetDir = joinPaths distPref (joinPaths "doc" "html")
@@ -418,7 +419,7 @@ haddock pkg_descr lbi verbose pps =
         setupMessage "Running Haddock for" pkg_descr
         let outFiles = map (joinFileName tmpDir)
                        (map ((flip changeFileExt) "hs") inFiles)
-        code <- rawSystemVerbose verbose (fromJust mHaddock)
+        code <- rawSystemVerbose verbose (programBinName $ fromJust mHaddock)
                 (["-h",
                   "-o", targetDir,
                   "-t", showPkg,

Distribution/Simple/Configure.hs

@@ -85,6 +85,7 @@ import Data.Maybe(fromMaybe)
 import System.Directory
 import Distribution.Compat.FilePath (splitFileName, joinFileName,
                                   joinFileExt, exeExtension)
+import Distribution.Program(Program(..), ProgramLocation(..), lookupProgram)
 import System.Cmd		( system )
 import System.Exit		( ExitCode(..) )
 import Control.Monad		( when, unless )
@@ -141,7 +142,7 @@ configure pkg_descr cfg
         unless (null exts) $ warn $ -- Just warn, FIXME: Should this be an error?
             show f' ++ " does not support the following extensions:\n " ++
             concat (intersperse ", " (map show exts))
-        haddock   <- findProgram "haddock"   (configHaddock cfg)
+        haddock   <- lookupProgram "haddock" (configPrograms cfg) (configHaddock cfg)
         happy     <- findProgram "happy"     (configHappy cfg)
         alex      <- findProgram "alex"      (configAlex cfg)
         hsc2hs    <- findProgram "hsc2hs"    (configHsc2hs cfg)
@@ -154,7 +155,7 @@ configure pkg_descr cfg
         message $ "Compiler flavor: " ++ (show f')
         message $ "Compiler version: " ++ showVersion ver
         message $ "Using package tool: " ++ pkg
-        reportProgram "haddock"   haddock
+        reportProgram' "haddock"  haddock
         reportProgram "happy"     happy
         reportProgram "alex"      alex
         reportProgram "hsc2hs"    hsc2hs
@@ -203,6 +204,18 @@ reportProgram :: String -> Maybe FilePath -> IO ()
 reportProgram name Nothing = message ("No " ++ name ++ " found")
 reportProgram name (Just p) = message ("Using " ++ name ++ ": " ++ p)
 
+reportProgram' :: String -> Maybe Program -> IO ()
+reportProgram' _ (Just Program{ programName=name
+                              , programLocation=EmptyLocation})
+                  = message ("No " ++ name ++ " found")
+reportProgram' _ (Just Program{ programName=name
+                              , programLocation=FoundOnSystem p})
+                  = message ("Using " ++ name ++ " found on system at: " ++ p)
+reportProgram' _ (Just Program{ programName=name
+                              , programLocation=UserSpecified p})
+                  = message ("Using " ++ name ++ " given by user at: " ++ p)
+reportProgram' name Nothing = message ("No " ++ name ++ " found")
+
 
 -- | Test for a package dependency and record the version we have installed.
 configDependency :: [PackageIdentifier] -> Dependency -> IO PackageIdentifier

Distribution/Simple/LocalBuildInfo.hs

@@ -43,6 +43,7 @@ module Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
     where
 
 import Distribution.Package (PackageIdentifier)
+import Distribution.Program (ProgramLocation, Program)
 import Distribution.Compiler (Compiler)
 
 -- |Data cached after configuration step.
@@ -61,7 +62,7 @@ data LocalBuildInfo = LocalBuildInfo {
 		-- that must be satisfied in terms of version ranges.  This
 		-- field fixes those dependencies to the specific versions
 		-- available on this machine for this compiler.
-        withHaddock   :: Maybe FilePath, -- ^Might be the location of the Haddock executable.
+        withHaddock   :: Maybe Program, -- ^Might be the location of the Haddock executable.
         withHappy     :: Maybe FilePath, -- ^Might be the location of the Happy executable.
         withAlex      :: Maybe FilePath, -- ^Might be the location of the Alex executable.
         withHsc2hs    :: Maybe FilePath, -- ^Might be the location of the Hsc2hs executable.
@@ -71,6 +72,5 @@ data LocalBuildInfo = LocalBuildInfo {
         withProfLib   :: Bool,
         withProfExe   :: Bool,
 	withGHCiLib   :: Bool
-  }
-  deriving (Show, Read, Eq)
+  } deriving (Read, Show)