{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module FFICXX.Generate.Code.Cabal where

import Data.Aeson.Encode.Pretty    (encodePretty)
import qualified Data.ByteString.Lazy as BL
import Data.List                   (intercalate, nub)
import Data.Monoid                 ((<>))
import Data.Text                   (Text)
import Data.Text.Template          (substitute)
import qualified Data.Text as T    (intercalate,pack,replicate,unlines)
import qualified Data.Text.Lazy as TL (toStrict)
import qualified Data.Text.IO as TIO (writeFile)
import System.FilePath             ((<.>),(</>))
--
import FFICXX.Runtime.CodeGen.Cxx  ( HeaderName(..) )
--
import FFICXX.Generate.Type.Cabal  ( AddCInc(..)
                                   , AddCSrc(..)
                                   , BuildType(..)
                                   , CabalName(..)
                                   , Cabal(..)
                                   , GeneratedCabalInfo(..)
                                   )
import FFICXX.Generate.Type.Class  ( hasProxy )
import FFICXX.Generate.Type.Module
-- import FFICXX.Generate.Type.PackageInterface
import FFICXX.Generate.Util


cabalIndentation :: Text
cabalIndentation :: Text
cabalIndentation = Int -> Text -> Text
T.replicate Int
23 Text
" "


unlinesWithIndent :: [Text] -> Text
unlinesWithIndent = [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
cabalIndentation Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

-- for source distribution
genCsrcFiles :: (TopLevelImportHeader,[ClassModule])
             -> [AddCInc]
             -> [AddCSrc]
             -> [String]
genCsrcFiles :: (TopLevelImportHeader, [ClassModule])
-> [AddCInc] -> [AddCSrc] -> [String]
genCsrcFiles (TopLevelImportHeader
tih,[ClassModule]
cmods) [AddCInc]
acincs [AddCSrc]
acsrcs =
  let selfheaders' :: [HeaderName]
selfheaders' = do
        ClassModule
x <- [ClassModule]
cmods
        let y :: ClassImportHeader
y = ClassModule -> ClassImportHeader
cmCIH ClassModule
x
        HeaderName -> [HeaderName]
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassImportHeader -> HeaderName
cihSelfHeader ClassImportHeader
y)
      selfheaders :: [HeaderName]
selfheaders = [HeaderName] -> [HeaderName]
forall a. Eq a => [a] -> [a]
nub [HeaderName]
selfheaders'
      selfcpp' :: [String]
selfcpp' = do
        ClassModule
x <- [ClassModule]
cmods
        let y :: ClassImportHeader
y = ClassModule -> ClassImportHeader
cmCIH ClassModule
x
        String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassImportHeader -> String
cihSelfCpp ClassImportHeader
y)
      selfcpp :: [String]
selfcpp = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
selfcpp'
      tlh :: String
tlh = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"h"
      tlcpp :: String
tlcpp = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"cpp"
      includeFileStrsWithCsrc :: [String]
