From 69ff6dfd39bf1b70ec5d02253577efd76136087a Mon Sep 17 00:00:00 2001 From: Ian-Woo Kim Date: Thu, 6 Sep 2018 17:40:54 +0000 Subject: [PATCH 1/5] use for_ instead of mapM_ and forM_ in Builder. tidy up messages --- fficxx/lib/FFICXX/Generate/Builder.hs | 126 +++++++++++++++----------- 1 file changed, 73 insertions(+), 53 deletions(-) diff --git a/fficxx/lib/FFICXX/Generate/Builder.hs b/fficxx/lib/FFICXX/Generate/Builder.hs index 18920fa2..7b34cb9d 100644 --- a/fficxx/lib/FFICXX/Generate/Builder.hs +++ b/fficxx/lib/FFICXX/Generate/Builder.hs @@ -15,24 +15,26 @@ module FFICXX.Generate.Builder where -import Control.Monad ( forM_, void, when ) +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.Monoid ( (<>), mempty ) -import Language.Haskell.Exts.Pretty ( prettyPrint ) -import System.FilePath ( (), (<.>), splitExtension ) -import System.Directory ( copyFile, doesDirectoryExist - , doesFileExist, getCurrentDirectory ) -import System.IO ( hPutStrLn, withFile, IOMode(..) ) -import System.Process ( readProcess, system ) +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, doesDirectoryExist + ,doesFileExist,getCurrentDirectory) +import System.IO (hPutStrLn,withFile,IOMode(..)) +import System.Process (readProcess,system ) -- import FFICXX.Generate.Code.Cabal import FFICXX.Generate.Dependency import FFICXX.Generate.Config import FFICXX.Generate.ContentMaker -import FFICXX.Generate.Type.Cabal (Cabal(..),AddCInc(..),AddCSrc(..),CabalName(..)) -import FFICXX.Generate.Type.Config (ModuleUnitMap(..)) +import FFICXX.Generate.Type.Cabal (Cabal(..),CabalName(..) + ,AddCInc(..),AddCSrc(..)) +import FFICXX.Generate.Type.Config (ModuleUnitMap(..)) import FFICXX.Generate.Type.Class import FFICXX.Generate.Type.Module import FFICXX.Generate.Type.PackageInterface @@ -73,10 +75,10 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr notExistThenCreate (installDir "src") notExistThenCreate (installDir "csrc") -- - putStrLn "cabal file generation" + putStrLn "Generating Cabal file" buildCabalFile cabal topLevelMod pkgconfig extralibs (workingDircabalFileName) -- - putStrLn "header file generation" + putStrLn "Generating Header file" let typmacro = TypMcro ("__" <> macrofy (unCabalName (cabal_pkgname cabal)) <> "__") gen :: FilePath -> String -> IO () gen file str = @@ -84,67 +86,85 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr gen (unCabalName pkgname <> "Type.h") (buildTypeDeclHeader typmacro (map cihClass cihs)) - mapM_ (\hdr -> gen (unHdrName (cihSelfHeader hdr)) (buildDeclHeader typmacro (unCabalName pkgname) hdr)) cihs - gen (tihHeaderFileName tih <.> "h") (buildTopLevelHeader typmacro (unCabalName pkgname) tih) - forM_ tcms $ \m -> + for_ cihs $ \hdr -> gen + (unHdrName (cihSelfHeader hdr)) + (buildDeclHeader typmacro (unCabalName pkgname) hdr) + gen + (tihHeaderFileName tih <.> "h") + (buildTopLevelHeader typmacro (unCabalName pkgname) tih) + for_ tcms $ \m -> let tcihs = tcmTCIH m - in forM_ tcihs $ \tcih -> + in for_ tcihs $ \tcih -> let t = tcihTClass tcih hdr = unHdrName (tcihSelfHeader tcih) in gen hdr (buildTemplateHeader typmacro t) -- - putStrLn "cpp file generation" - mapM_ (\hdr -> gen (cihSelfCpp hdr) (buildDefMain hdr)) cihs + putStrLn "Generating Cpp file" + for_ cihs (\hdr -> gen (cihSelfCpp hdr) (buildDefMain hdr)) gen (tihHeaderFileName tih <.> "cpp") (buildTopLevelCppDef tih) -- - putStrLn "additional header/source generation" - mapM_ (\(AddCInc hdr txt) -> gen hdr txt) (cabal_additional_c_incs cabal) - mapM_ (\(AddCSrc hdr txt) -> gen hdr txt) (cabal_additional_c_srcs cabal) + putStrLn "Generating Additional Header/Source" + for_ (cabal_additional_c_incs cabal) (\(AddCInc hdr txt) -> gen hdr txt) + for_ (cabal_additional_c_srcs cabal) (\(AddCSrc hdr txt) -> gen hdr txt) -- - putStrLn "RawType.hs file generation" - mapM_ (\m -> gen (cmModule m <.> "RawType" <.> "hs") (prettyPrint (buildRawTypeHs m))) mods + putStrLn "Generating RawType.hs" + for_ mods $ \m -> gen + (cmModule m <.> "RawType" <.> "hs") + (prettyPrint (buildRawTypeHs m)) -- - putStrLn "FFI.hsc file generation" - mapM_ (\m -> gen (cmModule m <.> "FFI" <.> "hsc") (prettyPrint (buildFFIHsc m))) mods + putStrLn "Generating FFI.hsc" + for_ mods $ \m -> gen + (cmModule m <.> "FFI" <.> "hsc") + (prettyPrint (buildFFIHsc m)) -- - putStrLn "Interface.hs file generation" - mapM_ (\m -> gen (cmModule m <.> "Interface" <.> "hs") (prettyPrint (buildInterfaceHs mempty m))) mods + putStrLn "Generating Interface.hs" + for_ mods $ \m -> gen + (cmModule m <.> "Interface" <.> "hs") + (prettyPrint (buildInterfaceHs mempty m)) -- - putStrLn "Cast.hs file generation" - mapM_ (\m -> gen (cmModule m <.> "Cast" <.> "hs") (prettyPrint (buildCastHs m))) mods + putStrLn "Generating Cast.hs" + for_ mods $ \m -> gen + (cmModule m <.> "Cast" <.> "hs") + (prettyPrint (buildCastHs m)) -- - putStrLn "Implementation.hs file generation" - mapM_ (\m -> gen (cmModule m <.> "Implementation" <.> "hs") (prettyPrint (buildImplementationHs mempty m))) mods + putStrLn "Generating Implementation.hs" + for_ mods $ \m -> gen + (cmModule m <.> "Implementation" <.> "hs") + (prettyPrint (buildImplementationHs mempty m)) -- - putStrLn "Template.hs file generation" - mapM_ (\m -> gen (tcmModule m <.> "Template" <.> "hs") (prettyPrint (buildTemplateHs m))) tcms + putStrLn "Generating Template.hs" + for_ tcms $ \m -> gen + (tcmModule m <.> "Template" <.> "hs") + (prettyPrint (buildTemplateHs m)) -- - putStrLn "TH.hs file generation" - mapM_ (\m -> gen (tcmModule m <.> "TH" <.> "hs") (prettyPrint (buildTHHs m))) tcms - + putStrLn "Generating TH.hs" + for_ tcms $ \m -> gen + (tcmModule m <.> "TH" <.> "hs") + (prettyPrint (buildTHHs m)) -- -- TODO: Template.hs-boot need to be generated as well - putStrLn "hs-boot file generation" - mapM_ (\m -> gen (m <.> "Interface" <.> "hs-boot") (prettyPrint (buildInterfaceHSBOOT m))) hsbootlst + putStrLn "Generating hs-boot file" + for_ hsbootlst $ \m -> gen + (m <.> "Interface" <.> "hs-boot") + (prettyPrint (buildInterfaceHSBOOT m)) -- - - - - putStrLn "module file generation" - mapM_ (\m -> gen (cmModule m <.> "hs") (prettyPrint (buildModuleHs m))) mods + putStrLn "Genering Module summary file" + for_ mods $ \m -> gen + (cmModule m <.> "hs") + (prettyPrint (buildModuleHs m)) -- - putStrLn "top level module generation generation" + putStrLn "Generating Top-level Module" gen (topLevelMod <.> "hs") (prettyPrint (buildTopLevelHs topLevelMod (mods,tcms) tih)) -- - putStrLn "copying" + putStrLn "Copying generated files to target directory" touch (workingDir "LICENSE") copyFileWithMD5Check (workingDir cabalFileName) (installDir cabalFileName) copyFileWithMD5Check (workingDir "LICENSE") (installDir "LICENSE") copyCppFiles workingDir (csrcDir installDir) (unCabalName pkgname) pkgconfig - mapM_ (copyModule workingDir (srcDir installDir)) mods - mapM_ (copyTemplateModule workingDir (srcDir installDir)) tcms + for_ mods (copyModule workingDir (srcDir installDir)) + for_ tcms (copyTemplateModule workingDir (srcDir installDir)) moduleFileCopy workingDir (srcDir installDir) $ topLevelMod <.> "hs" @@ -181,20 +201,20 @@ copyCppFiles wdir ddir cprefix (PkgConfig _ cihs tih _ tcihs acincs acsrcs) = do >>= flip when (copyFileWithMD5Check (wdir tlhfile) (ddir tlhfile)) doesFileExist (wdir tlcppfile) >>= flip when (copyFileWithMD5Check (wdir tlcppfile) (ddir tlcppfile)) - forM_ cihs $ \header-> do + for_ cihs $ \header-> do let hfile = unHdrName (cihSelfHeader header) cppfile = cihSelfCpp header copyFileWithMD5Check (wdir hfile) (ddir hfile) copyFileWithMD5Check (wdir cppfile) (ddir cppfile) - forM_ tcihs $ \header-> do + for_ tcihs $ \header-> do let hfile = unHdrName (tcihSelfHeader header) copyFileWithMD5Check (wdir hfile) (ddir hfile) - forM_ acincs $ \(AddCInc header _) -> + for_ acincs $ \(AddCInc header _) -> copyFileWithMD5Check (wdir header) (ddir header) - forM_ acsrcs $ \(AddCSrc csrc _) -> + for_ acsrcs $ \(AddCSrc csrc _) -> copyFileWithMD5Check (wdir csrc) (ddir csrc) From b08e824758dbb216f874785bbbceded0bad92c4a Mon Sep 17 00:00:00 2001 From: Ian-Woo Kim Date: Thu, 6 Sep 2018 17:49:47 +0000 Subject: [PATCH 2/5] some more message. --- fficxx/lib/FFICXX/Generate/Builder.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/fficxx/lib/FFICXX/Generate/Builder.hs b/fficxx/lib/FFICXX/Generate/Builder.hs index 7b34cb9d..f95840a2 100644 --- a/fficxx/lib/FFICXX/Generate/Builder.hs +++ b/fficxx/lib/FFICXX/Generate/Builder.hs @@ -51,8 +51,12 @@ simpleBuilder :: String -> [(String,[String])] -- ^ extra module -> IO () simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extralibs extramods = do + putStrLn "----------------------------------------------------" + putStrLn "-- fficxx code generation for Haskell-C++ binding --" + putStrLn "----------------------------------------------------" + let pkgname = cabal_pkgname cabal - putStrLn ("generating " <> unCabalName pkgname) + putStrLn ("Generating " <> unCabalName pkgname) cwd <- getCurrentDirectory let cfg = FFICXXConfig { fficxxconfig_scriptBaseDir = cwd , fficxxconfig_workingDir = cwd "working" @@ -167,6 +171,10 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr for_ tcms (copyTemplateModule workingDir (srcDir installDir)) moduleFileCopy workingDir (srcDir installDir) $ topLevelMod <.> "hs" + putStrLn "----------------------------------------------------" + putStrLn "-- Code generation has been completed. Enjoy! --" + putStrLn "----------------------------------------------------" + -- | some dirty hack. later, we will do it with more proper approcah. From 6a7e926859520372d0b5809f1a868923dca0b36a Mon Sep 17 00:00:00 2001 From: Ian-Woo Kim Date: Thu, 6 Sep 2018 21:24:07 +0000 Subject: [PATCH 3/5] Introduce GeneratedCabalInfo and use it for cabal file generation --- fficxx/fficxx.cabal | 44 ++--- fficxx/lib/FFICXX/Generate/Code/Cabal.hs | 203 +++++++++++++++-------- fficxx/lib/FFICXX/Generate/Type/Cabal.hs | 71 ++++++-- fficxx/lib/FFICXX/Generate/Type/Class.hs | 10 +- fficxx/lib/FFICXX/Generate/Util.hs | 16 +- 5 files changed, 233 insertions(+), 111 deletions(-) diff --git a/fficxx/fficxx.cabal b/fficxx/fficxx.cabal index 98547b27..05ca1dd9 100644 --- a/fficxx/fficxx.cabal +++ b/fficxx/fficxx.cabal @@ -16,27 +16,29 @@ Source-repository head Library hs-source-dirs: lib - Build-Depends: base == 4.*, - Cabal, - bytestring, - containers, - data-default, - directory, - either, - errors, - filepath>1, - hashable, - haskell-src-exts >= 1.18, - lens > 3, - mtl>2, - process, - pureMD5, - split, - transformers >= 0.3, - template, - template-haskell, - text, - unordered-containers + Build-Depends: base == 4.* + , aeson + , aeson-pretty + , bytestring + , Cabal + , containers + , data-default + , directory + , either + , errors + , filepath>1 + , hashable + , haskell-src-exts >= 1.18 + , lens > 3 + , mtl>2 + , process + , pureMD5 + , split + , transformers >= 0.3 + , template + , template-haskell + , text + , unordered-containers Exposed-Modules: diff --git a/fficxx/lib/FFICXX/Generate/Code/Cabal.hs b/fficxx/lib/FFICXX/Generate/Code/Cabal.hs index 87eb6f86..2734098e 100644 --- a/fficxx/lib/FFICXX/Generate/Code/Cabal.hs +++ b/fficxx/lib/FFICXX/Generate/Code/Cabal.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : FFICXX.Generate.Code.Cabal @@ -17,25 +17,33 @@ module FFICXX.Generate.Code.Cabal where 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.Generate.Type.Cabal (AddCInc(..),AddCSrc(..),CabalName(..),Cabal(..)) +import FFICXX.Generate.Type.Cabal (AddCInc(..),AddCSrc(..) + ,CabalName(..),Cabal(..) + ,GeneratedCabalInfo(..)) import FFICXX.Generate.Type.Module import FFICXX.Generate.Type.PackageInterface import FFICXX.Generate.Util -cabalIndentation :: String -cabalIndentation = replicate 23 ' ' +cabalIndentation :: Text -- String +cabalIndentation = T.replicate 23 " " + +unlinesWithIndent = T.unlines . map (cabalIndentation <>) -- for source distribution genCsrcFiles :: (TopLevelImportHeader,[ClassModule]) -> [AddCInc] -> [AddCSrc] - -> String + -> [String] genCsrcFiles (tih,cmods) acincs acsrcs = - let indent = cabalIndentation + let -- indent = cabalIndentation selfheaders' = do x <- cmods y <- cmCIH x @@ -48,70 +56,79 @@ genCsrcFiles (tih,cmods) acincs acsrcs = selfcpp = nub selfcpp' tlh = tihHeaderFileName tih <.> "h" tlcpp = tihHeaderFileName tih <.> "cpp" - includeFileStrsWithCsrc = map (\x->indent<>"csrc" x) $ + includeFileStrsWithCsrc = map (\x->"csrc" x) $ (if (null.tihFuncs) tih then map unHdrName selfheaders else tlh:(map unHdrName selfheaders)) ++ map (\(AddCInc hdr _) -> hdr) acincs - cppFilesWithCsrc = map (\x->indent<>"csrc"x) $ + cppFilesWithCsrc = map (\x->"csrc"x) $ (if (null.tihFuncs) tih then selfcpp else tlcpp:selfcpp) ++ map (\(AddCSrc src _) -> src) acsrcs - in unlines (includeFileStrsWithCsrc <> cppFilesWithCsrc) - + in includeFileStrsWithCsrc <> cppFilesWithCsrc -- for library genIncludeFiles :: String -- ^ package name -> ([ClassImportHeader],[TemplateClassImportHeader]) -> [AddCInc] - -> String + -> [String] genIncludeFiles pkgname (cih,tcih) acincs = - let indent = cabalIndentation + let -- indent = cabalIndentation selfheaders = map cihSelfHeader cih <> map tcihSelfHeader tcih - includeFileStrs = map ((indent<>).unHdrName) (selfheaders ++ map (\(AddCInc hdr _) -> HdrName hdr) acincs) - in unlines ((indent<>pkgname<>"Type.h") : includeFileStrs) + includeFileStrs = map unHdrName (selfheaders ++ map (\(AddCInc hdr _) -> HdrName hdr) acincs) + in (pkgname<>"Type.h") : includeFileStrs + + +-- unlines ((indent<> -- for library genCppFiles :: (TopLevelImportHeader,[ClassModule]) -> [AddCSrc] - -> String + -> [String] genCppFiles (tih,cmods) acsrcs = - let indent = cabalIndentation + let -- indent = cabalIndentation selfcpp' = do x <- cmods y <- cmCIH x return (cihSelfCpp y) selfcpp = nub selfcpp' tlcpp = tihHeaderFileName tih <.> "cpp" - cppFileStrs = map (\x->indent<> "csrc" x) $ + cppFileStrs = map (\x -> "csrc" x) $ (if (null.tihFuncs) tih then selfcpp else tlcpp:selfcpp) ++ map (\(AddCSrc src _) -> src) acsrcs - in unlines cppFileStrs + in cppFileStrs -- | generate exposed module list in cabal file -genExposedModules :: String -> ([ClassModule],[TemplateClassModule]) -> String +genExposedModules :: String -> ([ClassModule],[TemplateClassModule]) -> [String] genExposedModules summarymod (cmods,tmods) = - let indentspace = cabalIndentation - summarystrs = indentspace <> summarymod - cmodstrs = map ((\x->indentspace<>x).cmModule) cmods - rawType = map ((\x->indentspace<>x<>".RawType").cmModule) cmods - ffi = map ((\x->indentspace<>x<>".FFI").cmModule) cmods - interface= map ((\x->indentspace<>x<>".Interface").cmModule) cmods - cast = map ((\x->indentspace<>x<>".Cast").cmModule) cmods - implementation = map ((\x->indentspace<>x<>".Implementation").cmModule) cmods - template = map ((\x->indentspace<>x<>".Template").tcmModule) tmods - th = map ((\x->indentspace<>x<>".TH").tcmModule) tmods - in unlines ([summarystrs]<>cmodstrs<>rawType<>ffi<>interface<>cast<>implementation<>template<>th) + let -- indentspace = cabalIndentation + -- summarystrs = summarymod + cmodstrs = map cmModule cmods + rawType = map ((\x -> x <> ".RawType").cmModule) cmods + ffi = map ((\x -> x <> ".FFI").cmModule) cmods + interface= map ((\x-> x <> ".Interface").cmModule) cmods + cast = map ((\x-> x <> ".Cast").cmModule) cmods + implementation = map ((\x-> x <> ".Implementation").cmModule) cmods + template = map ((\x-> x <> ".Template").tcmModule) tmods + th = map ((\x-> x <> ".TH").tcmModule) tmods + in -- unlines + [summarymod]<>cmodstrs<>rawType<>ffi<>interface<>cast<>implementation<>template<>th -- | generate other modules in cabal file -genOtherModules :: [ClassModule] -> String -genOtherModules _cmods = "" +genOtherModules :: [ClassModule] -> [String] +genOtherModules _cmods = [""] -- | generate additional package dependencies. -genPkgDeps :: [CabalName] -> String -genPkgDeps cs = intercalate " " (map (\(CabalName c) -> ", " <> c) cs) +genPkgDeps :: [CabalName] -> [String] +genPkgDeps cs = [ "base > 4 && < 5" + , "fficxx >= 0.5" + , "fficxx-runtime >= 0.5" + , "template-haskell" + ] + ++ map unCabalName cs + -- | @@ -142,7 +159,7 @@ cabalTemplate = \ 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\ \ cc-options: $ccOptions\n\ - \ Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell$deps\n\ + \ Build-Depends: $pkgdeps\n\ \ Exposed-Modules:\n\ \$exposedModules\n\ \ Other-Modules:\n\ @@ -156,6 +173,84 @@ cabalTemplate = \ 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 summarymodule pkgconfig extralibs = + let tih = pcfg_topLevelImportHeader pkgconfig + classmodules = pcfg_classModules pkgconfig + cih = pcfg_classImportHeaders pkgconfig + tmods = pcfg_templateClassModules pkgconfig + tcih = pcfg_templateClassImportHeaders pkgconfig + acincs = pcfg_additional_c_incs pkgconfig + acsrcs = pcfg_additional_c_srcs pkgconfig + extrafiles = cabal_extrafiles cabal + in GeneratedCabalInfo { + gci_pkgname = T.pack (unCabalName (cabal_pkgname cabal)) + , gci_version = T.pack (cabal_version cabal) + , gci_synopsis = "" + , gci_description = "" + , gci_homepage = "" + , gci_license = maybe "" T.pack (cabal_license cabal) + , gci_licenseFile = maybe "" T.pack (cabal_licensefile cabal) + , gci_author = "" + , gci_maintainer = "" + , gci_category = "" + , gci_buildtype = "Simple" + , gci_extraFiles = map T.pack extrafiles + , gci_csrcFiles = map T.pack $ genCsrcFiles (tih,classmodules) acincs acsrcs + , gci_sourcerepository = "" + , gci_ccOptions = ["-std=c++14"] + , gci_pkgdeps = map T.pack $ genPkgDeps (cabal_additional_pkgdeps cabal) + , gci_exposedModules = map T.pack $ genExposedModules summarymodule (classmodules,tmods) + , gci_otherModules = map T.pack $ genOtherModules classmodules + , gci_extraLibDirs = map T.pack $ cabal_extralibdirs cabal + , gci_extraLibraries = map T.pack extralibs + , gci_extraIncludeDirs = map T.pack $ cabal_extraincludedirs cabal + , gci_pkgconfigDepends = map T.pack $ cabal_pkg_config_depends cabal + , gci_includeFiles = map T.pack $ genIncludeFiles (unCabalName (cabal_pkgname cabal)) (cih,tcih) acincs + , gci_cppFiles = map T.pack $ genCppFiles (tih,classmodules) acsrcs + } + + +genCabalFile :: GeneratedCabalInfo -> Text +genCabalFile GeneratedCabalInfo {..} = + TL.toStrict $ + substitute cabalTemplate $ + contextT [ ("licenseField" , "license: " <> gci_license) + , ("licenseFileField", "license-file: " <> gci_licenseFile) + , ("pkgname" , gci_pkgname) + , ("version" , gci_version) + , ("buildtype" , gci_buildtype) + , ("synopsis" , gci_synopsis) + , ("description" , gci_description) + , ("homepage" , gci_homepage) + , ("author" , gci_author) + , ("maintainer" , gci_maintainer) + , ("category" , gci_category) + , ("sourcerepository", gci_sourcerepository) + , ("ccOptions" , T.intercalate " " gci_ccOptions) + , ("pkgdeps" , T.intercalate ", " gci_pkgdeps) + , ("extraFiles" , unlinesWithIndent gci_extraFiles) + , ("csrcFiles" , unlinesWithIndent gci_csrcFiles) + , ("includeFiles" , unlinesWithIndent gci_includeFiles) + , ("cppFiles" , unlinesWithIndent gci_cppFiles) + , ("exposedModules" , unlinesWithIndent gci_exposedModules) + , ("otherModules" , unlinesWithIndent gci_otherModules) + , ("extralibdirs" , T.intercalate ", " gci_extraLibDirs) + , ("extraincludedirs", T.intercalate ", " gci_extraIncludeDirs) + , ("extraLibraries" , T.intercalate ", " gci_extraLibraries) + , ("cabalIndentation", cabalIndentation) + , ("pkgconfigDepends", T.intercalate ", " gci_pkgconfigDepends) + ] + + -- | buildCabalFile :: Cabal @@ -165,41 +260,15 @@ buildCabalFile -> FilePath -> IO () buildCabalFile cabal summarymodule pkgconfig extralibs cabalfile = do - let tih = pcfg_topLevelImportHeader pkgconfig + let + {- tih = pcfg_topLevelImportHeader pkgconfig classmodules = pcfg_classModules pkgconfig cih = pcfg_classImportHeaders pkgconfig tmods = pcfg_templateClassModules pkgconfig tcih = pcfg_templateClassImportHeaders pkgconfig acincs = pcfg_additional_c_incs pkgconfig acsrcs = pcfg_additional_c_srcs pkgconfig - extrafiles = cabal_extrafiles cabal - txt = subst cabalTemplate - (context ([ ("licenseField", "license: " <> license) - | Just license <- [cabal_license cabal] ] <> - [ ("licenseFileField", "license-file: " <> licensefile) - | Just licensefile <- [cabal_licensefile cabal] ] <> - [ ("pkgname", unCabalName (cabal_pkgname cabal)) - , ("version", cabal_version cabal) - , ("buildtype", "Simple") - , ("synopsis", "") - , ("description", "") - , ("homepage","") - , ("author","") - , ("maintainer","") - , ("category","") - , ("sourcerepository","") - , ("ccOptions","-std=c++14") - , ("deps", genPkgDeps (cabal_additional_pkgdeps cabal)) - , ("extraFiles", concatMap (\x -> cabalIndentation <> x <> "\n") extrafiles) - , ("csrcFiles", genCsrcFiles (tih,classmodules) acincs acsrcs) - , ("includeFiles", genIncludeFiles (unCabalName (cabal_pkgname cabal)) (cih,tcih) acincs) - , ("cppFiles", genCppFiles (tih,classmodules) acsrcs) - , ("exposedModules", genExposedModules summarymodule (classmodules,tmods)) - , ("otherModules", genOtherModules classmodules) - , ("extralibdirs", intercalate ", " $ cabal_extralibdirs cabal) - , ("extraincludedirs", intercalate ", " $ cabal_extraincludedirs cabal) - , ("extraLibraries", concatMap (", " <>) extralibs) - , ("cabalIndentation", cabalIndentation) - , ("pkgconfigDepends", intercalate ", " (cabal_pkg_config_depends cabal)) - ])) - writeFile cabalfile txt + extrafiles = cabal_extrafiles cabal -} + cinfo = genCabalInfo cabal summarymodule pkgconfig extralibs + txt = genCabalFile cinfo + TIO.writeFile cabalfile txt diff --git a/fficxx/lib/FFICXX/Generate/Type/Cabal.hs b/fficxx/lib/FFICXX/Generate/Type/Cabal.hs index 70b86322..28425c32 100644 --- a/fficxx/lib/FFICXX/Generate/Type/Cabal.hs +++ b/fficxx/lib/FFICXX/Generate/Type/Cabal.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : FFICXX.Generate.Type.Cabal @@ -12,24 +14,65 @@ module FFICXX.Generate.Type.Cabal where +import Data.Aeson (ToJSON(..),genericToJSON,defaultOptions) +import Data.Aeson.Types (fieldLabelModifier) +import Data.Text (Text) +import GHC.Generics (Generic) + data AddCInc = AddCInc FilePath String data AddCSrc = AddCSrc FilePath String +-- TODO: change String to Text newtype CabalName = CabalName { unCabalName :: String } deriving (Show,Eq,Ord) -data Cabal = Cabal { cabal_pkgname :: CabalName - , cabal_version :: String - , cabal_cheaderprefix :: String - , cabal_moduleprefix :: String - , cabal_additional_c_incs :: [AddCInc] - , cabal_additional_c_srcs :: [AddCSrc] - , cabal_additional_pkgdeps :: [CabalName] - , cabal_license :: Maybe String - , cabal_licensefile :: Maybe String - , cabal_extraincludedirs :: [FilePath] - , cabal_extralibdirs :: [FilePath] - , cabal_extrafiles :: [FilePath] - , cabal_pkg_config_depends :: [String] - } +-- TODO: change String to Text +data Cabal = + Cabal { + cabal_pkgname :: CabalName + , cabal_version :: String + , cabal_cheaderprefix :: String + , cabal_moduleprefix :: String + , cabal_additional_c_incs :: [AddCInc] + , cabal_additional_c_srcs :: [AddCSrc] + , cabal_additional_pkgdeps :: [CabalName] + , cabal_license :: Maybe String + , cabal_licensefile :: Maybe String + , cabal_extraincludedirs :: [FilePath] + , cabal_extralibdirs :: [FilePath] + , cabal_extrafiles :: [FilePath] + , cabal_pkg_config_depends :: [String] + } + +data GeneratedCabalInfo = + GeneratedCabalInfo { + 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_ccOptions :: [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] + } + deriving (Show,Generic) + +instance ToJSON GeneratedCabalInfo where + toJSON = genericToJSON defaultOptions {fieldLabelModifier = drop 4} diff --git a/fficxx/lib/FFICXX/Generate/Type/Class.hs b/fficxx/lib/FFICXX/Generate/Type/Class.hs index a602c6ad..a1b2a76e 100644 --- a/fficxx/lib/FFICXX/Generate/Type/Class.hs +++ b/fficxx/lib/FFICXX/Generate/Type/Class.hs @@ -68,12 +68,12 @@ data Types = Void | SelfType | CT CTypes IsConst | CPT CPPTypes IsConst - | TemplateApp TemplateAppInfo -- ^ like vector* - | TemplateAppRef TemplateAppInfo -- ^ like vector& - | TemplateAppMove TemplateAppInfo -- ^ like unique_ptr (using std::move) - | TemplateType TemplateClass -- ^ template self? TODO: clarify this. + | TemplateApp TemplateAppInfo -- ^ like vector* + | TemplateAppRef TemplateAppInfo -- ^ like vector& + | TemplateAppMove TemplateAppInfo -- ^ like unique_ptr (using std::move) + | TemplateType TemplateClass -- ^ template self? TODO: clarify this. | TemplateParam String - | TemplateParamPointer String -- ^ this is A* with template + | TemplateParamPointer String -- ^ this is A* with template deriving Show ------------- diff --git a/fficxx/lib/FFICXX/Generate/Util.hs b/fficxx/lib/FFICXX/Generate/Util.hs index b89b0108..0062bfac 100644 --- a/fficxx/lib/FFICXX/Generate/Util.hs +++ b/fficxx/lib/FFICXX/Generate/Util.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : FFICXX.Generate.Util --- Copyright : (c) 2011-2016 Ian-Woo Kim +-- Copyright : (c) 2011-2018 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -16,8 +17,9 @@ module FFICXX.Generate.Util where import Data.Char import Data.List import Data.List.Split -import Data.Monoid ( (<>) ) -import Data.Text ( Text ) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Template @@ -81,11 +83,17 @@ intercalateWithM f mapper x | otherwise = return "" +-- TODO: deprecate this and use contextT context :: [(Text,String)] -> Context context assocs x = maybe err (T.pack) . lookup x $ assocs where err = error $ "Could not find key: " <> (T.unpack x) - +-- TODO: Rename this to context. +-- TODO: Proper error handling. +contextT :: [(Text,Text)] -> Context +contextT assocs x = fromMaybe err . lookup x $ assocs + where err = error $ T.unpack ("Could not find key: " <> x) + subst :: Text -> Context -> String subst t c = TL.unpack (substitute t c) From 01f4c94ebdda931b8f6df7cea749d2740bb4d12d Mon Sep 17 00:00:00 2001 From: Ian-Woo Kim Date: Thu, 6 Sep 2018 22:35:52 +0000 Subject: [PATCH 4/5] generate JSON file --- fficxx/lib/FFICXX/Generate/Builder.hs | 5 +++++ fficxx/lib/FFICXX/Generate/Code/Cabal.hs | 27 +++++++++++++++--------- stdcxx-gen/default.nix | 2 +- 3 files changed, 23 insertions(+), 11 deletions(-) diff --git a/fficxx/lib/FFICXX/Generate/Builder.hs b/fficxx/lib/FFICXX/Generate/Builder.hs index f95840a2..2e01971c 100644 --- a/fficxx/lib/FFICXX/Generate/Builder.hs +++ b/fficxx/lib/FFICXX/Generate/Builder.hs @@ -73,6 +73,7 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr (cabal_additional_c_srcs cabal) hsbootlst = mkHSBOOTCandidateList mods cabalFileName = unCabalName pkgname <.> "cabal" + jsonFileName = unCabalName pkgname <.> "json" -- notExistThenCreate workingDir notExistThenCreate installDir @@ -82,6 +83,9 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr putStrLn "Generating Cabal file" buildCabalFile cabal topLevelMod pkgconfig extralibs (workingDircabalFileName) -- + putStrLn "Generating JSON file" + buildJSONFile cabal topLevelMod pkgconfig extralibs (workingDirjsonFileName) + -- putStrLn "Generating Header file" let typmacro = TypMcro ("__" <> macrofy (unCabalName (cabal_pkgname cabal)) <> "__") gen :: FilePath -> String -> IO () @@ -164,6 +168,7 @@ simpleBuilder topLevelMod mumap (cabal,classes,toplevelfunctions,templates) extr putStrLn "Copying generated files to target directory" touch (workingDir "LICENSE") copyFileWithMD5Check (workingDir cabalFileName) (installDir cabalFileName) + copyFileWithMD5Check (workingDir jsonFileName) (installDir jsonFileName) copyFileWithMD5Check (workingDir "LICENSE") (installDir "LICENSE") copyCppFiles workingDir (csrcDir installDir) (unCabalName pkgname) pkgconfig diff --git a/fficxx/lib/FFICXX/Generate/Code/Cabal.hs b/fficxx/lib/FFICXX/Generate/Code/Cabal.hs index 2734098e..90c9a492 100644 --- a/fficxx/lib/FFICXX/Generate/Code/Cabal.hs +++ b/fficxx/lib/FFICXX/Generate/Code/Cabal.hs @@ -14,6 +14,8 @@ 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) @@ -256,19 +258,24 @@ buildCabalFile :: Cabal -> String -> PackageConfig - -> [String] -- ^ extra libs - -> FilePath + -> [String] -- ^ Extra libs + -> FilePath -- ^ Cabal file path -> IO () buildCabalFile cabal summarymodule pkgconfig extralibs cabalfile = do let - {- tih = pcfg_topLevelImportHeader pkgconfig - classmodules = pcfg_classModules pkgconfig - cih = pcfg_classImportHeaders pkgconfig - tmods = pcfg_templateClassModules pkgconfig - tcih = pcfg_templateClassImportHeaders pkgconfig - acincs = pcfg_additional_c_incs pkgconfig - acsrcs = pcfg_additional_c_srcs pkgconfig - extrafiles = cabal_extrafiles cabal -} cinfo = genCabalInfo cabal summarymodule pkgconfig extralibs txt = genCabalFile cinfo TIO.writeFile cabalfile txt + + +-- | +buildJSONFile + :: Cabal + -> String + -> PackageConfig + -> [String] -- ^ Extra libs + -> FilePath -- ^ JSON file path + -> IO () +buildJSONFile cabal summarymodule pkgconfig extralibs jsonfile = do + let cinfo = genCabalInfo cabal summarymodule pkgconfig extralibs + BL.writeFile jsonfile (encodePretty cinfo) diff --git a/stdcxx-gen/default.nix b/stdcxx-gen/default.nix index 02eb4f19..62d9c8b4 100644 --- a/stdcxx-gen/default.nix +++ b/stdcxx-gen/default.nix @@ -7,7 +7,7 @@ in { mkDerivation, base, fficxx, fficxx-runtime, stdenv, template-haskell }: mkDerivation { pname = "stdcxx"; - version = "0.0"; + version = "0.5"; src = stdcxx-src; libraryHaskellDepends = [ base fficxx fficxx-runtime template-haskell From 665fb94df83aa70e7306980cb01868903b6e0a85 Mon Sep 17 00:00:00 2001 From: Ian-Woo Kim Date: Thu, 6 Sep 2018 23:00:27 +0000 Subject: [PATCH 5/5] add FromJSON instance for GeneratedCabalInfo --- fficxx/lib/FFICXX/Generate/Type/Cabal.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/fficxx/lib/FFICXX/Generate/Type/Cabal.hs b/fficxx/lib/FFICXX/Generate/Type/Cabal.hs index 28425c32..23f36909 100644 --- a/fficxx/lib/FFICXX/Generate/Type/Cabal.hs +++ b/fficxx/lib/FFICXX/Generate/Type/Cabal.hs @@ -14,10 +14,12 @@ module FFICXX.Generate.Type.Cabal where -import Data.Aeson (ToJSON(..),genericToJSON,defaultOptions) +import Data.Aeson (FromJSON(..),ToJSON(..) + ,genericParseJSON,genericToJSON + ,defaultOptions) import Data.Aeson.Types (fieldLabelModifier) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Text (Text) +import GHC.Generics (Generic) data AddCInc = AddCInc FilePath String @@ -76,3 +78,6 @@ data GeneratedCabalInfo = instance ToJSON GeneratedCabalInfo where toJSON = genericToJSON defaultOptions {fieldLabelModifier = drop 4} + +instance FromJSON GeneratedCabalInfo where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = drop 4}