-- | Input the Cabal package description.
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Debian.Debianize.InputCabal
    ( inputCabalization
    ) where

import Control.Exception (bracket)
import Control.Lens (view)
import Control.Monad (when)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Set as Set (toList)
import Debian.Debianize.BasicInfo (Flags, verbosity, compilerFlavor, cabalFlagAssignments)
import Debian.Debianize.Prelude (intToVerbosity')
import Debian.GHC (getCompilerInfo)
import Debian.Orphans ()
import Distribution.Compiler (CompilerInfo)
import Distribution.Package (Package(packageId))
import Distribution.PackageDescription as Cabal (PackageDescription)
import Distribution.PackageDescription.Configuration (finalizePD)
#if MIN_VERSION_Cabal(3,8,1)
import Distribution.Simple.PackageDescription (readGenericPackageDescription)
#else
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
#endif
import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec(ComponentRequestedSpec))
import Distribution.Simple.Utils (defaultPackageDesc, die', setupMessage)
import Distribution.System as Cabal (buildArch, Platform(..))
import qualified Distribution.System as Cabal (buildOS)
#if MIN_VERSION_Cabal(3,2,0)
import Distribution.Types.Flag (mkFlagAssignment)
#else
import Distribution.Types.GenericPackageDescription (mkFlagAssignment)
#endif
import Distribution.Verbosity (Verbosity)
import Prelude hiding (break, lines, log, null, readFile, sum)
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Exit (ExitCode(..))
import System.Posix.Files (setFileCreationMask)
import System.Process (system)

-- | Load a PackageDescription using the information in the Flags record -
-- in particular, using the dependency environment in the EnvSet, find
-- the newest available compiler of the requested compiler flavor and
-- use that information load the configured PackageDescription.
inputCabalization :: forall m. (MonadIO m) => Flags -> m (Either String PackageDescription)
inputCabalization :: forall (m :: * -> *).
MonadIO m =>
Flags -> m (Either String PackageDescription)
inputCabalization Flags
flags =
    Flags -> m (Either String CompilerInfo)
forall (m :: * -> *).
MonadIO m =>
Flags -> m (Either String CompilerInfo)
getCompInfo Flags
flags m (Either String CompilerInfo)
-> (Either String CompilerInfo
    -> m (Either String PackageDescription))
-> m (Either String PackageDescription)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m (Either String PackageDescription))
-> (CompilerInfo -> m (Either String PackageDescription))
-> Either String CompilerInfo
-> m (Either String PackageDescription)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either String PackageDescription
-> m (Either String PackageDescription)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PackageDescription
 -> m (Either String PackageDescription))
-> (String -> Either String PackageDescription)
-> String
-> m (Either String PackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String PackageDescription
forall a b. a -> Either a b
Left) (\CompilerInfo
cinfo -> PackageDescription -> Either String PackageDescription
forall a b. b -> Either a b
Right (PackageDescription -> Either String PackageDescription)
-> m PackageDescription -> m (Either String PackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompilerInfo -> m PackageDescription
doCompInfo CompilerInfo
cinfo)
    where
      doCompInfo :: CompilerInfo -> m PackageDescription
      doCompInfo :: CompilerInfo -> m PackageDescription
doCompInfo CompilerInfo
cinfo = do
        -- Load a GenericPackageDescription from the current directory
        -- and from that create a finalized PackageDescription for the
        -- given CompilerId.
        GenericPackageDescription
genPkgDesc <- IO GenericPackageDescription -> m GenericPackageDescription
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> m GenericPackageDescription)
-> IO GenericPackageDescription -> m GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ Verbosity -> IO String
defaultPackageDesc Verbosity
vb IO String
-> (String -> IO GenericPackageDescription)
-> IO GenericPackageDescription
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
vb
        let finalized :: Either [Dependency] (PackageDescription, FlagAssignment)
