Upgrade code and get it all working once again

This fixes year long issues in regards to linking. It's been frustrating
to say the least and was a big reason I let the code bit rot. Given
their is a pandemic goin on now and well I got bored I took the time to
fix all the code. This moves it into Rust 2018 edition works on a newer
version of GHC and overall reformats and cleans up the code with some
better libraries. This isn't the state the release will be in, but it's
just nice to have all the test suites working again and maybe now I can
make some actual progress on creating a good library.

.editorconfig

@@ -4,7 +4,7 @@ root = true
 indent_style = tab
 
 [*.rs]
-indent_style = tab
+indent_style = space
 indent_size = 4
 
 [*.hs]

.gitignore

@@ -2,6 +2,7 @@ target
 Cargo.lock
 .stack-work
 dist
+**/dist-newstyle
 *.a
 *.so
 .cabal-sandbox

Cargo.toml

@@ -1,6 +1,7 @@
 [package]
 name = "curryrs"
 version = "0.2.0"
+edition = "2018"
 authors = ["Michael Gattozzi <mgattozzi@gmail.com>"]
 description = "Utilities making Rust/Haskell FFI easier"
 documentation = "https://docs.rs/curryrs/"
@@ -30,6 +31,11 @@ members = ["rtest", "hrgen", "hrgen/hs-type-parser"]
 [dependencies]
 libc = "0.2"
 
+[build-dependencies]
+bindgen = "0.53"
+toml = "*"
+walkdir = "*"
+
 [features]
 # Features available for choosing alternative
 # Runtime libraries for Haskell. By default it

benches/benches.rs

@@ -0,0 +1 @@
+

build.rs

@@ -1,22 +1,19 @@
-use std::fs::read_dir;
-use std::path::Path;
-use std::process::Command;
-use std::io;
-use std::str;
+use std::{env, error::Error, path::PathBuf, process::Command, str};
+use walkdir::WalkDir;
 
 fn command_output(cmd: &mut Command) -> String {
-	str::from_utf8(&cmd.output().unwrap().stdout)
-		.unwrap()
-		.trim_right()
-		.to_string()
+  str::from_utf8(&cmd.output().unwrap().stdout)
+    .unwrap()
+    .trim()
+    .to_string()
 }
 
 fn command_ok(cmd: &mut Command) -> bool {
-	cmd.status().ok().map_or(false, |s| s.success())
+  cmd.status().ok().map_or(false, |s| s.success())
 }
 
 fn ghc(builder: &str, arg: &str) -> String {
-	command_output(Command::new(builder).args(&["exec", "--", "ghc", arg]))
+  command_output(Command::new(builder).args(&["exec", "--", "ghc", arg]))
 }
 
 // Each os has a diferent extesion for the Dynamic Libraries. This compiles for
