mirror of
https://github.com/nmattia/snack.git
synced 2024-09-11 11:55:36 +03:00
Add TH support in GHCi
This commit is contained in:
parent
bf102221f3
commit
e80c007de2
@ -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")
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
{
|
||||
|
@ -1,5 +0,0 @@
|
||||
import Conduit
|
||||
import FooBar
|
||||
|
||||
main :: IO ()
|
||||
main = runConduit $ spitOut .| takeC 5 .| digest
|
@ -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
|
@ -1,5 +0,0 @@
|
||||
import Conduit
|
||||
import FooBar
|
||||
|
||||
main :: IO ()
|
||||
main = runConduit $ spitOut .| takeC 5 .| digest
|
@ -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
|
1
tests/template-haskell-4/assets/foo.txt
Normal file
1
tests/template-haskell-4/assets/foo.txt
Normal file
@ -0,0 +1 @@
|
||||
Hello, World!
|
2
tests/template-haskell-4/golden
Normal file
2
tests/template-haskell-4/golden
Normal file
@ -0,0 +1,2 @@
|
||||
Hello, World!
|
||||
|
11
tests/template-haskell-4/snack.nix
Normal file
11
tests/template-haskell-4/snack.nix
Normal file
@ -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 []);
|
||||
}
|
9
tests/template-haskell-4/src/Main.hs
Normal file
9
tests/template-haskell-4/src/Main.hs
Normal file
@ -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")
|
14
tests/template-haskell-4/test
Executable file
14
tests/template-haskell-4/test
Executable file
@ -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
|
@ -1,5 +0,0 @@
|
||||
import Conduit
|
||||
import FooBar
|
||||
|
||||
main :: IO ()
|
||||
main = runConduit $ spitOut .| takeC 5 .| digest
|
@ -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
|
Loading…
Reference in New Issue
Block a user