Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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
Gregory Collins authored June 02, 2009
44  Distribution/OSX/InstallerScript.hs
@@ -17,13 +17,13 @@ import Text.XML.HXT.Arrow
17 17
 ------------------------------------------------------------------------
18 18
 
19 19
 data InstallerScript = InstallerScript {
20  
-      title        :: String
21  
-    , background   :: Maybe String
22  
-    , welcome      :: Maybe String
23  
-    , readme       :: Maybe String
24  
-    , license      :: Maybe String
25  
-    , conclusion   :: Maybe String
26  
-    , pkgFileNames :: [String]
  20
+      is_title        :: String
  21
+    , is_background   :: Maybe String
  22
+    , is_welcome      :: Maybe String
  23
+    , is_readme       :: Maybe String
  24
+    , is_license      :: Maybe String
  25
+    , is_conclusion   :: Maybe String
  26
+    , is_pkgFileNames :: [(String,Int)]
27 27
 }
28 28
 
29 29
 
@@ -36,7 +36,9 @@ installerScript :: String           -- ^ package title
36 36
                 -> Maybe String     -- ^ readme blurb
37 37
                 -> Maybe String     -- ^ license blurb
38 38
                 -> Maybe String     -- ^ conclusion blurb
39  
-                -> [String]         -- ^ list of .pkg files to include
  39
+                -> [(String,Int)]   -- ^ list of .pkg files to
  40
+                                    -- include, along with their
  41
+                                    -- installed sizes
40 42
                 -> InstallerScript
41 43
 installerScript = InstallerScript
42 44
 
