mirror of
https://github.com/nmattia/snack.git
synced 2024-09-11 03:45:32 +03:00
Reimplement snack-exe in haskell
This commit is contained in:
parent
bf4c74e92d
commit
2c9677c1e0
206
bin/Snack.hs
Normal file
206
bin/Snack.hs
Normal file
@ -0,0 +1,206 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson ((.:))
|
||||
import Data.ByteString as BS
|
||||
import Data.FileEmbed (embedStringFile)
|
||||
import Data.Semigroup
|
||||
import Data.String (fromString)
|
||||
import Data.String.Interpolate
|
||||
import Data.Text as T
|
||||
import Shelly (Sh)
|
||||
import System.Posix.Process (executeFile)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Options.Applicative as Opts
|
||||
import qualified Shelly as S
|
||||
|
||||
{-
|
||||
|
||||
TODO:
|
||||
Mode
|
||||
= HPack HPackPah
|
||||
| Standalone SnackNix
|
||||
| Discovery (Either HPackPath SnackNix)
|
||||
-}
|
||||
|
||||
data Mode
|
||||
= Standalone SnackNix -- Reads a snack.nix file
|
||||
|
||||
-- | Like a FilePath, but Nix friendly
|
||||
newtype SnackNix = SnackNix { unSnackNix :: FilePath }
|
||||
|
||||
mkSnackNix :: FilePath -> SnackNix
|
||||
mkSnackNix = SnackNix -- XXX: this is not nix friendly, but it's ok, because
|
||||
-- it'll be gone soon
|
||||
|
||||
data Command
|
||||
= Build
|
||||
| Run
|
||||
| Ghci
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
opts <- Opts.execParser (Opts.info (options <**> Opts.helper) mempty)
|
||||
runCommand (mode opts) (command opts)
|
||||
|
||||
data Options = Options
|
||||
{ mode :: Mode
|
||||
, command :: Command
|
||||
}
|
||||
|
||||
data Project = Project
|
||||
{ outPath :: FilePath
|
||||
, exePath :: FilePath
|
||||
}
|
||||
|
||||
instance Aeson.FromJSON Project where
|
||||
parseJSON = Aeson.withObject "project" $ \o ->
|
||||
Project <$> o .: "out_path" <*> o .: "exe_path"
|
||||
|
||||
parseMode :: Opts.Parser Mode
|
||||
parseMode =
|
||||
Opts.flag Standalone Standalone
|
||||
(Opts.long "--standalone")
|
||||
|
||||
<*> (mkSnackNix <$>
|
||||
Opts.strOption
|
||||
(Opts.long "--snack-nix"
|
||||
<> Opts.short 's'
|
||||
<> Opts.value "./snack.nix"
|
||||
<> Opts.metavar "PATH")
|
||||
)
|
||||
|
||||
options :: Opts.Parser Options
|
||||
options = Options <$> parseMode <*> parseCommand
|
||||
|
||||
snackGhci :: SnackNix -> Sh ()
|
||||
snackGhci snackNix = do
|
||||
path <- S.print_stdout False $ exePath <$> snackBuildGhci snackNix
|
||||
S.print_stdout True $ run_ (fromString path) []
|
||||
|
||||
snackBuildGhci :: SnackNix -> Sh Project
|
||||
snackBuildGhci snackNix = do
|
||||
out <- runStdin1
|
||||
(T.pack [i|
|
||||
{ snackNix, lib64, specJson }:
|
||||
let
|
||||
spec = builtins.fromJSON specJson;
|
||||
pkgs = import (builtins.fetchTarball
|
||||
{ url = "https://github.com/${spec.owner}/${spec.repo}/archive/${spec.rev}.tar.gz";
|
||||
sha256 = spec.sha256;
|
||||
}) {} ;
|
||||
libDir =
|
||||
let
|
||||
b64 = pkgs.writeTextFile { name = "lib-b64"; text = lib64; };
|
||||
in
|
||||
pkgs.runCommand "snack-lib" {}
|
||||
''
|
||||
cat ${b64} | base64 --decode > out.tar.gz
|
||||
mkdir -p $out
|
||||
tar -C $out -xzf out.tar.gz
|
||||
chmod +w $out
|
||||
'';
|
||||
snack = pkgs.callPackage libDir {};
|
||||
proj = snack.executable (import snackNix);
|
||||
in
|
||||
{ build = proj.build;
|
||||
ghci = proj.ghci;
|
||||
}
|
||||
|]
|
||||
)
|
||||
"nix-build"
|
||||
[ "-"
|
||||
, "--arg", "snackNix", T.pack $ unSnackNix snackNix
|
||||
, "--argstr", "lib64", libb64
|
||||
, "--argstr", "specJson", specJson
|
||||
, "--no-out-link"
|
||||
, "-A", "ghci.json"
|
||||
]
|
||||
json <- liftIO $ BS.readFile (T.unpack out)
|
||||
let Just proj = Aeson.decodeStrict' json
|
||||
pure proj
|
||||
|
||||
snackBuild :: SnackNix -> Sh Project
|
||||
snackBuild snackNix = do
|
||||
out <- runStdin1
|
||||
(T.pack [i|
|
||||
{ snackNix, lib64, specJson }:
|
||||
let
|
||||
spec = builtins.fromJSON specJson;
|
||||
pkgs = import (builtins.fetchTarball
|
||||
{ url = "https://github.com/${spec.owner}/${spec.repo}/archive/${spec.rev}.tar.gz";
|
||||
sha256 = spec.sha256;
|
||||
}) {} ;
|
||||
libDir =
|
||||
let
|
||||
b64 = pkgs.writeTextFile { name = "lib-b64"; text = lib64; };
|
||||
in
|
||||
pkgs.runCommand "snack-lib" {}
|
||||
''
|
||||
cat ${b64} | base64 --decode > out.tar.gz
|
||||
mkdir -p $out
|
||||
tar -C $out -xzf out.tar.gz
|
||||
chmod +w $out
|
||||
'';
|
||||
snack = pkgs.callPackage libDir {};
|
||||
proj = snack.executable (import snackNix);
|
||||
in
|
||||
{ build = proj.build;
|
||||
ghci = proj.ghci;
|
||||
}
|
||||
|]
|
||||
)
|
||||
"nix-build"
|
||||
[ "-"
|
||||
, "--arg", "snackNix", T.pack $ unSnackNix snackNix
|
||||
, "--argstr", "lib64", libb64
|
||||
, "--argstr", "specJson", specJson
|
||||
, "--no-out-link"
|
||||
, "-A", "build.json"
|
||||
]
|
||||
json <- liftIO $ BS.readFile (T.unpack out)
|
||||
let Just proj = Aeson.decodeStrict' json
|
||||
pure proj
|
||||
|
||||
runCommand :: Mode -> Command -> IO ()
|
||||
runCommand (Standalone snackNix) = \case
|
||||
Build -> S.shelly $ void $ snackBuild snackNix
|
||||
Run -> snackRun snackBuild
|
||||
Ghci -> snackRun snackBuildGhci
|
||||
where
|
||||
snackRun build = do
|
||||
fp <- S.shelly $ S.print_stdout False $ exePath <$> build snackNix
|
||||
executeFile fp True [] Nothing
|
||||
|
||||
parseCommand :: Opts.Parser Command
|
||||
parseCommand =
|
||||
Opts.hsubparser $
|
||||
( Opts.command "build" (Opts.info (pure Build) mempty)
|
||||
<> Opts.command "run" (Opts.info (pure Run) mempty)
|
||||
<> Opts.command "ghci" (Opts.info (pure Ghci) mempty)
|
||||
)
|
||||
|
||||
run :: S.FilePath -> [T.Text] -> Sh [T.Text]
|
||||
run p args = T.lines <$> S.run p args
|
||||
|
||||
runStdin1 :: T.Text -> S.FilePath -> [T.Text] -> Sh T.Text
|
||||
runStdin1 stin p args = do
|
||||
S.setStdin stin
|
||||
[out] <- run p args
|
||||
pure out
|
||||
|
||||
run_ :: S.FilePath -> [T.Text] -> Sh ()
|
||||
run_ p args = void $ run p args
|
||||
|
||||
specJson :: T.Text
|
||||
specJson = $(embedStringFile "spec.json")
|
||||
|
||||
libb64 :: T.Text
|
||||
libb64 = $(embedStringFile "lib.tar.gz.b64")
|
110
bin/snack
110
bin/snack
@ -1,110 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
## Defaults
|
||||
|
||||
NIXPKGS=
|
||||
NIX_BUILD=nix-build
|
||||
SNACK_NIX="./snack.nix"
|
||||
WRAPPER_NIX=
|
||||
COMMAND=
|
||||
|
||||
## Functions
|
||||
|
||||
log_error() {
|
||||
echo "ERROR: $*" >&2
|
||||
}
|
||||
|
||||
show_usage() {
|
||||
cat <<USAGE
|
||||
Usage: snack [options] <command>
|
||||
|
||||
Snack is a Haskell build tool
|
||||
|
||||
Options:
|
||||
-f | --snack-nix <PATH>: sets the path ot the "snack.nix" file. Default: "./snack.nix"
|
||||
-w | --wrapper-nix <PATH>: sets the path ot the nix wrapper file. This file
|
||||
should take at least one argument, "snackNix", which is the path to the
|
||||
"snack.nix".
|
||||
-n | --nixpkgs <PATH>: use the path to import nixpkgs. The expression should
|
||||
take no arguments and evaluate to a set containing at least
|
||||
"snack-lib".
|
||||
-h | --help: Shows this help
|
||||
|
||||
Commands:
|
||||
run: builds and executes
|
||||
build: builds
|
||||
ghci: builds and loads in ghci
|
||||
USAGE
|
||||
}
|
||||
|
||||
## Main
|
||||
|
||||
while [[ $# -gt 0 ]]; do
|
||||
key="$1"
|
||||
|
||||
case $key in
|
||||
-f | --snack-nix)
|
||||
SNACK_NIX="$2"
|
||||
shift
|
||||
shift
|
||||
;;
|
||||
-w | --wrapper-nix)
|
||||
WRAPPER_NIX="$2"
|
||||
shift
|
||||
shift
|
||||
;;
|
||||
-n | --nixpkgs)
|
||||
NIXPKGS="$2"
|
||||
shift
|
||||
shift
|
||||
;;
|
||||
-h | --help)
|
||||
show_usage
|
||||
exit 0
|
||||
;;
|
||||
run | build | ghci)
|
||||
COMMAND="$1"
|
||||
shift # past argument
|
||||
;;
|
||||
*) # unknown option
|
||||
echo "unknown option: $1"
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
done
|
||||
|
||||
if [[ -z "$COMMAND" ]]; then
|
||||
log_error "missing <command>\n"
|
||||
show_usage
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [[ -z "$WRAPPER_NIX" ]]; then
|
||||
log_error "missing <wrapper>\n"
|
||||
show_usage
|
||||
exit 1
|
||||
fi
|
||||
|
||||
call_snack() {
|
||||
"$NIX_BUILD" \
|
||||
--no-out-link \
|
||||
-A $1 \
|
||||
"$WRAPPER_NIX" \
|
||||
--arg snackNix "$SNACK_NIX" \
|
||||
--arg nixpkgs "$NIXPKGS"
|
||||
}
|
||||
|
||||
case $COMMAND in
|
||||
build)
|
||||
call_snack build
|
||||
;;
|
||||
ghci)
|
||||
res=$(call_snack ghci)
|
||||
"$res"
|
||||
;;
|
||||
run)
|
||||
res=$(call_snack build)
|
||||
"$res/out"
|
||||
;;
|
||||
esac
|
35
bin/snack.nix
Normal file
35
bin/snack.nix
Normal file
@ -0,0 +1,35 @@
|
||||
{ runCommand, writeTextFile, symlinkJoin }:
|
||||
let
|
||||
specJson = writeTextFile
|
||||
{ name = "spec-json";
|
||||
text = builtins.readFile ../nix/nixpkgs/nixpkgs-src.json;
|
||||
destination = "/spec.json";
|
||||
};
|
||||
lib64 = runCommand "lib64" {}
|
||||
''
|
||||
tar -czf lib.tar.gz -C ${../snack-lib} .
|
||||
mkdir -p $out
|
||||
base64 lib.tar.gz > $out/lib.tar.gz.b64
|
||||
'';
|
||||
in
|
||||
{ main = "Snack";
|
||||
src = ./.;
|
||||
dependencies =
|
||||
[
|
||||
"aeson"
|
||||
"file-embed"
|
||||
"interpolate"
|
||||
"optparse-applicative"
|
||||
"shelly"
|
||||
"text"
|
||||
"unix"
|
||||
];
|
||||
ghcOpts = [ "-Werror" "-Wall" ] ;
|
||||
|
||||
extra-directories =
|
||||
{ Snack =
|
||||
[ specJson
|
||||
lib64
|
||||
];
|
||||
};
|
||||
}
|
@ -1,9 +1,4 @@
|
||||
_: pkgs: {
|
||||
_: pkgs: rec {
|
||||
snack-lib = pkgs.callPackage ../snack-lib/default.nix { };
|
||||
snack-exe = pkgs.writeScriptBin
|
||||
"snack"
|
||||
(builtins.replaceStrings
|
||||
["NIX_BUILD=nix-build" "WRAPPER_NIX="]
|
||||
["NIX_BUILD=${pkgs.nix}/bin/nix-build" "WRAPPER_NIX=${../snack-lib/wrapper.nix}"]
|
||||
(builtins.readFile ../bin/snack));
|
||||
snack-exe = (snack-lib.executable (import ../bin/snack.nix { inherit (pkgs) writeTextFile symlinkJoin runCommand;})).build.out;
|
||||
}
|
||||
|
@ -1,4 +1,4 @@
|
||||
#!/usr/bin/env nix-shell
|
||||
#!nix-shell -p shfmt -i bash
|
||||
cd "$(dirname "$0")/.."
|
||||
shfmt -i 2 -w bin/snack
|
||||
shfmt -i 2 -w script/test
|
||||
|
@ -4,6 +4,7 @@
|
||||
#!nix-shell -p snack-exe
|
||||
#!nix-shell -p shfmt
|
||||
#!nix-shell -p jq
|
||||
#!nix-shell -p nix
|
||||
#!nix-shell --pure
|
||||
# vim: ft=sh sw=2 et
|
||||
|
||||
@ -34,8 +35,6 @@ END_HEREDOC
|
||||
|
||||
export -f capture_io
|
||||
|
||||
export SNACK="snack -n $(readlink -f ./nix)"
|
||||
|
||||
fail() {
|
||||
echo "ERROR: $*"
|
||||
exit 1
|
||||
@ -85,9 +84,9 @@ pushd tests/extensions
|
||||
./test
|
||||
popd
|
||||
|
||||
banner "Test stack-exe formatting"
|
||||
list=$(shfmt -i 2 -l bin/snack)
|
||||
banner "Test this file's formatting"
|
||||
list=$(shfmt -i 2 -l script/test)
|
||||
if [[ -n "$list" ]]; then
|
||||
fail "Please apply script/snack-fmt to format bin/snack"
|
||||
fail "Please apply script/snack-fmt to format script/test"
|
||||
fi
|
||||
echo OK
|
||||
|
@ -6,7 +6,7 @@
|
||||
, rsync
|
||||
, stdenv
|
||||
, symlinkJoin
|
||||
, writeScript
|
||||
, writeScriptBin
|
||||
, writeText
|
||||
, runCommand
|
||||
, callPackage
|
||||
@ -135,15 +135,22 @@ let
|
||||
ghc = ghcWith deps;
|
||||
ghcOptsArgs = lib.strings.escapeShellArgs mod.moduleGhcOpts;
|
||||
packageList = map (p: "-package ${p}") deps;
|
||||
in runCommand "linker" {}
|
||||
relExePath = "bin/${lib.strings.toLower mod.moduleName}";
|
||||
drv = runCommand "linker" {}
|
||||
''
|
||||
mkdir -p $out
|
||||
mkdir -p $out/bin
|
||||
${ghc}/bin/ghc \
|
||||
${lib.strings.escapeShellArgs packageList} \
|
||||
${lib.strings.escapeShellArgs objList} \
|
||||
${ghcOptsArgs} \
|
||||
-o $out/out
|
||||
-o $out/${relExePath}
|
||||
'';
|
||||
in
|
||||
{
|
||||
out = drv;
|
||||
relExePath = relExePath;
|
||||
};
|
||||
|
||||
|
||||
# Write a new ghci executable that loads all the modules defined in the
|
||||
# module spec
|
||||
@ -182,8 +189,9 @@ let
|
||||
};
|
||||
in
|
||||
# This symlinks the extra dirs to $PWD for GHCi to work
|
||||
writeScript "ghci-with-files"
|
||||
writeScriptBin "ghci-with-files"
|
||||
''
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
TRAPS=""
|
||||
@ -253,10 +261,23 @@ let
|
||||
in
|
||||
{
|
||||
build =
|
||||
writeText
|
||||
"library-build"
|
||||
# This json is a bit different than the other ones, because it's
|
||||
# a map of modules to object files (rather than out_path +
|
||||
# exe_path)
|
||||
{ json = writeText "build_output"
|
||||
(builtins.toJSON (buildLibrary ghcWith modSpecs));
|
||||
ghci = ghciWithModules ghcWith modSpecs;
|
||||
};
|
||||
ghci =
|
||||
let
|
||||
drv = ghciWithModules ghcWith modSpecs;
|
||||
json =
|
||||
{ out_path = "${drv.out}";
|
||||
exe_path = "${drv.out}/bin/ghci-with-files";
|
||||
};
|
||||
in
|
||||
{ out = drv.out;
|
||||
json = writeText "ghci_output" (builtins.toJSON json);
|
||||
};
|
||||
}
|
||||
else
|
||||
let
|
||||
@ -267,8 +288,29 @@ let
|
||||
modSpecs = foldDAG fld [mainModName];
|
||||
in modSpecs.${mainModName};
|
||||
in
|
||||
{ build = linkMainModule ghcWith mainModSpec;
|
||||
ghci = ghciWithMain ghcWith mainModSpec;
|
||||
{ build =
|
||||
let
|
||||
drv = linkMainModule ghcWith mainModSpec;
|
||||
json =
|
||||
{ out_path = "${drv.out}";
|
||||
exe_path = "${drv.out}/${drv.relExePath}";
|
||||
};
|
||||
in
|
||||
{ out = drv.out;
|
||||
json = writeText "build_output" (builtins.toJSON json);
|
||||
};
|
||||
|
||||
ghci =
|
||||
let
|
||||
drv = ghciWithMain ghcWith mainModSpec;
|
||||
json =
|
||||
{ out_path = "${drv.out}";
|
||||
exe_path = "${drv.out}/bin/ghci-with-files";
|
||||
};
|
||||
in
|
||||
{ out = drv.out;
|
||||
json = writeText "ghci_output" (builtins.toJSON json);
|
||||
};
|
||||
};
|
||||
in
|
||||
{
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -5,11 +5,11 @@ set -euo pipefail
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
cat $($SNACK build) | jq -M 'keys' > $TMP_FILE
|
||||
cat $(snack build) | jq -M 'keys' > $TMP_FILE
|
||||
|
||||
diff golden.jq $TMP_FILE
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
diff golden $TMP_FILE
|
||||
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build -f code/snack.nix
|
||||
$SNACK run -f code/snack.nix | diff golden -
|
||||
snack build -s code/snack.nix
|
||||
snack run -s code/snack.nix | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK -f code/snack.nix ghci
|
||||
capture_io "$TMP_FILE" main | snack -s code/snack.nix ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
@ -3,12 +3,12 @@
|
||||
|
||||
set -euo pipefail
|
||||
|
||||
$SNACK build
|
||||
$SNACK run | diff golden -
|
||||
snack build
|
||||
snack run | diff golden -
|
||||
|
||||
TMP_FILE=$(mktemp)
|
||||
|
||||
capture_io "$TMP_FILE" main | $SNACK ghci
|
||||
capture_io "$TMP_FILE" main | snack ghci
|
||||
|
||||
diff golden $TMP_FILE
|
||||
rm $TMP_FILE
|
||||
|
Loading…
Reference in New Issue
Block a user