{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module FFICXX.Generate.Builder where

import           Control.Monad                           ( void, when )
import qualified Data.ByteString.Lazy.Char8        as L
import           Data.Char                               ( toUpper )
import           Data.Digest.Pure.MD5                    ( md5 )
import           Data.Foldable                           ( for_ )
import           Data.Monoid                             ( (<>), mempty )
import           Language.Haskell.Exts.Pretty            ( prettyPrint )
import           System.FilePath                         ( (</>), (<.>), splitExtension )
import           System.Directory                        ( copyFile
                                                         , createDirectoryIfMissing
                                                         , doesFileExist
                                                         )
import           System.IO                               ( hPutStrLn, withFile, IOMode(..) )
import           System.Process                          ( readProcess )
--
import           FFICXX.Runtime.CodeGen.Cxx              ( HeaderName(..) )
--
import           FFICXX.Generate.Code.Cabal              ( buildCabalFile
                                                         , buildJSONFile
                                                         )
import           FFICXX.Generate.Dependency              ( findModuleUnitImports
                                                         , mkHSBOOTCandidateList
                                                         , mkPackageConfig
                                                         )
import           FFICXX.Generate.Config                  ( FFICXXConfig(..)
                                                         , SimpleBuilderConfig(..)
                                                         )
import           FFICXX.Generate.ContentMaker
import           FFICXX.Generate.Type.Cabal              ( Cabal(..)
                                                         , CabalName(..)
                                                         , AddCInc(..)
                                                         , AddCSrc(..)
                                                         )
import           FFICXX.Generate.Type.Class              ( hasProxy )
import           FFICXX.Generate.Type.Module             ( ClassImportHeader(..)
                                                         , ClassModule(..)
                                                         , PackageConfig(..)
                                                         , TemplateClassModule(..)
                                                         , TopLevelImportHeader(..)
                                                         )
import           FFICXX.Generate.Util                    ( moduleDirFile )
--

macrofy :: String -> String
macrofy :: String -> String
macrofy = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map ((\Char
x->if Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-' then Char
'_' else Char
x) (Char -> Char) -> (Char -> Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper)


simpleBuilder :: FFICXXConfig -> SimpleBuilderConfig -> IO ()
simpleBuilder :: FFICXXConfig -> SimpleBuilderConfig -> IO ()
simpleBuilder FFICXXConfig
cfg SimpleBuilderConfig
sbc = do
  String -> IO ()
putStrLn String
"----------------------------------------------------"
  String -> IO ()
putStrLn String
"-- fficxx code generation for Haskell-C++ binding --"
  String -> IO ()
putStrLn String
"----------------------------------------------------"
  let SimpleBuilderConfig
        String
topLevelMod
        ModuleUnitMap
mumap
        Cabal
cabal
        [Class]
classes
        [TopLevel]
toplevelfunctions
        [TemplateClassImportHeader]
templates
        [String]
extralibs
        [(String, [String])]
extramods
        [String]
staticFiles
        = SimpleBuilderConfig
sbc
      pkgname :: CabalName
pkgname = Cabal -> CabalName
cabal_pkgname Cabal
cabal
  String -> IO ()
putStrLn (String
"Generating " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CabalName -> String
unCabalName CabalName
pkgname)
  let workingDir :: String
workingDir = FFICXXConfig -> String
fficxxconfig_workingDir FFICXXConfig
cfg
      installDir :: String
installDir = FFICXXConfig -> String
fficxxconfig_installBaseDir FFICXXConfig
cfg
      staticDir :: String
staticDir  = FFICXXConfig -> String
fficxxconfig_staticFileDir FFICXXConfig
cfg

      pkgconfig :: PackageConfig
pkgconfig@(PkgConfig [ClassModule]
mods [ClassImportHeader]
cihs TopLevelImportHeader
tih [TemplateClassModule]
tcms [TemplateClassImportHeader]
_tcihs [AddCInc]
_ [AddCSrc]
_) =
        (CabalName, ModuleUnit -> ModuleUnitImports)
-> ([Class], [TopLevel], [TemplateClassImportHeader],
    [(String, [String])])
-> [AddCInc]
-> [AddCSrc]
-> PackageConfig
mkPackageConfig
          (CabalName
pkgname, ModuleUnitMap -> ModuleUnit -> ModuleUnitImports
findModuleUnitImports ModuleUnitMap
mumap)
          ([Class]
classes, [TopLevel]
toplevelfunctions,[TemplateClassImportHeader]
templates,[(String, [String])]
extramods)
          (Cabal -> [AddCInc]
cabal_additional_c_incs Cabal
cabal)
          (Cabal -> [AddCSrc]
cabal_additional_c_srcs Cabal
cabal)
      hsbootlst :: [String]
hsbootlst = [ClassModule] -> [String]
mkHSBOOTCandidateList [ClassModule]
mods
      cabalFileName :: String
cabalFileName = CabalName -> String
unCabalName CabalName
pkgname String -> String -> String
<.> String
"cabal"
      jsonFileName :: String
jsonFileName = CabalName -> String
unCabalName CabalName
pkgname String -> String -> String
<.> String
"json"
  --
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
workingDir
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
installDir
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
installDir String -> String -> String
</> String
"src")
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
installDir String -> String -> String
</> String
"csrc")
  --
  String -> IO ()
