Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

More work on cabal2macpkg -- partial support for haskell platform

Meta mode is still broken, but as of this changeset it does enough to
generate .pkg files for the haskell platform (which you still need to
assemble into a distribution by hand, augh)
  • Loading branch information...
commit 5cc4579ef6f30f8fbd38c22bc9a1fb93e3fe6b9a 1 parent 1800952
@gregorycollins authored
View
44 Distribution/OSX/InstallerScript.hs
@@ -17,13 +17,13 @@ import Text.XML.HXT.Arrow
------------------------------------------------------------------------
data InstallerScript = InstallerScript {
- title :: String
- , background :: Maybe String
- , welcome :: Maybe String
- , readme :: Maybe String
- , license :: Maybe String
- , conclusion :: Maybe String
- , pkgFileNames :: [String]
+ is_title :: String
+ , is_background :: Maybe String
+ , is_welcome :: Maybe String
+ , is_readme :: Maybe String
+ , is_license :: Maybe String
+ , is_conclusion :: Maybe String
+ , is_pkgFileNames :: [(String,Int)]
}
@@ -36,7 +36,9 @@ installerScript :: String -- ^ package title
-> Maybe String -- ^ readme blurb
-> Maybe String -- ^ license blurb
-> Maybe String -- ^ conclusion blurb
- -> [String] -- ^ list of .pkg files to include
+ -> [(String,Int)] -- ^ list of .pkg files to
+ -- include, along with their
+ -- installed sizes
-> InstallerScript
installerScript = InstallerScript
@@ -90,7 +92,7 @@ blurbAttrs = [ sattr "language" "en"
------------------------------------------------------------------------
blurb :: (ArrowXml a) => String -> String -> a n XmlTree
-blurb tagName txt = mkelem tagName blurbAttrs [cdata txt]
+blurb tagName s = mkelem tagName blurbAttrs [cdata s]
------------------------------------------------------------------------
@@ -131,9 +133,9 @@ mkChoicesOutline choiceIds =
------------------------------------------------------------------------
mkChoice :: (ArrowXml a) => String -> String -> String -> a n XmlTree
-mkChoice id title pkgref =
+mkChoice iD title pkgref =
mkelem "choice"
- [ sattr "id" id
+ [ sattr "id" iD
, sattr "title" title
, sattr "start_visible" "false" ]
[ mkelem "pkg-ref" [sattr "id" pkgref] [] ]
@@ -141,13 +143,13 @@ mkChoice id title pkgref =
------------------------------------------------------------------------
mkPkgRef :: (ArrowXml a) => String -> String -> [Char] -> a n XmlTree
-mkPkgRef id installKBytes pkgFileName =
+mkPkgRef iD installKBytes pkgFileName =
mkelem "pkg-ref"
- [ sattr "id" id
+ [ sattr "id" iD
, sattr "installKBytes" installKBytes
, sattr "version" ""
, sattr "auth" "Root" ]
- [ txt $ "file:./Contents/Packages/" ++ pkgFileName ]
+ [ txt $ "#" ++ pkgFileName ]
------------------------------------------------------------------------
@@ -162,21 +164,21 @@ installerScriptHead body =
mkInstallerScript :: (ArrowXml a) => InstallerScript -> a n XmlTree
mkInstallerScript is =
installerScriptHead $ concat [
- [ mkTitle (title is) ]
+ [ mkTitle (is_title is) ]
, catMaybes [
- (welcome is) >>= Just . mkWelcome
- , (readme is) >>= Just . mkReadme
- , (license is) >>= Just . mkLicense
- , (conclusion is) >>= Just . mkConclusion ]
+ (is_welcome is) >>= Just . mkWelcome
+ , (is_readme is) >>= Just . mkReadme
+ , (is_license is) >>= Just . mkLicense
+ , (is_conclusion is) >>= Just . mkConclusion ]
, [ choicesOutline ]
, choices
, pkgRefs ]
where
- pkgFiles = pkgFileNames is
+ pkgFiles = is_pkgFileNames is
n = length pkgFiles
choiceIds = [ "choice" ++ (show i) | i <- [0..(n-1)] ]
pkgRefIds = [ "pkg" ++ (show i) | i <- [0..(n-1)] ]
choicesOutline = mkChoicesOutline choiceIds
choices = map (\(x,y) -> mkChoice x x y) (choiceIds `zip` pkgRefIds)
-- FIXME: installKBytes should not be "0"!
- pkgRefs = map (\(x,y) -> mkPkgRef x "0" y) (pkgRefIds `zip` pkgFiles)
+ pkgRefs = map (\(x,(f,sz)) -> mkPkgRef x (show sz) f) (pkgRefIds `zip` pkgFiles)
View
3  Main.hs
@@ -52,7 +52,8 @@ main :: IO ()
main = do
opts <- getOptions
bracket getTempDirectory
- cleanupTempDirectory
+ --cleanupTempDirectory
+ (const $ return ())
(runMain opts)
View
145 Program/MakeMetaPackage.hs
@@ -1,46 +1,41 @@
{-# LANGUAGE BangPatterns #-}
--- | This module contains routines for making a mac .mpkg file from a
--- .cabal file's dependencies. Note that for right now (until this
--- program develops further) the intention is to do just enough to be
--- able to build an installer for the Haskell Platform
+-- | This module contains routines for making a mac distribution file
+-- from a .cabal file's dependencies. Note that for right now (until
+-- this program develops further) the intention is to do just enough
+-- to be able to build an installer for the Haskell Platform
------------------------------------------------------------------------
module Program.MakeMetaPackage (runMakeMetaPkg)
where
-import Control.Exception
-import Control.Monad
-
-import Data.Maybe
-import Data.Version
-
-import Distribution.Package
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Configuration
-import Distribution.PackageDescription.Parse
-import Distribution.Simple.Utils hiding (intercalate)
-import Distribution.Verbosity as Verbosity
-import Distribution.Version
-
-import System.Directory
-import System.Environment
-import System.FilePath
-import System.FilePath.Glob
-import System.IO
-
+import Control.Exception
+import Control.Monad
import qualified Data.ByteString.Lazy as B
-
-import Text.Regex
-
+import Data.Maybe
+import Data.Version
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Configuration
+import Distribution.PackageDescription.Parse
+import Distribution.Simple.Utils hiding (intercalate)
+import Distribution.Verbosity as Verbosity
+import Distribution.Version
+import System.Directory
+import System.Environment
+import System.FilePath
+import System.FilePath.Glob
+import System.IO
+import Text.Printf
+import Text.Regex
------------------------------------------------------------------------
-- local imports
------------------------------------------------------------------------
-import Distribution.OSX.InstallerScript
-import Program.MakePackage
-import Program.Options
-import Program.Util
+import Distribution.OSX.InstallerScript
+import Program.MakePackage
+import Program.Options
+import Program.Util
------------------------------------------------------------------------
@@ -57,7 +52,7 @@ checkDependenciesHaveExactVersions d =
------------------------------------------------------------------------
--- | Builds an OSX .mpkg based on a .cabal file
+-- | Builds an OSX distribution based on a .cabal file
makeMacMetaPkg :: Options -- ^ command-line options
-> FilePath -- ^ path to temp directory
-> PackageDescription -- ^ a parsed .cabal file
@@ -69,17 +64,16 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
outputPackageDir <- makeAndCanonicalize $ fromMaybe cwd (packageOutputDir opts)
outputPackagePath <- makeAndCanonicalize $
- fromMaybe (outputPackageDir </> computedPackageName)
+ fromMaybe (outputPackageDir </> computedPackageFileName)
(packageOutputFile opts)
- contentsDir <- makeAndCanonicalize $ outputPackagePath </> "Contents"
- packagesDir <- makeAndCanonicalize $ contentsDir </> "Packages"
+ contentsDir <- makeAndCanonicalize $ tmpdir </> "Stage"
+ packagesDir <- makeAndCanonicalize $ tmpdir </> "Packages"
let subOptions = opts { packageOutputDir = Just packagesDir
, packageOutputFile = Nothing }
- (createDirectoryIfMissing True) `mapM_` [ outputPackagePath
- , contentsDir
+ (createDirectoryIfMissing True) `mapM_` [ contentsDir
, packagesDir ]
mapM_ (buildOne subOptions) packagesToFetch
@@ -91,18 +85,31 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
maybe (return [])
(\x -> do
files <- globPackages x
- mapM_ (copyTo outputPackagePath) files
+ mapM_ (copyTo packagesDir) files
return (takeFileName `map` files))
(extraPkgDir opts)
- writeInstallerScript (contentsDir </> "distribution.dist") $
+
+ let allPackages = extraPackages ++ packageFileNames
+
+ -- FIXME: sizes bogus
+ sizes <- mapM (unXarToStaging packagesDir contentsDir) allPackages
+
+ -- write any Resources/ files (likely none), dump out
+ -- "Distribution" file, and xar up the results
+
+ -- FIXME: Resources/ (for background images)
+
+ writeInstallerScript (contentsDir </> "Distribution") $
installerScript pkgTitle
Nothing -- FIXME: populate these
Nothing
(Just pkgDescription)
Nothing
Nothing
- (extraPackages ++ packageFileNames)
+ (allPackages `zip` sizes)
+
+ xarUpResults contentsDir outputPackagePath
where
--------------------------------------------------------------------
@@ -118,7 +125,7 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
pkgBaseName = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
--------------------------------------------------------------------
- computedPackageName = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".mpkg")
+ computedPackageFileName = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".pkg")
deps = executableDeps opts ++ buildDepends pkgDesc
@@ -138,14 +145,51 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
--------------------------------------------------------------------
- cabalFetch (pkgName,pkgVersion) = do
+ -- Actions
+ --------------------------------------------------------------------
+ unXarToStaging :: FilePath -> FilePath -> FilePath -> IO Int
+ unXarToStaging pkgPath outDir pkgFile = do
+ bracket
+ getCurrentDirectory
+ setCurrentDirectory
+ (\_ -> do
+ setCurrentDirectory outDir
+
+ let srcFile = pkgPath </> pkgFile
+ let destDir = outDir </> pkgFile
+
+ createDirectoryIfMissing True $ destDir
+ setCurrentDirectory $ destDir
+
+ putStrLn $ printf "un-xaring '%s' to '%s'..." srcFile destDir
+ putStrLn $ "------------------------------------------------------------------------"
+ hFlush stdout
+
+ runCmd "xar" ["-xvf", srcFile]
+ -- FIXME: parse PackageInfo
+ return 0)
+
+
+ --------------------------------------------------------------------
+ xarUpResults :: FilePath -> FilePath -> IO ()
+ xarUpResults staging outputFileName = do
+ bracket
+ getCurrentDirectory
+ setCurrentDirectory
+ (\_ -> do
+ setCurrentDirectory staging
+ runCmd "xar" ["-cvf", outputFileName, "."])
+
+
+ --------------------------------------------------------------------
+ cabalFetch (name,vers) = do
-- FIXME: change this when cabal fetch takes an -o argument
home <- getEnv "HOME"
- let pkgbase = pkgName ++ "-" ++ pkgVersion
+ let pkgbase = name ++ "-" ++ vers
let pkg = pkgbase ++ ".tar.gz"
let pkgloc = home </> ".cabal/packages/hackage.haskell.org/"
- </> pkgName </> pkgVersion </> pkg
+ </> name </> vers </> pkg
runCmd "cabal" ["fetch", pkgbase]
fe <- doesFileExist pkgloc
@@ -158,9 +202,9 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
--------------------------------------------------------------------
- buildOne opts (pkgName,pkgVersion) = do
+ buildOne opt (name,vers) = do
putStrLn $ "\n" ++ (replicate 72 '-')
- putStrLn $ "Making " ++ pkgName ++ "-" ++ pkgVersion
+ putStrLn $ "Making " ++ name ++ "-" ++ vers
putStrLn $ replicate 72 '-'
hFlush stdout
@@ -174,8 +218,8 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
let workdir = td </> "work"
createDirectoryIfMissing True workdir
- cabalFetch (pkgName,pkgVersion)
- runMakePackage opts workdir
+ cabalFetch (name,vers)
+ runMakePackage opt workdir
)
--------------------------------------------------------------------
@@ -186,9 +230,9 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
------------------------------------------------------------------------
--- | globs a directory for .pkg and .mpkg files
+-- | globs a directory for .pkg files
globPackages :: FilePath -> IO [FilePath]
-globPackages dir = namesMatching `mapM` ((dir </>) `map` ["*.pkg", "*.mpkg"])
+globPackages dir = namesMatching `mapM` ((dir </>) `map` ["*.pkg"])
>>= return . concat
@@ -217,4 +261,5 @@ runMakeMetaPkg opts tmpdir = do
+makeAndCanonicalize :: FilePath -> IO FilePath
makeAndCanonicalize fp = createDirectoryIfMissing True fp >> canonicalizePath fp
View
20 Program/MakePackage.hs
@@ -65,9 +65,9 @@ makeMacPkg opts tmpdir pkgDesc = do
createDirectories
--------------------------------------------------------------------
- buildPackageContents
+ hasPostFlight <- buildPackageContents
setRootPrivileges
- mkInfoFiles
+ mkInfoFiles hasPostFlight
runPackageMaker
where
@@ -132,23 +132,27 @@ makeMacPkg opts tmpdir pkgDesc = do
makePostFlightScriptFile src dest = do
fe <- doesFileExist src
if not fe then
- return ()
+ return False
else do
contents <- readFile src
let output = "#!/bin/sh\n\
- \echo '" ++ contents ++
- "' | /usr/bin/env ghc-pkg --global update -"
+ \/usr/bin/ghc-pkg --global update - <<EOF\n"
+ ++ contents ++ "\nEOF\n"
writeFile dest output
+ return True
--------------------------------------------------------------------
-- populate the packageinfo file in the resource directory
- mkInfoFiles :: IO ()
- mkInfoFiles = do
+ mkInfoFiles :: Bool -> IO ()
+ mkInfoFiles hasPf = do
nf <- getNumFiles contentsDir
kb <- getFileSizesInKB contentsDir
+
+ let pf = if hasPf then Just "postflight" else Nothing
+
let pinfo = PackageInfo kb nf ("haskell."++pkgTitle)
- Nothing (Just "postinstall")
+ Nothing pf
writePackageInfo infoPath pinfo
View
2  Program/Options.hs
@@ -77,7 +77,7 @@ data Options = Options {
defaultOptions :: Options
defaultOptions = Options {
- installPrefix = Just "/"
+ installPrefix = Just "/usr/local"
, showUsage = False
, packageMakerPath = Just "/Developer/usr/bin/packagemaker"
, packageOutputDir = Nothing
Please sign in to comment.
Something went wrong with that request. Please try again.