@@ -25,78 +22,103 @@ fn ghc(builder: &str, arg: &str) -> String {
 const DYLIB_EXTENSION: &'static str = ".so";
 
 #[cfg(target_os = "macos")]
-const DYLIB_EXTENSION: &'static str = ".dylib";
+const DYLIB_EXTENSION: &'static str = ".a";
 
 #[cfg(target_os = "windows")]
 const DYLIB_EXTENSION: &'static str = ".dll";
 
-// This allows the user to choose which version of the Runtime System they want
-// to use. By default it is non threaded.
-#[cfg(not(any(feature = "threaded", feature = "threaded_l", feature = "threaded_debug")))]
-const RTS: &'static str = "libHSrts-g";
-
-#[cfg(feature = "threaded")]
-const RTS: &'static str = "libHSrts_thr-";
-
-#[cfg(feature = "threaded_l")]
-const RTS: &'static str = "libHSrts_thr_l-";
-
-#[cfg(feature = "threaded_debug")]
-const RTS: &'static str = "libHSrts_thr_debug-";
-
 fn main() {
-	// Traverse the directory to link all of the libs in ghc
-	// then tell cargo where to get htest for linking
-	match link_ghc_libs() {
-		Err(e) => panic!("Unable to link ghc_libs: {}", e),
-		Ok(_)  => println!("cargo:rustc-link-search=native=htest"),
-	}
+  // Traverse the directory to link all of the libs in ghc
+  // then tell cargo where to get htest for linking
+  match link_ghc_libs() {
+    Err(e) => panic!("Unable to link ghc_libs: {}", e),
+    Ok(_) => {
+      println!("cargo:rustc-link-search=native=htest/dist-newstyle/build/x86_64-osx/ghc-8.8.3/htest-0.1.0.0/build/");
+      println!("cargo:rustc-link-lib=static=HShtest-0.1.0.0-inplace");
+
+      let bindings = bindgen::Builder::default()
+        // The input header we would like to generate
+        // bindings for.
+        .header({
+          let mut dir = PathBuf::from(ghc("cabal", "--print-libdir"));
+          dir.push("include");
+          dir.push("HsFFI.h");
+          dir.as_os_str().to_owned().to_string_lossy()
+        })
+        // Tell cargo to invalidate the built crate whenever any of the
+        // included header files changed.
+        .parse_callbacks(Box::new(bindgen::CargoCallbacks))
+        // Finish the builder and generate the bindings.
+        .generate()
+        // Unwrap the Result and panic on failure.
+        .expect("Unable to generate bindings");
+      // Write the bindings to the $OUT_DIR/bindings.rs file.
+      let out_path = PathBuf::from(env::var("OUT_DIR").unwrap());
+      bindings
+        .write_to_file(out_path.join("bindings.rs"))
+        .expect("Couldn't write bindings!");
+    }
+  }
 }
 
-fn link_ghc_libs() -> io::Result<()> {
-
-	let builder = if command_ok(Command::new("stack").arg("--version")) {
-		"stack"
-	} else {
-		"cabal"
-	};
-
-	// Go to the libdir for ghc then traverse all the entries
-	for entry in try!(read_dir(Path::new(&ghc(builder, "--print-libdir")))) {
-		let entry = try!(entry);
-
-		// For each directory in the libdir check it for .so files and
-		// link them.
-		if try!(entry.metadata()).is_dir() {
-			for item in try!(read_dir(entry.path())) {
-				match (entry.path().to_str(), try!(item).file_name().to_str()) {
-					// This directory has lib files link them
-					(Some(e),Some(i)) => {
-						if i.starts_with("lib") && i.ends_with(DYLIB_EXTENSION) {
-
-							// This filtering of items gets us the bare minimum of libraries
-							// we need in order to get the Haskell Runtime linked into the
-							// library. By default it's the non-threaded version that is
-							// chosen
-							if  i.starts_with(RTS) ||
-								i.starts_with("libHSghc-") && !i.starts_with("libHSghc-boot-") ||
-								i.starts_with("libHSbase") ||
-								i.starts_with("libHSinteger-gmp") {
-
-								println!("cargo:rustc-link-search=native={}", e);
-								// Get rid of lib from the file name
-								let temp = i.split_at(3).1;
-								// Get rid of the .so from the file name
-								let trimmed = temp.split_at(temp.len() - DYLIB_EXTENSION.len()).0;
-								println!("cargo:rustc-link-lib=dylib={}", trimmed);
-							}
-						}
-					},
-					_ => panic!("Unable to link ghc libs"),
-				}
-			}
-		}
-	}
-
-	Ok(())
+fn link_ghc_libs() -> Result<(), Box<dyn Error>> {
+  let builder = if command_ok(Command::new("stack").arg("--version")) {
+    "stack"
+  } else {
+    "cabal"
+  };
+
+  // Go to the libdir for ghc then traverse all the entries
+  for entry in WalkDir::new(&ghc(builder, "--print-libdir"))
+    .min_depth(1)
+    .into_iter()
+  {
+    let entry = entry?;
+    match (entry.path().to_str(), entry.file_name().to_str()) {
+      (Some(e), Some(file_name)) => {
+        // This filters out every file shipped with GHC that isn't
+        // a static archive file and only one of every type (RTS and
+        // C FFI have a few different versions)
+        if entry.path().extension().map(|y| y != "a").unwrap_or(true)
+          || entry.path().is_dir()
+          || e.ends_with("_p.a")
+          || e.ends_with("_thr.a")
+          || e.ends_with("_thr_l.a")
+          || e.ends_with("_thr_debug.a")
+          || e.ends_with("_l.a")
+          || e.ends_with("_debug.a")
+          || e.contains("_debug.a")
+        {
+          continue;
+        }
+
+        // Get the path without the file in the name
+        let lib_path = {
+          let mut path = entry.path().to_owned();
+          path.pop();
+          path
+        }
+        .to_str()
+        .unwrap()
+        .to_owned();
+
+        println!("cargo:rustc-link-search=native={}", lib_path);
+        // Get rid of lib from the file name
+        let temp = file_name.split_at(3).1;
+        // Get rid of the .so from the file name
+        let trimmed = temp.split_at(temp.len() - DYLIB_EXTENSION.len()).0;
+        println!("cargo:rustc-link-lib=static={}", trimmed);
+      }
+      _ => panic!("Unable to link GHC libs at all"),
+    }
+  }
+
+  // Mac specific linking bugs cause it really is developer hostile and
+  // doesn't care about you and working!
+  #[cfg(target_os = "macos")]
+  println!("cargo:rustc-link-search=native=/usr/lib");
+  #[cfg(target_os = "macos")]
+  println!("cargo:rustc-link-lib=dylib=iconv");
+
+  Ok(())
 }

curryrs.cabal

@@ -32,7 +32,8 @@ test-suite curryrs-test
                      , tasty-quickcheck >= 0.8.4
   -- We only have to do this because ghc-pkg doesn't work with relative paths for
   -- extra-lib-dirs.
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Ltarget/release -lrtest -lpthread
+  ghc-options:         -Ltarget/release -lrtest
+  extra-libraries:     pthread
   default-language:    Haskell2010
 
 benchmark curryrs-bench
@@ -43,7 +44,8 @@ benchmark curryrs-bench
                      , curryrs
   -- We only have to do this because ghc-pkg doesn't work with relative paths for
   -- extra-lib-dirs.
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Ltarget/release -lrtest -lpthread
+  ghc-options:         -Ltarget/release -lrtest
+  extra-libraries:     pthread
   default-language:    Haskell2010
 
 source-repository head

examples/rust.rs

@@ -1,3 +1 @@
-fn main() {
-
-}
+fn main() {}

haskell-tests/Test.hs

@@ -7,19 +7,31 @@ import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 
 -- Rust Function Imports
-foreign import ccall "double_input" doubleInput :: I64 -> I64
+foreign import ccall "double_input" doubleInput :: U64 -> U64
 foreign import ccall "get_true" getTrue :: Boolean
 foreign import ccall "get_false" getFalse :: Boolean
 
 main :: IO ()
 main = defaultMain tests
 
 -- Test Function Helpers
-divTwo :: I64 -> I64
-divTwo x = x `div` 2
-
-timesTwo :: I64 -> I64
-timesTwo x = x *  2
+divTwo :: Maybe U64 -> Maybe U64
+divTwo x = case x of
+  Just y -> Just $ y `div` 2
+  Nothing -> Nothing
+
+timesTwo :: U64 -> Maybe U64
+timesTwo x
+  -- This number or higher causes the value to wrap to a negative value
+  | x >= 4611686018427387904 = Nothing
+  | otherwise = Just $ x * 2
+
+-- Wrapped Rust code variant
+inputDouble :: U64 -> Maybe U64
+inputDouble x
+  -- This number or higher causes the value to wrap to a negative value
+  | x >= 4611686018427387904 = Nothing
+  | otherwise = Just $ doubleInput x
 
 -- Test Declarations
 tests :: TestTree
@@ -35,8 +47,15 @@ unitTests = testGroup "Unit Tests"
   ]
 
 quickCheckTests = testGroup "Quickcheck Tests"
-  [ testProperty "(divTwo . doubleInput) == id" $
-    \x -> (divTwo . doubleInput) x == id x,
+  [
+    testProperty "(divTwo . inputDouble) == id" $
+    \x -> case (divTwo . inputDouble) x of
+      Just y -> y == id x
+      Nothing -> True,
+
     testProperty "doubleInput == timesTwo" $
-    \x -> doubleInput x == timesTwo x
+    \x ->  case [inputDouble x, timesTwo x] of
+      [Just x, Just y] -> x == y
+      [Nothing, Nothing] -> True
+      otherwise -> False
   ]