@@ -90,7 +92,7 @@ blurbAttrs = [ sattr "language" "en"
90 92
 
91 93
 ------------------------------------------------------------------------
92 94
 blurb :: (ArrowXml a) => String -> String -> a n XmlTree
93  
-blurb tagName txt = mkelem tagName blurbAttrs [cdata txt]
  95
+blurb tagName s = mkelem tagName blurbAttrs [cdata s]
94 96
 
95 97
 
96 98
 ------------------------------------------------------------------------
@@ -131,9 +133,9 @@ mkChoicesOutline choiceIds =
131 133
 
132 134
 ------------------------------------------------------------------------
133 135
 mkChoice :: (ArrowXml a) => String -> String -> String -> a n XmlTree
134  
-mkChoice id title pkgref =
  136
+mkChoice iD title pkgref =
135 137
     mkelem "choice"
136  
-           [ sattr "id"            id
  138
+           [ sattr "id"            iD
137 139
            , sattr "title"         title
138 140
            , sattr "start_visible" "false" ]
139 141
            [ mkelem "pkg-ref" [sattr "id" pkgref] [] ]
@@ -141,13 +143,13 @@ mkChoice id title pkgref =
141 143
 
142 144
 ------------------------------------------------------------------------
143 145
 mkPkgRef :: (ArrowXml a) => String -> String -> [Char] -> a n XmlTree
144  
-mkPkgRef id installKBytes pkgFileName =
  146
+mkPkgRef iD installKBytes pkgFileName =
145 147
     mkelem "pkg-ref"
146  
-           [ sattr "id"            id
  148
+           [ sattr "id"            iD
147 149
            , sattr "installKBytes" installKBytes
148 150
            , sattr "version"       ""
149 151
            , sattr "auth"          "Root" ]
150  
-           [ txt $ "file:./Contents/Packages/" ++ pkgFileName ]
  152
+           [ txt $ "#" ++ pkgFileName ]
151 153
 
152 154
 
153 155
 ------------------------------------------------------------------------
@@ -162,21 +164,21 @@ installerScriptHead body =
162 164
 mkInstallerScript :: (ArrowXml a) => InstallerScript -> a n XmlTree
163 165
 mkInstallerScript is =
164 166
     installerScriptHead $ concat [
165  
-                              [ mkTitle (title is) ]
  167
+                              [ mkTitle (is_title is) ]
166 168
                             , catMaybes [
167  
-                                  (welcome is)    >>= Just . mkWelcome
168  
-                                , (readme is)     >>= Just . mkReadme
169  
-                                , (license is)    >>= Just . mkLicense
170  
-                                , (conclusion is) >>= Just . mkConclusion ]
  169
+                                  (is_welcome is)    >>= Just . mkWelcome
  170
+                                , (is_readme is)     >>= Just . mkReadme
  171
+                                , (is_license is)    >>= Just . mkLicense
  172
+                                , (is_conclusion is) >>= Just . mkConclusion ]
171 173
                             , [ choicesOutline ]
172 174
                             , choices
173 175
                             , pkgRefs ]
174 176
   where
175  
-    pkgFiles       = pkgFileNames is
  177
+    pkgFiles       = is_pkgFileNames is
176 178
     n              = length pkgFiles
177 179
     choiceIds      = [ "choice" ++ (show i) | i <- [0..(n-1)] ]
178 180
     pkgRefIds      = [ "pkg"    ++ (show i) | i <- [0..(n-1)] ]
179 181
     choicesOutline = mkChoicesOutline choiceIds
180 182
     choices        = map (\(x,y) -> mkChoice x x y) (choiceIds `zip` pkgRefIds)
181 183
     -- FIXME: installKBytes should not be "0"!
182  
-    pkgRefs        = map (\(x,y) -> mkPkgRef x "0" y) (pkgRefIds `zip` pkgFiles)
  184
+    pkgRefs        = map (\(x,(f,sz)) -> mkPkgRef x (show sz) f) (pkgRefIds `zip` pkgFiles)
3  Main.hs
@@ -52,7 +52,8 @@ main :: IO ()
52 52
 main = do
53 53
   opts <- getOptions
54 54
   bracket getTempDirectory
55  
-          cleanupTempDirectory
  55
+          --cleanupTempDirectory
  56
+          (const $ return ())
56 57
           (runMain opts)
57 58
 
58 59
 
145  Program/MakeMetaPackage.hs
... ...
@@ -1,46 +1,41 @@
1 1
 {-# LANGUAGE BangPatterns #-}
2 2
 
3  
--- | This module contains routines for making a mac .mpkg file from a
4  
--- .cabal file's dependencies. Note that for right now (until this
5  
--- program develops further) the intention is to do just enough to be
6  
--- able to build an installer for the Haskell Platform
  3
+-- | This module contains routines for making a mac distribution file
  4
+-- from a .cabal file's dependencies. Note that for right now (until
  5
+-- this program develops further) the intention is to do just enough
  6
+-- to be able to build an installer for the Haskell Platform
7 7
 ------------------------------------------------------------------------
8 8
 
9 9
 module Program.MakeMetaPackage (runMakeMetaPkg)
10 10
 where
11 11
 
12  
-import Control.Exception
13  
-import Control.Monad
14  
-
15  
-import Data.Maybe
16  
-import Data.Version
17  
-
18  
-import Distribution.Package
19  
-import Distribution.PackageDescription
20  
-import Distribution.PackageDescription.Configuration
21  
-import Distribution.PackageDescription.Parse
22  
-import Distribution.Simple.Utils hiding (intercalate)
23  
-import Distribution.Verbosity as Verbosity
24  
-import Distribution.Version
25  
-
26  
-import System.Directory
27  
-import System.Environment
28  
-import System.FilePath
29  
-import System.FilePath.Glob
30  
-import System.IO
31  
-
  12
+import           Control.Exception
  13
+import           Control.Monad
32 14
 import qualified Data.ByteString.Lazy as B
33  
-
34  
-import Text.Regex
35  
-
  15
+import           Data.Maybe
  16
+import           Data.Version
  17
+import           Distribution.Package
  18
+import           Distribution.PackageDescription
  19
+import           Distribution.PackageDescription.Configuration
  20
+import           Distribution.PackageDescription.Parse
  21
+import           Distribution.Simple.Utils hiding (intercalate)
  22
+import           Distribution.Verbosity as Verbosity
  23
+import           Distribution.Version
  24
+import           System.Directory
  25
+import           System.Environment
  26
+import           System.FilePath
  27
+import           System.FilePath.Glob
  28
+import           System.IO
  29
+import           Text.Printf
  30
+import           Text.Regex
36 31
 
37 32
 ------------------------------------------------------------------------
38 33
 -- local imports
39 34
 ------------------------------------------------------------------------
40  
-import Distribution.OSX.InstallerScript
41  
-import Program.MakePackage
42  
-import Program.Options
43  
-import Program.Util
  35
+import           Distribution.OSX.InstallerScript
  36
+import           Program.MakePackage
  37
+import           Program.Options
  38
+import           Program.Util
44 39
 
45 40
 
46 41
 ------------------------------------------------------------------------
@@ -57,7 +52,7 @@ checkDependenciesHaveExactVersions d =
57 52
 
58 53
 
59 54
 ------------------------------------------------------------------------
60  
--- | Builds an OSX .mpkg based on a .cabal file
  55
+-- | Builds an OSX distribution based on a .cabal file
61 56
 makeMacMetaPkg :: Options             -- ^ command-line options
62 57
                -> FilePath            -- ^ path to temp directory
63 58
                -> PackageDescription  -- ^ a parsed .cabal file
@@ -69,17 +64,16 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
69 64
 
70 65
     outputPackageDir  <- makeAndCanonicalize $ fromMaybe cwd (packageOutputDir opts)
71 66
     outputPackagePath <- makeAndCanonicalize $
72  
-                         fromMaybe (outputPackageDir </> computedPackageName)
  67
+                         fromMaybe (outputPackageDir </> computedPackageFileName)
73 68
                                    (packageOutputFile opts)
74 69
 
75  
-    contentsDir       <- makeAndCanonicalize $ outputPackagePath </> "Contents"
76  
-    packagesDir       <- makeAndCanonicalize $ contentsDir </> "Packages"
  70
+    contentsDir       <- makeAndCanonicalize $ tmpdir </> "Stage"
  71
+    packagesDir       <- makeAndCanonicalize $ tmpdir </> "Packages"
77 72
 
78 73
     let subOptions = opts { packageOutputDir  = Just packagesDir
79 74
                           , packageOutputFile = Nothing }
80 75
 
81  
-    (createDirectoryIfMissing True) `mapM_` [ outputPackagePath
82  
-                                            , contentsDir
  76
+    (createDirectoryIfMissing True) `mapM_` [ contentsDir
83 77
                                             , packagesDir ]
84 78
 
85 79
     mapM_ (buildOne subOptions) packagesToFetch
@@ -91,18 +85,31 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
91 85
         maybe (return [])
92 86
               (\x -> do
93 87
                  files <- globPackages x
94  
-                 mapM_ (copyTo outputPackagePath) files
  88
+                 mapM_ (copyTo packagesDir) files
95 89
                  return (takeFileName `map` files))
96 90
               (extraPkgDir opts)
97 91
 
98  
-    writeInstallerScript (contentsDir </> "distribution.dist") $
  92
+
  93
+    let allPackages = extraPackages ++ packageFileNames
  94
+
  95
+    -- FIXME: sizes bogus
  96
+    sizes <- mapM (unXarToStaging packagesDir contentsDir) allPackages
  97
+
  98
+    -- write any Resources/ files (likely none), dump out
  99
+    -- "Distribution" file, and xar up the results
  100
+
  101
+    -- FIXME: Resources/ (for background images)
  102
+
  103
+    writeInstallerScript (contentsDir </> "Distribution") $
99 104
       installerScript pkgTitle
100 105
                       Nothing   -- FIXME: populate these
101 106
                       Nothing
102 107
                       (Just pkgDescription)
103 108
                       Nothing
104 109
                       Nothing
105  
-                      (extraPackages ++ packageFileNames)
  110
+                      (allPackages `zip` sizes)
  111
+
  112
+    xarUpResults contentsDir outputPackagePath
106 113
 
107 114
   where
108 115
     --------------------------------------------------------------------
@@ -118,7 +125,7 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
118 125
     pkgBaseName          = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
119 126
 
120 127
     --------------------------------------------------------------------
121  
-    computedPackageName  = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".mpkg")
  128
+    computedPackageFileName = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".pkg")
122 129
 
