module Debian.GHC
( withCompilerVersion
, newestAvailable
, compilerIdFromDebianVersion
, compilerFlavorOption
, newestAvailableCompilerId
, compilerPackageName
) where
import Control.DeepSeq (force)
import Control.Exception (SomeException, try)
import Control.Monad (when)
import Data.Char ( toUpper)
import Data.Function.Memoize (deriveMemoizable, memoize2)
import Data.Maybe (fromMaybe)
import Data.Version (showVersion, Version(Version))
import Debian.Debianize.BinaryDebDescription (PackageType(..))
import Debian.Relation (BinPkgName(BinPkgName))
import Debian.Version (DebianVersion, parseDebianVersion)
import Distribution.Compiler (CompilerFlavor(..), CompilerId(CompilerId))
import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(..))
import System.Directory (doesDirectoryExist)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess)
import System.Unix.Chroot (useEnv)
import Text.Read (readMaybe)
$(deriveMemoizable ''CompilerFlavor)
$(deriveMemoizable ''BinPkgName)
withCompilerVersion :: FilePath -> CompilerFlavor -> (DebianVersion -> a) -> a
withCompilerVersion root hc f = f (newestAvailableCompiler root hc)
newestAvailable :: FilePath -> BinPkgName -> Maybe DebianVersion
newestAvailable root pkg =
memoize2 f pkg root
where
f :: BinPkgName -> FilePath -> Maybe DebianVersion
f pkg' root' = unsafePerformIO (newestAvailable' root' pkg')
newestAvailable' :: FilePath -> BinPkgName -> IO (Maybe DebianVersion)
newestAvailable' root (BinPkgName name) = do
exists <- doesDirectoryExist root
when (not exists) (error $ "newestAvailable: no such environment: " ++ show root)
versions <- try $ chroot root $
(readProcess "apt-cache" ["showpkg", name] "" >>=
return . dropWhile (/= "Versions: ") . lines) :: IO (Either SomeException [String])
case versions of
Left e -> error $ "newestAvailable failed in " ++ show root ++ ": " ++ show e
Right (_ : versionLine : _) -> return . Just . parseDebianVersion . takeWhile (/= ' ') $ versionLine
_ -> return Nothing
where
chroot "/" = id
chroot _ = useEnv root (return . force)
newestAvailableCompiler :: FilePath -> CompilerFlavor -> DebianVersion
newestAvailableCompiler root hc =
fromMaybe (error $ "newestAvailableCompiler - No versions of " ++ show hc ++ " available in " ++ show root)
(newestAvailable root (compilerPackageName hc Development))
newestAvailableCompilerId :: FilePath -> CompilerFlavor -> CompilerId
newestAvailableCompilerId root hc = compilerIdFromDebianVersion hc (newestAvailableCompiler root hc)
compilerIdFromDebianVersion :: CompilerFlavor -> DebianVersion -> CompilerId
compilerIdFromDebianVersion hc debVersion =
let (Version ds ts) = greatestLowerBound debVersion (map (\ d -> Version [d] []) [0..]) in
CompilerId hc (greatestLowerBound debVersion (map (\ d -> Version (ds ++ [d]) ts) [0..]))
where
greatestLowerBound :: DebianVersion -> [Version] -> Version
greatestLowerBound b xs = last $ takeWhile (\ v -> parseDebianVersion (showVersion v) < b) xs
compilerFlavorOption :: forall a. (CompilerFlavor -> a -> a) -> OptDescr (a -> a)
compilerFlavorOption f =
Option [] ["hc", "compiler-flavor"] (ReqArg readHC "COMPILER") "Build packages using this Haskell compiler"
where
readHC :: String -> a -> a
readHC s = maybe (error $ "Invalid CompilerFlavor: " ++ show s) f (readMaybe (map toUpper s))
compilerPackageName :: CompilerFlavor -> PackageType -> BinPkgName
compilerPackageName GHC Documentation = BinPkgName "ghc-doc"
compilerPackageName GHC Profiling = BinPkgName "ghc-prof"
compilerPackageName GHC Development = BinPkgName "ghc"
compilerPackageName GHC _ = BinPkgName "ghc"
#if MIN_VERSION_Cabal(1,22,0)
compilerPackageName GHCJS Documentation = BinPkgName "ghcjs"
compilerPackageName GHCJS Profiling = error "Profiling not supported for GHCJS"
compilerPackageName GHCJS Development = BinPkgName "ghcjs"
compilerPackageName GHCJS _ = BinPkgName "ghcjs"
#endif
compilerPackageName x _ = error $ "Unsupported compiler flavor: " ++ show x