putStrLn String
"Copying static files"
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
x->String -> String -> IO ()
copyFileWithMD5Check (String
staticDir String -> String -> String
</> String
x) (String
installDir String -> String -> String
</> String
x)) [String]
staticFiles
  --
  String -> IO ()
putStrLn String
"Generating Cabal file"
  Cabal -> String -> PackageConfig -> [String] -> String -> IO ()
buildCabalFile Cabal
cabal String
topLevelMod PackageConfig
pkgconfig [String]
extralibs (String
workingDirString -> String -> String
</>String
cabalFileName)
  --
  String -> IO ()
putStrLn String
"Generating JSON file"
  Cabal -> String -> PackageConfig -> [String] -> String -> IO ()
buildJSONFile Cabal
cabal String
topLevelMod PackageConfig
pkgconfig [String]
extralibs (String
workingDirString -> String -> String
</>String
jsonFileName)
  --
  String -> IO ()
putStrLn String
"Generating Header file"
  let
      gen :: FilePath -> String -> IO ()
      gen :: String -> String -> IO ()
gen String
file String
str =
        let path :: String
path = String
workingDir String -> String -> String
</> String
file in String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
WriteMode ((Handle -> String -> IO ()) -> String -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> String -> IO ()
hPutStrLn String
str)


  String -> String -> IO ()
gen (CabalName -> String
unCabalName CabalName
pkgname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Type.h") ([Class] -> String
buildTypeDeclHeader ((ClassImportHeader -> Class) -> [ClassImportHeader] -> [Class]
forall a b. (a -> b) -> [a] -> [b]
map ClassImportHeader -> Class
cihClass [ClassImportHeader]
cihs))
  [ClassImportHeader] -> (ClassImportHeader -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassImportHeader]
