----------------------------------------------------------------------------- -- | -- Module : MakeBundle.Main -- Copyright : (c) 2008 Thomas Davie (Anygma, www.anygma.com) -- License : GPL -- -- Maintainer : tom.davie@gmail.org -- Stability : provisional -- Portability : portable -- -- Constructs a Mac OS X .app bundle from a particular application binary. -- Includes options to include icon files, and finder get info strings etc. -- ----------------------------------------------------------------------------- module Main where import qualified System (getArgs) import System.Directory import System.FilePath import Char (toUpper) import Data.List (isPrefixOf) import MakeBundle (makeBundle,generateBundle,Options(..)) -- |Major Version Number majV :: Integral a => a majV = 0 -- |Minor Version Number minV :: Integral a => a minV = 2 main :: IO () main = do args <- System.getArgs pwd <- getCurrentDirectory let as = parseArgs pwd args if binary as == "" then putStr usage else do checkBinaryFile as checkIconFile as checkOutputFile as makeBundle pwd (generateBundle as) -- | Produce an arguments record from a list of string options passed to the -- program. parseArgs :: FilePath -> [String] -> Options parseArgs pwd [] = defaultArgs pwd parseArgs pwd [(b:bin)] = (defaultArgs pwd){binary=pwd (b:bin),bundleName=(binName ++ ".app")} where binName = (toUpper b) : bin parseArgs pwd ("-f":xs) = (parseArgs pwd xs){force=True} parseArgs pwd ("-t":x:xs) = (parseArgs pwd xs){bundleType=x} parseArgs pwd ("-c":x:xs) = (parseArgs pwd xs){creatorCode=x} parseArgs pwd ("-ic":x:xs) = (parseArgs pwd xs){icon=Just x} parseArgs pwd ("-is":x:xs) = (parseArgs pwd xs){getInfoString=x} parseArgs pwd ("-majv":x:xs) = (parseArgs pwd xs){majorVersion=read x} parseArgs pwd ("-minv":x:xs) = (parseArgs pwd xs){minorVersion=read x} parseArgs pwd ("-rev":x:xs) = (parseArgs pwd xs){revisionVersion=read x} parseArgs pwd ("-longv":x:xs) = (parseArgs pwd xs){extraVersionString=x} parseArgs pwd ("-build":x:xs) = (parseArgs pwd xs){buildNumber=Just (read x)} parseArgs pwd ("-id":x:xs) = (parseArgs pwd xs){bundleIdentifier=x} parseArgs pwd ("-r":xs) = opts{resources=resources opts ++ res} where (res,opts) = collectArgumentList pwd xs parseArgs pwd ("-fw":xs) = opts{frameworks=frameworks opts ++ fws} where (fws,opts) = collectArgumentList pwd xs -- Ignore unknown agruments parseArgs pwd (x:xs) = parseArgs pwd xs -- | Default argument set defaultArgs :: FilePath -> Options defaultArgs pwd = (Opts {binary="", icon=Nothing, getInfoString="" ,majorVersion=0,minorVersion=0,revisionVersion=0 ,extraVersionString = "",buildNumber = Nothing ,bundleName="",bundleType="APPL",creatorCode="????" ,bundlePath=pwd,bundleIdentifier="com.none.none" ,force=False,resources=[],frameworks=[]}) {- | Collect a list of arguments bound to the same flag. This collects all arguments that do not start with a '-' character Examples: collectArgumentList ["jam", "ham", "-id", "com.doom.doom"] -- collects "jam" and "ham" collectArgumentList [] -- collects no arguments at all collectArgumentList ["myBinary"] -- collects nothing at all -} collectArgumentList :: FilePath -> [String] -> ([String], Options) collectArgumentList pwd [] = ([],parseArgs pwd []) collectArgumentList pwd [x] = ([],parseArgs pwd [x]) collectArgumentList pwd (x:xs) | "-" `isPrefixOf` x = ([],parseArgs pwd (x:xs)) | otherwise = let (is,opts) = collectArgumentList pwd xs in (x:is,opts) -- |Generate a usage string usage :: String usage = unlines ["Make Bundle Version " ++ (show majV) ++ "." ++ (show minV) ,"Usage: mkbndl options binary" ,"Available options:" ," -f Force creation of the bundle, even when overwriting files." ," -t Specify a 4 character bundle-type code, defaults to APPL." ," -c Specify a 4 character creator code, defaults to ????." ," -ic Specify an icon file for the bundle." ," -is Specify a get info string" ," -majv Specify the major version number of the application." ," -minv Specify the minor version number of the application." ," -rev Specify the revision number of the application." ," -longv Specify a long version string of the application." ," -build Specify a build number of the application" ," -id Specify a bundle identifier for the application" ," -r Specify a list of resources to copy into the bundle's Resources" ," folder." ," -fw Specify a list of frameworks to copy into the bundle's" ," Frameworks folder." ,"" ,"Example:" ," mkbndl -f -majv 3 -minv 1 -rev 1 -longv \"alpha 1\" -build 2697 \\" ," -id com.anygma.mkbndl -r images icons/* -f Mk.framework mkbndl" ," Creates a bundle called Mkbndl.app: the Resources folder will contain" ," images, and the contents of icons; the Frameworks folder will contain" ," Mk.framework; the MacOS folder will contain mkbndl. The application" ," will identify itself as com.anygma.mkbndl, version 3.1.1 alpha 1 (2697)"] -- |Checks if a given input file exists, and generates an appropriate error -- message if it is missing or a directory. checkInputFile :: FilePath -> IO () checkInputFile fp = do fe <- doesFileExist fp de <- doesDirectoryExist fp if fe then return () else if de then fail (fp ++ " is a directory.") else fail (fp ++ " does not exist.") -- |Checks if the binary exists. checkBinaryFile :: Options -> IO () checkBinaryFile as = checkInputFile (binary as) -- |Checks if the icon file exists. checkIconFile :: Options -> IO () checkIconFile as = case icon as of Nothing -> return () Just ic -> checkInputFile ic -- |Checks if we are going to overwrite the output directory, and if -f has -- been specified to allow us to do so. checkOutputFile :: Options -> IO () checkOutputFile as = do fe <- doesFileExist (bundleName as) de <- doesDirectoryExist (bundleName as) if (fe || de) && not (force as) then fail (bundleName as ++ " already exists. Use -f to force removal.") else if fe then removeFile (bundleName as) else if de then removeDirectoryRecursive (bundleName as) else return ()