{-# 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.Text (Text)
import qualified Data.Text as T (intercalate, pack, replicate, unlines)
import qualified Data.Text.IO as TIO (writeFile)
import qualified Data.Text.Lazy as TL (toStrict)
import Data.Text.Template (substitute)
import FFICXX.Generate.Type.Cabal
  ( AddCInc (..),
    AddCSrc (..),
    BuildType (..),
    Cabal (..),
    CabalName (..),
    GeneratedCabalInfo (..),
  )
import FFICXX.Generate.Type.Class (hasProxy)
import FFICXX.Generate.Type.Module
  ( ClassImportHeader (..),
    ClassModule (..),
    PackageConfig (..),
    TemplateClassImportHeader,
    TemplateClassModule (..),
    TopLevelImportHeader (..),
  )
import FFICXX.Generate.Util (contextT)
import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..))
import System.FilePath ((<.>), (</>))

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 a. a -> [a]
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 a. a -> [a]
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 a. [a] -> 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
tlh String -> [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 a. [a] -> 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
tlcpp String -> [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 ::
  -- | package name
  String ->
  ([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
pkgname String -> 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 a. a -> [a]
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 a. [a] -> 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
tlcpp String -> [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
summarymod String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Ordinary", String
summarymod String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".Template", String
summarymod String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".TH"]
        [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.7",
    String
"fficxx-runtime >= 0.7",
    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
"Cabal-version:  3.0\n\
  \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 == 9.0.2 || == 9.2.4 || == 9.4.2 \n\
  \$buildtype\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\
  \  Cxx-sources:\n\
  \$cppFiles\n"

-- TODO: remove all T.pack after we switch over to Text
genCabalInfo ::
  Cabal ->
  String ->
  PackageConfig ->
  -- | extra libs
  [String] ->
  -- | cxx options
  [String] ->
  GeneratedCabalInfo
genCabalInfo :: Cabal
-> String
-> PackageConfig
-> [String]
-> [String]
-> GeneratedCabalInfo
genCabalInfo Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs [String]
cxxopts =
  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
        { 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 = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
cxxopts,
          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_pkgname :: GeneratedCabalInfo -> Text
gci_version :: GeneratedCabalInfo -> Text
gci_synopsis :: GeneratedCabalInfo -> Text
gci_description :: GeneratedCabalInfo -> Text
gci_homepage :: GeneratedCabalInfo -> Text
gci_license :: GeneratedCabalInfo -> Text
gci_licenseFile :: GeneratedCabalInfo -> Text
gci_author :: GeneratedCabalInfo -> Text
gci_maintainer :: GeneratedCabalInfo -> Text
gci_category :: GeneratedCabalInfo -> Text
gci_buildtype :: GeneratedCabalInfo -> Text
gci_extraFiles :: GeneratedCabalInfo -> [Text]
gci_csrcFiles :: GeneratedCabalInfo -> [Text]
gci_sourcerepository :: GeneratedCabalInfo -> Text
gci_cxxOptions :: GeneratedCabalInfo -> [Text]
gci_pkgdeps :: GeneratedCabalInfo -> [Text]
gci_exposedModules :: GeneratedCabalInfo -> [Text]
gci_otherModules :: GeneratedCabalInfo -> [Text]
gci_extraLibDirs :: GeneratedCabalInfo -> [Text]
gci_extraLibraries :: GeneratedCabalInfo -> [Text]
gci_extraIncludeDirs :: GeneratedCabalInfo -> [Text]
gci_pkgconfigDepends :: GeneratedCabalInfo -> [Text]
gci_includeFiles :: GeneratedCabalInfo -> [Text]
gci_cppFiles :: GeneratedCabalInfo -> [Text]
gci_pkgname :: Text
gci_version :: Text
gci_synopsis :: Text
gci_description :: Text
gci_homepage :: Text
gci_license :: Text
gci_licenseFile :: Text
gci_author :: Text
gci_maintainer :: Text
gci_category :: Text
gci_buildtype :: Text
gci_extraFiles :: [Text]
gci_csrcFiles :: [Text]
gci_sourcerepository :: Text
gci_cxxOptions :: [Text]
gci_pkgdeps :: [Text]
gci_exposedModules :: [Text]
gci_otherModules :: [Text]
gci_extraLibDirs :: [Text]
gci_extraLibraries :: [Text]
gci_extraIncludeDirs :: [Text]
gci_pkgconfigDepends :: [Text]
gci_includeFiles :: [Text]
gci_cppFiles :: [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 ->
  -- | Extra libs
  [String] ->
  -- | cxx options
  [String] ->
  -- | Cabal file path
  FilePath ->
  IO ()
buildCabalFile :: Cabal
-> String
-> PackageConfig
-> [String]
-> [String]
-> String
-> IO ()
buildCabalFile Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs [String]
cxxopts String
cabalfile = do
  let cinfo :: GeneratedCabalInfo
cinfo = Cabal
-> String
-> PackageConfig
-> [String]
-> [String]
-> GeneratedCabalInfo
genCabalInfo Cabal
cabal String
summarymodule PackageConfig
pkgconfig [String]
extralibs [String]
cxxopts
      txt :: Text
txt = GeneratedCabalInfo -> Text
genCabalFile GeneratedCabalInfo
cinfo
  String -> Text -> IO ()
TIO.writeFile String
cabalfile Text
txt

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