cihs ((ClassImportHeader -> IO ()) -> IO ())
-> (ClassImportHeader -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassImportHeader
hdr -> String -> String -> IO ()
gen
                        (HeaderName -> String
unHdrName (ClassImportHeader -> HeaderName
cihSelfHeader ClassImportHeader
hdr))
                        (String -> ClassImportHeader -> String
buildDeclHeader (CabalName -> String
unCabalName CabalName
pkgname) ClassImportHeader
hdr)
  String -> String -> IO ()
gen
    (TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"h")
    (String -> TopLevelImportHeader -> String
buildTopLevelHeader (CabalName -> String
unCabalName CabalName
pkgname) TopLevelImportHeader
tih)

  String -> IO ()
putStrLn String
"Generating Cpp file"
  [ClassImportHeader] -> (ClassImportHeader -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassImportHeader]
cihs (\ClassImportHeader
hdr -> String -> String -> IO ()
gen (ClassImportHeader -> String
cihSelfCpp ClassImportHeader
hdr) (ClassImportHeader -> String
buildDefMain ClassImportHeader
hdr))
  String -> String -> IO ()
gen (TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"cpp") (TopLevelImportHeader -> String
buildTopLevelCppDef TopLevelImportHeader
tih)
  --
  String -> IO ()
putStrLn String
"Generating Additional Header/Source"
  [AddCInc] -> (AddCInc -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Cabal -> [AddCInc]
cabal_additional_c_incs Cabal
cabal) (\(AddCInc String
hdr String
txt) -> String -> String -> IO ()
gen String
hdr String
txt)
  [AddCSrc] -> (AddCSrc -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Cabal -> [AddCSrc]
cabal_additional_c_srcs Cabal
cabal) (\(AddCSrc String
hdr String
txt) -> String -> String -> IO ()
gen String
hdr String
txt)
  --
  String -> IO ()
putStrLn String
"Generating RawType.hs"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"RawType" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (ClassModule -> Module ()
buildRawTypeHs ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating FFI.hsc"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"FFI" String -> String -> String
<.> String
"hsc")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (ClassModule -> Module ()
buildFFIHsc ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating Interface.hs"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"Interface" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (AnnotateMap -> ClassModule -> Module ()
buildInterfaceHs AnnotateMap
forall a. Monoid a => a
mempty ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating Cast.hs"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"Cast" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (ClassModule -> Module ()
buildCastHs ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating Implementation.hs"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"Implementation" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (AnnotateMap -> ClassModule -> Module ()
buildImplementationHs AnnotateMap
forall a. Monoid a => a
mempty ClassModule
m))
 --
  String -> IO ()