finalized = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD ([(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment (Set (FlagName, Bool) -> [(FlagName, Bool)]
forall a. Set a -> [a]
toList Set (FlagName, Bool)
fs)) (Bool -> Bool -> ComponentRequestedSpec
ComponentRequestedSpec Bool
True Bool
False) (Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True) (Arch -> OS -> Platform
Platform Arch
buildArch OS
Cabal.buildOS) CompilerInfo
cinfo [] GenericPackageDescription
genPkgDesc
        Either [Dependency] PackageDescription
ePkgDesc <- ([Dependency] -> m (Either [Dependency] PackageDescription))
-> ((PackageDescription, FlagAssignment)
    -> m (Either [Dependency] PackageDescription))
-> Either [Dependency] (PackageDescription, FlagAssignment)
-> m (Either [Dependency] PackageDescription)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either [Dependency] PackageDescription
-> m (Either [Dependency] PackageDescription)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Dependency] PackageDescription
 -> m (Either [Dependency] PackageDescription))
-> ([Dependency] -> Either [Dependency] PackageDescription)
-> [Dependency]
-> m (Either [Dependency] PackageDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dependency] -> Either [Dependency] PackageDescription
forall a b. a -> Either a b
Left)
                           (\ (PackageDescription
pkgDesc, FlagAssignment
_) -> do IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO FileMode
-> (FileMode -> IO FileMode) -> (FileMode -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FileMode -> IO FileMode
setFileCreationMask FileMode
0o022) FileMode -> IO FileMode
setFileCreationMask ((FileMode -> IO ()) -> IO ()) -> (FileMode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FileMode
_ -> Verbosity -> PackageDescription -> IO ()
autoreconf Verbosity
vb PackageDescription
pkgDesc
                                                 Either [Dependency] PackageDescription
-> m (Either [Dependency] PackageDescription)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription -> Either [Dependency] PackageDescription
forall a b. b -> Either a b
Right PackageDescription
pkgDesc))
                           Either [Dependency] (PackageDescription, FlagAssignment)
finalized
        ([Dependency] -> m PackageDescription)
-> (PackageDescription -> m PackageDescription)
-> Either [Dependency] PackageDescription
-> m PackageDescription
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ [Dependency]
deps -> IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory m String
-> (String -> m PackageDescription) -> m PackageDescription
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
here ->
                          String -> m PackageDescription
forall a. HasCallStack => String -> a
error (String -> m PackageDescription) -> String -> m PackageDescription
forall a b. (a -> b) -> a -> b
$ String
"Missing dependencies in cabal package at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
here String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Dependency] -> String
forall a. Show a => a -> String
show [Dependency]
deps)
               PackageDescription -> m PackageDescription
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
               Either [Dependency] PackageDescription
ePkgDesc
      vb :: Verbosity
vb = Int -> Verbosity
intToVerbosity' (Int -> Verbosity) -> Int -> Verbosity
forall a b. (a -> b) -> a -> b
$ Getting Int Flags Int -> Flags -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Flags Int
Lens' Flags Int
verbosity Flags
flags
      fs :: Set (FlagName, Bool)
fs = Getting (Set (FlagName, Bool)) Flags (Set (FlagName, Bool))
-> Flags -> Set (FlagName, Bool)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set (FlagName, Bool)) Flags (Set (FlagName, Bool))
Lens' Flags (Set (FlagName, Bool))
cabalFlagAssignments Flags
flags

getCompInfo :: MonadIO m => Flags -> m (Either String CompilerInfo)
getCompInfo :: forall (m :: * -> *).
MonadIO m =>
Flags -> m (Either String CompilerInfo)
getCompInfo Flags
flags =
              CompilerFlavor -> m (Either String CompilerInfo)
forall (m :: * -> *).
MonadIO m =>
CompilerFlavor -> m (Either String CompilerInfo)
getCompilerInfo (Getting CompilerFlavor Flags CompilerFlavor
-> Flags -> CompilerFlavor
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CompilerFlavor Flags CompilerFlavor
Lens' Flags CompilerFlavor
compilerFlavor Flags
flags)

-- | Run the package's configuration script.
autoreconf :: Verbosity -> Cabal.PackageDescription -> IO ()
autoreconf :: Verbosity -> PackageDescription -> IO ()
autoreconf Verbosity
verbose PackageDescription
pkgDesc = do
    Bool
ac <- String -> IO Bool
doesFileExist String
"configure.ac"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ac (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
c <- String -> IO Bool
doesFileExist String
"configure"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbose String
"Running autoreconf" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkgDesc)
            ExitCode
ret <- String -> IO ExitCode
system String
"autoreconf"
            case ExitCode
ret of
              ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              ExitFailure Int
n -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbose (String
"autoreconf failed with status " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)