module Distribution.Simple.Dll (
    zEncode,
    rootLibraryModules, packageVersionedName,
    generateDllMain,

    defaultDll
    ) where

-- Local
-- Libraries
-- Standard
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate)
import Distribution.Simple.Setup
import Distribution.Simple.InstallDirs
import Distribution.PackageDescription

import Control.Monad
import System.Cmd
import System.Directory
import System.FilePath
import Data.Version
import Data.Maybe

-- Declaration

-- | Performs z-encoding.
zEncode :: String -> String

-- | Returns list of root modules, that must be exported.
rootLibraryModules :: Library -> [String]

-- | Returns versioned name of package.
packageVersionedName :: PackageDescription -> String

-- | Generates main dll module in C.
generateDllMain :: String -> [String] -> String

defaultDll :: IO ()

-- Implementation

zEncode "" = ""
zEncode (c:s) = z c ++ zEncode s where
    z '.' = "zi"
    z '-' = "zm"
    z '`' = "zq"
    z 'z' = "zz"
    z 'Z' = "ZZ"
    z x = [x]

rootLibraryModules = fromMaybe [] . fmap lines . lookup "x-export" . customFieldsBI . libBuildInfo

packageVersionedName pkg = case pkgName $ package pkg of
    PackageName nm -> nm ++ "-" ++ showVersion (pkgVersion (package pkg))

generateDllMain pkg modules = unlines $ [
    "#include <windows.h>",
    "#include <Rts.h>",
    ""] ++ map genFun funNames ++ [
    "",
    "static int argc = 1;",
    "static char * args[] = { \"ghcDll\", NULL };",
    "static char ** argv = args;",
    "",
    "BOOL __stdcall DllMain(HANDLE hModule, DWORD reason, void * reserved)",
    "{",
    "\tif (reason == DLL_PROCESS_ATTACH)",
    "\t{",
    "\t\ths_init(&argc, &argv);"] ++ map genAddRoot funNames ++ [
    "\t\treturn TRUE;",
    "\t}",
    "\telse if (reason == DLL_PROCESS_DETACH)",
    "\t{",
    "\t\ths_exit();",
    "\t}",
    "\treturn TRUE;",
    "}"] where
        funNames = map (("__stginit_" ++) . zEncode . ((pkg ++ "_") ++)) modules
        genFun name = "extern void " ++ name ++ "(void);"
        genAddRoot name = "\t\ths_add_root(" ++ name ++ ");"

defaultDll = defaultMainWithHooks (simpleUserHooks { postBuild = buildDll, postInst = instDll }) where
    buildDll _ _ pkg info = withLib pkg () (buildLib pkg info)
    instDll _ _ pkg info = withLib pkg () (instLib pkg info)

    buildLib pkg info pkgLib = do
        putStrLn "Building DLL..."
        setCurrentDirectory (buildDir info)
        let
            autogen = "autogen"
            dllmain = "dllmain"
            dllmainObj = autogen </> (dllmain ++ ".o")
            dllmainSrc = autogen </> (dllmain ++ ".c")

            buildCmd = unwords [cmd pkg info, dllmainObj]
            makeCmd = unwords [ghcExe info, "-c", dllmainSrc]

        writeFile dllmainSrc $ generateDllMain (packageVersionedName pkg) (rootLibraryModules pkgLib)
        putStrLn makeCmd
        system makeCmd
        putStrLn buildCmd
        system buildCmd
        let dll = dllFile pkg
        let lib = libFile pkg
        let buildPath = name pkg
        let cpCmd file = "copy " ++ file ++ " " ++ buildPath </> file
        putStrLn $ cpCmd dll
        putStrLn $ cpCmd lib
        doesDirectoryExist buildPath >>= flip when (createDirectory buildPath) . not
        mapM_ (system . cpCmd) [dll, lib]

    instLib pkg info _ = do
        putStrLn "Installing DLL..."
        setCurrentDirectory (buildDir info)
        let binPath = bindir $ installDirTemplates info
        let libPath = libdir $ installDirTemplates info
        let path = fromPathTemplate . substPathTemplate (fullPathTemplateEnv (packageId pkg) (compilerId $ compiler info) (fmap fromPathTemplate $ installDirTemplates info))
        let dll = dllFile pkg
        let lib = libFile pkg
        let cpCmd p file = "copy " ++ name pkg </> file ++ " " ++ path p </> file
        putStrLn $ cpCmd binPath dll
        putStrLn $ cpCmd libPath lib
        mapM_ (\d -> doesDirectoryExist d >>= flip when (createDirectory d) . not)
            [path binPath, path libPath]
        mapM_ (system . uncurry cpCmd) [(binPath, dll), (libPath, lib)]
    ghcExe :: LocalBuildInfo -> String
    ghcExe = compilerName . compilerId . compiler
    mainOFile :: PackageDescription -> String
    mainOFile pd = "HS" ++ name pd ++ "-" ++ showVersion (pkgVersion (package pd)) ++ ".o"
    cmd :: PackageDescription -> LocalBuildInfo -> String
    cmd pd i = ghcExe i ++ " -shared -o " ++ dllFile pd ++ " " ++ mainOFile pd ++ " " ++ packages i
    packages :: LocalBuildInfo -> String
    packages = foldl1 (\x y -> x ++ " " ++ y) . map showPackage . packageDeps
    compilerName :: CompilerId -> String
    compilerName (CompilerId flavor _) = show flavor
    showPackage :: PackageIdentifier -> String
    showPackage pi = "-package " ++ namePI pi
    namePI :: PackageIdentifier -> String
    namePI pi = case (pkgName pi) of
        PackageName nm -> nm
    name :: PackageDescription -> String
    name = namePI . package
    dllFile :: PackageDescription -> String
    dllFile pd = name pd ++ "-" ++ showVersion (pkgVersion (package pd)) ++ ".dll"
    libFile :: PackageDescription -> String
    libFile pd = name pd ++ "-" ++ showVersion (pkgVersion (package pd)) ++ ".dll.a"