Add TH support in GHCi

bin/snack

@@ -68,7 +68,7 @@ case $COMMAND in
     ;;
   ghci)
     res=$("$NIX_BUILD" --no-out-link -A ghci "$SNACK_NIX")
-    "$res/bin/ghci"
+    "$res"
     ;;
   run)
     res=$("$NIX_BUILD" --no-out-link -A build "$SNACK_NIX")

script/test

@@ -62,6 +62,11 @@ pushd tests/template-haskell-3
 ./test
 popd
 
+banner "Test Template Haskell 4"
+pushd tests/template-haskell-4
+./test
+popd
+
 banner "Test stack-exe formatting"
 list=$(shfmt -i 2 -l bin/snack)
 if [[ -n "$list" ]]; then

snack/default.nix

@@ -93,10 +93,6 @@ let
       makeSymModule =
         # TODO: symlink instead of copy
         "rsync -r ${singleOutModule base mod.moduleName}/ .";
-
-
-
-
       pred = file: path: type:
         let
           topLevel = (builtins.toString base) + "/";
@@ -259,6 +255,13 @@ let
   allModuleNames = modSpec:
     [ modSpec.moduleName ] ++ (pkgs.lib.lists.concatMap allModuleNames modSpec.moduleDependencies);
 
+  allModuleDirectories = modSpec:
+    pkgs.lib.lists.concatLists
+    (
+    [ modSpec.moduleDirectories ]
+    ++ (pkgs.lib.lists.concatMap allModuleDirectories modSpec.moduleDependencies)
+    );
+
   # Write a new ghci executable that loads all the modules defined in the
   # module spec
   ghciExecutable = ghc: ghcOpts: base: modSpec:
@@ -268,19 +271,40 @@ let
       absoluteModuleFiles = map prependBase moduleFiles;
       moduleFiles = map moduleToFile modules;
       modules = allModuleNames modSpec;
+      dirs = allModuleDirectories modSpec;
       prependBase = f: builtins.toString base + "/${f}";
+      newGhc =
+        pkgs.symlinkJoin
+          { name = "ghci";
+            paths = [ ghc ];
+            postBuild =
+            ''
+              wrapProgram "$out/bin/ghci" \
+                --add-flags "${ghciArgs}"
+            '';
+            buildInputs = [pkgs.makeWrapper];
+          };
     in
-      pkgs.symlinkJoin
-        { name = "ghci";
-          paths = [ ghc ];
-          postBuild =
-          ''
-            source $stdenv/setup
-            wrapProgram "$out/bin/ghci" \
-              --add-flags "${ghciArgs}"
-          '';
-          buildInputs = [pkgs.makeWrapper];
-        };
+      # This symlinks the extra dirs to $PWD for GHCi to work
+      pkgs.writeScript "ghci-with-files"
+        ''
+        set -euo pipefail
+
+        TRAPS=""
+        for i in ${pkgs.lib.strings.escapeShellArgs dirs}; do
+          if [ "$i" != "$PWD" ]; then
+          for j in $(find "$i" ! -path "$i"); do
+            file=$(basename $j)
+            echo "Temporarily symlinking $j to $file..."
+            ln -s $j $file
+            TRAPS="rm $file ; $TRAPS"
+            trap "$TRAPS" EXIT
+            echo "done."
+          done
+          fi
+        done
+        ${newGhc}/bin/ghci
+        '';
 
   executable = descr:
       let
@@ -298,20 +322,14 @@ let
             if builtins.isList descr.extra-files
             then (_x: descr.extra-files)
             else descr.extra-files
-          else (x: []);
-        #if (builtins.hasAttr "extra-files" descr)
-        #then
-          #if builtins.isList descr.extra-files
-          #then (_x: descr.extra-files)
-          #else descr.extra-files
-        #else (x: []);
+          else (_x: []);
         extraDirs =
           if (builtins.hasAttr "extra-directories" descr)
           then
             if builtins.isList descr.extra-directories
             then (_x: descr.extra-directories)
             else descr.extra-directories
-          else (x: []);
+          else (_x: []);
         mainModName = descr.main;
       in
     {

tests/template-haskell-2/code/src/Foo.hs

@@ -1,5 +0,0 @@
-import Conduit
-import FooBar
-
-main :: IO ()
-main = runConduit $ spitOut .| takeC 5 .| digest

tests/template-haskell-2/code/src/FooBar.hs

@@ -1,9 +0,0 @@
-module FooBar where
-
-import Conduit
-
-spitOut :: ConduitT () Int IO ()
-spitOut = yieldMany [ 1 ..]
-
-digest :: ConduitT Int Void IO ()
-digest = mapM_C print

tests/template-haskell-3/src/Foo.hs

@@ -1,5 +0,0 @@
-import Conduit
-import FooBar
-
-main :: IO ()
-main = runConduit $ spitOut .| takeC 5 .| digest

tests/template-haskell-3/src/FooBar.hs

@@ -1,9 +0,0 @@
-module FooBar where
-
-import Conduit
-
-spitOut :: ConduitT () Int IO ()
-spitOut = yieldMany [ 1 ..]
-
-digest :: ConduitT Int Void IO ()
-digest = mapM_C print

tests/template-haskell-4/assets/foo.txt

@@ -0,0 +1 @@
+Hello, World!

tests/template-haskell-4/golden

@@ -0,0 +1,2 @@
+Hello, World!
+

tests/template-haskell-4/snack.nix

@@ -0,0 +1,11 @@
+let
+  pkgs = import ../../nix {};
+  snack = pkgs.snack.snack-lib;
+in
+  snack.executable
+    { main = "Main";
+      src = ./src;
+      dependencies = ["file-embed"];
+      extra-directories =
+        (modName: if modName == "Main" then [ ./assets ] else []);
+    }

tests/template-haskell-4/src/Main.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import Data.FileEmbed
+import qualified Data.ByteString.Char8 as BS8
+
+main :: IO ()
+main = BS8.putStrLn $(embedFile "foo.txt")

tests/template-haskell-4/test

@@ -0,0 +1,14 @@
+#!/usr/bin/env bash
+# vim: ft=sh sw=2 et
+
+set -euo pipefail
+
+snack build
+snack run | diff golden -
+
+TMP_FILE=$(mktemp)
+
+capture_io "$TMP_FILE" main | snack ghci
+
+diff golden $TMP_FILE
+rm $TMP_FILE

tests/template-haskell/src/Foo.hs

@@ -1,5 +0,0 @@
-import Conduit
-import FooBar
-
-main :: IO ()
-main = runConduit $ spitOut .| takeC 5 .| digest

tests/template-haskell/src/FooBar.hs

@@ -1,9 +0,0 @@
-module FooBar where
-
-import Conduit
-
-spitOut :: ConduitT () Int IO ()
-spitOut = yieldMany [ 1 ..]
-
-digest :: ConduitT Int Void IO ()
-digest = mapM_C print