putStrLn String
"Generating Proxy.hs"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m ->
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Class -> Bool
hasProxy (Class -> Bool) -> (ClassModule -> Class) -> ClassModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassImportHeader -> Class
cihClass (ClassImportHeader -> Class)
-> (ClassModule -> ClassImportHeader) -> ClassModule -> Class
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> ClassImportHeader
cmCIH (ClassModule -> Bool) -> ClassModule -> Bool
forall a b. (a -> b) -> a -> b
$ ClassModule
m) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> String -> IO ()
gen (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"Proxy" String -> String -> String
<.> String
"hs") (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (ClassModule -> Module ()
buildProxyHs ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating Template.hs"
  [TemplateClassModule] -> (TemplateClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TemplateClassModule]
tcms ((TemplateClassModule -> IO ()) -> IO ())
-> (TemplateClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TemplateClassModule
m -> String -> String -> IO ()
gen
                      (TemplateClassModule -> String
tcmModule TemplateClassModule
m String -> String -> String
<.> String
"Template" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (TemplateClassModule -> Module ()
buildTemplateHs TemplateClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating TH.hs"
  [TemplateClassModule] -> (TemplateClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TemplateClassModule]
tcms ((TemplateClassModule -> IO ()) -> IO ())
-> (TemplateClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TemplateClassModule
m -> String -> String -> IO ()
gen
                      (TemplateClassModule -> String
tcmModule TemplateClassModule
m String -> String -> String
<.> String
"TH" String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (TemplateClassModule -> Module ()
buildTHHs TemplateClassModule
m))

  --
  -- TODO: Template.hs-boot need to be generated as well
  String -> IO ()
putStrLn String
"Generating hs-boot file"
  [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
hsbootlst ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
m -> String -> String -> IO ()
gen
                           (String
m String -> String -> String
<.> String
"Interface" String -> String -> String
<.> String
"hs-boot")
                           (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (String -> Module ()
buildInterfaceHSBOOT String
m))
  --
  String -> IO ()
putStrLn String
"Generating Module summary file"
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods ((ClassModule -> IO ()) -> IO ())
-> (ClassModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassModule
m -> String -> String -> IO ()
gen
                      (ClassModule -> String
cmModule ClassModule
m String -> String -> String
<.> String
"hs")
                      (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (ClassModule -> Module ()
buildModuleHs ClassModule
m))
  --
  String -> IO ()
putStrLn String
"Generating Top-level Module"
  String -> String -> IO ()
gen (String
topLevelMod String -> String -> String
<.> String
"hs") (Module () -> String
forall a. Pretty a => a -> String
prettyPrint (String
-> ([ClassModule], [TemplateClassModule])
-> TopLevelImportHeader
-> Module ()
buildTopLevelHs String
topLevelMod ([ClassModule]
mods,[TemplateClassModule]
tcms) TopLevelImportHeader
tih))
  --
  String -> IO ()
putStrLn String
"Copying generated files to target directory"
  String -> IO ()
touch (String
workingDir String -> String -> String
</> String
"LICENSE")
  String -> String -> IO ()
copyFileWithMD5Check (String
workingDir String -> String -> String
</> String
cabalFileName)  (String
installDir String -> String -> String
</> String
cabalFileName)
  String -> String -> IO ()
copyFileWithMD5Check (String
workingDir String -> String -> String
</> String
jsonFileName)  (String
installDir String -> String -> String
</> String
jsonFileName)
  String -> String -> IO ()
copyFileWithMD5Check (String
workingDir String -> String -> String
</> String
"LICENSE") (String
installDir String -> String -> String
</> String
"LICENSE")

  String -> String -> String -> PackageConfig -> IO ()
copyCppFiles String
workingDir (String -> String
csrcDir String
installDir) (CabalName -> String
unCabalName CabalName
pkgname) PackageConfig
pkgconfig
  [ClassModule] -> (ClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassModule]
mods (String -> String -> ClassModule -> IO ()
copyModule String
workingDir (String -> String
srcDir String
installDir))
  [TemplateClassModule] -> (TemplateClassModule -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TemplateClassModule]
tcms (String -> String -> TemplateClassModule -> IO ()
copyTemplateModule String
workingDir (String -> String
srcDir String
installDir))
  String -> String -> String -> IO ()
moduleFileCopy String
workingDir (String -> String
srcDir String
installDir) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
topLevelMod String -> String -> String
<.> String
"hs"

  String -> IO ()
putStrLn String
"----------------------------------------------------"
  String -> IO ()
putStrLn String
"-- Code generation has been completed. Enjoy!     --"
  String -> IO ()
putStrLn String
"----------------------------------------------------"


-- | some dirty hack. later, we will do it with more proper approcah.

touch :: FilePath -> IO ()
touch :: String -> IO ()
touch String
fp = IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> [String] -> String -> IO String
readProcess String
"touch" [String
fp] String
"")


copyFileWithMD5Check :: FilePath -> FilePath -> IO ()
copyFileWithMD5Check :: String -> String -> IO ()
copyFileWithMD5Check String
src String
tgt = do
  Bool
b <- String -> IO Bool
doesFileExist String
tgt
  if Bool
b
    then do
      MD5Digest
srcmd5 <- ByteString -> MD5Digest
md5 (ByteString -> MD5Digest) -> IO ByteString -> IO MD5Digest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
L.readFile String
src
      MD5Digest
tgtmd5 <- ByteString -> MD5Digest
md5 (ByteString -> MD5Digest) -> IO ByteString -> IO MD5Digest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
L.readFile String
tgt
      if MD5Digest
srcmd5 MD5Digest -> MD5Digest -> Bool
forall a. Eq a => a -> a -> Bool
== MD5Digest
tgtmd5 then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> String -> IO ()
copyFile String
src String
tgt
    else String -> String -> IO ()
copyFile String
src String
tgt


copyCppFiles :: FilePath -> FilePath -> String -> PackageConfig -> IO ()
copyCppFiles :: String -> String -> String -> PackageConfig -> IO ()
copyCppFiles String
wdir String
ddir String
cprefix (PkgConfig [ClassModule]
_ [ClassImportHeader]
cihs TopLevelImportHeader
tih [TemplateClassModule]
_ [TemplateClassImportHeader]
_tcihs [AddCInc]
acincs [AddCSrc]
acsrcs) = do
  let thfile :: String
thfile = String
cprefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Type.h"
      tlhfile :: String
tlhfile = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"h"
      tlcppfile :: String
tlcppfile = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"cpp"
  String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
thfile) (String
ddir String -> String -> String
</> String
thfile)
  String -> IO Bool
doesFileExist (String
wdir String -> String -> String
</> String
tlhfile)
    IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
tlhfile) (String
ddir String -> String -> String
</> String
tlhfile))
  String -> IO Bool
doesFileExist (String
wdir String -> String -> String
</> String
tlcppfile)
    IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
tlcppfile) (String
ddir String -> String -> String
</> String
tlcppfile))
  [ClassImportHeader] -> (ClassImportHeader -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClassImportHeader]
cihs ((ClassImportHeader -> IO ()) -> IO ())
-> (ClassImportHeader -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ClassImportHeader
header-> do
    let hfile :: String
hfile = HeaderName -> String
unHdrName (ClassImportHeader -> HeaderName
cihSelfHeader ClassImportHeader
header)
        cppfile :: String
cppfile = ClassImportHeader -> String
cihSelfCpp ClassImportHeader
header
    String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
hfile) (String
ddir String -> String -> String
</> String
hfile)
    String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
cppfile) (String
ddir String -> String -> String
</> String
cppfile)

  [AddCInc] -> (AddCInc -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [AddCInc]
acincs ((AddCInc -> IO ()) -> IO ()) -> (AddCInc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(AddCInc String
header String
_) ->
    String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
header) (String
ddir String -> String -> String
</> String
header)

  [AddCSrc] -> (AddCSrc -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [AddCSrc]
acsrcs ((AddCSrc -> IO ()) -> IO ()) -> (AddCSrc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(AddCSrc String
csrc String
_) ->
    String -> String -> IO ()
copyFileWithMD5Check (String
wdir String -> String -> String
</> String
csrc) (String
ddir String -> String -> String
</> String
csrc)


moduleFileCopy :: FilePath -> FilePath -> FilePath -> IO ()
moduleFileCopy :: String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir String
fname = do
  let (String
fnamebody,String
fnameext) = String -> (String, String)
splitExtension String
fname
      (String
mdir,String
mfile) = String -> (String, String)
moduleDirFile String
fnamebody
      origfpath :: String
origfpath = String
wdir String -> String -> String
</> String
fname
      (String
mfile',String
_mext') = String -> (String, String)
splitExtension String
mfile
      newfpath :: String
newfpath = String
ddir String -> String -> String
</> String
mdir String -> String -> String
</> String
mfile' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fnameext
  Bool
b <- String -> IO Bool
doesFileExist String
origfpath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
ddir String -> String -> String
</> String
mdir)
    String -> String -> IO ()
copyFileWithMD5Check String
origfpath String
newfpath


copyModule :: FilePath -> FilePath -> ClassModule -> IO ()
copyModule :: String -> String -> ClassModule -> IO ()
copyModule String
wdir String
ddir ClassModule
m = do
  let modbase :: String
modbase = ClassModule -> String
cmModule ClassModule
m
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".RawType.hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".FFI.hsc"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Interface.hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Cast.hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Implementation.hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Interface.hs-boot"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Class -> Bool
hasProxy (Class -> Bool) -> (ClassModule -> Class) -> ClassModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassImportHeader -> Class
cihClass (ClassImportHeader -> Class)
-> (ClassModule -> ClassImportHeader) -> ClassModule -> Class
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> ClassImportHeader
cmCIH (ClassModule -> Bool) -> ClassModule -> Bool
forall a b. (a -> b) -> a -> b
$ ClassModule
m) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Proxy.hs"


copyTemplateModule :: FilePath -> FilePath -> TemplateClassModule -> IO ()
copyTemplateModule :: String -> String -> TemplateClassModule -> IO ()
copyTemplateModule String
wdir String
ddir TemplateClassModule
m = do
  let modbase :: String
modbase = TemplateClassModule -> String
tcmModule TemplateClassModule
m
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Template.hs"
  String -> String -> String -> IO ()
moduleFileCopy String
wdir String
ddir (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modbase String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".TH.hs"