----------------------------------------------------------------------------- -- | -- 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.Hs2lib 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 = call session -- This needs to check for OS bit, in windows x64 there is only one calling convention let adj = strReplace "%callconv" (map toLower (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