Skip to content
Browse files

Split some code out into modules, uptick version number

  • Loading branch information...
1 parent 72bf8ea commit 9420adf3f619d66fd9c68272b4bbb0e82edf7761 @gregorycollins committed Apr 8, 2009
Showing with 448 additions and 419 deletions.
  1. +12 −418 Main.hs
  2. +196 −0 Program/MakePackage.hs
  3. +176 −0 Program/Options.hs
  4. +63 −0 Program/Util.hs
  5. +1 −1 cabal2macpkg.cabal
View
430 Main.hs
@@ -26,58 +26,26 @@
module Main (
-- * Program entry point
main
- , runMain
-
- -- * Command-line options
- , Options(..)
- , getOptions
- , optionFlags
- , usage
-
- -- * The \"heavy lifting\"
- , makeMacPkg
-
- -- * Misc. helper functions
- , cleanupTempDirectory
- , getTempDirectory
- , runCmd
+ , runMakePackage
) where
import Control.Exception
import Control.Monad
-import Data.Char
-import Data.Function
-import Data.List
-import Data.Maybe
-import Data.Monoid
-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 System.Directory
-import System.Environment (getArgs)
-import System.Exit
-import System.FilePath
import System.IO
-import System.Posix.User (getEffectiveUserName)
-import System.Process
-
-import Text.Regex
-
-import qualified System.Console.GetOpt as GetOpt
------------------------------------------------------------------------
-- local imports
-import Distribution.OSX.Info
-
+import Program.MakePackage
+import Program.Options
+import Program.Util
------------------------------------------------------------------------
-- | Program entry point. Parses command line options, creates a
@@ -89,395 +57,21 @@ main = do
opts <- getOptions
bracket getTempDirectory
cleanupTempDirectory
- (runMain opts)
+ (runMakePackage opts)
------------------------------------------------------------------------
--- | The guts of the program. Given the command-line options and a
--- temp directory path, searches the current working directory for a
--- .cabal file and builds an OSX package file based on its contents.
+-- | The program driver. Given the command-line options and a temp
+-- directory path, searches the current working directory for a .cabal
+-- file and builds an OSX package file based on its contents.
------------------------------------------------------------------------
-runMain :: Options -- ^ command-line options
- -> FilePath -- ^ temp directory path
- -> IO ()
-runMain opts tmpdir = do
+runMakePackage :: Options -- ^ command-line options
+ -> FilePath -- ^ temp directory path
+ -> IO ()
+runMakePackage opts tmpdir = do
cabalFile <- findPackageDesc "."
pkgDesc <- flattenPackageDescription `liftM`
readPackageDescription Verbosity.normal cabalFile
makeMacPkg opts tmpdir pkgDesc
-
-
-
-------------------------------------------------------------------------
--- program options
-------------------------------------------------------------------------
-
-------------------------------------------------------------------------
--- | A monoid instance for the command-line options allows us to build
--- up the options object from parts, i.e.:
--- @
--- a \``mappend`\` b
--- @
--- will build an Options object where the fields of @a@ are overridden
--- by the non-'Nothing' fields of @b@
-data Options = Options {
- installPrefix :: Maybe String -- ^ the installation prefix
- -- for the generated library
-
- , packageMakerPath :: Maybe String -- ^ path to the OSX
- -- packagemaker binary (we'll
- -- choose a sane default
- -- here)
-
- , showUsage :: Bool -- ^ if true, show the usage
- -- message, either because
- -- the user requested it or
- -- because of an error
- -- parsing the command line
- -- arguments
-
- , packageOutputDir :: Maybe String -- ^ output dir for generated
- -- .pkg file
-
- , packageOutputFile :: Maybe String -- ^ output filename for
- -- generated .pkg file -- if
- -- specified overrides
- -- packageOutputDir
-
- } deriving (Eq, Show)
-
-
-defaultOptions :: Options
-defaultOptions = Options { installPrefix = Just "/"
- , showUsage = False
- , packageMakerPath = Just "/Developer/usr/bin/packagemaker"
- , packageOutputDir = Nothing
- , packageOutputFile = Nothing
- }
-
-instance Monoid Options where
- mempty = Options { installPrefix = Nothing
- , showUsage = False
- , packageMakerPath = Nothing
- , packageOutputDir = Nothing
- , packageOutputFile = Nothing
- }
-
- a `mappend` b =
- Options {
- installPrefix = override installPrefix
- , packageMakerPath = override packageMakerPath
- , packageOutputDir = override packageOutputDir
- , packageOutputFile = override packageOutputFile
- , showUsage = showUsage a || showUsage b
- }
- where
- -- monoid append using "Last" behaviour
- (*+*) :: Maybe a -> Maybe a -> Maybe a
- (*+*) = (getLast .) . (mappend `on` Last)
-
- override f = f a *+* f b
-
-
-------------------------------------------------------------------------
--- | list of the option flags we accept (for GetOpt)
-optionFlags :: [GetOpt.OptDescr Options]
-optionFlags = [ GetOpt.Option
- "h"
- ["help"]
- (GetOpt.NoArg $ mempty {showUsage=True})
- "prints usage statement"
-
- , GetOpt.Option
- ""
- ["prefix"]
- (GetOpt.OptArg mkPrefix "DIR")
- "installation prefix directory"
-
- , GetOpt.Option
- "d"
- ["outdir"]
- (GetOpt.OptArg mkOutputDir "DIR")
- "output install package to the given directory (default \".\")"
-
- , GetOpt.Option
- "o"
- ["output"]
- (GetOpt.OptArg mkOutputFile "FILE")
- "output install package to the given file"
- ]
-
- where
- mkPrefix :: Maybe String -> Options
- mkPrefix m = mempty { installPrefix = m }
-
- mkOutputDir :: Maybe String -> Options
- mkOutputDir m = mempty { packageOutputDir = m }
-
- mkOutputFile :: Maybe String -> Options
- mkOutputFile m = mempty { packageOutputFile = m }
-
-
-------------------------------------------------------------------------
--- | prints the usage statement
-usage :: [String] -- ^ list of error messages
- -> IO a
-usage errs = do
- putStrLn $ usageString header ++ errstr
- exitFailure
-
- where
- usageString :: String -> String
- usageString = flip GetOpt.usageInfo optionFlags
-
- preamble =
- "cabal2macpkg is a tool to create OSX installer packages\
- \ for cabal libraries"
-
- usageLine = "Usage: cabal2macpkg [OPTION..]"
-
- header = preamble ++ "\n\n" ++ usageLine
- ++ "\n" ++ (const '-' `map` usageLine) ++ "\n"
-
- errstr = if null errs then ""
- else '\n' : concat errs
-
-
-------------------------------------------------------------------------
--- | parses the command line arguments -- shows usage screen and bails
--- upon error
-getOptions :: IO Options
-getOptions = do
- args <- getArgs
- opts <-
- case GetOpt.getOpt GetOpt.RequireOrder optionFlags args of
- (o,_,[]) -> return $ defaultOptions `mappend` mconcat o
- (_,_,errs) -> usage errs
-
- if showUsage opts
- then usage []
- else return opts
-
-------------------------------------------------------------------------
--- end options stuff
-------------------------------------------------------------------------
-
-
-------------------------------------------------------------------------
--- "the guts"
-------------------------------------------------------------------------
-
-------------------------------------------------------------------------
--- | the 'makeMacPkg' function does (or will do) all of the dirty work
--- of building the .pkg files
-makeMacPkg :: Options -- ^ command-line options
- -> FilePath -- ^ path to temp directory
- -> PackageDescription -- ^ a parsed .cabal file
- -> IO ()
-makeMacPkg opts tmpdir pkgDesc = do
- -- some portions of package building process require root
- -- privileges
-
- checkRootPrivileges
-
-
- createDirectories
-
- --------------------------------------------------------------------
- buildPackageContents
- setRootPrivileges
- mkInfoFiles
- runPackageMaker
-
- where
- --------------------------------------------------------------------
- -- variables
- --------------------------------------------------------------------
-
- -- package metadata
- pkgDescription = synopsis pkgDesc
- pkgTitle = unPackageName . packageName $ pkgDesc
- pkgVersionString = showVersion . packageVersion $ pkgDesc
- pkgBaseName = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
-
- -- directories
- cabalBuildDir = tmpdir </> "dist"
- contentsDir = stagingDir </> "Contents"
- resourceDir = tmpdir </> "Resources"
- scriptsDir = tmpdir </> "Scripts"
- stagingDir = tmpdir </> "stage"
-
- -- config options
- packageMakerCmd = fromJust $ packageMakerPath opts
- prefix = fromJust $ installPrefix opts
-
- -- output files
- temporaryPkgConfig = tmpdir </> "temp.pkgconfig"
- infoPath = tmpdir </> "Info.plist"
- descInfoPath = resourceDir </> "Description.plist"
- postflightScriptFile = resourceDir </> "postflight"
-
-
- outputPackageDir = fromMaybe "." (packageOutputDir opts)
- computedPackageFile = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".pkg")
- outputPackagePath = fromMaybe (outputPackageDir </> computedPackageFile)
- (packageOutputFile opts)
-
-
- --------------------------------------------------------------------
- -- helper I/O actions
- --------------------------------------------------------------------
-
- --------------------------------------------------------------------
- -- checks that we're root and bails if not
- checkRootPrivileges :: IO ()
- checkRootPrivileges = do
- whoiam <- getEffectiveUserName
- when (whoiam /= "root") $ die "must be root to run cabal2macpkg"
-
-
- --------------------------------------------------------------------
- -- creates necessary directories inside the work area
- createDirectories =
- createDirectory `mapM_` [stagingDir, scriptsDir, resourceDir,
- contentsDir]
-
-
- --------------------------------------------------------------------
- -- uses cabal to build the package into the work area
- buildPackageContents = do
- runSetup "configure" ["--global", "--prefix=/usr/local"]
- runSetup "build" []
- runSetup "haddock" []
- runSetup "copy" ["--destdir=" ++ contentsDir]
- runSetup "register" ["--gen-pkg-config=" ++ temporaryPkgConfig]
-
- makePostFlightScriptFile temporaryPkgConfig postflightScriptFile
-
-
- --------------------------------------------------------------------
- -- FIXME: make this stuff relocatable
- makePostFlightScriptFile src dest = do
- contents <- readFile src
- let output = "#!/bin/sh\n\
- \echo '" ++ contents ++
- "' | /usr/bin/env ghc-pkg --global update -"
- writeFile dest output
-
-
- --------------------------------------------------------------------
- -- populate the package .info file in the resource directory
- mkInfoFiles :: IO ()
- mkInfoFiles = do
- writeFile infoPath (show pinfo)
- writeFile descInfoPath (show dpinfo)
- where
- pinfo = mkInfoPlist pkgBaseName
- pkgVersionString
- pkgDescription
- prefix
-
- dpinfo = mkDescriptionPlist pkgBaseName pkgVersionString
-
-
-
- --------------------------------------------------------------------
- -- make sure files are owned by root and have correct permissions
- setRootPrivileges :: IO ()
- setRootPrivileges = do
- runCmd "chmod" ["-R", "g+r,g-w,o+r,o-w", tmpdir]
- runCmd "chown" ["-R", "root:wheel", tmpdir]
- runCmd "sh" ["-c", "find " ++ tmpdir
- ++ " -print0 -type d | xargs -0 chmod a+x"]
-
-
- --------------------------------------------------------------------
- -- build the package
- runPackageMaker :: IO ()
- runPackageMaker = do
- putStrLn $ "building " ++ outputPackagePath
- hFlush stdout
-
- runCmd packageMakerCmd [ "-build"
- , "-p"
- , outputPackagePath
- , "-f"
- , contentsDir
- , "-ds"
- , "-r"
- , resourceDir
- , "-i"
- , infoPath
- , "-d"
- , descInfoPath ]
-
-
-
- --------------------------------------------------------------------
- -- helper functions
- --------------------------------------------------------------------
-
- -- | runs Setup.[l]hs with the given subcommand and arguments
- runSetup :: String -- ^ subcommand of Setup.hs,
- -- i.e. "configure"/"build"/etc
- -> [String] -- ^ additional arguments
- -> IO ()
- runSetup cmd args =
- runCmd "runghc" $ ["Setup", cmd] ++ mkOpts args
- where
- mkOpts s = s ++ ["--builddir=" ++ cabalBuildDir]
-
-
- unPackageName (PackageName s) = s
-
-
-------------------------------------------------------------------------
--- misc. useful functions
-------------------------------------------------------------------------
-
-
-------------------------------------------------------------------------
--- |
--- run a subprocess with the given arguments, ignoring the output. Die
--- if the program returns a nonzero status code
---
-runCmd :: String -- ^ command to run
- -> [String] -- ^ command arguments
- -> IO ()
-runCmd cmd args = do
- e <- rawSystem cmd args
- case e of ExitSuccess -> return ()
- ExitFailure _ -> die $ "command failed: "
- ++ cmd ++ " "
- ++ intercalate " " args
-
-
-
-------------------------------------------------------------------------
--- | grab a temporary directory. Produces the path to the new
--- directory.
---
-getTempDirectory :: IO FilePath
-getTempDirectory =
- do (ecode, out, err) <- readProcessWithExitCode
- "mktemp"
- ["-d", "-t", "cabal2macpkg"] []
-
- case ecode of
- ExitSuccess -> do
- let dir = makeValid (init out)
- return dir
- ExitFailure _ -> die $ "mktemp failed, saying '" ++ err ++ "'"
-
-
-
-------------------------------------------------------------------------
--- | cleans up a temporary directory
---
-cleanupTempDirectory :: FilePath
- -> IO ()
-cleanupTempDirectory = removeDirectoryRecursive
-
-
View
196 Program/MakePackage.hs
@@ -0,0 +1,196 @@
+-- | This module contains routines for making mac .pkg files.
+------------------------------------------------------------------------
+module Program.MakePackage ( makeMacPkg ) where
+
+import Control.Monad
+
+import Data.Char
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.Version
+
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.Simple.Utils hiding (intercalate)
+
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Posix.User (getEffectiveUserName)
+
+import Text.Regex
+
+
+------------------------------------------------------------------------
+-- local imports
+import Distribution.OSX.Info
+import Program.Options
+import Program.Util
+
+
+------------------------------------------------------------------------
+-- "the guts"
+------------------------------------------------------------------------
+
+------------------------------------------------------------------------
+-- | the 'makeMacPkg' function does (or will do) all of the dirty work
+-- of building the .pkg files
+makeMacPkg :: Options -- ^ command-line options
+ -> FilePath -- ^ path to temp directory
+ -> PackageDescription -- ^ a parsed .cabal file
+ -> IO ()
+makeMacPkg opts tmpdir pkgDesc = do
+ -- some portions of package building process require root
+ -- privileges (thanks, Apple!)
+ checkRootPrivileges
+ createDirectories
+
+ --------------------------------------------------------------------
+ buildPackageContents
+ setRootPrivileges
+ mkInfoFiles
+ runPackageMaker
+
+ where
+ --------------------------------------------------------------------
+ -- variables
+ --------------------------------------------------------------------
+
+ -- package metadata
+ pkgDescription = synopsis pkgDesc
+ pkgTitle = unPackageName . packageName $ pkgDesc
+ pkgVersionString = showVersion . packageVersion $ pkgDesc
+ pkgBaseName = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
+
+ -- directories
+ cabalBuildDir = tmpdir </> "dist"
+ contentsDir = stagingDir </> "Contents"
+ resourceDir = tmpdir </> "Resources"
+ scriptsDir = tmpdir </> "Scripts"
+ stagingDir = tmpdir </> "stage"
+
+ -- config options
+ packageMakerCmd = fromJust $ packageMakerPath opts
+ prefix = fromJust $ installPrefix opts
+
+ -- output files
+ temporaryPkgConfig = tmpdir </> "temp.pkgconfig"
+ infoPath = tmpdir </> "Info.plist"
+ descInfoPath = resourceDir </> "Description.plist"
+ postflightScriptFile = resourceDir </> "postflight"
+
+
+ outputPackageDir = fromMaybe "." (packageOutputDir opts)
+ computedPackageFile = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".pkg")
+ outputPackagePath = fromMaybe (outputPackageDir </> computedPackageFile)
+ (packageOutputFile opts)
+
+
+ --------------------------------------------------------------------
+ -- helper I/O actions
+ --------------------------------------------------------------------
+
+ --------------------------------------------------------------------
+ -- checks that we're root and bails if not
+ checkRootPrivileges :: IO ()
+ checkRootPrivileges = do
+ whoiam <- getEffectiveUserName
+ when (whoiam /= "root") $ die "must be root to run cabal2macpkg"
+
+
+ --------------------------------------------------------------------
+ -- creates necessary directories inside the work area
+ createDirectories =
+ createDirectory `mapM_` [stagingDir, scriptsDir, resourceDir,
+ contentsDir]
+
+
+ --------------------------------------------------------------------
+ -- uses cabal to build the package into the work area
+ buildPackageContents = do
+ runSetup "configure" ["--global", "--prefix=/usr/local"]
+ runSetup "build" []
+ runSetup "haddock" []
+ runSetup "copy" ["--destdir=" ++ contentsDir]
+ runSetup "register" ["--gen-pkg-config=" ++ temporaryPkgConfig]
+
+ makePostFlightScriptFile temporaryPkgConfig postflightScriptFile
+
+
+ --------------------------------------------------------------------
+ -- FIXME: make this stuff relocatable
+ makePostFlightScriptFile src dest = do
+ contents <- readFile src
+ let output = "#!/bin/sh\n\
+ \echo '" ++ contents ++
+ "' | /usr/bin/env ghc-pkg --global update -"
+ writeFile dest output
+
+
+ --------------------------------------------------------------------
+ -- populate the package .info file in the resource directory
+ mkInfoFiles :: IO ()
+ mkInfoFiles = do
+ writeFile infoPath (show pinfo)
+ writeFile descInfoPath (show dpinfo)
+ where
+ pinfo = mkInfoPlist pkgBaseName
+ pkgVersionString
+ pkgDescription
+ prefix
+
+ dpinfo = mkDescriptionPlist pkgBaseName pkgVersionString
+
+
+
+ --------------------------------------------------------------------
+ -- make sure files are owned by root and have correct permissions
+ setRootPrivileges :: IO ()
+ setRootPrivileges = do
+ runCmd "chmod" ["-R", "g+r,g-w,o+r,o-w", tmpdir]
+ runCmd "chown" ["-R", "root:wheel", tmpdir]
+ runCmd "sh" ["-c", "find " ++ tmpdir
+ ++ " -print0 -type d | xargs -0 chmod a+x"]
+
+
+ --------------------------------------------------------------------
+ -- build the package
+ runPackageMaker :: IO ()
+ runPackageMaker = do
+ putStrLn $ "building " ++ outputPackagePath
+ hFlush stdout
+
+ runCmd packageMakerCmd [ "-build"
+ , "-p"
+ , outputPackagePath
+ , "-f"
+ , contentsDir
+ , "-ds"
+ , "-r"
+ , resourceDir
+ , "-i"
+ , infoPath
+ , "-d"
+ , descInfoPath ]
+
+
+
+ --------------------------------------------------------------------
+ -- helper functions
+ --------------------------------------------------------------------
+
+ -- | runs Setup.[l]hs with the given subcommand and arguments
+ runSetup :: String -- ^ subcommand of Setup.hs,
+ -- i.e. "configure"/"build"/etc
+ -> [String] -- ^ additional arguments
+ -> IO ()
+ runSetup cmd args =
+ runCmd "runghc" $ ["Setup", cmd] ++ mkOpts args
+ where
+ mkOpts s = s ++ ["--builddir=" ++ cabalBuildDir]
+
+
+ unPackageName (PackageName s) = s
+
+
View
176 Program/Options.hs
@@ -0,0 +1,176 @@
+-- | Datatypes for handling cabal2macpkg command-line options
+
+module Program.Options
+(
+ Options(..)
+ , getOptions
+ , optionFlags
+ , usage
+) where
+
+import Control.Monad
+
+import Data.Char
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.Monoid
+
+import System.Environment (getArgs)
+import System.Exit
+import System.IO
+
+import qualified System.Console.GetOpt as GetOpt
+
+
+------------------------------------------------------------------------
+-- program options
+------------------------------------------------------------------------
+
+------------------------------------------------------------------------
+-- | A monoid instance for the command-line options allows us to build
+-- up the options object from parts, i.e.:
+-- @
+-- a \``mappend`\` b
+-- @
+-- will build an Options object where the fields of @a@ are overridden
+-- by the non-'Nothing' fields of @b@
+data Options = Options {
+ installPrefix :: Maybe String -- ^ the installation prefix
+ -- for the generated library
+
+ , packageMakerPath :: Maybe String -- ^ path to the OSX
+ -- packagemaker binary (we'll
+ -- choose a sane default
+ -- here)
+
+ , showUsage :: Bool -- ^ if true, show the usage
+ -- message, either because
+ -- the user requested it or
+ -- because of an error
+ -- parsing the command line
+ -- arguments
+
+ , packageOutputDir :: Maybe String -- ^ output dir for generated
+ -- .pkg file
+
+ , packageOutputFile :: Maybe String -- ^ output filename for
+ -- generated .pkg file -- if
+ -- specified overrides
+ -- packageOutputDir
+
+ } deriving (Eq, Show)
+
+
+defaultOptions :: Options
+defaultOptions = Options { installPrefix = Just "/"
+ , showUsage = False
+ , packageMakerPath = Just "/Developer/usr/bin/packagemaker"
+ , packageOutputDir = Nothing
+ , packageOutputFile = Nothing
+ }
+
+instance Monoid Options where
+ mempty = Options { installPrefix = Nothing
+ , showUsage = False
+ , packageMakerPath = Nothing
+ , packageOutputDir = Nothing
+ , packageOutputFile = Nothing
+ }
+
+ a `mappend` b =
+ Options {
+ installPrefix = override installPrefix
+ , packageMakerPath = override packageMakerPath
+ , packageOutputDir = override packageOutputDir
+ , packageOutputFile = override packageOutputFile
+ , showUsage = showUsage a || showUsage b
+ }
+ where
+ -- monoid append using "Last" behaviour
+ (*+*) :: Maybe a -> Maybe a -> Maybe a
+ (*+*) = (getLast .) . (mappend `on` Last)
+
+ override f = f a *+* f b
+
+
+------------------------------------------------------------------------
+-- | list of the option flags we accept (for GetOpt)
+optionFlags :: [GetOpt.OptDescr Options]
+optionFlags = [ GetOpt.Option
+ "h"
+ ["help"]
+ (GetOpt.NoArg $ mempty {showUsage=True})
+ "prints usage statement"
+
+ , GetOpt.Option
+ ""
+ ["prefix"]
+ (GetOpt.OptArg mkPrefix "DIR")
+ "installation prefix directory"
+
+ , GetOpt.Option
+ "d"
+ ["outdir"]
+ (GetOpt.OptArg mkOutputDir "DIR")
+ "output install package to the given directory (default \".\")"
+
+ , GetOpt.Option
+ "o"
+ ["output"]
+ (GetOpt.OptArg mkOutputFile "FILE")
+ "output install package to the given file"
+ ]
+
+ where
+ mkPrefix :: Maybe String -> Options
+ mkPrefix m = mempty { installPrefix = m }
+
+ mkOutputDir :: Maybe String -> Options
+ mkOutputDir m = mempty { packageOutputDir = m }
+
+ mkOutputFile :: Maybe String -> Options
+ mkOutputFile m = mempty { packageOutputFile = m }
+
+
+------------------------------------------------------------------------
+-- | prints the usage statement
+usage :: [String] -- ^ list of error messages
+ -> IO a
+usage errs = do
+ putStrLn $ usageString header ++ errstr
+ exitFailure
+
+ where
+ usageString :: String -> String
+ usageString = flip GetOpt.usageInfo optionFlags
+
+ preamble =
+ "cabal2macpkg is a tool to create OSX installer packages\
+ \ for cabal libraries"
+
+ usageLine = "Usage: cabal2macpkg [OPTION..]"
+
+ header = preamble ++ "\n\n" ++ usageLine
+ ++ "\n" ++ (const '-' `map` usageLine) ++ "\n"
+
+ errstr = if null errs then ""
+ else '\n' : concat errs
+
+
+------------------------------------------------------------------------
+-- | parses the command line arguments -- shows usage screen and bails
+-- upon error
+getOptions :: IO Options
+getOptions = do
+ args <- getArgs
+ opts <-
+ case GetOpt.getOpt GetOpt.RequireOrder optionFlags args of
+ (o,_,[]) -> return $ defaultOptions `mappend` mconcat o
+ (_,_,errs) -> usage errs
+
+ if showUsage opts
+ then usage []
+ else return opts
+
+
View
63 Program/Util.hs
@@ -0,0 +1,63 @@
+-- | Utility functions
+module Program.Util (runCmd, getTempDirectory, cleanupTempDirectory)
+where
+
+
+
+import Control.Monad
+
+import Data.Char
+import Data.Function
+import Data.List
+
+import Distribution.Simple.Utils hiding (intercalate)
+
+import System.Directory
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+
+
+
+------------------------------------------------------------------------
+-- |
+-- run a subprocess with the given arguments, ignoring the output. Die
+-- if the program returns a nonzero status code
+--
+runCmd :: String -- ^ command to run
+ -> [String] -- ^ command arguments
+ -> IO ()
+runCmd cmd args = do
+ e <- rawSystem cmd args
+ case e of ExitSuccess -> return ()
+ ExitFailure _ -> die $ "command failed: "
+ ++ cmd ++ " "
+ ++ intercalate " " args
+
+
+
+------------------------------------------------------------------------
+-- | grab a temporary directory. Produces the path to the new
+-- directory.
+--
+getTempDirectory :: IO FilePath
+getTempDirectory =
+ do (ecode, out, err) <- readProcessWithExitCode
+ "mktemp"
+ ["-d", "-t", "cabal2macpkg"] []
+
+ case ecode of
+ ExitSuccess -> do
+ let dir = makeValid (init out)
+ return dir
+ ExitFailure _ -> die $ "mktemp failed, saying '" ++ err ++ "'"
+
+
+
+------------------------------------------------------------------------
+-- | cleans up a temporary directory
+--
+cleanupTempDirectory :: FilePath
+ -> IO ()
+cleanupTempDirectory = removeDirectoryRecursive
View
2 cabal2macpkg.cabal
@@ -1,5 +1,5 @@
name: cabal2macpkg
-version: 0.1
+version: 0.2
homepage: http://gregorycollins.net/
synopsis: Create OSX installation packages from Cabal packages
description: Create OSX installation packages from Cabal packages

0 comments on commit 9420adf

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