123 130
     deps = executableDeps opts ++ buildDepends pkgDesc
124 131
 
@@ -138,14 +145,51 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
138 145
 
139 146
 
140 147
     --------------------------------------------------------------------
141  
-    cabalFetch (pkgName,pkgVersion) = do
  148
+    -- Actions
  149
+    --------------------------------------------------------------------
  150
+    unXarToStaging :: FilePath -> FilePath -> FilePath -> IO Int
  151
+    unXarToStaging pkgPath outDir pkgFile = do
  152
+        bracket
  153
+          getCurrentDirectory
  154
+          setCurrentDirectory
  155
+          (\_ -> do
  156
+             setCurrentDirectory outDir
  157
+
  158
+             let srcFile = pkgPath </> pkgFile
  159
+             let destDir = outDir </> pkgFile
  160
+
  161
+             createDirectoryIfMissing True $ destDir
  162
+             setCurrentDirectory $ destDir
  163
+
  164
+             putStrLn $ printf "un-xaring '%s' to '%s'..." srcFile destDir
  165
+             putStrLn $ "------------------------------------------------------------------------"
  166
+             hFlush stdout
  167
+                              
  168
+             runCmd "xar" ["-xvf", srcFile]
  169
+             -- FIXME: parse PackageInfo
  170
+             return 0)
  171