includeFileStrsWithCsrc = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x->String
"csrc"String -> String -> String
</> String
x) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                                 (if ([TopLevel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([TopLevel] -> Bool)
-> (TopLevelImportHeader -> [TopLevel])
-> TopLevelImportHeader
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TopLevelImportHeader -> [TopLevel]
tihFuncs) TopLevelImportHeader
tih then (HeaderName -> String) -> [HeaderName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HeaderName -> String
unHdrName [HeaderName]
selfheaders else String
tlhString -> [String] -> [String]
forall a. a -> [a] -> [a]
:((HeaderName -> String) -> [HeaderName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HeaderName -> String
unHdrName [HeaderName]
selfheaders))
                                 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (AddCInc -> String) -> [AddCInc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddCInc String
hdr String
_) -> String
hdr) [AddCInc]
acincs
      cppFilesWithCsrc :: [String]
cppFilesWithCsrc = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x->String
"csrc"String -> String -> String
</>String
x)  ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                           (if ([TopLevel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([TopLevel] -> Bool)
-> (TopLevelImportHeader -> [TopLevel])
-> TopLevelImportHeader
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TopLevelImportHeader -> [TopLevel]
tihFuncs) TopLevelImportHeader
tih then [String]
selfcpp else String
tlcppString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
selfcpp)
                           [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (AddCSrc -> String) -> [AddCSrc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddCSrc String
src String
_) -> String
src) [AddCSrc]
acsrcs


  in [String]
includeFileStrsWithCsrc [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cppFilesWithCsrc

-- for library
genIncludeFiles :: String        -- ^ package name
                -> ([ClassImportHeader],[TemplateClassImportHeader])
                -> [AddCInc]
                -> [String]
genIncludeFiles :: String
-> ([ClassImportHeader], [TemplateClassImportHeader])
-> [AddCInc]
-> [String]
genIncludeFiles String
pkgname ([ClassImportHeader]
cih,[TemplateClassImportHeader]
_tcih) [AddCInc]
acincs =
  let selfheaders :: [HeaderName]
selfheaders = (ClassImportHeader -> HeaderName)
-> [ClassImportHeader] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map ClassImportHeader -> HeaderName
cihSelfHeader [ClassImportHeader]
cih
      includeFileStrs :: [String]
includeFileStrs = (HeaderName -> String) -> [HeaderName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HeaderName -> String
unHdrName ([HeaderName]
selfheaders [HeaderName] -> [HeaderName] -> [HeaderName]
forall a. [a] -> [a] -> [a]
++ (AddCInc -> HeaderName) -> [AddCInc] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddCInc String
hdr String
_) -> String -> HeaderName
HdrName String
hdr) [AddCInc]
acincs)
  in (String
pkgnameString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
"Type.h") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
includeFileStrs

-- for library
genCppFiles :: (TopLevelImportHeader,[ClassModule])
            -> [AddCSrc]
            -> [String]
genCppFiles :: (TopLevelImportHeader, [ClassModule]) -> [AddCSrc] -> [String]
genCppFiles (TopLevelImportHeader
tih,[ClassModule]
cmods) [AddCSrc]
acsrcs =
  let selfcpp' :: [String]
selfcpp' = do
        ClassModule
x <- [ClassModule]
cmods
        let y :: ClassImportHeader
y = ClassModule -> ClassImportHeader
cmCIH ClassModule
x
        String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassImportHeader -> String
cihSelfCpp ClassImportHeader
y)
      selfcpp :: [String]
selfcpp = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
selfcpp'
      tlcpp :: String
tlcpp = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
tih String -> String -> String
<.> String
"cpp"
      cppFileStrs :: [String]
cppFileStrs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
"csrc" String -> String -> String
</> String
x)  ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                      (if ([TopLevel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([TopLevel] -> Bool)
-> (TopLevelImportHeader -> [TopLevel])
-> TopLevelImportHeader
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TopLevelImportHeader -> [TopLevel]
tihFuncs) TopLevelImportHeader
tih then [String]
selfcpp else String
tlcppString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
selfcpp)
                      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (AddCSrc -> String) -> [AddCSrc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(AddCSrc String
src String
_) -> String
src) [AddCSrc]
acsrcs
  in [String]
cppFileStrs

-- | generate exposed module list in cabal file
genExposedModules :: String -> ([ClassModule],[TemplateClassModule]) -> [String]
genExposedModules :: String -> ([ClassModule], [TemplateClassModule]) -> [String]
genExposedModules String
summarymod ([ClassModule]
cmods,[TemplateClassModule]
tmods) =
  let cmodstrs :: [String]
cmodstrs       = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ClassModule -> String
cmModule [ClassModule]
cmods
      rawType :: [String]
rawType        = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".RawType")        (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule) [ClassModule]
cmods
      ffi :: [String]
ffi            = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (( String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".FFI")           (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule) [ClassModule]
cmods
      interface :: [String]
interface      = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".Interface")      (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule) [ClassModule]
cmods
      cast :: [String]
cast           = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".Cast")           (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule) [ClassModule]
cmods
      implementation :: [String]
