Hs2lib-0.4.8: WinDll/EntryPoint.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module contains the code to generate the main entry point 'dllMain.c' 
-- for the dll to be compiled.
-- 
-- The file to be included is modular, where the following variables are supported
-- %callconv = the current calling convention
-- %name     = the library's name
-- 
-- See http:\/\/tdistler.com\/2007\/10\/05\/implementing-dllmain-in-a-linux-shared-library
-- and http:\/\/www.haskell.org\/ghc\/docs\/latest\/html\/users_guide\/ffi-ghc.html
-----------------------------------------------------------------------------

module WinDll.EntryPoint where

import WinDll.Session
import WinDll.Utils.Feedback
import WinDll.Builder

import Data.Char

import System.Directory
import System.FilePath
import Paths_Hs2lib

writeEntryPoint :: Component
writeEntryPoint = createComponent "dllmain.c" _self
 where _self :: Exec String
       _self = fmap (entrypoint.workingset) get

-- | Adjust sets the dllmain file based on the given filepath
setEntryPoint :: Exec ()
setEntryPoint =
 do inform _normal "Validating main file..."
    session <- get
    let _main  = dllmain session
        manual = if dllmanual session then ("no"++) else id
    let file'  = if null _main 
                    then "Templates" ++ pathSeparators ++ manual (
                         case (platform session) of
                            Windows -> "main.template-win.c"
                            Unix    -> "main.template-unix.c")
                    else _main
    file   <- liftIO $ getDataFileName file'
    exists <- liftIO $ doesFileExist file
    unless exists (die $ "The supplied file '" ++ file ++ "' does not exist." )
    put $ session { dllmain = file }

-- | Generate the required entry point and store it in the session
generateEntryPoint :: Exec ()
generateEntryPoint =
 do inform _normal "Discovering name for entry point..."
    -- Determine the entrypoint
    setEntryPoint
 
    session <- get
    let deps = (dependencies . workingset) session
    when (null deps) $ die "Dependencies are null. Please trace dependencies before calling this function" 
    
    let name = namespace session
    inform _detail ("Using '" ++ name ++ "' as main entry point.")
    
    inform _detail "replacing variable names in template with actual values..."
    file <- liftIO $ readFile (dllmain session)
    let callconv = case platform session of
                      Windows -> StdCall
                      _       -> call session
    let adj = strReplace "%callconv" (map toUpper (genCcall $ callconv)) 
            . strReplace "%name" name
            
    let newfile = adj file
    inform _detail ("Entrypoint:\n" ++ newfile)
            
    let wrkSet = (workingset session) { entrypoint = newfile }
    
    inform _detail "Working set updated, proceeding to next phase..."
    put $ session { workingset = wrkSet }
    
    inform _detail "EntryPoint succesfully generated..."
 
-- | A rather slow, but good enough way to replace all occurrences of a string with a string
strReplace :: String -> String -> String -> String
strReplace _   _     []           = []
strReplace var value input@(x:xs) = 
 case length input < length var of
    True -> input
    False -> let current = take (length var) input
             in if current == var 
                    then value ++ strReplace var value (drop (length var) input)
                    else x :  strReplace var value xs