write mod.rs files for sub-modules

Author: ners

inline-rust.cabal

@@ -47,6 +47,7 @@ library
                      , ScopedTypeVariables
 
   build-depends:       base                 >=4.9 && <5.0
+                     , extra                >=0.5
                      , language-rust        >=0.2.0
                      , prettyprinter        >=1.1
                      , process              >=1.4

src/Language/Rust/Inline/Internal.hs

@@ -35,10 +35,11 @@ import Data.Typeable               ( Typeable )
 import Data.Monoid                 ( Endo(..) )
 import Data.Maybe                  ( fromMaybe )
 import Data.List                   ( unfoldr )
-import Data.Char                   ( isAlpha, isAlphaNum )
+import Data.Char                   ( isAlpha, isAlphaNum, isUpperCase )
 
-import System.FilePath             ( (</>), (<.>), takeDirectory, takeExtension )
-import System.Directory            ( copyFile, createDirectoryIfMissing, getDirectoryContents )
+import System.FilePath             ( (</>), (<.>), takeBaseName, takeDirectory, takeExtension )
+import System.Directory            ( copyFile, removeFile, createDirectoryIfMissing )
+import System.Directory.Extra      ( listFilesRecursive, listDirectories, listFiles )
 import System.Process              ( spawnProcess, readProcess, waitForProcess )
 import System.Exit                 ( ExitCode(..) )
 import System.Environment          ( setEnv )
@@ -71,8 +72,8 @@ initCodeBlocks dependenciesOpt = do
 
   -- add hooks for writing out files (and possibly compiling the project)
   let finalizer = case dependenciesOpt of
-                    Nothing -> fileFinalizer 
-                    Just deps -> fileFinalizer *> cargoFinalizer [] deps
+                    Nothing -> fileFinalizer True
+                    Just deps -> fileFinalizer False *> cargoFinalizer [] deps
   addModFinalizer finalizer
 
   -- add a module state
@@ -137,7 +138,6 @@ getRType rustType = do
 getHType :: HType -> Q RType
 getHType haskType = getHTypeInContext haskType =<< getContext
 
-
 -- * Finalizers
 
 -- | A finalizer to run Cargo and link in the static library. This function
@@ -150,24 +150,36 @@ cargoFinalizer :: [String]           -- ^ Extra @cargo@ arguments
                -> [(String, String)] -- ^ Dependencies
                -> Q ()
 cargoFinalizer extraArgs dependencies = do
-  (pkg, mods) <- currentFile
+  (pkg, _) <- currentFile
 
-  let dir = ".inline-rust" </> pkg
-      thisFile = foldr1 (</>) mods <.> "rs"
+  let pkgDir = ".inline-rust" </> pkg
+      srcDir = pkgDir </> "src"
       crate = "quasiquote_" ++ pkg
 
-  nameFiles <- map (dir </>) . filter ((".ffinames" ==) . takeExtension) <$> runIO (getDirectoryContents dir)
-  runIO $ print nameFiles
+  nameFiles <- filter ((".ffinames" ==) . takeExtension) <$> runIO (listFilesRecursive srcDir)
+
+  let modDir dir = do
+        subdirs <- listDirectories dir
+        mapM_ modDir $ (dir </>) <$> subdirs
+        srcs <- filter (\file -> takeExtension file == ".rs" && isUpperCase (head $ takeBaseName file)) <$> listFiles dir
+        let modules = takeBaseName <$> (subdirs <> srcs)
+        writeFile (dir </> "mod.rs") . unlines . concat $
+            [["", "pub mod " <> name <> ";", "pub use " <> name <> "::*;"] | name <- modules]
+
+  runIO $ do
+    modDir srcDir
+    readFile (srcDir </> "mod.rs") >>= appendFile (srcDir </> "lib.rs")
+    removeFile $ srcDir </> "mod.rs"
+
   names <- runIO $ concat <$> forM nameFiles (fmap lines . readFile)
-  runIO $ print names
   ffiFakeSig <- [t| IO () |]
   forM_ names $ \name -> do
     name' <- newName $ name <> "_fake"
     let ffiImport = ForeignD (ImportF CCall Unsafe name name' ffiFakeSig)
     addTopDecls [ffiImport]
 
   -- Make contents of a @Cargo.toml@ file
-  let cargoToml = dir </> "Cargo" <.> "toml"
+  let cargoToml = pkgDir </> "Cargo" <.> "toml"
       cargoSrc = unlines [ "[package]"
                          , "name = \"" ++ crate ++ "\""
                          , "version = \"0.0.0\""
@@ -178,11 +190,11 @@ cargoFinalizer extraArgs dependencies = do
                                    ]
 
                          , "[lib]"
-                         , "path = \"" ++ thisFile ++ "\""
                          , "crate-type = [\"staticlib\"]"
                          ]
-  runIO $ createDirectoryIfMissing True dir
-  runIO $ writeFile cargoToml cargoSrc
+  runIO $ do
+    createDirectoryIfMissing True pkgDir
+    writeFile cargoToml cargoSrc
 
   -- Run Cargo to compile the project
   --
@@ -242,12 +254,13 @@ rustcErrMsg = "Rust source file associated with this module failed to compile"
 -- a module. This emits into a file in the @.inline-rust@ directory all of the
 -- Rust code we have produced while processing the current files contexts and
 -- quasiquotes.
-fileFinalizer :: Q ()
-fileFinalizer = do
+fileFinalizer :: Bool -> Q ()
+fileFinalizer submodule = do
   (pkg, mods) <- currentFile
 
-  let dir = ".inline-rust" </> pkg
-      thisFile = foldr1 (</>) mods
+  let pkgDir = ".inline-rust" </> pkg
+      srcDir = pkgDir </> "src"
+      thisFile = if submodule then foldr1 (</>) mods else "lib"
 
   -- Figure out what we are putting into this file 
   Just cb <- getQ
@@ -262,13 +275,13 @@ fileFinalizer = do
            $ ""
 
   -- Write out the file
-  let filepath = dir </> thisFile <.> "rs"
+  let filepath = srcDir </> thisFile <.> "rs"
   runIO $ do
     createDirectoryIfMissing True $ takeDirectory filepath
     writeFile filepath code
 
   Just (FFINames names) <- getQ
-  let namesFile = dir </> foldr1 (<.>) mods <.> "ffinames"
+  let namesFile = srcDir </> foldr1 (<.>) mods <.> "ffinames"
   runIO . writeFile namesFile . unlines $ names
 
 -- | Figure out what file we are currently in.
@@ -289,5 +302,3 @@ currentFile = do
     splitDots = unfoldr splitDot
     splitDot s | null s = Nothing
                | otherwise = let (x,r) = break (== '.') s in Just (x,drop 1 r)
-
-

tests/Main.hs

@@ -24,22 +24,6 @@ import Foreign.Marshal.Array
 extendContext basic
 setCrateRoot []
 
-[rust|
-mod GhcUnboxedTypes;
-mod SimpleTypes;
-mod PointerTypes;
-mod FunctionPointerTypes;
-mod PreludeTypes;
-mod AlgebraicDataTypes;
-
-pub use GhcUnboxedTypes::*;
-pub use SimpleTypes::*;
-pub use PointerTypes::*;
-pub use FunctionPointerTypes::*;
-pub use PreludeTypes::*;
-pub use AlgebraicDataTypes::*;
-|]
-
 main :: IO ()
 main = hspec $
   describe "Rust quasiquoter" $ do