implementation = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".Implementation") (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule) [ClassModule]
cmods
      proxy :: [String]
proxy          = (ClassModule -> String) -> [ClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".Proxy")          (String -> String)
-> (ClassModule -> String) -> ClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> String
cmModule)
                     ([ClassModule] -> [String])
-> ([ClassModule] -> [ClassModule]) -> [ClassModule] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClassModule -> Bool) -> [ClassModule] -> [ClassModule]
forall a. (a -> Bool) -> [a] -> [a]
filter (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] -> [String]) -> [ClassModule] -> [String]
forall a b. (a -> b) -> a -> b
$ [ClassModule]
cmods
      template :: [String]
template       = (TemplateClassModule -> String)
-> [TemplateClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".Template")       (String -> String)
-> (TemplateClassModule -> String) -> TemplateClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateClassModule -> String
tcmModule) [TemplateClassModule]
tmods
      th :: [String]
th             = (TemplateClassModule -> String)
-> [TemplateClassModule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
".TH")             (String -> String)
-> (TemplateClassModule -> String) -> TemplateClassModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateClassModule -> String
tcmModule) [TemplateClassModule]
tmods
  in    [String
summarymod]
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cmodstrs
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
rawType
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ffi
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
interface
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cast
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
implementation
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
proxy
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
template
     [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
th

-- | generate other modules in cabal file
genOtherModules :: [ClassModule] -> [String]
genOtherModules :: [ClassModule] -> [String]
genOtherModules [ClassModule]
_cmods = [String
""]

-- | generate additional package dependencies.
genPkgDeps :: [CabalName] -> [String]
genPkgDeps :: [CabalName] -> [String]
genPkgDeps [CabalName]
cs =    [ String
"base > 4 && < 5"
                   , String
"fficxx >= 0.5"
                   , String
"fficxx-runtime >= 0.5"
                   , String
"template-haskell"
                   ]
                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (CabalName -> String) -> [CabalName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CabalName -> String
unCabalName [CabalName]
cs



-- |
cabalTemplate :: Text
cabalTemplate :: Text
cabalTemplate =
  Text
"Name:                $pkgname\n\
  \Version:     $version\n\
  \Synopsis:    $synopsis\n\
  \Description:         $description\n\
  \Homepage:       $homepage\n\
  \$licenseField\n\
  \$licenseFileField\n\
  \Author:              $author\n\
  \Maintainer:  $maintainer\n\
  \Category:       $category\n\
  \Tested-with:    GHC >= 7.6\n\
  \$buildtype\n\
  \cabal-version:  >= 2\n\
  \Extra-source-files:\n\
  \$extraFiles\n\
  \$csrcFiles\n\
  \\n\
  \$sourcerepository\n\
  \\n\
  \Library\n\
  \  default-language: Haskell2010\n\
  \  hs-source-dirs: src\n\
  \  ghc-options:  -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports\n\
  \  ghc-prof-options: -caf-all -auto-all\n\
  \  cxx-options: $cxxOptions\n\
  \  Build-Depends: $pkgdeps\n\
  \  Exposed-Modules:\n\
  \$exposedModules\n\
  \  Other-Modules:\n\
  \$otherModules\n\
  \  extra-lib-dirs: $extralibdirs\n\
  \  extra-libraries:    $extraLibraries\n\
  \  Include-dirs:       csrc $extraincludedirs\n\
  \  pkgconfig-depends: $pkgconfigDepends\n\
  \  Install-includes:\n\
  \$includeFiles\n\
  \  C-sources:\n\
  \$cppFiles\n"



-- TODO: remove all T.pack after we switch over to Text
genCabalInfo
  :: Cabal
  -> String
  -> PackageConfig
  -> [String] -- ^ extra libs
  -> GeneratedCabalInfo
genCabalInfo :: Cabal -> String -> PackageConfig -> [String] -> GeneratedCabalInfo
genCabalInfo Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs =
  let tih :: TopLevelImportHeader
tih = PackageConfig -> TopLevelImportHeader
pcfg_topLevelImportHeader PackageConfig
pkgconfig
      classmodules :: [ClassModule]
classmodules = PackageConfig -> [ClassModule]
pcfg_classModules PackageConfig
pkgconfig
      cih :: [ClassImportHeader]
cih = PackageConfig -> [ClassImportHeader]
pcfg_classImportHeaders PackageConfig
pkgconfig
      tmods :: [TemplateClassModule]
tmods = PackageConfig -> [TemplateClassModule]
pcfg_templateClassModules PackageConfig
pkgconfig
      tcih :: [TemplateClassImportHeader]
tcih = PackageConfig -> [TemplateClassImportHeader]
pcfg_templateClassImportHeaders PackageConfig
pkgconfig
      acincs :: [AddCInc]
acincs = PackageConfig -> [AddCInc]
pcfg_additional_c_incs PackageConfig
pkgconfig
      acsrcs :: [AddCSrc]
acsrcs = PackageConfig -> [AddCSrc]
pcfg_additional_c_srcs PackageConfig
pkgconfig
      extrafiles :: [String]
extrafiles = Cabal -> [String]
cabal_extrafiles Cabal
cabal
  in GeneratedCabalInfo :: Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> [Text]
-> Text
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> GeneratedCabalInfo
GeneratedCabalInfo {
       gci_pkgname :: Text
gci_pkgname          = String -> Text
T.pack (CabalName -> String
unCabalName (Cabal -> CabalName
cabal_pkgname Cabal
cabal))
     , gci_version :: Text
gci_version          = String -> Text
T.pack (Cabal -> String
cabal_version Cabal
cabal)
     , gci_synopsis :: Text
gci_synopsis         = Text
""
     , gci_description :: Text
gci_description      = Text
""
     , gci_homepage :: Text
gci_homepage         = Text
""
     , gci_license :: Text
gci_license          = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Cabal -> Maybe String
cabal_license Cabal
cabal)
     , gci_licenseFile :: Text
gci_licenseFile      = Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack (Cabal -> Maybe String
cabal_licensefile Cabal
cabal)
     , gci_author :: Text
gci_author           = Text
""
     , gci_maintainer :: Text
gci_maintainer       = Text
""
     , gci_category :: Text
gci_category         = Text
""
     , gci_buildtype :: Text
gci_buildtype        = case Cabal -> BuildType
cabal_buildType Cabal
cabal of
                                BuildType
Simple ->
                                  Text
"Build-Type: Simple"
                                Custom [CabalName]
deps ->
                                     Text
"Build-Type: Custom\ncustom-setup\n  setup-depends: "
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CabalName -> String) -> [CabalName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CabalName -> String
unCabalName [CabalName]
deps))
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
     , gci_extraFiles :: [Text]
