{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Make
-- Copyright   :  Martin Sjögren 2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is an alternative build system that delegates everything to the @make@
-- program. All the commands just end up calling @make@ with appropriate
-- arguments. The intention was to allow preexisting packages that used
-- makefiles to be wrapped into Cabal packages. In practice essentially all
-- such packages were converted over to the \"Simple\" build system instead.
-- Consequently this module is not used much and it certainly only sees cursory
-- maintenance and no testing. Perhaps at some point we should stop pretending
-- that it works.
--
-- Uses the parsed command-line from "Distribution.Simple.Setup" in order to build
-- Haskell tools using a back-end build system based on make. Obviously we
-- assume that there is a configure script, and that after the ConfigCmd has
-- been run, there is a Makefile. Further assumptions:
--
-- [ConfigCmd] We assume the configure script accepts
--              @--with-hc@,
--              @--with-hc-pkg@,
--              @--prefix@,
--              @--bindir@,
--              @--libdir@,
--              @--libexecdir@,
--              @--datadir@.
--
-- [BuildCmd] We assume that the default Makefile target will build everything.
--
-- [InstallCmd] We assume there is an @install@ target. Note that we assume that
-- this does *not* register the package!
--
-- [CopyCmd]    We assume there is a @copy@ target, and a variable @$(destdir)@.
--              The @copy@ target should probably just invoke @make install@
--              recursively (e.g. @$(MAKE) install prefix=$(destdir)\/$(prefix)
--              bindir=$(destdir)\/$(bindir)@. The reason we can\'t invoke @make
--              install@ directly here is that we don\'t know the value of @$(prefix)@.
--
-- [SDistCmd] We assume there is a @dist@ target.
--
-- [RegisterCmd] We assume there is a @register@ target and a variable @$(user)@.
--
-- [UnregisterCmd] We assume there is an @unregister@ target.
--
-- [HaddockCmd] We assume there is a @docs@ or @doc@ target.


--                      copy :
--                              $(MAKE) install prefix=$(destdir)/$(prefix) \
--                                              bindir=$(destdir)/$(bindir) \

module Distribution.Make (
        module Distribution.Package,
        License(..), Version,
        defaultMain, defaultMainArgs
  ) where

import Prelude ()
import Distribution.Compat.Prelude

-- local
import Distribution.Compat.Exception
import Distribution.Package
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Command

import Distribution.Simple.Utils

import Distribution.License
import Distribution.Version
import Distribution.Pretty

import System.Environment (getArgs, getProgName)
import System.Exit

defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = IO [String]
getArgs IO [String] -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ()
[String] -> IO ()
defaultMainArgs

defaultMainArgs :: [String] -> IO ()
defaultMainArgs :: [String] -> IO ()
defaultMainArgs = [String] -> IO ()
[String] -> IO ()
defaultMainHelper

defaultMainHelper :: [String] -> IO ()
defaultMainHelper :: [String] -> IO ()
defaultMainHelper [String]
args =
  case CommandUI GlobalFlags
-> [Command (IO ())]
-> [String]
-> CommandParse (GlobalFlags, CommandParse (IO ()))
forall a action.
CommandUI a
-> [Command action]
-> [String]
-> CommandParse (a, CommandParse action)
commandsRun ([Command (IO ())] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand [Command (IO ())]
commands) [Command (IO ())]
commands [String]
args of
    CommandHelp   String -> String
help                 -> (String -> String) -> IO ()
printHelp String -> String
help
    CommandList   [String]
opts                 -> [String] -> IO ()
printOptionsList [String]
opts
    CommandErrors [String]
errs                 -> [String] -> IO ()
forall b. [String] -> IO b
printErrors [String]
errs
    CommandReadyToGo (GlobalFlags
flags, CommandParse (IO ())
commandParse)  ->
      case CommandParse (IO ())
commandParse of
        CommandParse (IO ())
_ | Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (GlobalFlags -> Flag Bool
globalVersion GlobalFlags
flags)        -> IO ()
printVersion
          | Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (GlobalFlags -> Flag Bool
globalNumericVersion GlobalFlags
flags) -> IO ()
printNumericVersion
        CommandHelp     String -> String
help           -> (String -> String) -> IO ()
printHelp String -> String
help
        CommandList     [String]
opts           -> [String] -> IO ()
printOptionsList [String]
opts
        CommandErrors   [String]
errs           -> [String] -> IO ()
forall b. [String] -> IO b
printErrors [String]
errs
        CommandReadyToGo IO ()
action        -> IO ()
action

  where
    printHelp :: (String -> String) -> IO ()
printHelp String -> String
help = IO String
getProgName IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
help
    printOptionsList :: [String] -> IO ()
printOptionsList = String -> IO ()
putStr (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
    printErrors :: [String] -> IO b
printErrors [String]
errs = do
      String -> IO ()
putStr (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
errs)
      ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
    printNumericVersion :: IO ()
printNumericVersion = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
cabalVersion
    printVersion :: IO ()
printVersion        = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cabal library version "
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
cabalVersion

    progs :: ProgramDb
progs = ProgramDb
defaultProgramDb
    commands :: [Command (IO ())]
commands =
      [ProgramDb -> CommandUI ConfigFlags
configureCommand ProgramDb
progs CommandUI ConfigFlags
-> (ConfigFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` ConfigFlags -> [String] -> IO ()
ConfigFlags -> [String] -> IO ()
configureAction
      ,ProgramDb -> CommandUI BuildFlags
buildCommand     ProgramDb
progs CommandUI BuildFlags
-> (BuildFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` BuildFlags -> [String] -> IO ()
BuildFlags -> [String] -> IO ()
buildAction
      ,CommandUI InstallFlags
installCommand         CommandUI InstallFlags
-> (InstallFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` InstallFlags -> [String] -> IO ()
InstallFlags -> [String] -> IO ()
installAction
      ,CommandUI CopyFlags
copyCommand            CommandUI CopyFlags
-> (CopyFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` CopyFlags -> [String] -> IO ()
CopyFlags -> [String] -> IO ()
copyAction
      ,CommandUI HaddockFlags
haddockCommand         CommandUI HaddockFlags
-> (HaddockFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` HaddockFlags -> [String] -> IO ()
HaddockFlags -> [String] -> IO ()
haddockAction
      ,CommandUI CleanFlags
cleanCommand           CommandUI CleanFlags
-> (CleanFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` CleanFlags -> [String] -> IO ()
CleanFlags -> [String] -> IO ()
cleanAction
      ,CommandUI SDistFlags
sdistCommand           CommandUI SDistFlags
-> (SDistFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` SDistFlags -> [String] -> IO ()
SDistFlags -> [String] -> IO ()
sdistAction
      ,CommandUI RegisterFlags
registerCommand        CommandUI RegisterFlags
-> (RegisterFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` RegisterFlags -> [String] -> IO ()
RegisterFlags -> [String] -> IO ()
registerAction
      ,CommandUI RegisterFlags
unregisterCommand      CommandUI RegisterFlags
-> (RegisterFlags -> [String] -> IO ()) -> Command (IO ())
forall flags action.
CommandUI flags -> (flags -> [String] -> action) -> Command action
`commandAddAction` RegisterFlags -> [String] -> IO ()
RegisterFlags -> [String] -> IO ()
unregisterAction
      ]

configureAction :: ConfigFlags -> [String] -> IO ()
configureAction :: ConfigFlags -> [String] -> IO ()
configureAction ConfigFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags)
  Verbosity -> String -> [String] -> IO ()
rawSystemExit Verbosity
verbosity String
"sh" ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"configure"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> ConfigFlags -> [String]
configureArgs Bool
backwardsCompatHack ConfigFlags
flags
  where backwardsCompatHack :: Bool
backwardsCompatHack = Bool
True

copyAction :: CopyFlags -> [String] -> IO ()
copyAction :: CopyFlags -> [String] -> IO ()
copyAction CopyFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  let destArgs :: [String]
destArgs = case Flag CopyDest -> CopyDest
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag CopyDest -> CopyDest) -> Flag CopyDest -> CopyDest
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags of
        CopyDest
NoCopyDest      -> [String
"install"]
        CopyTo String
path     -> [String
"copy", String
"destdir=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path]
        CopyToDb String
_      -> String -> [String]
forall a. HasCallStack => String -> a
error String
"CopyToDb not supported via Make"

  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags) String
"make" [String]
destArgs

installAction :: InstallFlags -> [String] -> IO ()
installAction :: InstallFlags -> [String] -> IO ()
installAction InstallFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags) String
"make" [String
"install"]
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags) String
"make" [String
"register"]

haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction :: HaddockFlags -> [String] -> IO ()
haddockAction HaddockFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
flags) String
"make" [String
"docs"]
    IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ ->
    Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
flags) String
"make" [String
"doc"]

buildAction :: BuildFlags -> [String] -> IO ()
buildAction :: BuildFlags -> [String] -> IO ()
buildAction BuildFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags) String
"make" []

cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction :: CleanFlags -> [String] -> IO ()
cleanAction CleanFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CleanFlags -> Flag Verbosity
cleanVerbosity CleanFlags
flags) String
"make" [String
"clean"]

sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction :: SDistFlags -> [String] -> IO ()
sdistAction SDistFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags) String
"make" [String
"dist"]

registerAction :: RegisterFlags -> [String] -> IO ()
registerAction :: RegisterFlags -> [String] -> IO ()
registerAction  RegisterFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags) String
"make" [String
"register"]

unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction :: RegisterFlags -> [String] -> IO ()
unregisterAction RegisterFlags
flags [String]
args = do
  [String] -> IO ()
noExtraFlags [String]
args
  Verbosity -> String -> [String] -> IO ()
rawSystemExit (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags) String
"make" [String
"unregister"]