@@ -35,10 +35,11 @@ import Data.Typeable ( Typeable )
3535import Data.Monoid ( Endo (.. ) )
3636import Data.Maybe ( fromMaybe )
3737import Data.List ( unfoldr )
38- import Data.Char ( isAlpha , isAlphaNum )
38+ import Data.Char ( isAlpha , isAlphaNum , isUpperCase )
3939
40- import System.FilePath ( (</>) , (<.>) , takeDirectory , takeExtension )
41- import System.Directory ( copyFile , createDirectoryIfMissing , getDirectoryContents )
40+ import System.FilePath ( (</>) , (<.>) , takeBaseName , takeDirectory , takeExtension )
41+ import System.Directory ( copyFile , removeFile , createDirectoryIfMissing )
42+ import System.Directory.Extra ( listFilesRecursive , listDirectories , listFiles )
4243import System.Process ( spawnProcess , readProcess , waitForProcess )
4344import System.Exit ( ExitCode (.. ) )
4445import System.Environment ( setEnv )
@@ -71,8 +72,8 @@ initCodeBlocks dependenciesOpt = do
7172
7273 -- add hooks for writing out files (and possibly compiling the project)
7374 let finalizer = case dependenciesOpt of
74- Nothing -> fileFinalizer
75- Just deps -> fileFinalizer *> cargoFinalizer [] deps
75+ Nothing -> fileFinalizer True
76+ Just deps -> fileFinalizer False *> cargoFinalizer [] deps
7677 addModFinalizer finalizer
7778
7879 -- add a module state
@@ -137,7 +138,6 @@ getRType rustType = do
137138getHType :: HType -> Q RType
138139getHType haskType = getHTypeInContext haskType =<< getContext
139140
140-
141141-- * Finalizers
142142
143143-- | A finalizer to run Cargo and link in the static library. This function
@@ -150,24 +150,37 @@ cargoFinalizer :: [String] -- ^ Extra @cargo@ arguments
150150 -> [(String , String )] -- ^ Dependencies
151151 -> Q ()
152152cargoFinalizer extraArgs dependencies = do
153- (pkg, mods ) <- currentFile
153+ (pkg, _ ) <- currentFile
154154
155- let dir = " .inline-rust" </> pkg
156- thisFile = foldr1 ( </>) mods <.> " rs "
155+ let pkgDir = " .inline-rust" </> pkg
156+ srcDir = pkgDir </> " src "
157157 crate = " quasiquote_" ++ pkg
158158
159- nameFiles <- map (dir </> ) . filter ((" .ffinames" == ) . takeExtension) <$> runIO (getDirectoryContents dir)
160- runIO $ print nameFiles
159+ nameFiles <- filter ((" .ffinames" == ) . takeExtension) <$> runIO (listFilesRecursive srcDir)
160+
161+ let modDir dir = do
162+ subdirs <- listDirectories dir
163+ mapM_ modDir $ (dir </> ) <$> subdirs
164+ srcs <- filter (\ file -> takeExtension file == " .rs" && isUpperCase (head $ takeBaseName file)) <$> listFiles dir
165+ let modules = takeBaseName <$> (subdirs <> srcs)
166+ writeFile (dir </> " mod.rs" ) . unlines . concat $ [ [" " , " pub mod " <> name <> " ;" , " pub use " <> name <> " ::*;" ]
167+ | name <- modules
168+ ]
169+
170+ runIO $ do
171+ modDir srcDir
172+ readFile (srcDir </> " mod.rs" ) >>= appendFile (srcDir </> " lib.rs" )
173+ removeFile $ srcDir </> " mod.rs"
174+
161175 names <- runIO $ concat <$> forM nameFiles (fmap lines . readFile )
162- runIO $ print names
163176 ffiFakeSig <- [t | IO () |]
164177 forM_ names $ \ name -> do
165178 name' <- newName $ name <> " _fake"
166179 let ffiImport = ForeignD (ImportF CCall Unsafe name name' ffiFakeSig)
167180 addTopDecls [ffiImport]
168181
169182 -- Make contents of a @Cargo.toml@ file
170- let cargoToml = dir </> " Cargo" <.> " toml"
183+ let cargoToml = pkgDir </> " Cargo" <.> " toml"
171184 cargoSrc = unlines [ " [package]"
172185 , " name = \" " ++ crate ++ " \" "
173186 , " version = \" 0.0.0\" "
@@ -178,11 +191,11 @@ cargoFinalizer extraArgs dependencies = do
178191 ]
179192
180193 , " [lib]"
181- , " path = \" " ++ thisFile ++ " \" "
182194 , " crate-type = [\" staticlib\" ]"
183195 ]
184- runIO $ createDirectoryIfMissing True dir
185- runIO $ writeFile cargoToml cargoSrc
196+ runIO $ do
197+ createDirectoryIfMissing True pkgDir
198+ writeFile cargoToml cargoSrc
186199
187200 -- Run Cargo to compile the project
188201 --
@@ -242,12 +255,13 @@ rustcErrMsg = "Rust source file associated with this module failed to compile"
242255-- a module. This emits into a file in the @.inline-rust@ directory all of the
243256-- Rust code we have produced while processing the current files contexts and
244257-- quasiquotes.
245- fileFinalizer :: Q ()
246- fileFinalizer = do
258+ fileFinalizer :: Bool -> Q ()
259+ fileFinalizer submodule = do
247260 (pkg, mods) <- currentFile
248261
249- let dir = " .inline-rust" </> pkg
250- thisFile = foldr1 (</>) mods
262+ let pkgDir = " .inline-rust" </> pkg
263+ srcDir = pkgDir </> " src"
264+ thisFile = if submodule then foldr1 (</>) mods else " lib"
251265
252266 -- Figure out what we are putting into this file
253267 Just cb <- getQ
@@ -262,14 +276,13 @@ fileFinalizer = do
262276 $ " "
263277
264278 -- Write out the file
265- let filepath = dir </> thisFile <.> " rs"
279+ let filepath = srcDir </> thisFile <.> " rs"
280+ let namesFile = srcDir </> thisFile <.> " ffinames"
281+ Just (FFINames names) <- getQ
266282 runIO $ do
267283 createDirectoryIfMissing True $ takeDirectory filepath
268284 writeFile filepath code
269-
270- Just (FFINames names) <- getQ
271- let namesFile = dir </> foldr1 (<.>) mods <.> " ffinames"
272- runIO . writeFile namesFile . unlines $ names
285+ writeFile namesFile . unlines $ names
273286
274287-- | Figure out what file we are currently in.
275288currentFile :: Q ( String -- ^ package name, amended to be a valid crate name
@@ -289,5 +302,3 @@ currentFile = do
289302 splitDots = unfoldr splitDot
290303 splitDot s | null s = Nothing
291304 | otherwise = let (x,r) = break (== ' .' ) s in Just (x,drop 1 r)
292-
293-
0 commit comments