gci_extraFiles       = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
extrafiles
     , gci_csrcFiles :: [Text]
gci_csrcFiles        = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (TopLevelImportHeader, [ClassModule])
-> [AddCInc] -> [AddCSrc] -> [String]
genCsrcFiles (TopLevelImportHeader
tih,[ClassModule]
classmodules) [AddCInc]
acincs [AddCSrc]
acsrcs
     , gci_sourcerepository :: Text
gci_sourcerepository = Text
""
     , gci_cxxOptions :: [Text]
gci_cxxOptions       = [Text
"-std=c++14"]
     , gci_pkgdeps :: [Text]
gci_pkgdeps          = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [CabalName] -> [String]
genPkgDeps (Cabal -> [CabalName]
cabal_additional_pkgdeps Cabal
cabal)
     , gci_exposedModules :: [Text]
gci_exposedModules   = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> ([ClassModule], [TemplateClassModule]) -> [String]
genExposedModules String
summarymodule ([ClassModule]
classmodules,[TemplateClassModule]
tmods)
     , gci_otherModules :: [Text]
gci_otherModules     = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [ClassModule] -> [String]
genOtherModules [ClassModule]
classmodules
     , gci_extraLibDirs :: [Text]
gci_extraLibDirs     = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Cabal -> [String]
cabal_extralibdirs Cabal
cabal
     , gci_extraLibraries :: [Text]
