    {-# OPTIONS -cpp #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Program
    -- Copyright   :  Isaac Jones 2006
    --
    -- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
    -- Stability   :  alpha
    -- Portability :  GHC, Hugs
    --
    -- Explanation: A program is basically a name, a location, and some
    -- arguments.
    --
    -- One nice thing about using it is that any program that is
    -- registered with Cabal will get some \"configure\" and \".cabal\"
    -- helpers like --with-foo-args --foo-path= and extra-foo-args.
    --
    -- There's also good default behavior for trying to find \"foo\" in
    -- PATH, being able to override its location, etc.
    --
    -- There's also a hook for adding programs in a Setup.lhs script.  See
    -- hookedPrograms in 'Distribution.Simple.UserHooks'.  This gives a
    -- hook user the ability to get the above flags and such so that they
    -- don't have to write all the PATH logic inside Setup.lhs.

    module Distribution.Simple.Program (
        -- * Program and functions for constructing them
          Program(..)
        , simpleProgram
        , findProgramOnPath
        , findProgramVersion

        -- * Configured program and related functions
        , ConfiguredProgram(..)
        , programPath
        , ProgArg
        , ProgramLocation(..)
        , rawSystemProgram
        , rawSystemProgramStdout

        -- * The collection of unconfigured and configured progams
        , builtinPrograms

        -- * The collection of configured programs we can run
        , ProgramConfiguration
        , emptyProgramConfiguration
        , defaultProgramConfiguration
        , addKnownProgram
        , lookupKnownProgram
        , knownPrograms
        , userSpecifyPath
        , userMaybeSpecifyPath
        , userSpecifyArgs
        , lookupProgram
        , updateProgram
        , configureAllKnownPrograms
        , requireProgram
        , rawSystemProgramConf
        , rawSystemProgramStdoutConf

        -- * Programs that Cabal knows about
        , ghcProgram
        , ghcPkgProgram
        , nhcProgram
        , hmakeProgram
        , jhcProgram
        , hugsProgram
        , ffihugsProgram
        , ranlibProgram
        , arProgram
        , happyProgram
        , alexProgram
        , hsc2hsProgram
        , c2hsProgram
        , cpphsProgram
        , hscolourProgram
        , haddockProgram
        , greencardProgram
        , ldProgram
        , tarProgram
        , cppProgram
        , pfesetupProgram
        , pkgConfigProgram
        ) where

    import qualified Distribution.Compat.Map as Map
    import Distribution.Compat.Directory (findExecutable)
    import Distribution.Compat.TempFile (withTempFile)
    import Distribution.Simple.Utils (die, debug, warn, rawSystemExit,
                                      rawSystemStdout, rawSystemStdout')
    import Distribution.Version (Version(..), readVersion, showVersion,
                                 VersionRange(..), withinRange, showVersionRange)
    import Distribution.Verbosity
    import System.Directory (doesFileExist, removeFile)
    import System.FilePath  (dropExtension)
    import System.IO.Error (try)
    import Control.Monad (join, foldM)
    import Control.Exception as Exception (catch)

    -- | Represents a program which can be configured.
    data Program = Program {
            -- | The simple name of the program, eg. ghc
            programName :: String,

            -- | A function to search for the program if it's location was not
            -- specified by the user. Usually this will just be a
            programFindLocation :: Verbosity -> IO (Maybe FilePath),

            -- | Try to find the version of the program. For many programs this is
            -- not possible or is not necessary so it's ok to return Nothing.
            programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
        }

    type ProgArg = String

    data ConfiguredProgram = ConfiguredProgram {
            -- | Just the name again
            programId :: String,

            -- | The version of this program, if it is known.
            programVersion :: Maybe Version,

            -- | Default command-line args for this program.
            -- These flags will appear first on the command line, so they can be
            -- overridden by subsequent flags.
            programArgs :: [ProgArg],

            -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@
            programLocation :: ProgramLocation
        } deriving (Read, Show)

    -- | Where a program was found. Also tells us whether it's specifed by user or
    -- not.  This includes not just the path, but the program as well.
    data ProgramLocation
        = UserSpecified { locationPath :: FilePath }
          -- ^The user gave the path to this program,
          -- eg. --ghc-path=\/usr\/bin\/ghc-6.6
        | FoundOnSystem { locationPath :: FilePath }
          -- ^The location of the program, as located by searching PATH.
          deriving (Read, Show)

    -- ------------------------------------------------------------
    -- * Programs functions
    -- ------------------------------------------------------------

    -- | The full path of a configured program.
    programPath :: ConfiguredProgram -> FilePath
    programPath = locationPath . programLocation

    -- | Make a simple named program.
    --
    -- By default we'll just search for it in the path and not try to find the
    -- version name. You can override these behaviours if necessary, eg:
    --
    -- > simpleProgram "foo" { programFindLocation = ... , programFindVersion ... }
    --
    simpleProgram :: String -> Program
    simpleProgram name =
      Program name (findProgramOnPath name) (\_ _ -> return Nothing)

    -- | Look for a program on the path.
    findProgramOnPath :: FilePath -> Verbosity -> IO (Maybe FilePath)
    findProgramOnPath prog verbosity = do
      debug verbosity $ "searching for " ++ prog ++ " in path."
      res <- findExecutable prog
      case res of
          Nothing   -> debug verbosity ("Cannot find " ++ prog ++ " on the path")
          Just path -> debug verbosity ("found " ++ prog ++ " at "++ path)
      return res

    -- | Look for a program and try to find it's version number. It can accept
    -- either an absolute path or the name of a program binary, in which case we
    -- will look for the program on the path.
    --
    findProgramVersion :: ProgArg            -- ^ version args
                       -> (String -> String) -- ^ function to select version
                                             --   number from program output
                       -> Verbosity
                       -> FilePath           -- ^ location
                       -> IO (Maybe Version)
    findProgramVersion versionArg selectVersion verbosity path = do
      str <- rawSystemStdout verbosity path [versionArg]
             `Exception.catch` \_ -> return ""
      let version = readVersion (selectVersion str)
      case version of
          Nothing -> warn verbosity $ "cannot determine version of " ++ path
                                   ++ " :\n" ++ show str
          Just v  -> debug verbosity $ path ++ " is version " ++ showVersion v
      return version

    -- ------------------------------------------------------------
    -- * Programs database
    -- ------------------------------------------------------------

    -- | The configuration is a collection of information about programs. It
    -- contains information both about configured programs and also about programs
    -- that we are yet to configure.
    --
    -- The idea is that we start from a collection of unconfigured programs and one
    -- by one we try to configure them at which point we move them into the
    -- configured collection. For unconfigured programs we record not just the
    -- 'Program' but also any user-provided arguments and location for the program.
    data ProgramConfiguration = ProgramConfiguration {
            unconfiguredProgs :: UnconfiguredProgs,
            configuredProgs   :: ConfiguredProgs
        }
    type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg])
    type UnconfiguredProgs = Map.Map String UnconfiguredProgram
    type ConfiguredProgs =   Map.Map String ConfiguredProgram

    emptyProgramConfiguration :: ProgramConfiguration
    emptyProgramConfiguration = ProgramConfiguration Map.empty Map.empty

    defaultProgramConfiguration :: ProgramConfiguration
    defaultProgramConfiguration =
      foldl (flip addKnownProgram) emptyProgramConfiguration builtinPrograms

    -- internal helpers:
    updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs)
                            -> ProgramConfiguration -> ProgramConfiguration
    updateUnconfiguredProgs update conf =
      conf { unconfiguredProgs = update (unconfiguredProgs conf) }
    updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs)
                          -> ProgramConfiguration -> ProgramConfiguration
    updateConfiguredProgs update conf =
      conf { configuredProgs = update (configuredProgs conf) }

    -- Read & Show instances are based on listToFM
    -- Note that we only serialise the configured part of the database, this is
    -- because we don't need the unconfigured part after the configure stage, and
    -- additionally because we cannot read/show 'Program' as it contains functions.
    instance Show ProgramConfiguration where
      show = show . Map.toAscList . configuredProgs

    instance Read ProgramConfiguration where
      readsPrec p s =
        [ (emptyProgramConfiguration { configuredProgs = Map.fromList s' }, r)
        | (s', r) <- readsPrec p s ]

    -- -------------------------------
    -- Managing unconfigured programs

    -- | Add a known program that we may configure later
    addKnownProgram :: Program -> ProgramConfiguration -> ProgramConfiguration
    addKnownProgram prog = updateUnconfiguredProgs $
      Map.insert (programName prog) (prog, Nothing, [])

    lookupKnownProgram :: String -> ProgramConfiguration -> Maybe Program
    lookupKnownProgram name =
      fmap (\(p,_,_)->p) . Map.lookup name . unconfiguredProgs

    knownPrograms :: ProgramConfiguration -> [(Program, Maybe ConfiguredProgram)]
    knownPrograms conf =
      [ (p,p') | (p,_,_) <- Map.elems (unconfiguredProgs conf)
               , let p' = Map.lookup (programName p) (configuredProgs conf) ]

    -- |User-specify this path.  Basically override any path information
    -- for this program in the configuration. If it's not a known
    -- program ignore it.
    userSpecifyPath :: String   -- ^Program name
                    -> FilePath -- ^user-specified path to the program
                    -> ProgramConfiguration -> ProgramConfiguration
    userSpecifyPath name path = updateUnconfiguredProgs $
      flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args)

    userMaybeSpecifyPath :: String -> Maybe FilePath
                         -> ProgramConfiguration -> ProgramConfiguration
    userMaybeSpecifyPath _    Nothing conf     = conf
    userMaybeSpecifyPath name (Just path) conf = userSpecifyPath name path conf

    -- |User-specify the arguments for this program.  Basically override
    -- any args information for this program in the configuration. If it's
    -- not a known program, ignore it..
    userSpecifyArgs :: String    -- ^Program name
                    -> [ProgArg] -- ^user-specified args
                    -> ProgramConfiguration
                    -> ProgramConfiguration
    userSpecifyArgs name args' =
        updateUnconfiguredProgs
          (flip Map.update name $
             \(prog, path, args) -> Just (prog, path, args ++ args'))
      . updateConfiguredProgs
          (flip Map.update name $
             \prog -> Just prog { programArgs = programArgs prog ++ args' })

    userSpecifiedPath :: Program -> ProgramConfiguration -> Maybe FilePath
    userSpecifiedPath prog =
      join . fmap (\(_,p,_)->p) . Map.lookup (programName prog) . unconfiguredProgs

    userSpecifiedArgs :: Program -> ProgramConfiguration -> [ProgArg]
    userSpecifiedArgs prog =
      maybe [] (\(_,_,as)->as) . Map.lookup (programName prog) . unconfiguredProgs

    -- -----------------------------
    -- Managing configured programs

    -- | Try to find a configured program
    lookupProgram :: Program -> ProgramConfiguration -> Maybe ConfiguredProgram
    lookupProgram prog = Map.lookup (programName prog) . configuredProgs

    -- | Update a configured program in the database.
    updateProgram :: ConfiguredProgram -> ProgramConfiguration
                                       -> ProgramConfiguration
    updateProgram prog = updateConfiguredProgs $
      Map.insert (programId prog) prog

    -- ---------------------------
    -- Configuring known programs

    -- | Try to configure a specific program. If the program is already included in
    -- the colleciton of unconfigured programs then we use any user-supplied
    -- location and arguments. If the program gets configured sucessfully it gets
    -- added to the configured collection.
    --
    -- Note that it is not a failure if the program cannot be configured. It's only
    -- a failure if the user supplied a location and the program could not be found
    -- at that location.
    --
    -- The reason for it not being a failure at this stage is that we don't know up
    -- front all the programs we will need, so we try to configure them all.
    -- To verify that a program was actually sucessfully configured use
    -- 'requireProgram'.
    --
    configureProgram :: Verbosity
                     -> Program
                     -> ProgramConfiguration
                     -> IO ProgramConfiguration
    configureProgram verbosity prog conf = do
      let name = programName prog
      maybeLocation <- case userSpecifiedPath prog conf of
        Nothing   -> programFindLocation prog verbosity
                 >>= return . fmap FoundOnSystem
        Just path -> do
          absolute <- doesFileExist path
          if absolute
            then return (Just (UserSpecified path))
            else findProgramOnPath path verbosity
             >>= maybe (die notFound) (return . Just . UserSpecified)
          where notFound = "Cannot find " ++ name ++ " at "
                         ++ path ++ " or on the path"
      case maybeLocation of
        Nothing -> return conf
        Just location -> do
          version <- programFindVersion prog verbosity (locationPath location)
          let configuredProg = ConfiguredProgram {
                programId       = name,
                programVersion  = version,
                programArgs     = userSpecifiedArgs prog conf,
                programLocation = location
              }
          return (updateConfiguredProgs (Map.insert name configuredProg) conf)

    -- | Try to configure all the known programs that have not yet been configured.
    configureAllKnownPrograms :: Verbosity
                      -> ProgramConfiguration
                      -> IO ProgramConfiguration
    configureAllKnownPrograms verbosity conf =
      foldM (flip (configureProgram verbosity)) conf
        [ prog | (prog,_,_) <- Map.elems (unconfiguredProgs conf
                         `Map.difference` configuredProgs conf) ]

    -- | Check that a program is configured and available to be run.
    --
    -- Additionally check that the version of the program number is suitable.
    -- For example 'AnyVersion' or @'orLaterVersion' ('Version' [1,0] [])@
    --
    -- It raises an exception if the program could not be configured or the version
    -- is unsuitable, otherwise it returns the configured program.
    requireProgram :: Verbosity -> Program -> VersionRange -> ProgramConfiguration
                   -> IO (ConfiguredProgram, ProgramConfiguration)
    requireProgram verbosity prog range conf = do

      -- If it's not already been configured, try to configure it now
      conf' <- case lookupProgram prog conf of
        Nothing -> configureProgram verbosity prog conf
        Just _  -> return conf

      case lookupProgram prog conf' of
        Nothing                           -> die notFound
        Just configuredProg
          | range == AnyVersion           -> return (configuredProg, conf')
        Just configuredProg@ConfiguredProgram { programLocation = location } ->
          case programVersion configuredProg of
            Just version
              | withinRange version range -> return (configuredProg, conf')
              | otherwise                 -> die (badVersion version location)
            Nothing                       -> die (noVersion location)

      where notFound       = programName prog ++ versionRequirement
                          ++ " is required but it could not be found."
            badVersion v l = programName prog ++ versionRequirement
                          ++ " is required but the version found at "
                          ++ locationPath l ++ " is version " ++ showVersion v
            noVersion l    = programName prog ++ versionRequirement
                          ++ " is required but the version of "
                          ++ locationPath l ++ " could not be determined."
            versionRequirement
              | range == AnyVersion = ""
              | otherwise           = " version " ++ showVersionRange range

    -- ------------------------------------------------------------
    -- * Running programs
    -- ------------------------------------------------------------

    -- | Runs the given configured program.
    rawSystemProgram :: Verbosity          -- ^Verbosity
                     -> ConfiguredProgram  -- ^The program to run
                     -> [ProgArg]          -- ^Any /extra/ arguments to add
                     -> IO ()
    rawSystemProgram verbosity prog extraArgs
      = rawSystemExit verbosity (programPath prog) (programArgs prog ++ extraArgs)

    -- | Runs the given configured program and gets the output.
    rawSystemProgramStdout :: Verbosity          -- ^Verbosity
                           -> ConfiguredProgram  -- ^The program to run
                           -> [ProgArg]          -- ^Any /extra/ arguments to add
                           -> IO String
    rawSystemProgramStdout verbosity prog extraArgs
      = rawSystemStdout verbosity (programPath prog) (programArgs prog ++ extraArgs)

    -- | Looks up the given program in the program configuration and runs it.
    rawSystemProgramConf :: Verbosity            -- ^verbosity
                         -> Program              -- ^The program to run
                         -> ProgramConfiguration -- ^look up the program here
                         -> [ProgArg]            -- ^Any /extra/ arguments to add
                         -> IO ()
    rawSystemProgramConf verbosity prog programConf extraArgs =
      case lookupProgram prog programConf of
        Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found")
        Just configuredProg -> rawSystemProgram verbosity configuredProg extraArgs

    -- | Looks up the given program in the program configuration and runs it.
    rawSystemProgramStdoutConf :: Verbosity            -- ^verbosity
                               -> Program              -- ^The program to run
                               -> ProgramConfiguration -- ^look up the program here
                               -> [ProgArg]            -- ^Any /extra/ arguments to add
                               -> IO String
    rawSystemProgramStdoutConf verbosity prog programConf extraArgs =
      case lookupProgram prog programConf of
        Nothing -> die ("The program " ++ programName prog ++ " is required but it could not be found")
        Just configuredProg -> rawSystemProgramStdout verbosity configuredProg extraArgs

    -- ------------------------------------------------------------
    -- * Known programs
    -- ------------------------------------------------------------

    -- | The default list of programs.
    -- These programs are typically used internally to Cabal.
    builtinPrograms :: [Program]
    builtinPrograms =
        [
        -- compilers and related progs
          ghcProgram
        , ghcPkgProgram
        , hugsProgram
        , ffihugsProgram
        , nhcProgram
        , hmakeProgram
        , jhcProgram
        -- preprocessors
        , hscolourProgram
        , haddockProgram
        , happyProgram
        , alexProgram
        , hsc2hsProgram
        , c2hsProgram
        , cpphsProgram
        , greencardProgram
        , pfesetupProgram
        -- platform toolchain
        , ranlibProgram
        , arProgram
        , ldProgram
        , tarProgram
        -- configuration tools
        , pkgConfigProgram
        ]

    ghcProgram :: Program
    ghcProgram = (simpleProgram "ghc") {
        programFindVersion = findProgramVersion "--numeric-version" id
      }

    ghcPkgProgram :: Program
    ghcPkgProgram = (simpleProgram "ghc-pkg") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          -- Invoking "ghc-pkg --version" gives a string like
          -- "GHC package manager version 6.4.1"
          case words str of
            (_:_:_:_:ver:_) -> ver
            _               -> ""
      }

    nhcProgram :: Program
    nhcProgram = simpleProgram "nhc98"

    hmakeProgram :: Program
    hmakeProgram = (simpleProgram "hmake") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          case words str of
            (_:ver:_) -> ver
            _         -> ""
      }

    jhcProgram :: Program
    jhcProgram = (simpleProgram "jhc") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          case words str of
            (_:ver:_) -> ver
            _         -> ""
      }

    -- AArgh! Finding the version of hugs or ffihugs is almost impossible.
    hugsProgram :: Program
    hugsProgram = simpleProgram "hugs"

    ffihugsProgram :: Program
    ffihugsProgram = simpleProgram "ffihugs"

    happyProgram :: Program
    happyProgram = (simpleProgram "happy") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          -- Invoking "happy --version" gives a string like
          -- "Happy Version 1.16 Copyright (c) ...."
          case words str of
            (_:_:ver:_) -> ver
            _           -> ""
      }

    alexProgram :: Program
    alexProgram = (simpleProgram "alex") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          -- Invoking "alex --version" gives a string like
          -- "Alex version 2.1.0, (c) 2003 Chris Dornan and Simon Marlow"
          case words str of
            (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver
            _           -> ""
      }

    ranlibProgram :: Program
    ranlibProgram = simpleProgram "ranlib"

    arProgram :: Program
    arProgram = simpleProgram "ar"

    hsc2hsProgram :: Program
    hsc2hsProgram = (simpleProgram "hsc2hs") {
        programFindVersion = \verbosity path -> do
          maybeVersion <- findProgramVersion "--version" (\str ->
            -- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
            case words str of
              (_:_:ver:_) -> ver
              _           -> "") verbosity path

          -- It turns out that it's important to know if hsc2hs is using gcc or ghc
          -- as it's C compiler since this affects how we escape C options.
          -- So here's a cunning hack, we make a temp .hsc file and call:
          -- hsch2s tmp.hsc --cflag=--version
          -- which passes --version through to ghc/gcc and we look at the result
          -- to see if it was indeed ghc or not.
          case maybeVersion of
            Nothing -> return Nothing
    	Just version ->
              withTempFile "dist" "hsc" $ \hsc -> do
    	    writeFile hsc ""
    	    (str, _) <- rawSystemStdout' verbosity path [hsc, "--cflag=--version"]
    	    try $ removeFile (dropExtension hsc ++ "_hsc_make.c")
    	    case words str of
    	      (_:"Glorious":"Glasgow":"Haskell":_)
    	        -> return $ Just version { versionTags = ["ghc"] }
    	      _ -> return $ Just version

      }

    c2hsProgram :: Program
    c2hsProgram = (simpleProgram "c2hs") {
        programFindVersion = findProgramVersion "--numeric-version" id
      }

    cpphsProgram :: Program
    cpphsProgram = (simpleProgram "cpphs") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          -- Invoking "cpphs --version" gives a string like "cpphs 1.3"
          case words str of
            (_:ver:_) -> ver
            _         -> ""
      }

    hscolourProgram :: Program
    hscolourProgram = (simpleProgram "hscolour") {
        programFindLocation = findProgramOnPath "HsColour",
        programFindVersion  = findProgramVersion "-version" $ \str ->
          -- Invoking "HsColour -version" gives a string like "HsColour 1.7"
          case words str of
            (_:ver:_) -> ver
            _         -> ""
      }

    haddockProgram :: Program
    haddockProgram = (simpleProgram "haddock") {
        programFindVersion = findProgramVersion "--version" $ \str ->
          -- Invoking "haddock --version" gives a string like
          -- "Haddock version 0.8, (c) Simon Marlow 2006"
          case words str of
            (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver
            _           -> ""
      }

    greencardProgram :: Program
    greencardProgram = simpleProgram "greencard"

    ldProgram :: Program
    ldProgram = simpleProgram "ld"

    tarProgram :: Program
    tarProgram = simpleProgram "tar"

    cppProgram :: Program
    cppProgram = simpleProgram "cpp"

    pfesetupProgram :: Program
    pfesetupProgram = simpleProgram "pfesetup"

    pkgConfigProgram :: Program
    pkgConfigProgram = (simpleProgram "pkg-config") {
        programFindVersion = findProgramVersion "--version" id
      }