Installer.hs

{-
    System.Installer : Installer wrapper for Haskell applications
    Copyright (C) 2007  Matthew Sackman

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
    USA
-}

-- | This module allows you to include any file into a module during
--   compilation. You can then write out the file at run time.
--
--   Expected use is via the Template Haskell splicing syntax. E.g.
--
-- @
--   $(installBinariesFunc \"installMyFiles\"
--     [(\"FileOne\", \"\/foo\/bar\/fileOne.txt\"),
--      (\"FileTwo\", \"\/foo\/bar\/fileTwo.txt\"),
--      (\"Three\",   \"\/foo\/baz\/thirdFile.qux\")
--     ])
-- @
--
--   This will cause an enumeration ADT to be defined as:
--
-- @
--   data Installer_installMyFiles =
--            Installer_installMyFiles_FileOne
--          | Installer_installMyFiles_FileTwo
--          | Installer_installMyFiles_Three
-- @
--
--    with instances for Enum, Eq, Ord and Show. The install for Show
--    will return the @fst@ element of the tuple in the list passed to
--    'installBinariesFunc'. A function called @installMyFiles@ will
--    also be defined of type
--    @Installer_installMyFiles -> FilePath -> IO ()@. Calling this
--    will cause the file content to be written out to the filepath.
--    If the filepath provided is a directory, then the file will be
--    created within that directory with the same name as the leaf of
--    the path in the @snd@ elem of the tuples passed to
--    'installBinariesFunc'.
--
--    Note that the files written out are not set executable so you
--    must correct file permissions yourself.
--
--    Also note that the current implementation includes the entire
--    file content as a String. This is horribly inefficient.
--    Consequently GHC may well stack overflow during compilation.
--    Set the stack bigger with @+RTS -K32M -RTS@. Compilation will
--    be /very/ slow, especially with any optimisations enabled.
module System.Installer 
    (installBinariesFunc
    )
    where

import System.Directory
import System.IO
import qualified System.Installer.TH as TH
import Language.Haskell.TH.Syntax

installBinariesFunc :: String -> [(String, FilePath)] -> Q [Dec]
installBinariesFunc funcName binaries
    = do { func <- TH.makeInstallFunc funcName clauses
         ; dataDecls <- TH.makeDataDecls funcName binaries
         ; return $ func : dataDecls
         }
    where
      clauses = map (loadAndMakeClause funcName) binaries

loadAndMakeClause :: String -> (String, FilePath) -> Q Clause
loadAndMakeClause funcName (name, bin)
    = do { contents <- runIO (loadBinary bin)
         ; TH.makeInstallFuncCase funcName name bin contents
         }

loadBinary :: FilePath -> IO String
loadBinary path
    = do { exists <- doesFileExist path
         ; case exists of
             True -> do { hdl <- openBinaryFile path ReadMode
                        ; contents <- hGetContents hdl
                        ; length contents `seq` return ()
                        ; hClose hdl
                        ; return contents
                        }
             False -> error $ "Unable to find file at " ++ path
         }