gci_extraLibraries   = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
extralibs
     , gci_extraIncludeDirs :: [Text]
gci_extraIncludeDirs = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Cabal -> [String]
cabal_extraincludedirs Cabal
cabal
     , gci_pkgconfigDepends :: [Text]
gci_pkgconfigDepends = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ Cabal -> [String]
cabal_pkg_config_depends Cabal
cabal
     , gci_includeFiles :: [Text]
gci_includeFiles     = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String
-> ([ClassImportHeader], [TemplateClassImportHeader])
-> [AddCInc]
-> [String]
genIncludeFiles (CabalName -> String
unCabalName (Cabal -> CabalName
cabal_pkgname Cabal
cabal)) ([ClassImportHeader]
cih,[TemplateClassImportHeader]
tcih) [AddCInc]
acincs
     , gci_cppFiles :: [Text]
gci_cppFiles         = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (TopLevelImportHeader, [ClassModule]) -> [AddCSrc] -> [String]
genCppFiles (TopLevelImportHeader
tih,[ClassModule]
classmodules) [AddCSrc]
acsrcs
     }


genCabalFile :: GeneratedCabalInfo -> Text
genCabalFile :: GeneratedCabalInfo -> Text
genCabalFile GeneratedCabalInfo {[Text]
Text
gci_cppFiles :: [Text]
gci_includeFiles :: [Text]
gci_pkgconfigDepends :: [Text]
gci_extraIncludeDirs :: [Text]
gci_extraLibraries :: [Text]
gci_extraLibDirs :: [Text]
gci_otherModules :: [Text]
gci_exposedModules :: [Text]
gci_pkgdeps :: [Text]
gci_cxxOptions :: [Text]
gci_sourcerepository :: Text
gci_csrcFiles :: [Text]
gci_extraFiles :: [Text]
gci_buildtype :: Text
gci_category :: Text
gci_maintainer :: Text
gci_author :: Text
gci_licenseFile :: Text
gci_license :: Text
gci_homepage :: Text
gci_description :: Text
gci_synopsis :: Text
gci_version :: Text
gci_pkgname :: Text
gci_cppFiles :: GeneratedCabalInfo -> [Text]
gci_includeFiles :: GeneratedCabalInfo -> [Text]
gci_pkgconfigDepends :: GeneratedCabalInfo -> [Text]
gci_extraIncludeDirs :: GeneratedCabalInfo -> [Text]
gci_extraLibraries :: GeneratedCabalInfo -> [Text]
gci_extraLibDirs :: GeneratedCabalInfo -> [Text]
gci_otherModules :: GeneratedCabalInfo -> [Text]
gci_exposedModules :: GeneratedCabalInfo -> [Text]
gci_pkgdeps :: GeneratedCabalInfo -> [Text]
gci_cxxOptions :: GeneratedCabalInfo -> [Text]
gci_sourcerepository :: GeneratedCabalInfo -> Text
gci_csrcFiles :: GeneratedCabalInfo -> [Text]
gci_extraFiles :: GeneratedCabalInfo -> [Text]
gci_buildtype :: GeneratedCabalInfo -> Text
gci_category :: GeneratedCabalInfo -> Text
gci_maintainer :: GeneratedCabalInfo -> Text
gci_author :: GeneratedCabalInfo -> Text
gci_licenseFile :: GeneratedCabalInfo -> Text
gci_license :: GeneratedCabalInfo -> Text
gci_homepage :: GeneratedCabalInfo -> Text
gci_description :: GeneratedCabalInfo -> Text
gci_synopsis :: GeneratedCabalInfo -> Text
gci_version :: GeneratedCabalInfo -> Text
gci_pkgname :: GeneratedCabalInfo -> Text
..} =
  Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
    Text -> (Text -> Text) -> Text