+
  172
+
  173
+    --------------------------------------------------------------------
  174
+    xarUpResults :: FilePath -> FilePath -> IO ()
  175
+    xarUpResults staging outputFileName = do
  176
+        bracket
  177
+          getCurrentDirectory
  178
+          setCurrentDirectory
  179
+          (\_ -> do
  180
+             setCurrentDirectory staging
  181
+             runCmd "xar" ["-cvf", outputFileName, "."])
  182
+
  183
+
  184
+    --------------------------------------------------------------------
  185
+    cabalFetch (name,vers) = do
142 186
       -- FIXME: change this when cabal fetch takes an -o argument
143 187
       home <- getEnv "HOME"
144 188
 
145  
-      let pkgbase = pkgName ++ "-" ++ pkgVersion
  189
+      let pkgbase = name ++ "-" ++ vers
146 190
       let pkg     = pkgbase  ++ ".tar.gz"
147 191
       let pkgloc  = home </> ".cabal/packages/hackage.haskell.org/"
148  
-                         </> pkgName </> pkgVersion </> pkg
  192
+                         </> name </> vers </> pkg
149 193
 
150 194
       runCmd "cabal" ["fetch", pkgbase]
151 195
       fe <- doesFileExist pkgloc
@@ -158,9 +202,9 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
158 202
 
159 203
 
160 204
     --------------------------------------------------------------------
161  
-    buildOne opts (pkgName,pkgVersion) = do
  205
+    buildOne opt (name,vers) = do
162 206
       putStrLn $ "\n" ++ (replicate 72 '-')
163  
-      putStrLn $ "Making " ++ pkgName ++ "-" ++ pkgVersion
  207
+      putStrLn $ "Making " ++ name ++ "-" ++ vers
164 208
       putStrLn $ replicate 72 '-'
165 209
       hFlush   stdout
166 210
 
@@ -174,8 +218,8 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
174 218
 
