diff --git a/README.md b/README.md index fca5487..979b301 100644 --- a/README.md +++ b/README.md @@ -35,24 +35,12 @@ If you want to use this with GHCi, make sure to pass in `-fobject-code`. ## Building -This currently depends on a GHC [feature][1] that will be available in GHC 8.6. -Until then, you'll have to [build GHC][0] yourself or get a binary. For the -latter, you can install one of GHC's nightly builds. +This depends ghc >= 8.6. An easy way to run the examples is to use environment files: - $ curl https://ghc-artifacts.s3.amazonaws.com/nightly/validate-x86_64-darwin/latest/bindist.tar.xz | tar xz - $ cd ghc-* - $ ./configure && make install - -With that installed, something like the following should work - - $ cabal new-build -w /usr/local/bin/ghc-8.5.20180423 - $ cabal new-test -w /usr/local/bin/ghc-8.5.20180423 - -Running the examples is only a matter of threading through the right package -databases. With a new enough Cabal, `new-exec` does this for you. - - $ cabal new-exec -w /usr/local/bin/ghc-8.5.20180423 ghc -- -threaded -package inline-rust examples/Hello.hs + $ cabal build --write-ghc-environment-files=always + $ ghc -threaded examples/Hello.hs [1 of 1] Compiling Main ( examples/Hello.hs, examples/Hello.o ) + ... Linking examples/Hello ... $ ./examples/Hello Haskell: Hello. Enter a number: diff --git a/inline-rust.cabal b/inline-rust.cabal index e30e158..0c015ee 100644 --- a/inline-rust.cabal +++ b/inline-rust.cabal @@ -45,7 +45,7 @@ library , ForeignFunctionInterface , ScopedTypeVariables - build-depends: base >=4.9 && <5.0 + build-depends: base >=4.12 && <5.0 , language-rust >=0.2.0 , prettyprinter >=1.1 , process >=1.4 diff --git a/src/Language/Rust/Inline/Context.hs b/src/Language/Rust/Inline/Context.hs index cf85319..86b5ffc 100644 --- a/src/Language/Rust/Inline/Context.hs +++ b/src/Language/Rust/Inline/Context.hs @@ -7,6 +7,7 @@ Maintainer : alec.theriault@gmail.com Stability : experimental Portability : GHC -} +{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -35,10 +36,14 @@ import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) import Foreign.Ptr ( Ptr, FunPtr ) import Foreign.C.Types -- pretty much every type here is used +import qualified Control.Monad.Fail as Fail import GHC.Exts ( Char#, Int#, Word#, Float#, Double#, ByteArray# ) +instance Fail.MonadFail First where + fail _ = mempty + -- Easier on the eyes type RType = Ty () type HType = Type diff --git a/src/Language/Rust/Inline/Internal.hs b/src/Language/Rust/Inline/Internal.hs index 1bb598a..082afdf 100644 --- a/src/Language/Rust/Inline/Internal.hs +++ b/src/Language/Rust/Inline/Internal.hs @@ -25,14 +25,14 @@ import Language.Rust.Inline.Context import Language.Haskell.TH import Language.Haskell.TH.Syntax -import Control.Monad ( when ) +import Control.Monad ( when ) import Data.Typeable ( Typeable ) import Data.Monoid ( Endo(..) ) import Data.Maybe ( fromMaybe ) import Data.List ( unfoldr ) import Data.Char ( isAlpha, isAlphaNum ) -import System.FilePath ( (), (<.>), takeExtension ) +import System.FilePath ( (), (<.>), takeDirectory, takeExtension ) import System.Directory ( copyFile, createDirectoryIfMissing ) import System.Process ( spawnProcess, readProcess, waitForProcess ) import System.Exit ( ExitCode(..) ) @@ -54,17 +54,17 @@ newtype CodeBlocks = CodeBlocks { showsCodeBlocks :: ShowS } -- | Initialize the 'CodeBlocks' of the current module. Crash if it is already -- intialized. This must be called exactly once. initCodeBlocks :: Maybe [(String,String)] -- ^ dependencies, if crate root - -> Q () + -> Q () initCodeBlocks dependenciesOpt = do -- check if there is already something there cb <- getQ case cb of Nothing -> pure () Just (CodeBlocks _) -> fail "initCodeBlocks: CodeBlocks already initialized" - + -- add hooks for writing out files (and possibly compiling the project) let finalizer = case dependenciesOpt of - Nothing -> fileFinalizer + Nothing -> fileFinalizer Just deps -> fileFinalizer *> cargoFinalizer [] deps addModFinalizer finalizer @@ -74,13 +74,13 @@ initCodeBlocks dependenciesOpt = do -- | Emit a raw 'String' of Rust code into the current 'ModuleState'. emitCodeBlock :: String -> Q [Dec] emitCodeBlock code = do - Just (CodeBlocks cbs) <- getQ + Just (CodeBlocks cbs) <- getQ putQ (CodeBlocks (cbs . showString code . showString "\n")) pure [] -- | Freeze the context and begin the part of the module which can contain Rust -- quasiquotes. If this module is also the crate root, use 'setCrateRoot' --- instead. +-- instead. -- -- This function must be called before any other Rust quasiquote in the file. setCrateModule :: Q [Dec] @@ -105,12 +105,12 @@ setCrateRoot dependencies = do getContext :: Q Context getContext = fromMaybe mempty <$> getQ --- | Append to the existing context +-- | Append to the existing context extendContext :: Q Context -> Q [Dec] extendContext qExtension = do extension <- qExtension ctx <- getContext - putQ (ctx <> extension) + putQ (ctx <> extension) pure [] -- | Search in a 'Context' for the Haskell type corresponding to a Rust type. @@ -128,10 +128,10 @@ getHType haskType = getHTypeInContext haskType =<< getContext -- | A finalizer to run Cargo and link in the static library. This function -- should be the very last @inline-rust@ related TH to run. --- +-- -- After generating an appropriate @Cargo.toml@ file, it calls out to Cargo to -- compile all the Rust files into a static library and which it then tells TH --- to link in. +-- to link in. cargoFinalizer :: [String] -- ^ Extra @cargo@ arguments -> [(String, String)] -- ^ Dependencies -> Q () @@ -177,22 +177,23 @@ cargoFinalizer extraArgs dependencies = do let cargoArgs = [ "build" , "--release" , "--manifest-path=" ++ cargoToml - ] ++ extraArgs + ] ++ extraArgs msgFormat = [ "--message-format=json" ] ec <- runIO $ spawnProcess "cargo" cargoArgs >>= waitForProcess when (ec /= ExitSuccess) (reportError rustcErrMsg) - + -- Run Cargo again to get the static library path jOuts <- runIO $ readProcess "cargo" (cargoArgs ++ msgFormat) "" - let jOut = last (lines jOuts) + let jOut = last (init $ lines jOuts) + -- runIO $ putStrLn jOuts rustLibFp <- case decode jOut of Error msg -> fail ("cargoFinalizer: " ++ msg) Ok jObj -> case lookup "filenames" (fromJSObject jObj) of Just (JSArray [ JSString jStr ]) -> pure (fromJSString jStr) - _ -> fail ("cargoFinalizer: did not find one static library") + _ -> fail ("cargoFinalizer: did not find one static library from output: " ++ show (fromJSObject jObj)) -- Move the library to a GHC temporary file let ext = takeExtension rustLibFp @@ -223,10 +224,10 @@ fileFinalizer = do let dir = ".inline-rust" pkg thisFile = foldr1 () mods <.> "rs" - -- Figure out what we are putting into this file + -- Figure out what we are putting into this file Just cb <- getQ Just (Context (_,_,impls)) <- getQ - let code = showsCodeBlocks cb + let code = showsCodeBlocks cb . showString "pub mod marshal {\n" . showString "#[allow(unused_imports)] use super::*;\n" . showString "pub trait MarshalInto { fn marshal(self) -> T; }\n" @@ -236,8 +237,9 @@ fileFinalizer = do $ "" -- Write out the file - runIO $ createDirectoryIfMissing True dir - runIO $ writeFile (dir thisFile) code + let filepath = dir thisFile + runIO $ createDirectoryIfMissing True (takeDirectory filepath) + runIO $ writeFile filepath code -- | Figure out what file we are currently in. currentFile :: Q ( String -- ^ package name, amended to be a valid crate name @@ -257,5 +259,3 @@ currentFile = do splitDots = unfoldr splitDot splitDot s | null s = Nothing | otherwise = let (x,r) = break (== '.') s in Just (x,drop 1 r) - -