-----------------------------------------------------------------------------
-- |
-- Module : MakeBundle.MakeBundle
-- Copyright : (c) 2008 Thomas Davie (Anygma, www.anygma.com)
-- License : GPL
--
-- Maintainer : tom.davie@gmail.org
-- Stability : provisional
-- Portability : portable
--
-- Core functionality of MakeBundle.
--
-----------------------------------------------------------------------------
module MakeBundle (makeBundle,generateBundle,Options(..)) where
import System.Directory
import System.FilePath
-- |A record of the options required for creating the .app bundle.
data Options = Opts {binary :: String, icon :: Maybe String
,getInfoString :: String, majorVersion :: Int
,minorVersion :: Int, revisionVersion :: Int
,extraVersionString :: String, buildNumber :: Maybe Int
,bundleName :: String,bundleType :: String
,creatorCode :: String,bundlePath :: FilePath
,bundleIdentifier :: String,force :: Bool
,resources :: [String],frameworks :: [String]}
-- |Specifies the directory structure that MakeBundle should create.
data BundleSpec = Folder FilePath [BundleSpec]
| File FilePath String
| Copy FilePath FilePath
-- |Constructs a bundle at a file path, given a specification to follow.
-- Will error out if the directories already exist.
makeBundle :: FilePath -> BundleSpec -> IO ()
makeBundle pwd (Folder name contents) =
do createDirectory (pwd > name)
mapM (makeBundle (pwd > name)) contents
return ()
makeBundle pwd (File name contents) =
writeFile (pwd > name) contents
makeBundle pwd (Copy src dst) =
recursiveCopyDir src (pwd > dst)
recursiveCopyDir :: FilePath -> FilePath -> IO ()
recursiveCopyDir src dst =
do f <- doesFileExist src
if f
then copyFile src dst
else do createDirectory dst
dirContents <- getDirectoryContents src
mapM_ (\x -> recursiveCopyDir (src > x) (dst > x))
(map takeFileName (tail (tail dirContents)))
-- | Generates the directory structure needed for a standard .app bundle.
generateBundle :: Options -> BundleSpec
generateBundle os =
Folder (bundleName os)
[Folder "Contents"
[Folder "MacOS"
[Copy (binary os) (takeFileName $ binary os)]
,File "info.plist" (buildInfoPlist os)
,File "PkgInfo" (bundleType os ++ creatorCode os)
,Folder "Resources"
((case (icon os) of
Nothing -> []
Just ic -> [Copy ic (takeFileName ic)])
++ map (\x -> Copy x (takeFileName x)) (resources os))
,Folder "Frameworks"
(map (\x -> Copy x (takeFileName x)) (frameworks os))]]
-- |Generates an info.plist file specifying the contents of the application.
buildInfoPlist :: Options -> String
buildInfoPlist os =
unlines
[infoPlistHeader
,makeDictEntry "CFBundleExecutable" (takeFileName $ binary os)
,makeDictEntry "CFBundleGetInfoString" (getInfoString os)
,makeDictEntry "CFBundleIconFile" (case icon os of
Nothing -> (takeFileName $ binary os)
Just ic -> (takeFileName ic))
,makeDictEntry "CFBundleIdentifier" (bundleIdentifier os)
,makeDictEntry "CFBundleName" (takeFileName $ binary os)
,makeDictEntry "CFBundlePackageType" (bundleType os)
,makeDictEntry "CFBundleSignature" (creatorCode os)
,makeDictEntry "CFBundleShortVersionString" (shortVersionString os)
,makeDictEntry "CFBundleVersion" (versionString os)
,infoPlistFooter]
-- |Standard header for all info.plist files.
infoPlistHeader :: String
infoPlistHeader =
unlines
[""
,""
,""
,""
," CFBundleDevelopmentRegion"
," English"
," CFBundleInfoDictionaryVersion"
," 6.0"]
-- |Standard footer for all info.plist files.
infoPlistFooter :: String
infoPlistFooter =
unlines
[""
,""]
-- |Constructs an info.plist dictionary entry, given a key and a value.
makeDictEntry :: String -> String -> String
makeDictEntry k v =
concat
[" ", k, "\n"
," ", v, ""]
-- |Constructs a standard short version string from the major, minor and
-- revision versions.
shortVersionString :: Options -> String
shortVersionString os =
(show $ majorVersion os) ++ "." ++ (show $ minorVersion os) ++ "." ++ (show $ revisionVersion os)
-- |Constructs a full version string including extra build information.
versionString :: Options -> String
versionString os =
unwords [(shortVersionString os), extraVersionString os, buildNo]
where
buildNo = case buildNumber os of
Nothing -> ""
Just x -> "(" ++ show x ++ ")"