175 219
             let workdir = td </> "work"
176 220
             createDirectoryIfMissing True workdir
177  
-            cabalFetch (pkgName,pkgVersion)
178  
-            runMakePackage opts workdir
  221
+            cabalFetch (name,vers)
  222
+            runMakePackage opt workdir
179 223
             )
180 224
 
181 225
     --------------------------------------------------------------------
@@ -186,9 +230,9 @@ makeMacMetaPkg opts tmpdir pkgDesc = do
186 230
 
187 231
 
188 232
 ------------------------------------------------------------------------
189  
--- | globs a directory for .pkg and .mpkg files
  233
+-- | globs a directory for .pkg files
190 234
 globPackages :: FilePath -> IO [FilePath]
191  
-globPackages dir = namesMatching `mapM` ((dir </>) `map` ["*.pkg", "*.mpkg"])
  235
+globPackages dir = namesMatching `mapM` ((dir </>) `map` ["*.pkg"])
192 236
                      >>= return . concat
193 237
 
194 238
 
@@ -217,4 +261,5 @@ runMakeMetaPkg opts tmpdir = do
217 261
 
218 262
 
219 263
 
  264
+makeAndCanonicalize :: FilePath -> IO FilePath
220 265
 makeAndCanonicalize fp = createDirectoryIfMissing True fp >> canonicalizePath fp
20  Program/MakePackage.hs
@@ -65,9 +65,9 @@ makeMacPkg opts tmpdir pkgDesc = do
65 65
     createDirectories
66 66
 
67 67
     --------------------------------------------------------------------
68  
-    buildPackageContents
  68
+    hasPostFlight <- buildPackageContents
69 69
     setRootPrivileges
70  
-    mkInfoFiles
  70
+    mkInfoFiles hasPostFlight
71 71
     runPackageMaker
72 72
 
73 73
   where
@@ -132,23 +132,27 @@ makeMacPkg opts tmpdir pkgDesc = do
132 132
     makePostFlightScriptFile src dest = do
133 133
         fe <- doesFileExist src
134 134
         if not fe then
135  
-            return ()
  135
+            return False
136 136
           else do
137 137
             contents <- readFile src
138 138
             let output = "#!/bin/sh\n\
139  
-                         \echo '" ++ contents ++ 
140  
-                          "' | /usr/bin/env ghc-pkg --global update -"
  139
+                         \/usr/bin/ghc-pkg --global update - <<EOF\n"
  140
+                         ++ contents ++ "\nEOF\n"
141 141
             writeFile dest output
  142
+            return True
142 143
 
143 144
 
144 145
     --------------------------------------------------------------------
145 146
     -- populate the packageinfo file in the resource directory
146  
-    mkInfoFiles :: IO ()
147  
-    mkInfoFiles = do
  147
+    mkInfoFiles :: Bool -> IO ()
  148
+    mkInfoFiles hasPf = do
148 149
         nf <- getNumFiles contentsDir
149 150
         kb <- getFileSizesInKB contentsDir
  151
+
  152
+        let pf = if hasPf then Just "postflight" else Nothing
  153
+
150 154
         let pinfo = PackageInfo kb nf ("haskell."++pkgTitle)
151  
-                                Nothing (Just "postinstall")
  155
+                                Nothing pf
152 156
 
153 157
         writePackageInfo infoPath pinfo
154 158
 
2  Program/Options.hs
@@ -77,7 +77,7 @@ data Options = Options {
77 77
 
78 78
 defaultOptions :: Options
79 79
 defaultOptions = Options {
80  
-    installPrefix          = Just "/"
  80
+    installPrefix          = Just "/usr/local"
81 81
   , showUsage              = False
82 82
   , packageMakerPath       = Just "/Developer/usr/bin/packagemaker"
83 83
   , packageOutputDir       = Nothing

0 notes on commit 5cc4579

Please sign in to comment.
Something went wrong with that request. Please try again.