-----------------------------------------------------------------------------
-- |
-- 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
    ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
    ,"<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\" \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">"
    ,"<plist version=\"1.0\">"
    ,"<dict>"
    ,"  <key>CFBundleDevelopmentRegion</key>"
    ,"  <string>English</string>"
    ,"  <key>CFBundleInfoDictionaryVersion</key>"
    ,"  <string>6.0</string>"]

-- |Standard footer for all info.plist files.
infoPlistFooter :: String
infoPlistFooter =
  unlines
    ["</dict>"
    ,"</plist>"]

-- |Constructs an info.plist dictionary entry, given a key and a value.
makeDictEntry :: String -> String -> String
makeDictEntry k v =
  concat
    ["  <key>", k, "</key>\n"
    ,"  <string>", v, "</string>"]

-- |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 ++ ")"