substitute Text
cabalTemplate ((Text -> Text) -> Text) -> (Text -> Text) -> Text
forall a b. (a -> b) -> a -> b
$
      [(Text, Text)] -> Text -> Text
contextT [ (Text
"licenseField"    , Text
"license: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gci_license)
               , (Text
"licenseFileField", Text
"license-file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gci_licenseFile)
               , (Text
"pkgname"         , Text
gci_pkgname)
               , (Text
"version"         , Text
gci_version)
               , (Text
"buildtype"       , Text
gci_buildtype)
               , (Text
"synopsis"        , Text
gci_synopsis)
               , (Text
"description"     , Text
gci_description)
               , (Text
"homepage"        , Text
gci_homepage)
               , (Text
"author"          , Text
gci_author)
               , (Text
"maintainer"      , Text
gci_maintainer)
               , (Text
"category"        , Text
gci_category)
               , (Text
"sourcerepository", Text
gci_sourcerepository)
               , (Text
"cxxOptions"       , Text -> [Text] -> Text
T.intercalate Text
" " [Text]
gci_cxxOptions)
               , (Text
"pkgdeps"         , Text -> [Text] -> Text
T.intercalate Text
", " [Text]
gci_pkgdeps)
               , (Text
"extraFiles"      , [Text] -> Text
unlinesWithIndent [Text]
gci_extraFiles)
               , (Text
"csrcFiles"       , [Text] -> Text
unlinesWithIndent [Text]
gci_csrcFiles)
               , (Text
"includeFiles"    , [Text] -> Text
unlinesWithIndent [Text]
gci_includeFiles)
               , (Text
"cppFiles"        , [Text] -> Text
unlinesWithIndent [Text]
gci_cppFiles)
               , (Text
"exposedModules"  , [Text] -> Text
unlinesWithIndent [Text]
gci_exposedModules)
               , (Text
"otherModules"    , [Text] -> Text
unlinesWithIndent [Text]
gci_otherModules)
               , (Text
"extralibdirs"    , Text -> [Text] -> Text
T.intercalate Text
", " [Text]
gci_extraLibDirs)
               , (Text
"extraincludedirs", Text -> [Text] -> Text
T.intercalate Text
", " [Text]
gci_extraIncludeDirs)
               , (Text
"extraLibraries"  , Text -> [Text] -> Text
T.intercalate Text
", " [Text]
gci_extraLibraries)
               , (Text
"cabalIndentation", Text
cabalIndentation)
               , (Text
"pkgconfigDepends", Text -> [Text] -> Text
T.intercalate Text
", " [Text]
gci_pkgconfigDepends)
               ]


-- |
buildCabalFile
  :: Cabal
  -> String
  -> PackageConfig
  -> [String]      -- ^ Extra libs
  -> FilePath      -- ^ Cabal file path
  -> IO ()
buildCabalFile :: Cabal -> String -> PackageConfig -> [String] -> String -> IO ()
buildCabalFile Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs String
cabalfile = do
  let
      cinfo :: GeneratedCabalInfo
cinfo = Cabal -> String -> PackageConfig -> [String] -> GeneratedCabalInfo
genCabalInfo Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs
      txt :: Text
txt = GeneratedCabalInfo -> Text
genCabalFile GeneratedCabalInfo
cinfo
  String -> Text -> IO ()
TIO.writeFile String
cabalfile Text
txt


-- |
buildJSONFile
  :: Cabal
  -> String
  -> PackageConfig
  -> [String]      -- ^ Extra libs
  -> FilePath      -- ^ JSON file path
  -> IO ()
buildJSONFile :: Cabal -> String -> PackageConfig -> [String] -> String -> IO ()
buildJSONFile Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs String
jsonfile = do
  let cinfo :: GeneratedCabalInfo
cinfo = Cabal -> String -> PackageConfig -> [String] -> GeneratedCabalInfo
genCabalInfo Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs
  String -> ByteString -> IO ()
BL.writeFile String
jsonfile (GeneratedCabalInfo -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty GeneratedCabalInfo
cinfo)