packages feed

hnix 0.5.2 → 0.6.0

raw patch · 99 files changed

+11299/−8342 lines, 99 filesdep +comonaddep +dependent-sumdep +freedep −ansi-wl-pprintdep −ghc-datasizedep ~megaparsec

Dependencies added: comonad, dependent-sum, free, hnix-store-core, monad-control, parser-combinators, prettyprinter, ref-tf, transformers-base

Dependencies removed: ansi-wl-pprint, ghc-datasize

Dependency ranges changed: megaparsec

Files

README.md view
@@ -24,7 +24,7 @@ # To run all of the tests, which takes up to a minute: $ env ALL_TESTS=yes cabal test # To run only specific tests (see `tests/Main.hs` for a list)-$ env NIXPKGS_TESTS=yes PRETTY_TESTS=yes cabal test+$ env NIXPKGS_TESTS=yes PRETTY_TESTS=1 cabal test $ ./dist/build/hnix/hnix --help ``` @@ -89,8 +89,18 @@ This will build an `hnix` library that can be linked to your GHCJS application. +## Using the Cachix binary cache++If you're on macOS, you can use the binary cache at Cachix to avoid building+the specific dependencies used by hnix. Just use these commands:++    nix-env -iA cachix -f https://github.com/NixOS/nixpkgs/tarball/db557aab7b690f5e0e3348459f2e4dc8fd0d9298+    cachix use hnix+ ## How you can help +### Issue Tracker Backlog+ If you're looking for a way to help out, try taking a look [here](https://github.com/haskell-nix/hnix/issues?q=is%3Aissue+is%3Aopen+label%3A%22help+wanted%22+no%3Aassignee). When you find an issue that looks interesting to you, comment on the ticket to@@ -106,3 +116,13 @@  Make sure that all the tests that were passing prior to your PR are still passing afterwards; it's OK if no new tests are passing.++### Evaluating Nixpkgs with HNix++Currently the main high-level goal is to be able to evaluate all of nixpkgs. To+run this yourself, first build hnix with `nix-build`, then run the following+command:++```+./result/bin/hnix --eval -E "import <nixpkgs> {}" --find+```
benchmarks/Main.hs view
@@ -1,10 +1,8 @@ module Main where -import Criterion.Main+import           Criterion.Main  import qualified ParserBench  main :: IO ()-main = defaultMain-  [ ParserBench.benchmarks-  ]+main = defaultMain [ParserBench.benchmarks]
benchmarks/ParserBench.hs view
@@ -1,15 +1,16 @@ module ParserBench (benchmarks) where -import Nix.Parser+import           Nix.Parser -import Control.Applicative-import Criterion+import           Control.Applicative+import           Criterion  benchFile :: FilePath -> Benchmark benchFile = bench <*> whnfIO . parseNixFile . ("data/" ++)  benchmarks :: Benchmark-benchmarks = bgroup "Parser"+benchmarks = bgroup+  "Parser"   [ benchFile "nixpkgs-all-packages.nix"   , benchFile "nixpkgs-all-packages-pretty.nix"   , benchFile "let-comments.nix"
data/nix/Makefile view
@@ -5,17 +5,7 @@   src/libmain/local.mk \   src/libexpr/local.mk \   src/nix/local.mk \-  src/nix-store/local.mk \-  src/nix-instantiate/local.mk \-  src/nix-env/local.mk \-  src/nix-daemon/local.mk \-  src/nix-collect-garbage/local.mk \-  src/nix-copy-closure/local.mk \-  src/nix-prefetch-url/local.mk \   src/resolve-system-dependencies/local.mk \-  src/nix-channel/local.mk \-  src/nix-build/local.mk \-  src/build-remote/local.mk \   scripts/local.mk \   corepkgs/local.mk \   misc/systemd/local.mk \
data/nix/Makefile.config.in view
@@ -1,4 +1,6 @@+AR = @AR@ BDW_GC_LIBS = @BDW_GC_LIBS@+BUILD_SHARED_LIBS = @BUILD_SHARED_LIBS@ CC = @CC@ CFLAGS = @CFLAGS@ CXX = @CXX@@@ -6,7 +8,6 @@ ENABLE_S3 = @ENABLE_S3@ HAVE_SODIUM = @HAVE_SODIUM@ HAVE_READLINE = @HAVE_READLINE@-HAVE_BROTLI = @HAVE_BROTLI@ HAVE_SECCOMP = @HAVE_SECCOMP@ LIBCURL_LIBS = @LIBCURL_LIBS@ OPENSSL_LIBS = @OPENSSL_LIBS@@@ -16,9 +17,9 @@ LIBLZMA_LIBS = @LIBLZMA_LIBS@ SQLITE3_LIBS = @SQLITE3_LIBS@ LIBBROTLI_LIBS = @LIBBROTLI_LIBS@+EDITLINE_LIBS = @EDITLINE_LIBS@ bash = @bash@ bindir = @bindir@-brotli = @brotli@ lsof = @lsof@ datadir = @datadir@ datarootdir = @datarootdir@
data/nix/config/config.guess view
@@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,-#   2011, 2012 Free Software Foundation, Inc.+#   Copyright 1992-2018 Free Software Foundation, Inc. -timestamp='2012-08-14'+timestamp='2018-08-02'  # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or+# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but@@ -17,25 +15,23 @@ # General Public License for more details. # # You should have received a copy of the GNU General Public License-# along with this program; if not, see <http://www.gnu.org/licenses/>.+# along with this program; if not, see <https://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Originally written by Per Bothner.  Please send patches (context-# diff format) to <config-patches@gnu.org> and include a ChangeLog-# entry.+# the same distribution terms that you use for the rest of that+# program.  This Exception is an additional permission under section 7+# of the GNU General Public License, version 3 ("GPLv3"). #-# This script attempts to guess a canonical system name similar to-# config.sub.  If it succeeds, it prints the system name on stdout, and-# exits with 0.  Otherwise, it exits with 1.+# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from:-# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess+#+# Please send patches to <config-patches@gnu.org>. + me=`echo "$0" | sed -e 's,.*/,,'`  usage="\@@ -43,7 +39,7 @@  Output the configuration name of the system \`$me' is run on. -Operation modes:+Options:   -h, --help         print this help, then exit   -t, --time-stamp   print date of last modification, then exit   -v, --version      print version number, then exit@@ -54,9 +50,7 @@ GNU config.guess ($timestamp)  Originally written by Per Bothner.-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012-Free Software Foundation, Inc.+Copyright 1992-2018 Free Software Foundation, Inc.  This is free software; see the source for copying conditions.  There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."@@ -90,8 +84,6 @@   exit 1 fi -trap 'exit 1' 1 2 15- # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a@@ -102,34 +94,39 @@  # Portable tmp directory creation inspired by the Autoconf team. -set_cc_for_build='-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;-: ${TMPDIR=/tmp} ;- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;-dummy=$tmp/dummy ;-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;-case $CC_FOR_BUILD,$HOST_CC,$CC in- ,,)    echo "int x;" > $dummy.c ;-	for c in cc gcc c89 c99 ; do-	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then-	     CC_FOR_BUILD="$c"; break ;-	  fi ;-	done ;-	if test x"$CC_FOR_BUILD" = x ; then-	  CC_FOR_BUILD=no_compiler_found ;-	fi-	;;- ,,*)   CC_FOR_BUILD=$CC ;;- ,*,*)  CC_FOR_BUILD=$HOST_CC ;;-esac ; set_cc_for_build= ;'+tmp=+# shellcheck disable=SC2172+trap 'test -z "$tmp" || rm -fr "$tmp"' 1 2 13 15+trap 'exitcode=$?; test -z "$tmp" || rm -fr "$tmp"; exit $exitcode' 0 +set_cc_for_build() {+    : "${TMPDIR=/tmp}"+    # shellcheck disable=SC2039+    { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||+	{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||+	{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||+	{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }+    dummy=$tmp/dummy+    case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in+	,,)    echo "int x;" > "$dummy.c"+	       for driver in cc gcc c89 c99 ; do+		   if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then+		       CC_FOR_BUILD="$driver"+		       break+		   fi+	       done+	       if test x"$CC_FOR_BUILD" = x ; then+		   CC_FOR_BUILD=no_compiler_found+	       fi+	       ;;+	,,*)   CC_FOR_BUILD=$CC ;;+	,*,*)  CC_FOR_BUILD=$HOST_CC ;;+    esac+}+ # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24)-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then+if test -f /.attbin/uname ; then 	PATH=$PATH:/.attbin ; export PATH fi @@ -138,9 +135,37 @@ UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown +case "$UNAME_SYSTEM" in+Linux|GNU|GNU/*)+	# If the system lacks a compiler, then just pick glibc.+	# We could probably try harder.+	LIBC=gnu++	set_cc_for_build+	cat <<-EOF > "$dummy.c"+	#include <features.h>+	#if defined(__UCLIBC__)+	LIBC=uclibc+	#elif defined(__dietlibc__)+	LIBC=dietlibc+	#else+	LIBC=gnu+	#endif+	EOF+	eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`"++	# If ldd exists, use it to detect musl libc.+	if command -v ldd >/dev/null && \+		ldd --version 2>&1 | grep -q ^musl+	then+	    LIBC=musl+	fi+	;;+esac+ # Note: order is significant - the case branches are not exclusive. -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in+case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in     *:NetBSD:*:*) 	# NetBSD (nbsd) targets should (where applicable) match one or 	# more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,@@ -153,21 +178,31 @@ 	# Note: NetBSD doesn't particularly care about the vendor 	# portion of the name.  We always set it to "unknown". 	sysctl="sysctl -n hw.machine_arch"-	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \-	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`-	case "${UNAME_MACHINE_ARCH}" in+	UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \+	    "/sbin/$sysctl" 2>/dev/null || \+	    "/usr/sbin/$sysctl" 2>/dev/null || \+	    echo unknown)`+	case "$UNAME_MACHINE_ARCH" in 	    armeb) machine=armeb-unknown ;; 	    arm*) machine=arm-unknown ;; 	    sh3el) machine=shl-unknown ;; 	    sh3eb) machine=sh-unknown ;; 	    sh5el) machine=sh5le-unknown ;;-	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;+	    earmv*)+		arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`+		endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`+		machine="${arch}${endian}"-unknown+		;;+	    *) machine="$UNAME_MACHINE_ARCH"-unknown ;; 	esac 	# The Operating System including object format, if it has switched-	# to ELF recently, or will in the future.-	case "${UNAME_MACHINE_ARCH}" in+	# to ELF recently (or will in the future) and ABI.+	case "$UNAME_MACHINE_ARCH" in+	    earm*)+		os=netbsdelf+		;; 	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)-		eval $set_cc_for_build+		set_cc_for_build 		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ 			| grep -q __ELF__ 		then@@ -182,44 +217,67 @@ 		os=netbsd 		;; 	esac+	# Determine ABI tags.+	case "$UNAME_MACHINE_ARCH" in+	    earm*)+		expr='s/^earmv[0-9]/-eabi/;s/eb$//'+		abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`+		;;+	esac 	# The OS release 	# Debian GNU/NetBSD machines have a different userland, and 	# thus, need a distinct triplet. However, they do not need 	# kernel version information, so it can be replaced with a 	# suitable tag, in the style of linux-gnu.-	case "${UNAME_VERSION}" in+	case "$UNAME_VERSION" in 	    Debian*) 		release='-gnu' 		;; 	    *)-		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`+		release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` 		;; 	esac 	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: 	# contains redundant information, the shorter form: 	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.-	echo "${machine}-${os}${release}"+	echo "$machine-${os}${release}${abi-}" 	exit ;;     *:Bitrig:*:*) 	UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`-	echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}+	echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" 	exit ;;     *:OpenBSD:*:*) 	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`-	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}+	echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" 	exit ;;+    *:LibertyBSD:*:*)+	UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`+	echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE"+	exit ;;+    *:MidnightBSD:*:*)+	echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE"+	exit ;;     *:ekkoBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" 	exit ;;     *:SolidBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" 	exit ;;     macppc:MirBSD:*:*)-	echo powerpc-unknown-mirbsd${UNAME_RELEASE}+	echo powerpc-unknown-mirbsd"$UNAME_RELEASE" 	exit ;;     *:MirBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" 	exit ;;+    *:Sortix:*:*)+	echo "$UNAME_MACHINE"-unknown-sortix+	exit ;;+    *:Redox:*:*)+	echo "$UNAME_MACHINE"-unknown-redox+	exit ;;+    mips:OSF1:*.*)+        echo mips-dec-osf1+        exit ;;     alpha:OSF1:*:*) 	case $UNAME_RELEASE in 	*4.0)@@ -236,63 +294,54 @@ 	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1` 	case "$ALPHA_CPU_TYPE" in 	    "EV4 (21064)")-		UNAME_MACHINE="alpha" ;;+		UNAME_MACHINE=alpha ;; 	    "EV4.5 (21064)")-		UNAME_MACHINE="alpha" ;;+		UNAME_MACHINE=alpha ;; 	    "LCA4 (21066/21068)")-		UNAME_MACHINE="alpha" ;;+		UNAME_MACHINE=alpha ;; 	    "EV5 (21164)")-		UNAME_MACHINE="alphaev5" ;;+		UNAME_MACHINE=alphaev5 ;; 	    "EV5.6 (21164A)")-		UNAME_MACHINE="alphaev56" ;;+		UNAME_MACHINE=alphaev56 ;; 	    "EV5.6 (21164PC)")-		UNAME_MACHINE="alphapca56" ;;+		UNAME_MACHINE=alphapca56 ;; 	    "EV5.7 (21164PC)")-		UNAME_MACHINE="alphapca57" ;;+		UNAME_MACHINE=alphapca57 ;; 	    "EV6 (21264)")-		UNAME_MACHINE="alphaev6" ;;+		UNAME_MACHINE=alphaev6 ;; 	    "EV6.7 (21264A)")-		UNAME_MACHINE="alphaev67" ;;+		UNAME_MACHINE=alphaev67 ;; 	    "EV6.8CB (21264C)")-		UNAME_MACHINE="alphaev68" ;;+		UNAME_MACHINE=alphaev68 ;; 	    "EV6.8AL (21264B)")-		UNAME_MACHINE="alphaev68" ;;+		UNAME_MACHINE=alphaev68 ;; 	    "EV6.8CX (21264D)")-		UNAME_MACHINE="alphaev68" ;;+		UNAME_MACHINE=alphaev68 ;; 	    "EV6.9A (21264/EV69A)")-		UNAME_MACHINE="alphaev69" ;;+		UNAME_MACHINE=alphaev69 ;; 	    "EV7 (21364)")-		UNAME_MACHINE="alphaev7" ;;+		UNAME_MACHINE=alphaev7 ;; 	    "EV7.9 (21364A)")-		UNAME_MACHINE="alphaev79" ;;+		UNAME_MACHINE=alphaev79 ;; 	esac 	# A Pn.n version is a patched version. 	# A Vn.n version is a released version. 	# A Tn.n version is a released field test version. 	# A Xn.n version is an unreleased experimental baselevel. 	# 1.2 uses "1.2" for uname -r.-	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`+	echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" 	# Reset EXIT trap before exiting to avoid spurious non-zero exit code. 	exitcode=$? 	trap '' 0 	exit $exitcode ;;-    Alpha\ *:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# Should we change UNAME_MACHINE based on the output of uname instead-	# of the specific Alpha model?-	echo alpha-pc-interix-	exit ;;-    21064:Windows_NT:50:3)-	echo alpha-dec-winnt3.5-	exit ;;     Amiga*:UNIX_System_V:4.0:*) 	echo m68k-unknown-sysv4 	exit ;;     *:[Aa]miga[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-amigaos+	echo "$UNAME_MACHINE"-unknown-amigaos 	exit ;;     *:[Mm]orph[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-morphos+	echo "$UNAME_MACHINE"-unknown-morphos 	exit ;;     *:OS/390:*:*) 	echo i370-ibm-openedition@@ -304,9 +353,9 @@ 	echo powerpc-ibm-os400 	exit ;;     arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)-	echo arm-acorn-riscix${UNAME_RELEASE}+	echo arm-acorn-riscix"$UNAME_RELEASE" 	exit ;;-    arm:riscos:*:*|arm:RISCOS:*:*)+    arm*:riscos:*:*|arm*:RISCOS:*:*) 	echo arm-unknown-riscos 	exit ;;     SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)@@ -331,38 +380,33 @@ 	    sparc) echo sparc-icl-nx7; exit ;; 	esac ;;     s390x:SunOS:*:*)-	echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" 	exit ;;     sun4H:SunOS:5.*:*)-	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" 	exit ;;     sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)-	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" 	exit ;;     i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)-	echo i386-pc-auroraux${UNAME_RELEASE}+	echo i386-pc-auroraux"$UNAME_RELEASE" 	exit ;;     i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)-	eval $set_cc_for_build-	SUN_ARCH="i386"-	# If there is a compiler, see if it is configured for 64-bit objects.-	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.-	# This test works for both compilers.-	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then-	    if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \-		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \-		grep IS_64BIT_ARCH >/dev/null-	    then-		SUN_ARCH="x86_64"-	    fi-	fi-	echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	UNAME_REL="`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"+	case `isainfo -b` in+	    32)+		echo i386-pc-solaris2"$UNAME_REL"+		;;+	    64)+		echo x86_64-pc-solaris2"$UNAME_REL"+		;;+	esac 	exit ;;     sun4*:SunOS:6*:*) 	# According to config.sub, this is the proper way to canonicalize 	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but 	# it's likely to be more like Solaris than SunOS4.-	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" 	exit ;;     sun4*:SunOS:*:*) 	case "`/usr/bin/arch -k`" in@@ -371,25 +415,25 @@ 		;; 	esac 	# Japanese Language versions have a version number like `4.1.3-JL'.-	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`+	echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" 	exit ;;     sun3*:SunOS:*:*)-	echo m68k-sun-sunos${UNAME_RELEASE}+	echo m68k-sun-sunos"$UNAME_RELEASE" 	exit ;;     sun*:*:4.2BSD:*) 	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`-	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3+	test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 	case "`/bin/arch`" in 	    sun3)-		echo m68k-sun-sunos${UNAME_RELEASE}+		echo m68k-sun-sunos"$UNAME_RELEASE" 		;; 	    sun4)-		echo sparc-sun-sunos${UNAME_RELEASE}+		echo sparc-sun-sunos"$UNAME_RELEASE" 		;; 	esac 	exit ;;     aushp:SunOS:*:*)-	echo sparc-auspex-sunos${UNAME_RELEASE}+	echo sparc-auspex-sunos"$UNAME_RELEASE" 	exit ;;     # The situation for MiNT is a little confusing.  The machine name     # can be virtually everything (everything which is not@@ -400,44 +444,44 @@     # MiNT.  But MiNT is downward compatible to TOS, so this should     # be no problem.     atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)-	echo m68k-atari-mint${UNAME_RELEASE}+	echo m68k-atari-mint"$UNAME_RELEASE" 	exit ;;     atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)-	echo m68k-atari-mint${UNAME_RELEASE}+	echo m68k-atari-mint"$UNAME_RELEASE" 	exit ;;     *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)-	echo m68k-atari-mint${UNAME_RELEASE}+	echo m68k-atari-mint"$UNAME_RELEASE" 	exit ;;     milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)-	echo m68k-milan-mint${UNAME_RELEASE}+	echo m68k-milan-mint"$UNAME_RELEASE" 	exit ;;     hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)-	echo m68k-hades-mint${UNAME_RELEASE}+	echo m68k-hades-mint"$UNAME_RELEASE" 	exit ;;     *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)-	echo m68k-unknown-mint${UNAME_RELEASE}+	echo m68k-unknown-mint"$UNAME_RELEASE" 	exit ;;     m68k:machten:*:*)-	echo m68k-apple-machten${UNAME_RELEASE}+	echo m68k-apple-machten"$UNAME_RELEASE" 	exit ;;     powerpc:machten:*:*)-	echo powerpc-apple-machten${UNAME_RELEASE}+	echo powerpc-apple-machten"$UNAME_RELEASE" 	exit ;;     RISC*:Mach:*:*) 	echo mips-dec-mach_bsd4.3 	exit ;;     RISC*:ULTRIX:*:*)-	echo mips-dec-ultrix${UNAME_RELEASE}+	echo mips-dec-ultrix"$UNAME_RELEASE" 	exit ;;     VAX*:ULTRIX*:*:*)-	echo vax-dec-ultrix${UNAME_RELEASE}+	echo vax-dec-ultrix"$UNAME_RELEASE" 	exit ;;     2020:CLIX:*:* | 2430:CLIX:*:*)-	echo clipper-intergraph-clix${UNAME_RELEASE}+	echo clipper-intergraph-clix"$UNAME_RELEASE" 	exit ;;     mips:*:*:UMIPS | mips:*:*:RISCos)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c+	set_cc_for_build+	sed 's/^	//' << EOF > "$dummy.c" #ifdef __cplusplus #include <stdio.h>  /* for printf() prototype */ 	int main (int argc, char *argv[]) {@@ -446,23 +490,23 @@ #endif 	#if defined (host_mips) && defined (MIPSEB) 	#if defined (SYSTYPE_SYSV)-	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);+	  printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); 	#endif 	#if defined (SYSTYPE_SVR4)-	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);+	  printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); 	#endif 	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)-	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);+	  printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); 	#endif 	#endif 	  exit (-1); 	} EOF-	$CC_FOR_BUILD -o $dummy $dummy.c &&-	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&-	  SYSTEM_NAME=`$dummy $dummyarg` &&+	$CC_FOR_BUILD -o "$dummy" "$dummy.c" &&+	  dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&+	  SYSTEM_NAME=`"$dummy" "$dummyarg"` && 	    { echo "$SYSTEM_NAME"; exit; }-	echo mips-mips-riscos${UNAME_RELEASE}+	echo mips-mips-riscos"$UNAME_RELEASE" 	exit ;;     Motorola:PowerMAX_OS:*:*) 	echo powerpc-motorola-powermax@@ -488,17 +532,17 @@     AViiON:dgux:*:*) 	# DG/UX returns AViiON for all architectures 	UNAME_PROCESSOR=`/usr/bin/uname -p`-	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]+	if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] 	then-	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \-	       [ ${TARGET_BINARY_INTERFACE}x = x ]+	    if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \+	       [ "$TARGET_BINARY_INTERFACE"x = x ] 	    then-		echo m88k-dg-dgux${UNAME_RELEASE}+		echo m88k-dg-dgux"$UNAME_RELEASE" 	    else-		echo m88k-dg-dguxbcs${UNAME_RELEASE}+		echo m88k-dg-dguxbcs"$UNAME_RELEASE" 	    fi 	else-	    echo i586-dg-dgux${UNAME_RELEASE}+	    echo i586-dg-dgux"$UNAME_RELEASE" 	fi 	exit ;;     M88*:DolphinOS:*:*)	# DolphinOS (SVR3)@@ -515,7 +559,7 @@ 	echo m68k-tektronix-bsd 	exit ;;     *:IRIX*:*:*)-	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`+	echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" 	exit ;;     ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. 	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id@@ -527,14 +571,14 @@ 	if [ -x /usr/bin/oslevel ] ; then 		IBM_REV=`/usr/bin/oslevel` 	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}+		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" 	fi-	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}+	echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" 	exit ;;     *:AIX:2:3) 	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then-		eval $set_cc_for_build-		sed 's/^		//' << EOF >$dummy.c+		set_cc_for_build+		sed 's/^		//' << EOF > "$dummy.c" 		#include <sys/systemcfg.h>  		main()@@ -545,7 +589,7 @@ 			exit(0); 			} EOF-		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`+		if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` 		then 			echo "$SYSTEM_NAME" 		else@@ -559,26 +603,27 @@ 	exit ;;     *:AIX:*:[4567]) 	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`-	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then+	if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then 		IBM_ARCH=rs6000 	else 		IBM_ARCH=powerpc 	fi-	if [ -x /usr/bin/oslevel ] ; then-		IBM_REV=`/usr/bin/oslevel`+	if [ -x /usr/bin/lslpp ] ; then+		IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc |+			   awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` 	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}+		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" 	fi-	echo ${IBM_ARCH}-ibm-aix${IBM_REV}+	echo "$IBM_ARCH"-ibm-aix"$IBM_REV" 	exit ;;     *:AIX:*:*) 	echo rs6000-ibm-aix 	exit ;;-    ibmrt:4.4BSD:*|romp-ibm:BSD:*)+    ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) 	echo romp-ibm-bsd4.4 	exit ;;     ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and-	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to+	echo romp-ibm-bsd"$UNAME_RELEASE"   # 4.3 with uname added to 	exit ;;                             # report: romp-ibm BSD 4.3     *:BOSX:*:*) 	echo rs6000-bull-bosx@@ -593,28 +638,28 @@ 	echo m68k-hp-bsd4.4 	exit ;;     9000/[34678]??:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	case "${UNAME_MACHINE}" in-	    9000/31? )            HP_ARCH=m68000 ;;-	    9000/[34]?? )         HP_ARCH=m68k ;;+	HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`+	case "$UNAME_MACHINE" in+	    9000/31?)            HP_ARCH=m68000 ;;+	    9000/[34]??)         HP_ARCH=m68k ;; 	    9000/[678][0-9][0-9]) 		if [ -x /usr/bin/getconf ]; then 		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` 		    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`-		    case "${sc_cpu_version}" in-		      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0-		      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1+		    case "$sc_cpu_version" in+		      523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0+		      528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 		      532)                      # CPU_PA_RISC2_0-			case "${sc_kernel_bits}" in-			  32) HP_ARCH="hppa2.0n" ;;-			  64) HP_ARCH="hppa2.0w" ;;-			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20+			case "$sc_kernel_bits" in+			  32) HP_ARCH=hppa2.0n ;;+			  64) HP_ARCH=hppa2.0w ;;+			  '') HP_ARCH=hppa2.0 ;;   # HP-UX 10.20 			esac ;; 		    esac 		fi-		if [ "${HP_ARCH}" = "" ]; then-		    eval $set_cc_for_build-		    sed 's/^		//' << EOF >$dummy.c+		if [ "$HP_ARCH" = "" ]; then+		    set_cc_for_build+		    sed 's/^		//' << EOF > "$dummy.c"  		#define _HPUX_SOURCE 		#include <stdlib.h>@@ -647,13 +692,13 @@ 		    exit (0); 		} EOF-		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`+		    (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` 		    test -z "$HP_ARCH" && HP_ARCH=hppa 		fi ;; 	esac-	if [ ${HP_ARCH} = "hppa2.0w" ]+	if [ "$HP_ARCH" = hppa2.0w ] 	then-	    eval $set_cc_for_build+	    set_cc_for_build  	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating 	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler@@ -664,23 +709,23 @@ 	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess 	    # => hppa64-hp-hpux11.23 -	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |+	    if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | 		grep -q __LP64__ 	    then-		HP_ARCH="hppa2.0w"+		HP_ARCH=hppa2.0w 	    else-		HP_ARCH="hppa64"+		HP_ARCH=hppa64 	    fi 	fi-	echo ${HP_ARCH}-hp-hpux${HPUX_REV}+	echo "$HP_ARCH"-hp-hpux"$HPUX_REV" 	exit ;;     ia64:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	echo ia64-hp-hpux${HPUX_REV}+	HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`+	echo ia64-hp-hpux"$HPUX_REV" 	exit ;;     3050*:HI-UX:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c+	set_cc_for_build+	sed 's/^	//' << EOF > "$dummy.c" 	#include <unistd.h> 	int 	main ()@@ -705,11 +750,11 @@ 	  exit (0); 	} EOF-	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&+	$CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && 		{ echo "$SYSTEM_NAME"; exit; } 	echo unknown-hitachi-hiuxwe2 	exit ;;-    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) 	echo hppa1.1-hp-bsd 	exit ;;     9000/8??:4.3bsd:*:*)@@ -718,7 +763,7 @@     *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) 	echo hppa1.0-hp-mpeix 	exit ;;-    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) 	echo hppa1.1-hp-osf 	exit ;;     hp8??:OSF1:*:*)@@ -726,9 +771,9 @@ 	exit ;;     i*86:OSF1:*:*) 	if [ -x /usr/sbin/sysversion ] ; then-	    echo ${UNAME_MACHINE}-unknown-osf1mk+	    echo "$UNAME_MACHINE"-unknown-osf1mk 	else-	    echo ${UNAME_MACHINE}-unknown-osf1+	    echo "$UNAME_MACHINE"-unknown-osf1 	fi 	exit ;;     parisc*:Lites*:*:*)@@ -753,127 +798,120 @@ 	echo c4-convex-bsd 	exit ;;     CRAY*Y-MP:*:*:*)-	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' 	exit ;;     CRAY*[A-Z]90:*:*:*)-	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \+	echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ 	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ 	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ 	      -e 's/\.[^.]*$/.X/' 	exit ;;     CRAY*TS:*:*:*)-	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' 	exit ;;     CRAY*T3E:*:*:*)-	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' 	exit ;;     CRAY*SV1:*:*:*)-	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' 	exit ;;     *:UNICOS/mp:*:*)-	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' 	exit ;;     F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)-	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`-	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-	FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`+	FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`+	FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`+	FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` 	echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" 	exit ;;     5000:UNIX_System_V:4.*:*)-	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-	FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`+	FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`+	FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` 	echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" 	exit ;;     i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)-	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" 	exit ;;     sparc*:BSD/OS:*:*)-	echo sparc-unknown-bsdi${UNAME_RELEASE}+	echo sparc-unknown-bsdi"$UNAME_RELEASE" 	exit ;;     *:BSD/OS:*:*)-	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" 	exit ;;+    arm*:FreeBSD:*:*)+	UNAME_PROCESSOR=`uname -p`+	set_cc_for_build+	if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \+	    | grep -q __ARM_PCS_VFP+	then+	    echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi+	else+	    echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf+	fi+	exit ;;     *:FreeBSD:*:*) 	UNAME_PROCESSOR=`/usr/bin/uname -p`-	case ${UNAME_PROCESSOR} in+	case "$UNAME_PROCESSOR" in 	    amd64)-		echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;-	    *)-		echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;+		UNAME_PROCESSOR=x86_64 ;;+	    i386)+		UNAME_PROCESSOR=i586 ;; 	esac+	echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" 	exit ;;     i*:CYGWIN*:*)-	echo ${UNAME_MACHINE}-pc-cygwin+	echo "$UNAME_MACHINE"-pc-cygwin 	exit ;;     *:MINGW64*:*)-	echo ${UNAME_MACHINE}-pc-mingw64+	echo "$UNAME_MACHINE"-pc-mingw64 	exit ;;     *:MINGW*:*)-	echo ${UNAME_MACHINE}-pc-mingw32-	exit ;;-    i*:MSYS*:*)-	echo ${UNAME_MACHINE}-pc-msys+	echo "$UNAME_MACHINE"-pc-mingw32 	exit ;;-    i*:windows32*:*)-	# uname -m includes "-pc" on this system.-	echo ${UNAME_MACHINE}-mingw32+    *:MSYS*:*)+	echo "$UNAME_MACHINE"-pc-msys 	exit ;;     i*:PW*:*)-	echo ${UNAME_MACHINE}-pc-pw32+	echo "$UNAME_MACHINE"-pc-pw32 	exit ;;     *:Interix*:*)-	case ${UNAME_MACHINE} in+	case "$UNAME_MACHINE" in 	    x86)-		echo i586-pc-interix${UNAME_RELEASE}+		echo i586-pc-interix"$UNAME_RELEASE" 		exit ;; 	    authenticamd | genuineintel | EM64T)-		echo x86_64-unknown-interix${UNAME_RELEASE}+		echo x86_64-unknown-interix"$UNAME_RELEASE" 		exit ;; 	    IA64)-		echo ia64-unknown-interix${UNAME_RELEASE}+		echo ia64-unknown-interix"$UNAME_RELEASE" 		exit ;; 	esac ;;-    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)-	echo i${UNAME_MACHINE}-pc-mks-	exit ;;-    8664:Windows_NT:*)-	echo x86_64-pc-mks-	exit ;;-    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we-	# UNAME_MACHINE based on the output of uname instead of i386?-	echo i586-pc-interix-	exit ;;     i*:UWIN*:*)-	echo ${UNAME_MACHINE}-pc-uwin+	echo "$UNAME_MACHINE"-pc-uwin 	exit ;;     amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) 	echo x86_64-unknown-cygwin 	exit ;;-    p*:CYGWIN*:*)-	echo powerpcle-unknown-cygwin-	exit ;;     prep*:SunOS:5.*:*)-	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" 	exit ;;     *:GNU:*:*) 	# the GNU system-	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`+	echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" 	exit ;;     *:GNU/*:*:*) 	# other systems with GNU libc and userland-	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu+	echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" 	exit ;;-    i*86:Minix:*:*)-	echo ${UNAME_MACHINE}-pc-minix+    *:Minix:*:*)+	echo "$UNAME_MACHINE"-unknown-minix 	exit ;;     aarch64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     aarch64_be:Linux:*:*) 	UNAME_MACHINE=aarch64_be-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     alpha:Linux:*:*) 	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in@@ -886,63 +924,64 @@ 	  EV68*) UNAME_MACHINE=alphaev68 ;; 	esac 	objdump --private-headers /bin/sh | grep -q ld.so.1-	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi-	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}+	if test "$?" = 0 ; then LIBC=gnulibc1 ; fi+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;+    arc:Linux:*:* | arceb:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"+	exit ;;     arm*:Linux:*:*)-	eval $set_cc_for_build+	set_cc_for_build 	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ 	    | grep -q __ARM_EABI__ 	then-	    echo ${UNAME_MACHINE}-unknown-linux-gnu+	    echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	else 	    if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ 		| grep -q __ARM_PCS_VFP 	    then-		echo ${UNAME_MACHINE}-unknown-linux-gnueabi+		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi 	    else-		echo ${UNAME_MACHINE}-unknown-linux-gnueabihf+		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf 	    fi 	fi 	exit ;;     avr32*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     cris:Linux:*:*)-	echo ${UNAME_MACHINE}-axis-linux-gnu+	echo "$UNAME_MACHINE"-axis-linux-"$LIBC" 	exit ;;     crisv32:Linux:*:*)-	echo ${UNAME_MACHINE}-axis-linux-gnu+	echo "$UNAME_MACHINE"-axis-linux-"$LIBC" 	exit ;;+    e2k:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"+	exit ;;     frv:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     hexagon:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     i*86:Linux:*:*)-	LIBC=gnu-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#ifdef __dietlibc__-	LIBC=dietlibc-	#endif-EOF-	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`-	echo "${UNAME_MACHINE}-pc-linux-${LIBC}"+	echo "$UNAME_MACHINE"-pc-linux-"$LIBC" 	exit ;;     ia64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;+    k1om:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"+	exit ;;     m32r*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     m68*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     mips:Linux:*:* | mips64:Linux:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c+	set_cc_for_build+	sed 's/^	//' << EOF > "$dummy.c" 	#undef CPU 	#undef ${UNAME_MACHINE} 	#undef ${UNAME_MACHINE}el@@ -956,55 +995,70 @@ 	#endif 	#endif EOF-	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`-	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }+	eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU'`"+	test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; } 	;;-    or32:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+    mips64el:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;+    openrisc*:Linux:*:*)+	echo or1k-unknown-linux-"$LIBC"+	exit ;;+    or32:Linux:*:* | or1k*:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"+	exit ;;     padre:Linux:*:*)-	echo sparc-unknown-linux-gnu+	echo sparc-unknown-linux-"$LIBC" 	exit ;;     parisc64:Linux:*:* | hppa64:Linux:*:*)-	echo hppa64-unknown-linux-gnu+	echo hppa64-unknown-linux-"$LIBC" 	exit ;;     parisc:Linux:*:* | hppa:Linux:*:*) 	# Look for CPU level 	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in-	  PA7*) echo hppa1.1-unknown-linux-gnu ;;-	  PA8*) echo hppa2.0-unknown-linux-gnu ;;-	  *)    echo hppa-unknown-linux-gnu ;;+	  PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;;+	  PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;;+	  *)    echo hppa-unknown-linux-"$LIBC" ;; 	esac 	exit ;;     ppc64:Linux:*:*)-	echo powerpc64-unknown-linux-gnu+	echo powerpc64-unknown-linux-"$LIBC" 	exit ;;     ppc:Linux:*:*)-	echo powerpc-unknown-linux-gnu+	echo powerpc-unknown-linux-"$LIBC" 	exit ;;+    ppc64le:Linux:*:*)+	echo powerpc64le-unknown-linux-"$LIBC"+	exit ;;+    ppcle:Linux:*:*)+	echo powerpcle-unknown-linux-"$LIBC"+	exit ;;+    riscv32:Linux:*:* | riscv64:Linux:*:*)+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"+	exit ;;     s390:Linux:*:* | s390x:Linux:*:*)-	echo ${UNAME_MACHINE}-ibm-linux+	echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" 	exit ;;     sh64*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     sh*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     sparc:Linux:*:* | sparc64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     tile*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     vax:Linux:*:*)-	echo ${UNAME_MACHINE}-dec-linux-gnu+	echo "$UNAME_MACHINE"-dec-linux-"$LIBC" 	exit ;;     x86_64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-pc-linux-"$LIBC" 	exit ;;     xtensa*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu+	echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" 	exit ;;     i*86:DYNIX/ptx:4*:*) 	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.@@ -1018,34 +1072,34 @@ 	# I am not positive that other SVR4 systems won't match this, 	# I just have to hope.  -- rms. 	# Use sysv4.2uw... so that sysv4* matches it.-	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}+	echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" 	exit ;;     i*86:OS/2:*:*) 	# If we were able to find `uname', then EMX Unix compatibility 	# is probably installed.-	echo ${UNAME_MACHINE}-pc-os2-emx+	echo "$UNAME_MACHINE"-pc-os2-emx 	exit ;;     i*86:XTS-300:*:STOP)-	echo ${UNAME_MACHINE}-unknown-stop+	echo "$UNAME_MACHINE"-unknown-stop 	exit ;;     i*86:atheos:*:*)-	echo ${UNAME_MACHINE}-unknown-atheos+	echo "$UNAME_MACHINE"-unknown-atheos 	exit ;;     i*86:syllable:*:*)-	echo ${UNAME_MACHINE}-pc-syllable+	echo "$UNAME_MACHINE"-pc-syllable 	exit ;;     i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)-	echo i386-unknown-lynxos${UNAME_RELEASE}+	echo i386-unknown-lynxos"$UNAME_RELEASE" 	exit ;;     i*86:*DOS:*:*)-	echo ${UNAME_MACHINE}-pc-msdosdjgpp+	echo "$UNAME_MACHINE"-pc-msdosdjgpp 	exit ;;-    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)-	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`+    i*86:*:4.*:*)+	UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` 	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then-		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}+		echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" 	else-		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}+		echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" 	fi 	exit ;;     i*86:*:5:[678]*)@@ -1055,12 +1109,12 @@ 	    *Pentium)	     UNAME_MACHINE=i586 ;; 	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;; 	esac-	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}+	echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}" 	exit ;;     i*86:*:3.2:*) 	if test -f /usr/options/cb.name; then 		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`-		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL+		echo "$UNAME_MACHINE"-pc-isc"$UNAME_REL" 	elif /bin/uname -X 2>/dev/null >/dev/null ; then 		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` 		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486@@ -1070,9 +1124,9 @@ 			&& UNAME_MACHINE=i686 		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ 			&& UNAME_MACHINE=i686-		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL+		echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" 	else-		echo ${UNAME_MACHINE}-pc-sysv32+		echo "$UNAME_MACHINE"-pc-sysv32 	fi 	exit ;;     pc:*:*:*)@@ -1080,7 +1134,7 @@ 	# uname -m prints for DJGPP always 'pc', but it prints nothing about 	# the processor, so we play safe by assuming i586. 	# Note: whatever this is, it MUST be the same as what config.sub-	# prints for the "djgpp" host, or else GDB configury will decide that+	# prints for the "djgpp" host, or else GDB configure will decide that 	# this is a cross-build. 	echo i586-pc-msdosdjgpp 	exit ;;@@ -1092,9 +1146,9 @@ 	exit ;;     i860:*:4.*:*) # i860-SVR4 	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then-	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4+	  echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 	else # Add other i860-SVR4 vendors below as they are discovered.-	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4+	  echo i860-unknown-sysv"$UNAME_RELEASE"  # Unknown i860-SVR4 	fi 	exit ;;     mini*:CTIX:SYS*5:*)@@ -1114,9 +1168,9 @@ 	test -r /etc/.relid \ 	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` 	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \-	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }+	  && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } 	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \-	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;+	  && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;     3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) 	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \ 	  && { echo i486-ncr-sysv4; exit; } ;;@@ -1125,28 +1179,28 @@ 	test -r /etc/.relid \ 	    && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` 	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \-	    && { echo i486-ncr-sysv4.3${OS_REL}; exit; }+	    && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } 	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \-	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; }+	    && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } 	/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \-	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;+	    && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;     m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)-	echo m68k-unknown-lynxos${UNAME_RELEASE}+	echo m68k-unknown-lynxos"$UNAME_RELEASE" 	exit ;;     mc68030:UNIX_System_V:4.*:*) 	echo m68k-atari-sysv4 	exit ;;     TSUNAMI:LynxOS:2.*:*)-	echo sparc-unknown-lynxos${UNAME_RELEASE}+	echo sparc-unknown-lynxos"$UNAME_RELEASE" 	exit ;;     rs6000:LynxOS:2.*:*)-	echo rs6000-unknown-lynxos${UNAME_RELEASE}+	echo rs6000-unknown-lynxos"$UNAME_RELEASE" 	exit ;;     PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)-	echo powerpc-unknown-lynxos${UNAME_RELEASE}+	echo powerpc-unknown-lynxos"$UNAME_RELEASE" 	exit ;;     SM[BE]S:UNIX_SV:*:*)-	echo mips-dde-sysv${UNAME_RELEASE}+	echo mips-dde-sysv"$UNAME_RELEASE" 	exit ;;     RM*:ReliantUNIX-*:*:*) 	echo mips-sni-sysv4@@ -1157,7 +1211,7 @@     *:SINIX-*:*:*) 	if uname -p 2>/dev/null >/dev/null ; then 		UNAME_MACHINE=`(uname -p) 2>/dev/null`-		echo ${UNAME_MACHINE}-sni-sysv4+		echo "$UNAME_MACHINE"-sni-sysv4 	else 		echo ns32k-sni-sysv 	fi@@ -1177,23 +1231,23 @@ 	exit ;;     i*86:VOS:*:*) 	# From Paul.Green@stratus.com.-	echo ${UNAME_MACHINE}-stratus-vos+	echo "$UNAME_MACHINE"-stratus-vos 	exit ;;     *:VOS:*:*) 	# From Paul.Green@stratus.com. 	echo hppa1.1-stratus-vos 	exit ;;     mc68*:A/UX:*:*)-	echo m68k-apple-aux${UNAME_RELEASE}+	echo m68k-apple-aux"$UNAME_RELEASE" 	exit ;;     news*:NEWS-OS:6*:*) 	echo mips-sony-newsos6 	exit ;;     R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) 	if [ -d /usr/nec ]; then-		echo mips-nec-sysv${UNAME_RELEASE}+		echo mips-nec-sysv"$UNAME_RELEASE" 	else-		echo mips-unknown-sysv${UNAME_RELEASE}+		echo mips-unknown-sysv"$UNAME_RELEASE" 	fi 	exit ;;     BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.@@ -1212,66 +1266,94 @@ 	echo x86_64-unknown-haiku 	exit ;;     SX-4:SUPER-UX:*:*)-	echo sx4-nec-superux${UNAME_RELEASE}+	echo sx4-nec-superux"$UNAME_RELEASE" 	exit ;;     SX-5:SUPER-UX:*:*)-	echo sx5-nec-superux${UNAME_RELEASE}+	echo sx5-nec-superux"$UNAME_RELEASE" 	exit ;;     SX-6:SUPER-UX:*:*)-	echo sx6-nec-superux${UNAME_RELEASE}+	echo sx6-nec-superux"$UNAME_RELEASE" 	exit ;;     SX-7:SUPER-UX:*:*)-	echo sx7-nec-superux${UNAME_RELEASE}+	echo sx7-nec-superux"$UNAME_RELEASE" 	exit ;;     SX-8:SUPER-UX:*:*)-	echo sx8-nec-superux${UNAME_RELEASE}+	echo sx8-nec-superux"$UNAME_RELEASE" 	exit ;;     SX-8R:SUPER-UX:*:*)-	echo sx8r-nec-superux${UNAME_RELEASE}+	echo sx8r-nec-superux"$UNAME_RELEASE" 	exit ;;+    SX-ACE:SUPER-UX:*:*)+	echo sxace-nec-superux"$UNAME_RELEASE"+	exit ;;     Power*:Rhapsody:*:*)-	echo powerpc-apple-rhapsody${UNAME_RELEASE}+	echo powerpc-apple-rhapsody"$UNAME_RELEASE" 	exit ;;     *:Rhapsody:*:*)-	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" 	exit ;;     *:Darwin:*:*) 	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown-	case $UNAME_PROCESSOR in-	    i386)-		eval $set_cc_for_build-		if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then-		  if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \-		      (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \-		      grep IS_64BIT_ARCH >/dev/null-		  then-		      UNAME_PROCESSOR="x86_64"-		  fi-		fi ;;-	    unknown) UNAME_PROCESSOR=powerpc ;;-	esac-	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}+	set_cc_for_build+	if test "$UNAME_PROCESSOR" = unknown ; then+	    UNAME_PROCESSOR=powerpc+	fi+	if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then+	    if [ "$CC_FOR_BUILD" != no_compiler_found ]; then+		if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \+		       (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \+		       grep IS_64BIT_ARCH >/dev/null+		then+		    case $UNAME_PROCESSOR in+			i386) UNAME_PROCESSOR=x86_64 ;;+			powerpc) UNAME_PROCESSOR=powerpc64 ;;+		    esac+		fi+		# On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc+		if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \+		       (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \+		       grep IS_PPC >/dev/null+		then+		    UNAME_PROCESSOR=powerpc+		fi+	    fi+	elif test "$UNAME_PROCESSOR" = i386 ; then+	    # Avoid executing cc on OS X 10.9, as it ships with a stub+	    # that puts up a graphical alert prompting to install+	    # developer tools.  Any system running Mac OS X 10.7 or+	    # later (Darwin 11 and later) is required to have a 64-bit+	    # processor. This is not true of the ARM version of Darwin+	    # that Apple uses in portable devices.+	    UNAME_PROCESSOR=x86_64+	fi+	echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" 	exit ;;     *:procnto*:*:* | *:QNX:[0123456789]*:*) 	UNAME_PROCESSOR=`uname -p`-	if test "$UNAME_PROCESSOR" = "x86"; then+	if test "$UNAME_PROCESSOR" = x86; then 		UNAME_PROCESSOR=i386 		UNAME_MACHINE=pc 	fi-	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}+	echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" 	exit ;;     *:QNX:*:4*) 	echo i386-pc-qnx 	exit ;;-    NEO-?:NONSTOP_KERNEL:*:*)-	echo neo-tandem-nsk${UNAME_RELEASE}+    NEO-*:NONSTOP_KERNEL:*:*)+	echo neo-tandem-nsk"$UNAME_RELEASE" 	exit ;;     NSE-*:NONSTOP_KERNEL:*:*)-	echo nse-tandem-nsk${UNAME_RELEASE}+	echo nse-tandem-nsk"$UNAME_RELEASE" 	exit ;;-    NSR-?:NONSTOP_KERNEL:*:*)-	echo nsr-tandem-nsk${UNAME_RELEASE}+    NSR-*:NONSTOP_KERNEL:*:*)+	echo nsr-tandem-nsk"$UNAME_RELEASE" 	exit ;;+    NSV-*:NONSTOP_KERNEL:*:*)+	echo nsv-tandem-nsk"$UNAME_RELEASE"+	exit ;;+    NSX-*:NONSTOP_KERNEL:*:*)+	echo nsx-tandem-nsk"$UNAME_RELEASE"+	exit ;;     *:NonStop-UX:*:*) 	echo mips-compaq-nonstopux 	exit ;;@@ -1279,18 +1361,19 @@ 	echo bs2000-siemens-sysv 	exit ;;     DS/*:UNIX_System_V:*:*)-	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}+	echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" 	exit ;;     *:Plan9:*:*) 	# "uname -m" is not consistent, so use $cputype instead. 386 	# is converted to i386 for consistency with other x86 	# operating systems.-	if test "$cputype" = "386"; then+	# shellcheck disable=SC2154+	if test "$cputype" = 386; then 	    UNAME_MACHINE=i386 	else 	    UNAME_MACHINE="$cputype" 	fi-	echo ${UNAME_MACHINE}-unknown-plan9+	echo "$UNAME_MACHINE"-unknown-plan9 	exit ;;     *:TOPS-10:*:*) 	echo pdp10-unknown-tops10@@ -1311,14 +1394,14 @@ 	echo pdp10-unknown-its 	exit ;;     SEI:*:*:SEIUX)-	echo mips-sei-seiux${UNAME_RELEASE}+	echo mips-sei-seiux"$UNAME_RELEASE" 	exit ;;     *:DragonFly:*:*)-	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`+	echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" 	exit ;;     *:*VMS:*:*) 	UNAME_MACHINE=`(uname -p) 2>/dev/null`-	case "${UNAME_MACHINE}" in+	case "$UNAME_MACHINE" in 	    A*) echo alpha-dec-vms ; exit ;; 	    I*) echo ia64-dec-vms ; exit ;; 	    V*) echo vax-dec-vms ; exit ;;@@ -1327,182 +1410,48 @@ 	echo i386-pc-xenix 	exit ;;     i*86:skyos:*:*)-	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'+	echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" 	exit ;;     i*86:rdos:*:*)-	echo ${UNAME_MACHINE}-pc-rdos+	echo "$UNAME_MACHINE"-pc-rdos 	exit ;;     i*86:AROS:*:*)-	echo ${UNAME_MACHINE}-pc-aros+	echo "$UNAME_MACHINE"-pc-aros 	exit ;;     x86_64:VMkernel:*:*)-	echo ${UNAME_MACHINE}-unknown-esx+	echo "$UNAME_MACHINE"-unknown-esx 	exit ;;+    amd64:Isilon\ OneFS:*:*)+	echo x86_64-unknown-onefs+	exit ;; esac -eval $set_cc_for_build-cat >$dummy.c <<EOF-#ifdef _SEQUENT_-# include <sys/types.h>-# include <sys/utsname.h>-#endif-main ()-{-#if defined (sony)-#if defined (MIPSEB)-  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,-     I don't know....  */-  printf ("mips-sony-bsd\n"); exit (0);-#else-#include <sys/param.h>-  printf ("m68k-sony-newsos%s\n",-#ifdef NEWSOS4-	"4"-#else-	""-#endif-	); exit (0);-#endif-#endif--#if defined (__arm) && defined (__acorn) && defined (__unix)-  printf ("arm-acorn-riscix\n"); exit (0);-#endif--#if defined (hp300) && !defined (hpux)-  printf ("m68k-hp-bsd\n"); exit (0);-#endif--#if defined (NeXT)-#if !defined (__ARCHITECTURE__)-#define __ARCHITECTURE__ "m68k"-#endif-  int version;-  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;-  if (version < 4)-    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);-  else-    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);-  exit (0);-#endif--#if defined (MULTIMAX) || defined (n16)-#if defined (UMAXV)-  printf ("ns32k-encore-sysv\n"); exit (0);-#else-#if defined (CMU)-  printf ("ns32k-encore-mach\n"); exit (0);-#else-  printf ("ns32k-encore-bsd\n"); exit (0);-#endif-#endif-#endif--#if defined (__386BSD__)-  printf ("i386-pc-bsd\n"); exit (0);-#endif--#if defined (sequent)-#if defined (i386)-  printf ("i386-sequent-dynix\n"); exit (0);-#endif-#if defined (ns32000)-  printf ("ns32k-sequent-dynix\n"); exit (0);-#endif-#endif--#if defined (_SEQUENT_)-    struct utsname un;--    uname(&un);--    if (strncmp(un.version, "V2", 2) == 0) {-	printf ("i386-sequent-ptx2\n"); exit (0);-    }-    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */-	printf ("i386-sequent-ptx1\n"); exit (0);-    }-    printf ("i386-sequent-ptx\n"); exit (0);--#endif--#if defined (vax)-# if !defined (ultrix)-#  include <sys/param.h>-#  if defined (BSD)-#   if BSD == 43-      printf ("vax-dec-bsd4.3\n"); exit (0);-#   else-#    if BSD == 199006-      printf ("vax-dec-bsd4.3reno\n"); exit (0);-#    else-      printf ("vax-dec-bsd\n"); exit (0);-#    endif-#   endif-#  else-    printf ("vax-dec-bsd\n"); exit (0);-#  endif-# else-    printf ("vax-dec-ultrix\n"); exit (0);-# endif-#endif+echo "$0: unable to guess system type" >&2 -#if defined (alliant) && defined (i860)-  printf ("i860-alliant-bsd\n"); exit (0);-#endif+case "$UNAME_MACHINE:$UNAME_SYSTEM" in+    mips:Linux | mips64:Linux)+	# If we got here on MIPS GNU/Linux, output extra information.+	cat >&2 <<EOF -  exit (1);-}+NOTE: MIPS GNU/Linux systems require a C compiler to fully recognize+the system type. Please install a C compiler and try again. EOF--$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&-	{ echo "$SYSTEM_NAME"; exit; }--# Apollos put the system type in the environment.--test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }--# Convex versions that predate uname can use getsysinfo(1)--if [ -x /usr/convex/getsysinfo ]-then-    case `getsysinfo -f cpu_type` in-    c1*)-	echo c1-convex-bsd-	exit ;;-    c2*)-	if getsysinfo -f scalar_acc-	then echo c32-convex-bsd-	else echo c2-convex-bsd-	fi-	exit ;;-    c34*)-	echo c34-convex-bsd-	exit ;;-    c38*)-	echo c38-convex-bsd-	exit ;;-    c4*)-	echo c4-convex-bsd-	exit ;;-    esac-fi+	;;+esac  cat >&2 <<EOF-$0: unable to guess system type -This script, last modified $timestamp, has failed to recognize-the operating system you are using. It is advised that you-download the most up to date version of the config scripts from+This script (version $timestamp), has failed to recognize the+operating system you are using. If your script is old, overwrite *all*+copies of config.guess and config.sub with the latest versions from: -  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD+  https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess and-  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD+  https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub -If the version you run ($0) is already up to date, please-send the following data and any information you think might be-pertinent to <config-patches@gnu.org> in order to provide the needed-information to handle your system.+If $0 has already been updated, send the following data and any+information you think might be pertinent to config-patches@gnu.org to+provide the necessary information to handle your system.  config.guess timestamp = $timestamp @@ -1521,16 +1470,16 @@ /usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` -UNAME_MACHINE = ${UNAME_MACHINE}-UNAME_RELEASE = ${UNAME_RELEASE}-UNAME_SYSTEM  = ${UNAME_SYSTEM}-UNAME_VERSION = ${UNAME_VERSION}+UNAME_MACHINE = "$UNAME_MACHINE"+UNAME_RELEASE = "$UNAME_RELEASE"+UNAME_SYSTEM  = "$UNAME_SYSTEM"+UNAME_VERSION = "$UNAME_VERSION" EOF  exit 1  # Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)+# eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'"
data/nix/config/config.sub view
@@ -1,1785 +1,1817 @@ #! /bin/sh # Configuration validation subroutine script.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,-#   2011, 2012 Free Software Foundation, Inc.--timestamp='2012-08-18'--# This file is (in principle) common to ALL GNU software.-# The presence of a machine in this file suggests that SOME GNU software-# can handle that machine.  It does not imply ALL GNU software can.-#-# This file is free software; you can redistribute it and/or modify-# it under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or-# (at your option) any later version.-#-# This program is distributed in the hope that it will be useful,-# but WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-# GNU General Public License for more details.-#-# You should have received a copy of the GNU General Public License-# along with this program; if not, see <http://www.gnu.org/licenses/>.-#-# As a special exception to the GNU General Public License, if you-# distribute this file as part of a program that contains a-# configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Please send patches to <config-patches@gnu.org>.  Submit a context-# diff and a properly formatted GNU ChangeLog entry.-#-# Configuration subroutine to validate and canonicalize a configuration type.-# Supply the specified configuration type as an argument.-# If it is invalid, we print an error message on stderr and exit with code 1.-# Otherwise, we print the canonical config type on stdout and succeed.--# You can get the latest version of this script from:-# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD--# This file is supposed to be the same for all GNU packages-# and recognize all the CPU types, system types and aliases-# that are meaningful with *any* GNU software.-# Each package is responsible for reporting which valid configurations-# it does not support.  The user should be able to distinguish-# a failure to support a valid configuration from a meaningless-# configuration.--# The goal of this file is to map all the various variations of a given-# machine specification into a single specification in the form:-#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM-# or in some cases, the newer four-part form:-#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM-# It is wrong to echo any other type of specification.--me=`echo "$0" | sed -e 's,.*/,,'`--usage="\-Usage: $0 [OPTION] CPU-MFR-OPSYS-       $0 [OPTION] ALIAS--Canonicalize a configuration name.--Operation modes:-  -h, --help         print this help, then exit-  -t, --time-stamp   print date of last modification, then exit-  -v, --version      print version number, then exit--Report bugs and patches to <config-patches@gnu.org>."--version="\-GNU config.sub ($timestamp)--Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012-Free Software Foundation, Inc.--This is free software; see the source for copying conditions.  There is NO-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."--help="-Try \`$me --help' for more information."--# Parse command line-while test $# -gt 0 ; do-  case $1 in-    --time-stamp | --time* | -t )-       echo "$timestamp" ; exit ;;-    --version | -v )-       echo "$version" ; exit ;;-    --help | --h* | -h )-       echo "$usage"; exit ;;-    -- )     # Stop option processing-       shift; break ;;-    - )	# Use stdin as input.-       break ;;-    -* )-       echo "$me: invalid option $1$help"-       exit 1 ;;--    *local*)-       # First pass through any local machine types.-       echo $1-       exit ;;--    * )-       break ;;-  esac-done--case $# in- 0) echo "$me: missing argument$help" >&2-    exit 1;;- 1) ;;- *) echo "$me: too many arguments$help" >&2-    exit 1;;-esac--# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).-# Here we must recognize all the valid KERNEL-OS combinations.-maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`-case $maybe_os in-  nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \-  linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \-  knetbsd*-gnu* | netbsd*-gnu* | \-  kopensolaris*-gnu* | \-  storm-chaos* | os2-emx* | rtmk-nova*)-    os=-$maybe_os-    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-    ;;-  android-linux)-    os=-linux-android-    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown-    ;;-  *)-    basic_machine=`echo $1 | sed 's/-[^-]*$//'`-    if [ $basic_machine != $1 ]-    then os=`echo $1 | sed 's/.*-/-/'`-    else os=; fi-    ;;-esac--### Let's recognize common machines as not being operating systems so-### that things like config.sub decstation-3100 work.  We also-### recognize some manufacturers as not being operating systems, so we-### can provide default operating systems below.-case $os in-	-sun*os*)-		# Prevent following clause from handling this invalid input.-		;;-	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \-	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \-	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \-	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\-	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \-	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \-	-apple | -axis | -knuth | -cray | -microblaze)-		os=-		basic_machine=$1-		;;-	-bluegene*)-		os=-cnk-		;;-	-sim | -cisco | -oki | -wec | -winbond)-		os=-		basic_machine=$1-		;;-	-scout)-		;;-	-wrs)-		os=-vxworks-		basic_machine=$1-		;;-	-chorusos*)-		os=-chorusos-		basic_machine=$1-		;;-	-chorusrdb)-		os=-chorusrdb-		basic_machine=$1-		;;-	-hiux*)-		os=-hiuxwe2-		;;-	-sco6)-		os=-sco5v6-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5)-		os=-sco3.2v5-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco4)-		os=-sco3.2v4-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2.[4-9]*)-		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2v[4-9]*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5v6*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco*)-		os=-sco3.2v2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-udk*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-isc)-		os=-isc2.2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-clix*)-		basic_machine=clipper-intergraph-		;;-	-isc*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-lynx*178)-		os=-lynxos178-		;;-	-lynx*5)-		os=-lynxos5-		;;-	-lynx*)-		os=-lynxos-		;;-	-ptx*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`-		;;-	-windowsnt*)-		os=`echo $os | sed -e 's/windowsnt/winnt/'`-		;;-	-psos*)-		os=-psos-		;;-	-mint | -mint[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-esac--# Decode aliases for certain CPU-COMPANY combinations.-case $basic_machine in-	# Recognize the basic CPU types without company name.-	# Some are omitted here because they have special meanings below.-	1750a | 580 \-	| a29k \-	| aarch64 | aarch64_be \-	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \-	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \-	| am33_2.0 \-	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \-        | be32 | be64 \-	| bfin \-	| c4x | clipper \-	| d10v | d30v | dlx | dsp16xx \-	| epiphany \-	| fido | fr30 | frv \-	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \-	| hexagon \-	| i370 | i860 | i960 | ia64 \-	| ip2k | iq2000 \-	| le32 | le64 \-	| lm32 \-	| m32c | m32r | m32rle | m68000 | m68k | m88k \-	| maxq | mb | microblaze | mcore | mep | metag \-	| mips | mipsbe | mipseb | mipsel | mipsle \-	| mips16 \-	| mips64 | mips64el \-	| mips64octeon | mips64octeonel \-	| mips64orion | mips64orionel \-	| mips64r5900 | mips64r5900el \-	| mips64vr | mips64vrel \-	| mips64vr4100 | mips64vr4100el \-	| mips64vr4300 | mips64vr4300el \-	| mips64vr5000 | mips64vr5000el \-	| mips64vr5900 | mips64vr5900el \-	| mipsisa32 | mipsisa32el \-	| mipsisa32r2 | mipsisa32r2el \-	| mipsisa64 | mipsisa64el \-	| mipsisa64r2 | mipsisa64r2el \-	| mipsisa64sb1 | mipsisa64sb1el \-	| mipsisa64sr71k | mipsisa64sr71kel \-	| mipstx39 | mipstx39el \-	| mn10200 | mn10300 \-	| moxie \-	| mt \-	| msp430 \-	| nds32 | nds32le | nds32be \-	| nios | nios2 \-	| ns16k | ns32k \-	| open8 \-	| or32 \-	| pdp10 | pdp11 | pj | pjl \-	| powerpc | powerpc64 | powerpc64le | powerpcle \-	| pyramid \-	| rl78 | rx \-	| score \-	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \-	| sh64 | sh64le \-	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \-	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \-	| spu \-	| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \-	| ubicom32 \-	| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \-	| we32k \-	| x86 | xc16x | xstormy16 | xtensa \-	| z8k | z80)-		basic_machine=$basic_machine-unknown-		;;-	c54x)-		basic_machine=tic54x-unknown-		;;-	c55x)-		basic_machine=tic55x-unknown-		;;-	c6x)-		basic_machine=tic6x-unknown-		;;-	m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)-		basic_machine=$basic_machine-unknown-		os=-none-		;;-	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)-		;;-	ms1)-		basic_machine=mt-unknown-		;;--	strongarm | thumb | xscale)-		basic_machine=arm-unknown-		;;-	xgate)-		basic_machine=$basic_machine-unknown-		os=-none-		;;-	xscaleeb)-		basic_machine=armeb-unknown-		;;--	xscaleel)-		basic_machine=armel-unknown-		;;--	# We use `pc' rather than `unknown'-	# because (1) that's what they normally are, and-	# (2) the word "unknown" tends to confuse beginning users.-	i*86 | x86_64)-	  basic_machine=$basic_machine-pc-	  ;;-	# Object if more than one company name word.-	*-*-*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-	# Recognize the basic CPU types with company name.-	580-* \-	| a29k-* \-	| aarch64-* | aarch64_be-* \-	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \-	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \-	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \-	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \-	| avr-* | avr32-* \-	| be32-* | be64-* \-	| bfin-* | bs2000-* \-	| c[123]* | c30-* | [cjt]90-* | c4x-* \-	| clipper-* | craynv-* | cydra-* \-	| d10v-* | d30v-* | dlx-* \-	| elxsi-* \-	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \-	| h8300-* | h8500-* \-	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \-	| hexagon-* \-	| i*86-* | i860-* | i960-* | ia64-* \-	| ip2k-* | iq2000-* \-	| le32-* | le64-* \-	| lm32-* \-	| m32c-* | m32r-* | m32rle-* \-	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \-	| m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \-	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \-	| mips16-* \-	| mips64-* | mips64el-* \-	| mips64octeon-* | mips64octeonel-* \-	| mips64orion-* | mips64orionel-* \-	| mips64r5900-* | mips64r5900el-* \-	| mips64vr-* | mips64vrel-* \-	| mips64vr4100-* | mips64vr4100el-* \-	| mips64vr4300-* | mips64vr4300el-* \-	| mips64vr5000-* | mips64vr5000el-* \-	| mips64vr5900-* | mips64vr5900el-* \-	| mipsisa32-* | mipsisa32el-* \-	| mipsisa32r2-* | mipsisa32r2el-* \-	| mipsisa64-* | mipsisa64el-* \-	| mipsisa64r2-* | mipsisa64r2el-* \-	| mipsisa64sb1-* | mipsisa64sb1el-* \-	| mipsisa64sr71k-* | mipsisa64sr71kel-* \-	| mipstx39-* | mipstx39el-* \-	| mmix-* \-	| mt-* \-	| msp430-* \-	| nds32-* | nds32le-* | nds32be-* \-	| nios-* | nios2-* \-	| none-* | np1-* | ns16k-* | ns32k-* \-	| open8-* \-	| orion-* \-	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \-	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \-	| pyramid-* \-	| rl78-* | romp-* | rs6000-* | rx-* \-	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \-	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \-	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \-	| sparclite-* \-	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \-	| tahoe-* \-	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \-	| tile*-* \-	| tron-* \-	| ubicom32-* \-	| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \-	| vax-* \-	| we32k-* \-	| x86-* | x86_64-* | xc16x-* | xps100-* \-	| xstormy16-* | xtensa*-* \-	| ymp-* \-	| z8k-* | z80-*)-		;;-	# Recognize the basic CPU types without company name, with glob match.-	xtensa*)-		basic_machine=$basic_machine-unknown-		;;-	# Recognize the various machine names and aliases which stand-	# for a CPU type and a company and sometimes even an OS.-	386bsd)-		basic_machine=i386-unknown-		os=-bsd-		;;-	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)-		basic_machine=m68000-att-		;;-	3b*)-		basic_machine=we32k-att-		;;-	a29khif)-		basic_machine=a29k-amd-		os=-udi-		;;-	abacus)-		basic_machine=abacus-unknown-		;;-	adobe68k)-		basic_machine=m68010-adobe-		os=-scout-		;;-	alliant | fx80)-		basic_machine=fx80-alliant-		;;-	altos | altos3068)-		basic_machine=m68k-altos-		;;-	am29k)-		basic_machine=a29k-none-		os=-bsd-		;;-	amd64)-		basic_machine=x86_64-pc-		;;-	amd64-*)-		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	amdahl)-		basic_machine=580-amdahl-		os=-sysv-		;;-	amiga | amiga-*)-		basic_machine=m68k-unknown-		;;-	amigaos | amigados)-		basic_machine=m68k-unknown-		os=-amigaos-		;;-	amigaunix | amix)-		basic_machine=m68k-unknown-		os=-sysv4-		;;-	apollo68)-		basic_machine=m68k-apollo-		os=-sysv-		;;-	apollo68bsd)-		basic_machine=m68k-apollo-		os=-bsd-		;;-	aros)-		basic_machine=i386-pc-		os=-aros-		;;-	aux)-		basic_machine=m68k-apple-		os=-aux-		;;-	balance)-		basic_machine=ns32k-sequent-		os=-dynix-		;;-	blackfin)-		basic_machine=bfin-unknown-		os=-linux-		;;-	blackfin-*)-		basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`-		os=-linux-		;;-	bluegene*)-		basic_machine=powerpc-ibm-		os=-cnk-		;;-	c54x-*)-		basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	c55x-*)-		basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	c6x-*)-		basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	c90)-		basic_machine=c90-cray-		os=-unicos-		;;-	cegcc)-		basic_machine=arm-unknown-		os=-cegcc-		;;-	convex-c1)-		basic_machine=c1-convex-		os=-bsd-		;;-	convex-c2)-		basic_machine=c2-convex-		os=-bsd-		;;-	convex-c32)-		basic_machine=c32-convex-		os=-bsd-		;;-	convex-c34)-		basic_machine=c34-convex-		os=-bsd-		;;-	convex-c38)-		basic_machine=c38-convex-		os=-bsd-		;;-	cray | j90)-		basic_machine=j90-cray-		os=-unicos-		;;-	craynv)-		basic_machine=craynv-cray-		os=-unicosmp-		;;-	cr16 | cr16-*)-		basic_machine=cr16-unknown-		os=-elf-		;;-	crds | unos)-		basic_machine=m68k-crds-		;;-	crisv32 | crisv32-* | etraxfs*)-		basic_machine=crisv32-axis-		;;-	cris | cris-* | etrax*)-		basic_machine=cris-axis-		;;-	crx)-		basic_machine=crx-unknown-		os=-elf-		;;-	da30 | da30-*)-		basic_machine=m68k-da30-		;;-	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)-		basic_machine=mips-dec-		;;-	decsystem10* | dec10*)-		basic_machine=pdp10-dec-		os=-tops10-		;;-	decsystem20* | dec20*)-		basic_machine=pdp10-dec-		os=-tops20-		;;-	delta | 3300 | motorola-3300 | motorola-delta \-	      | 3300-motorola | delta-motorola)-		basic_machine=m68k-motorola-		;;-	delta88)-		basic_machine=m88k-motorola-		os=-sysv3-		;;-	dicos)-		basic_machine=i686-pc-		os=-dicos-		;;-	djgpp)-		basic_machine=i586-pc-		os=-msdosdjgpp-		;;-	dpx20 | dpx20-*)-		basic_machine=rs6000-bull-		os=-bosx-		;;-	dpx2* | dpx2*-bull)-		basic_machine=m68k-bull-		os=-sysv3-		;;-	ebmon29k)-		basic_machine=a29k-amd-		os=-ebmon-		;;-	elxsi)-		basic_machine=elxsi-elxsi-		os=-bsd-		;;-	encore | umax | mmax)-		basic_machine=ns32k-encore-		;;-	es1800 | OSE68k | ose68k | ose | OSE)-		basic_machine=m68k-ericsson-		os=-ose-		;;-	fx2800)-		basic_machine=i860-alliant-		;;-	genix)-		basic_machine=ns32k-ns-		;;-	gmicro)-		basic_machine=tron-gmicro-		os=-sysv-		;;-	go32)-		basic_machine=i386-pc-		os=-go32-		;;-	h3050r* | hiux*)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	h8300hms)-		basic_machine=h8300-hitachi-		os=-hms-		;;-	h8300xray)-		basic_machine=h8300-hitachi-		os=-xray-		;;-	h8500hms)-		basic_machine=h8500-hitachi-		os=-hms-		;;-	harris)-		basic_machine=m88k-harris-		os=-sysv3-		;;-	hp300-*)-		basic_machine=m68k-hp-		;;-	hp300bsd)-		basic_machine=m68k-hp-		os=-bsd-		;;-	hp300hpux)-		basic_machine=m68k-hp-		os=-hpux-		;;-	hp3k9[0-9][0-9] | hp9[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k2[0-9][0-9] | hp9k31[0-9])-		basic_machine=m68000-hp-		;;-	hp9k3[2-9][0-9])-		basic_machine=m68k-hp-		;;-	hp9k6[0-9][0-9] | hp6[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k7[0-79][0-9] | hp7[0-79][0-9])-		basic_machine=hppa1.1-hp-		;;-	hp9k78[0-9] | hp78[0-9])-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][13679] | hp8[0-9][13679])-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][0-9] | hp8[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hppa-next)-		os=-nextstep3-		;;-	hppaosf)-		basic_machine=hppa1.1-hp-		os=-osf-		;;-	hppro)-		basic_machine=hppa1.1-hp-		os=-proelf-		;;-	i370-ibm* | ibm*)-		basic_machine=i370-ibm-		;;-	i*86v32)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv32-		;;-	i*86v4*)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv4-		;;-	i*86v)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv-		;;-	i*86sol2)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-solaris2-		;;-	i386mach)-		basic_machine=i386-mach-		os=-mach-		;;-	i386-vsta | vsta)-		basic_machine=i386-unknown-		os=-vsta-		;;-	iris | iris4d)-		basic_machine=mips-sgi-		case $os in-		    -irix*)-			;;-		    *)-			os=-irix4-			;;-		esac-		;;-	isi68 | isi)-		basic_machine=m68k-isi-		os=-sysv-		;;-	m68knommu)-		basic_machine=m68k-unknown-		os=-linux-		;;-	m68knommu-*)-		basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`-		os=-linux-		;;-	m88k-omron*)-		basic_machine=m88k-omron-		;;-	magnum | m3230)-		basic_machine=mips-mips-		os=-sysv-		;;-	merlin)-		basic_machine=ns32k-utek-		os=-sysv-		;;-	microblaze)-		basic_machine=microblaze-xilinx-		;;-	mingw64)-		basic_machine=x86_64-pc-		os=-mingw64-		;;-	mingw32)-		basic_machine=i386-pc-		os=-mingw32-		;;-	mingw32ce)-		basic_machine=arm-unknown-		os=-mingw32ce-		;;-	miniframe)-		basic_machine=m68000-convergent-		;;-	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-	mips3*-*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-		;;-	mips3*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown-		;;-	monitor)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	morphos)-		basic_machine=powerpc-unknown-		os=-morphos-		;;-	msdos)-		basic_machine=i386-pc-		os=-msdos-		;;-	ms1-*)-		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`-		;;-	msys)-		basic_machine=i386-pc-		os=-msys-		;;-	mvs)-		basic_machine=i370-ibm-		os=-mvs-		;;-	nacl)-		basic_machine=le32-unknown-		os=-nacl-		;;-	ncr3000)-		basic_machine=i486-ncr-		os=-sysv4-		;;-	netbsd386)-		basic_machine=i386-unknown-		os=-netbsd-		;;-	netwinder)-		basic_machine=armv4l-rebel-		os=-linux-		;;-	news | news700 | news800 | news900)-		basic_machine=m68k-sony-		os=-newsos-		;;-	news1000)-		basic_machine=m68030-sony-		os=-newsos-		;;-	news-3600 | risc-news)-		basic_machine=mips-sony-		os=-newsos-		;;-	necv70)-		basic_machine=v70-nec-		os=-sysv-		;;-	next | m*-next )-		basic_machine=m68k-next-		case $os in-		    -nextstep* )-			;;-		    -ns2*)-		      os=-nextstep2-			;;-		    *)-		      os=-nextstep3-			;;-		esac-		;;-	nh3000)-		basic_machine=m68k-harris-		os=-cxux-		;;-	nh[45]000)-		basic_machine=m88k-harris-		os=-cxux-		;;-	nindy960)-		basic_machine=i960-intel-		os=-nindy-		;;-	mon960)-		basic_machine=i960-intel-		os=-mon960-		;;-	nonstopux)-		basic_machine=mips-compaq-		os=-nonstopux-		;;-	np1)-		basic_machine=np1-gould-		;;-	neo-tandem)-		basic_machine=neo-tandem-		;;-	nse-tandem)-		basic_machine=nse-tandem-		;;-	nsr-tandem)-		basic_machine=nsr-tandem-		;;-	op50n-* | op60c-*)-		basic_machine=hppa1.1-oki-		os=-proelf-		;;-	openrisc | openrisc-*)-		basic_machine=or32-unknown-		;;-	os400)-		basic_machine=powerpc-ibm-		os=-os400-		;;-	OSE68000 | ose68000)-		basic_machine=m68000-ericsson-		os=-ose-		;;-	os68k)-		basic_machine=m68k-none-		os=-os68k-		;;-	pa-hitachi)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	paragon)-		basic_machine=i860-intel-		os=-osf-		;;-	parisc)-		basic_machine=hppa-unknown-		os=-linux-		;;-	parisc-*)-		basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`-		os=-linux-		;;-	pbd)-		basic_machine=sparc-tti-		;;-	pbb)-		basic_machine=m68k-tti-		;;-	pc532 | pc532-*)-		basic_machine=ns32k-pc532-		;;-	pc98)-		basic_machine=i386-pc-		;;-	pc98-*)-		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium | p5 | k5 | k6 | nexgen | viac3)-		basic_machine=i586-pc-		;;-	pentiumpro | p6 | 6x86 | athlon | athlon_*)-		basic_machine=i686-pc-		;;-	pentiumii | pentium2 | pentiumiii | pentium3)-		basic_machine=i686-pc-		;;-	pentium4)-		basic_machine=i786-pc-		;;-	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)-		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumpro-* | p6-* | 6x86-* | athlon-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium4-*)-		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pn)-		basic_machine=pn-gould-		;;-	power)	basic_machine=power-ibm-		;;-	ppc | ppcbe)	basic_machine=powerpc-unknown-		;;-	ppc-* | ppcbe-*)-		basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppcle | powerpclittle | ppc-le | powerpc-little)-		basic_machine=powerpcle-unknown-		;;-	ppcle-* | powerpclittle-*)-		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64)	basic_machine=powerpc64-unknown-		;;-	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64le | powerpc64little | ppc64-le | powerpc64-little)-		basic_machine=powerpc64le-unknown-		;;-	ppc64le-* | powerpc64little-*)-		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ps2)-		basic_machine=i386-ibm-		;;-	pw32)-		basic_machine=i586-unknown-		os=-pw32-		;;-	rdos)-		basic_machine=i386-pc-		os=-rdos-		;;-	rom68k)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	rm[46]00)-		basic_machine=mips-siemens-		;;-	rtpc | rtpc-*)-		basic_machine=romp-ibm-		;;-	s390 | s390-*)-		basic_machine=s390-ibm-		;;-	s390x | s390x-*)-		basic_machine=s390x-ibm-		;;-	sa29200)-		basic_machine=a29k-amd-		os=-udi-		;;-	sb1)-		basic_machine=mipsisa64sb1-unknown-		;;-	sb1el)-		basic_machine=mipsisa64sb1el-unknown-		;;-	sde)-		basic_machine=mipsisa32-sde-		os=-elf-		;;-	sei)-		basic_machine=mips-sei-		os=-seiux-		;;-	sequent)-		basic_machine=i386-sequent-		;;-	sh)-		basic_machine=sh-hitachi-		os=-hms-		;;-	sh5el)-		basic_machine=sh5le-unknown-		;;-	sh64)-		basic_machine=sh64-unknown-		;;-	sparclite-wrs | simso-wrs)-		basic_machine=sparclite-wrs-		os=-vxworks-		;;-	sps7)-		basic_machine=m68k-bull-		os=-sysv2-		;;-	spur)-		basic_machine=spur-unknown-		;;-	st2000)-		basic_machine=m68k-tandem-		;;-	stratus)-		basic_machine=i860-stratus-		os=-sysv4-		;;-	strongarm-* | thumb-*)-		basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	sun2)-		basic_machine=m68000-sun-		;;-	sun2os3)-		basic_machine=m68000-sun-		os=-sunos3-		;;-	sun2os4)-		basic_machine=m68000-sun-		os=-sunos4-		;;-	sun3os3)-		basic_machine=m68k-sun-		os=-sunos3-		;;-	sun3os4)-		basic_machine=m68k-sun-		os=-sunos4-		;;-	sun4os3)-		basic_machine=sparc-sun-		os=-sunos3-		;;-	sun4os4)-		basic_machine=sparc-sun-		os=-sunos4-		;;-	sun4sol2)-		basic_machine=sparc-sun-		os=-solaris2-		;;-	sun3 | sun3-*)-		basic_machine=m68k-sun-		;;-	sun4)-		basic_machine=sparc-sun-		;;-	sun386 | sun386i | roadrunner)-		basic_machine=i386-sun-		;;-	sv1)-		basic_machine=sv1-cray-		os=-unicos-		;;-	symmetry)-		basic_machine=i386-sequent-		os=-dynix-		;;-	t3e)-		basic_machine=alphaev5-cray-		os=-unicos-		;;-	t90)-		basic_machine=t90-cray-		os=-unicos-		;;-	tile*)-		basic_machine=$basic_machine-unknown-		os=-linux-gnu-		;;-	tx39)-		basic_machine=mipstx39-unknown-		;;-	tx39el)-		basic_machine=mipstx39el-unknown-		;;-	toad1)-		basic_machine=pdp10-xkl-		os=-tops20-		;;-	tower | tower-32)-		basic_machine=m68k-ncr-		;;-	tpf)-		basic_machine=s390x-ibm-		os=-tpf-		;;-	udi29k)-		basic_machine=a29k-amd-		os=-udi-		;;-	ultra3)-		basic_machine=a29k-nyu-		os=-sym1-		;;-	v810 | necv810)-		basic_machine=v810-nec-		os=-none-		;;-	vaxv)-		basic_machine=vax-dec-		os=-sysv-		;;-	vms)-		basic_machine=vax-dec-		os=-vms-		;;-	vpp*|vx|vx-*)-		basic_machine=f301-fujitsu-		;;-	vxworks960)-		basic_machine=i960-wrs-		os=-vxworks-		;;-	vxworks68)-		basic_machine=m68k-wrs-		os=-vxworks-		;;-	vxworks29k)-		basic_machine=a29k-wrs-		os=-vxworks-		;;-	w65*)-		basic_machine=w65-wdc-		os=-none-		;;-	w89k-*)-		basic_machine=hppa1.1-winbond-		os=-proelf-		;;-	xbox)-		basic_machine=i686-pc-		os=-mingw32-		;;-	xps | xps100)-		basic_machine=xps100-honeywell-		;;-	xscale-* | xscalee[bl]-*)-		basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'`-		;;-	ymp)-		basic_machine=ymp-cray-		os=-unicos-		;;-	z8k-*-coff)-		basic_machine=z8k-unknown-		os=-sim-		;;-	z80-*-coff)-		basic_machine=z80-unknown-		os=-sim-		;;-	none)-		basic_machine=none-none-		os=-none-		;;--# Here we handle the default manufacturer of certain CPU types.  It is in-# some cases the only manufacturer, in others, it is the most popular.-	w89k)-		basic_machine=hppa1.1-winbond-		;;-	op50n)-		basic_machine=hppa1.1-oki-		;;-	op60c)-		basic_machine=hppa1.1-oki-		;;-	romp)-		basic_machine=romp-ibm-		;;-	mmix)-		basic_machine=mmix-knuth-		;;-	rs6000)-		basic_machine=rs6000-ibm-		;;-	vax)-		basic_machine=vax-dec-		;;-	pdp10)-		# there are many clones, so DEC is not a safe bet-		basic_machine=pdp10-unknown-		;;-	pdp11)-		basic_machine=pdp11-dec-		;;-	we32k)-		basic_machine=we32k-att-		;;-	sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)-		basic_machine=sh-unknown-		;;-	sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)-		basic_machine=sparc-sun-		;;-	cydra)-		basic_machine=cydra-cydrome-		;;-	orion)-		basic_machine=orion-highlevel-		;;-	orion105)-		basic_machine=clipper-highlevel-		;;-	mac | mpw | mac-mpw)-		basic_machine=m68k-apple-		;;-	pmac | pmac-mpw)-		basic_machine=powerpc-apple-		;;-	*-unknown)-		# Make sure to match an already-canonicalized machine name.-		;;-	*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-esac--# Here we canonicalize certain aliases for manufacturers.-case $basic_machine in-	*-digital*)-		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`-		;;-	*-commodore*)-		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`-		;;-	*)-		;;-esac--# Decode manufacturer-specific aliases for certain operating systems.--if [ x"$os" != x"" ]-then-case $os in-	# First match some system type aliases-	# that might get confused with valid system types.-	# -solaris* is a basic system type, with this one exception.-	-auroraux)-		os=-auroraux-		;;-	-solaris1 | -solaris1.*)-		os=`echo $os | sed -e 's|solaris1|sunos4|'`-		;;-	-solaris)-		os=-solaris2-		;;-	-svr4*)-		os=-sysv4-		;;-	-unixware*)-		os=-sysv4.2uw-		;;-	-gnu/linux*)-		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`-		;;-	# First accept the basic system types.-	# The portable systems comes first.-	# Each alternative MUST END IN A *, to match a version number.-	# -sysv* is not here because it comes later, after sysvr4.-	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \-	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\-	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \-	      | -sym* | -kopensolaris* \-	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \-	      | -aos* | -aros* \-	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \-	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \-	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \-	      | -bitrig* | -openbsd* | -solidbsd* \-	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \-	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \-	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \-	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \-	      | -chorusos* | -chorusrdb* | -cegcc* \-	      | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \-	      | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \-	      | -linux-newlib* | -linux-musl* | -linux-uclibc* \-	      | -uxpv* | -beos* | -mpeix* | -udk* \-	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \-	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \-	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \-	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \-	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \-	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \-	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*)-	# Remember, each alternative MUST END IN *, to match a version number.-		;;-	-qnx*)-		case $basic_machine in-		    x86-* | i*86-*)-			;;-		    *)-			os=-nto$os-			;;-		esac-		;;-	-nto-qnx*)-		;;-	-nto*)-		os=`echo $os | sed -e 's|nto|nto-qnx|'`-		;;-	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \-	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \-	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)-		;;-	-mac*)-		os=`echo $os | sed -e 's|mac|macos|'`-		;;-	-linux-dietlibc)-		os=-linux-dietlibc-		;;-	-linux*)-		os=`echo $os | sed -e 's|linux|linux-gnu|'`-		;;-	-sunos5*)-		os=`echo $os | sed -e 's|sunos5|solaris2|'`-		;;-	-sunos6*)-		os=`echo $os | sed -e 's|sunos6|solaris3|'`-		;;-	-opened*)-		os=-openedition-		;;-	-os400*)-		os=-os400-		;;-	-wince*)-		os=-wince-		;;-	-osfrose*)-		os=-osfrose-		;;-	-osf*)-		os=-osf-		;;-	-utek*)-		os=-bsd-		;;-	-dynix*)-		os=-bsd-		;;-	-acis*)-		os=-aos-		;;-	-atheos*)-		os=-atheos-		;;-	-syllable*)-		os=-syllable-		;;-	-386bsd)-		os=-bsd-		;;-	-ctix* | -uts*)-		os=-sysv-		;;-	-nova*)-		os=-rtmk-nova-		;;-	-ns2 )-		os=-nextstep2-		;;-	-nsk*)-		os=-nsk-		;;-	# Preserve the version number of sinix5.-	-sinix5.*)-		os=`echo $os | sed -e 's|sinix|sysv|'`-		;;-	-sinix*)-		os=-sysv4-		;;-	-tpf*)-		os=-tpf-		;;-	-triton*)-		os=-sysv3-		;;-	-oss*)-		os=-sysv3-		;;-	-svr4)-		os=-sysv4-		;;-	-svr3)-		os=-sysv3-		;;-	-sysvr4)-		os=-sysv4-		;;-	# This must come after -sysvr4.-	-sysv*)-		;;-	-ose*)-		os=-ose-		;;-	-es1800*)-		os=-ose-		;;-	-xenix)-		os=-xenix-		;;-	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-		os=-mint-		;;-	-aros*)-		os=-aros-		;;-	-kaos*)-		os=-kaos-		;;-	-zvmoe)-		os=-zvmoe-		;;-	-dicos*)-		os=-dicos-		;;-	-nacl*)-		;;-	-none)-		;;-	*)-		# Get rid of the `-' at the beginning of $os.-		os=`echo $os | sed 's/[^-]*-//'`-		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2-		exit 1-		;;-esac-else--# Here we handle the default operating systems that come with various machines.-# The value should be what the vendor currently ships out the door with their-# machine or put another way, the most popular os provided with the machine.--# Note that if you're going to try to match "-MANUFACTURER" here (say,-# "-sun"), then you have to tell the case statement up towards the top-# that MANUFACTURER isn't an operating system.  Otherwise, code above-# will signal an error saying that MANUFACTURER isn't an operating-# system, and we'll never get to this point.--case $basic_machine in-	score-*)-		os=-elf-		;;-	spu-*)-		os=-elf-		;;-	*-acorn)-		os=-riscix1.2-		;;-	arm*-rebel)-		os=-linux-		;;-	arm*-semi)-		os=-aout-		;;-	c4x-* | tic4x-*)-		os=-coff-		;;-	hexagon-*)-		os=-elf-		;;-	tic54x-*)-		os=-coff-		;;-	tic55x-*)-		os=-coff-		;;-	tic6x-*)-		os=-coff-		;;-	# This must come before the *-dec entry.-	pdp10-*)-		os=-tops20-		;;-	pdp11-*)-		os=-none-		;;-	*-dec | vax-*)-		os=-ultrix4.2-		;;-	m68*-apollo)-		os=-domain-		;;-	i386-sun)-		os=-sunos4.0.2-		;;-	m68000-sun)-		os=-sunos3-		;;-	m68*-cisco)-		os=-aout-		;;-	mep-*)-		os=-elf-		;;-	mips*-cisco)-		os=-elf-		;;-	mips*-*)-		os=-elf-		;;-	or32-*)-		os=-coff-		;;-	*-tti)	# must be before sparc entry or we get the wrong os.-		os=-sysv3-		;;-	sparc-* | *-sun)-		os=-sunos4.1.1-		;;-	*-be)-		os=-beos-		;;-	*-haiku)-		os=-haiku-		;;-	*-ibm)-		os=-aix-		;;-	*-knuth)-		os=-mmixware-		;;-	*-wec)-		os=-proelf-		;;-	*-winbond)-		os=-proelf-		;;-	*-oki)-		os=-proelf-		;;-	*-hp)-		os=-hpux-		;;-	*-hitachi)-		os=-hiux-		;;-	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)-		os=-sysv-		;;-	*-cbm)-		os=-amigaos-		;;-	*-dg)-		os=-dgux-		;;-	*-dolphin)-		os=-sysv3-		;;-	m68k-ccur)-		os=-rtu-		;;-	m88k-omron*)-		os=-luna-		;;-	*-next )-		os=-nextstep-		;;-	*-sequent)-		os=-ptx-		;;-	*-crds)-		os=-unos-		;;-	*-ns)-		os=-genix-		;;-	i370-*)-		os=-mvs-		;;-	*-next)-		os=-nextstep3-		;;-	*-gould)-		os=-sysv-		;;-	*-highlevel)-		os=-bsd-		;;-	*-encore)-		os=-bsd-		;;-	*-sgi)-		os=-irix-		;;-	*-siemens)-		os=-sysv4-		;;-	*-masscomp)-		os=-rtu-		;;-	f30[01]-fujitsu | f700-fujitsu)-		os=-uxpv-		;;-	*-rom68k)-		os=-coff-		;;-	*-*bug)-		os=-coff-		;;-	*-apple)-		os=-macos-		;;-	*-atari*)-		os=-mint-		;;-	*)-		os=-none-		;;-esac-fi--# Here we handle the case where we know the os, and the CPU type, but not the-# manufacturer.  We pick the logical manufacturer.-vendor=unknown-case $basic_machine in-	*-unknown)-		case $os in-			-riscix*)-				vendor=acorn-				;;-			-sunos*)-				vendor=sun-				;;-			-cnk*|-aix*)-				vendor=ibm-				;;-			-beos*)-				vendor=be-				;;-			-hpux*)-				vendor=hp-				;;-			-mpeix*)-				vendor=hp-				;;-			-hiux*)-				vendor=hitachi-				;;-			-unos*)-				vendor=crds-				;;-			-dgux*)-				vendor=dg-				;;-			-luna*)-				vendor=omron-				;;-			-genix*)-				vendor=ns-				;;-			-mvs* | -opened*)-				vendor=ibm-				;;-			-os400*)-				vendor=ibm-				;;-			-ptx*)-				vendor=sequent-				;;-			-tpf*)-				vendor=ibm-				;;-			-vxsim* | -vxworks* | -windiss*)-				vendor=wrs-				;;-			-aux*)-				vendor=apple-				;;-			-hms*)-				vendor=hitachi-				;;-			-mpw* | -macos*)-				vendor=apple-				;;-			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-				vendor=atari-				;;-			-vos*)-				vendor=stratus-				;;-		esac-		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`-		;;-esac--echo $basic_machine$os-exit--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)+#   Copyright 1992-2018 Free Software Foundation, Inc.++timestamp='2018-08-13'++# This file is free software; you can redistribute it and/or modify it+# under the terms of the GNU General Public License as published by+# the Free Software Foundation; either version 3 of the License, or+# (at your option) any later version.+#+# This program is distributed in the hope that it will be useful, but+# WITHOUT ANY WARRANTY; without even the implied warranty of+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+# General Public License for more details.+#+# You should have received a copy of the GNU General Public License+# along with this program; if not, see <https://www.gnu.org/licenses/>.+#+# As a special exception to the GNU General Public License, if you+# distribute this file as part of a program that contains a+# configuration script generated by Autoconf, you may include it under+# the same distribution terms that you use for the rest of that+# program.  This Exception is an additional permission under section 7+# of the GNU General Public License, version 3 ("GPLv3").+++# Please send patches to <config-patches@gnu.org>.+#+# Configuration subroutine to validate and canonicalize a configuration type.+# Supply the specified configuration type as an argument.+# If it is invalid, we print an error message on stderr and exit with code 1.+# Otherwise, we print the canonical config type on stdout and succeed.++# You can get the latest version of this script from:+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub++# This file is supposed to be the same for all GNU packages+# and recognize all the CPU types, system types and aliases+# that are meaningful with *any* GNU software.+# Each package is responsible for reporting which valid configurations+# it does not support.  The user should be able to distinguish+# a failure to support a valid configuration from a meaningless+# configuration.++# The goal of this file is to map all the various variations of a given+# machine specification into a single specification in the form:+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM+# or in some cases, the newer four-part form:+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM+# It is wrong to echo any other type of specification.++me=`echo "$0" | sed -e 's,.*/,,'`++usage="\+Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS++Canonicalize a configuration name.++Options:+  -h, --help         print this help, then exit+  -t, --time-stamp   print date of last modification, then exit+  -v, --version      print version number, then exit++Report bugs and patches to <config-patches@gnu.org>."++version="\+GNU config.sub ($timestamp)++Copyright 1992-2018 Free Software Foundation, Inc.++This is free software; see the source for copying conditions.  There is NO+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."++help="+Try \`$me --help' for more information."++# Parse command line+while test $# -gt 0 ; do+  case $1 in+    --time-stamp | --time* | -t )+       echo "$timestamp" ; exit ;;+    --version | -v )+       echo "$version" ; exit ;;+    --help | --h* | -h )+       echo "$usage"; exit ;;+    -- )     # Stop option processing+       shift; break ;;+    - )	# Use stdin as input.+       break ;;+    -* )+       echo "$me: invalid option $1$help"+       exit 1 ;;++    *local*)+       # First pass through any local machine types.+       echo "$1"+       exit ;;++    * )+       break ;;+  esac+done++case $# in+ 0) echo "$me: missing argument$help" >&2+    exit 1;;+ 1) ;;+ *) echo "$me: too many arguments$help" >&2+    exit 1;;+esac++# Split fields of configuration type+IFS="-" read -r field1 field2 field3 field4 <<EOF+$1+EOF++# Separate into logical components for further validation+case $1 in+	*-*-*-*-*)+		echo Invalid configuration \`"$1"\': more than four components >&2+		exit 1+		;;+	*-*-*-*)+		basic_machine=$field1-$field2+		os=$field3-$field4+		;;+	*-*-*)+		# Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two+		# parts+		maybe_os=$field2-$field3+		case $maybe_os in+			nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc \+			| linux-newlib* | linux-musl* | linux-uclibc* | uclinux-uclibc* \+			| uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \+			| netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \+			| storm-chaos* | os2-emx* | rtmk-nova*)+				basic_machine=$field1+				os=$maybe_os+				;;+			android-linux)+				basic_machine=$field1-unknown+				os=linux-android+				;;+			*)+				basic_machine=$field1-$field2+				os=$field3+				;;+		esac+		;;+	*-*)+		# Second component is usually, but not always the OS+		case $field2 in+			# Prevent following clause from handling this valid os+			sun*os*)+				basic_machine=$field1+				os=$field2+				;;+			# Manufacturers+			dec* | mips* | sequent* | encore* | pc532* | sgi* | sony* \+			| att* | 7300* | 3300* | delta* | motorola* | sun[234]* \+			| unicom* | ibm* | next | hp | isi* | apollo | altos* \+			| convergent* | ncr* | news | 32* | 3600* | 3100* | hitachi* \+			| c[123]* | convex* | sun | crds | omron* | dg | ultra | tti* \+			| harris | dolphin | highlevel | gould | cbm | ns | masscomp \+			| apple | axis | knuth | cray | microblaze* \+			| sim | cisco | oki | wec | wrs | winbond)+				basic_machine=$field1-$field2+				os=+				;;+			*)+				basic_machine=$field1+				os=$field2+				;;+		esac+		;;+	*)+		# Convert single-component short-hands not valid as part of+		# multi-component configurations.+		case $field1 in+			386bsd)+				basic_machine=i386-pc+				os=bsd+				;;+			a29khif)+				basic_machine=a29k-amd+				os=udi+				;;+			adobe68k)+				basic_machine=m68010-adobe+				os=scout+				;;+			alliant)+				basic_machine=fx80-alliant+				os=+				;;+			altos | altos3068)+				basic_machine=m68k-altos+				os=+				;;+			am29k)+				basic_machine=a29k-none+				os=bsd+				;;+			amdahl)+				basic_machine=580-amdahl+				os=sysv+				;;+			amigaos | amigados)+				basic_machine=m68k-unknown+				os=amigaos+				;;+			amigaunix | amix)+				basic_machine=m68k-unknown+				os=sysv4+				;;+			apollo68)+				basic_machine=m68k-apollo+				os=sysv+				;;+			apollo68bsd)+				basic_machine=m68k-apollo+				os=bsd+				;;+			aros)+				basic_machine=i386-pc+				os=aros+				;;+			aux)+				basic_machine=m68k-apple+				os=aux+				;;+			balance)+				basic_machine=ns32k-sequent+				os=dynix+				;;+			blackfin)+				basic_machine=bfin-unknown+				os=linux+				;;+			cegcc)+				basic_machine=arm-unknown+				os=cegcc+				;;+			convex-c1)+				basic_machine=c1-convex+				os=bsd+				;;+			convex-c2)+				basic_machine=c2-convex+				os=bsd+				;;+			convex-c32)+				basic_machine=c32-convex+				os=bsd+				;;+			convex-c34)+				basic_machine=c34-convex+				os=bsd+				;;+			convex-c38)+				basic_machine=c38-convex+				os=bsd+				;;+			cray)+				basic_machine=j90-cray+				os=unicos+				;;+			crds | unos)+				basic_machine=m68k-crds+				os=+				;;+			delta88)+				basic_machine=m88k-motorola+				os=sysv3+				;;+			dicos)+				basic_machine=i686-pc+				os=dicos+				;;+			djgpp)+				basic_machine=i586-pc+				os=msdosdjgpp+				;;+			ebmon29k)+				basic_machine=a29k-amd+				os=ebmon+				;;+			es1800 | OSE68k | ose68k | ose | OSE)+				basic_machine=m68k-ericsson+				os=ose+				;;+			gmicro)+				basic_machine=tron-gmicro+				os=sysv+				;;+			go32)+				basic_machine=i386-pc+				os=go32+				;;+			h8300hms)+				basic_machine=h8300-hitachi+				os=hms+				;;+			h8300xray)+				basic_machine=h8300-hitachi+				os=xray+				;;+			h8500hms)+				basic_machine=h8500-hitachi+				os=hms+				;;+			harris)+				basic_machine=m88k-harris+				os=sysv3+				;;+			hp300bsd)+				basic_machine=m68k-hp+				os=bsd+				;;+			hp300hpux)+				basic_machine=m68k-hp+				os=hpux+				;;+			hppaosf)+				basic_machine=hppa1.1-hp+				os=osf+				;;+			hppro)+				basic_machine=hppa1.1-hp+				os=proelf+				;;+			i386mach)+				basic_machine=i386-mach+				os=mach+				;;+			vsta)+				basic_machine=i386-pc+				os=vsta+				;;+			isi68 | isi)+				basic_machine=m68k-isi+				os=sysv+				;;+			m68knommu)+				basic_machine=m68k-unknown+				os=linux+				;;+			magnum | m3230)+				basic_machine=mips-mips+				os=sysv+				;;+			merlin)+				basic_machine=ns32k-utek+				os=sysv+				;;+			mingw64)+				basic_machine=x86_64-pc+				os=mingw64+				;;+			mingw32)+				basic_machine=i686-pc+				os=mingw32+				;;+			mingw32ce)+				basic_machine=arm-unknown+				os=mingw32ce+				;;+			monitor)+				basic_machine=m68k-rom68k+				os=coff+				;;+			morphos)+				basic_machine=powerpc-unknown+				os=morphos+				;;+			moxiebox)+				basic_machine=moxie-unknown+				os=moxiebox+				;;+			msdos)+				basic_machine=i386-pc+				os=msdos+				;;+			msys)+				basic_machine=i686-pc+				os=msys+				;;+			mvs)+				basic_machine=i370-ibm+				os=mvs+				;;+			nacl)+				basic_machine=le32-unknown+				os=nacl+				;;+			ncr3000)+				basic_machine=i486-ncr+				os=sysv4+				;;+			netbsd386)+				basic_machine=i386-pc+				os=netbsd+				;;+			netwinder)+				basic_machine=armv4l-rebel+				os=linux+				;;+			news | news700 | news800 | news900)+				basic_machine=m68k-sony+				os=newsos+				;;+			news1000)+				basic_machine=m68030-sony+				os=newsos+				;;+			necv70)+				basic_machine=v70-nec+				os=sysv+				;;+			nh3000)+				basic_machine=m68k-harris+				os=cxux+				;;+			nh[45]000)+				basic_machine=m88k-harris+				os=cxux+				;;+			nindy960)+				basic_machine=i960-intel+				os=nindy+				;;+			mon960)+				basic_machine=i960-intel+				os=mon960+				;;+			nonstopux)+				basic_machine=mips-compaq+				os=nonstopux+				;;+			os400)+				basic_machine=powerpc-ibm+				os=os400+				;;+			OSE68000 | ose68000)+				basic_machine=m68000-ericsson+				os=ose+				;;+			os68k)+				basic_machine=m68k-none+				os=os68k+				;;+			paragon)+				basic_machine=i860-intel+				os=osf+				;;+			parisc)+				basic_machine=hppa-unknown+				os=linux+				;;+			pw32)+				basic_machine=i586-unknown+				os=pw32+				;;+			rdos | rdos64)+				basic_machine=x86_64-pc+				os=rdos+				;;+			rdos32)+				basic_machine=i386-pc+				os=rdos+				;;+			rom68k)+				basic_machine=m68k-rom68k+				os=coff+				;;+			sa29200)+				basic_machine=a29k-amd+				os=udi+				;;+			sei)+				basic_machine=mips-sei+				os=seiux+				;;+			sps7)+				basic_machine=m68k-bull+				os=sysv2+				;;+			st2000)+				basic_machine=m68k-tandem+				os=+				;;+			stratus)+				basic_machine=i860-stratus+				os=sysv4+				;;+			sun2)+				basic_machine=m68000-sun+				os=+				;;+			sun2os3)+				basic_machine=m68000-sun+				os=sunos3+				;;+			sun2os4)+				basic_machine=m68000-sun+				os=sunos4+				;;+			sun3)+				basic_machine=m68k-sun+				os=+				;;+			sun3os3)+				basic_machine=m68k-sun+				os=sunos3+				;;+			sun3os4)+				basic_machine=m68k-sun+				os=sunos4+				;;+			sun4)+				basic_machine=sparc-sun+				os=+				;;+			sun4os3)+				basic_machine=sparc-sun+				os=sunos3+				;;+			sun4os4)+				basic_machine=sparc-sun+				os=sunos4+				;;+			sun4sol2)+				basic_machine=sparc-sun+				os=solaris2+				;;+			sun386 | sun386i | roadrunner)+				basic_machine=i386-sun+				os=+				;;+			sv1)+				basic_machine=sv1-cray+				os=unicos+				;;+			symmetry)+				basic_machine=i386-sequent+				os=dynix+				;;+			t3e)+				basic_machine=alphaev5-cray+				os=unicos+				;;+			t90)+				basic_machine=t90-cray+				os=unicos+				;;+			toad1)+				basic_machine=pdp10-xkl+				os=tops20+				;;+			tpf)+				basic_machine=s390x-ibm+				os=tpf+				;;+			udi29k)+				basic_machine=a29k-amd+				os=udi+				;;+			ultra3)+				basic_machine=a29k-nyu+				os=sym1+				;;+			v810 | necv810)+				basic_machine=v810-nec+				os=none+				;;+			vaxv)+				basic_machine=vax-dec+				os=sysv+				;;+			vms)+				basic_machine=vax-dec+				os=vms+				;;+			vxworks960)+				basic_machine=i960-wrs+				os=vxworks+				;;+			vxworks68)+				basic_machine=m68k-wrs+				os=vxworks+				;;+			vxworks29k)+				basic_machine=a29k-wrs+				os=vxworks+				;;+			xbox)+				basic_machine=i686-pc+				os=mingw32+				;;+			ymp)+				basic_machine=ymp-cray+				os=unicos+				;;+			*)+				basic_machine=$1+				os=+				;;+		esac+		;;+esac++# Decode aliases for certain CPU-COMPANY combinations.+case $basic_machine in+	# Here we handle the default manufacturer of certain CPU types.  It is in+	# some cases the only manufacturer, in others, it is the most popular.+	craynv)+		basic_machine=craynv-cray+		os=${os:-unicosmp}+		;;+	fx80)+		basic_machine=fx80-alliant+		;;+	w89k)+		basic_machine=hppa1.1-winbond+		;;+	op50n)+		basic_machine=hppa1.1-oki+		;;+	op60c)+		basic_machine=hppa1.1-oki+		;;+	romp)+		basic_machine=romp-ibm+		;;+	mmix)+		basic_machine=mmix-knuth+		;;+	rs6000)+		basic_machine=rs6000-ibm+		;;+	vax)+		basic_machine=vax-dec+		;;+	pdp11)+		basic_machine=pdp11-dec+		;;+	we32k)+		basic_machine=we32k-att+		;;+	cydra)+		basic_machine=cydra-cydrome+		;;+	i370-ibm* | ibm*)+		basic_machine=i370-ibm+		;;+	orion)+		basic_machine=orion-highlevel+		;;+	orion105)+		basic_machine=clipper-highlevel+		;;+	mac | mpw | mac-mpw)+		basic_machine=m68k-apple+		;;+	pmac | pmac-mpw)+		basic_machine=powerpc-apple+		;;+	xps | xps100)+		basic_machine=xps100-honeywell+		;;++	# Recognize the basic CPU types without company name.+	# Some are omitted here because they have special meanings below.+	1750a | 580 \+	| a29k \+	| aarch64 | aarch64_be \+	| abacus \+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \+	| am33_2.0 \+	| arc | arceb \+	| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m | armv[78][arm] \+	| avr | avr32 \+	| asmjs \+	| ba \+	| be32 | be64 \+	| bfin \+	| c4x | c8051 | clipper | csky \+	| d10v | d30v | dlx | dsp16xx \+	| e2k | epiphany \+	| fido | fr30 | frv | ft32 \+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \+	| hexagon \+	| i370 | i860 | i960 | ia16 | ia64 \+	| ip2k | iq2000 \+	| k1om \+	| le32 | le64 \+	| lm32 \+	| m32c | m32r | m32rle | m68000 | m68k | m88k \+	| m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \+	| maxq | mb | microblaze | microblazeel | mcore | mep | metag \+	| mips | mipsbe | mipseb | mipsel | mipsle \+	| mips16 \+	| mips64 | mips64el \+	| mips64octeon | mips64octeonel \+	| mips64orion | mips64orionel \+	| mips64r5900 | mips64r5900el \+	| mips64vr | mips64vrel \+	| mips64vr4100 | mips64vr4100el \+	| mips64vr4300 | mips64vr4300el \+	| mips64vr5000 | mips64vr5000el \+	| mips64vr5900 | mips64vr5900el \+	| mipsisa32 | mipsisa32el \+	| mipsisa32r2 | mipsisa32r2el \+	| mipsisa32r6 | mipsisa32r6el \+	| mipsisa64 | mipsisa64el \+	| mipsisa64r2 | mipsisa64r2el \+	| mipsisa64r6 | mipsisa64r6el \+	| mipsisa64sb1 | mipsisa64sb1el \+	| mipsisa64sr71k | mipsisa64sr71kel \+	| mipsr5900 | mipsr5900el \+	| mipstx39 | mipstx39el \+	| mn10200 | mn10300 \+	| moxie \+	| mt \+	| msp430 \+	| nds32 | nds32le | nds32be \+	| nfp \+	| nios | nios2 | nios2eb | nios2el \+	| ns16k | ns32k \+	| open8 | or1k | or1knd | or32 \+	| pdp10 | pj | pjl \+	| powerpc | powerpc64 | powerpc64le | powerpcle \+	| pru \+	| pyramid \+	| riscv | riscv32 | riscv64 \+	| rl78 | rx \+	| score \+	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh[23]ele \+	| sh64 | sh64le \+	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \+	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \+	| spu \+	| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \+	| ubicom32 \+	| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \+	| visium \+	| wasm32 \+	| x86 | xc16x | xstormy16 | xgate | xtensa \+	| z8k | z80)+		basic_machine=$basic_machine-unknown+		;;+	c54x)+		basic_machine=tic54x-unknown+		;;+	c55x)+		basic_machine=tic55x-unknown+		;;+	c6x)+		basic_machine=tic6x-unknown+		;;+	leon|leon[3-9])+		basic_machine=sparc-$basic_machine+		;;+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65)+		;;+	m9s12z | m68hcs12z | hcs12z | s12z)+		basic_machine=s12z-unknown+		;;+	m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)+		basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	ms1)+		basic_machine=mt-unknown+		;;+	strongarm | thumb | xscale)+		basic_machine=arm-unknown+		;;+	xscaleeb)+		basic_machine=armeb-unknown+		;;++	xscaleel)+		basic_machine=armel-unknown+		;;++	# We use `pc' rather than `unknown'+	# because (1) that's what they normally are, and+	# (2) the word "unknown" tends to confuse beginning users.+	i*86 | x86_64)+	  basic_machine=$basic_machine-pc+	  ;;+	# Recognize the basic CPU types with company name.+	1750a-* | 580-* \+	| a29k-* \+	| aarch64-* | aarch64_be-* \+	| abacus-* \+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \+	| alphapca5[67]-* | alpha64pca5[67]-* \+	| am33_2.0-* \+	| arc-* | arceb-* \+	| arm-*  | arm[lb]e-* | arme[lb]-* | armv*-* \+	| avr-* | avr32-* \+	| asmjs-* \+	| ba-* \+	| be32-* | be64-* \+	| bfin-* | bs2000-* \+	| c[123]* | c30-* | [cjt]90-* | c4x-* \+	| c8051-* | clipper-* | craynv-* | csky-* | cydra-* \+	| d10v-* | d30v-* | dlx-* | dsp16xx-* \+	| e2k-* | elxsi-* | epiphany-* \+	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \+	| h8300-* | h8500-* \+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \+	| hexagon-* \+	| i370-* | i*86-* | i860-* | i960-* | ia16-* | ia64-* \+	| ip2k-* | iq2000-* \+	| k1om-* \+	| le32-* | le64-* \+	| lm32-* \+	| m32c-* | m32r-* | m32rle-* \+	| m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \+	| m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-* \+	| m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \+	| microblaze-* | microblazeel-* \+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \+	| mips16-* \+	| mips64-* | mips64el-* \+	| mips64octeon-* | mips64octeonel-* \+	| mips64orion-* | mips64orionel-* \+	| mips64r5900-* | mips64r5900el-* \+	| mips64vr-* | mips64vrel-* \+	| mips64vr4100-* | mips64vr4100el-* \+	| mips64vr4300-* | mips64vr4300el-* \+	| mips64vr5000-* | mips64vr5000el-* \+	| mips64vr5900-* | mips64vr5900el-* \+	| mipsisa32-* | mipsisa32el-* \+	| mipsisa32r2-* | mipsisa32r2el-* \+	| mipsisa32r6-* | mipsisa32r6el-* \+	| mipsisa64-* | mipsisa64el-* \+	| mipsisa64r2-* | mipsisa64r2el-* \+	| mipsisa64r6-* | mipsisa64r6el-* \+	| mipsisa64sb1-* | mipsisa64sb1el-* \+	| mipsisa64sr71k-* | mipsisa64sr71kel-* \+	| mipsr5900-* | mipsr5900el-* \+	| mipstx39-* | mipstx39el-* \+	| mmix-* \+	| mn10200-* | mn10300-* \+	| moxie-* \+	| mt-* \+	| msp430-* \+	| nds32-* | nds32le-* | nds32be-* \+	| nfp-* \+	| nios-* | nios2-* | nios2eb-* | nios2el-* \+	| none-* | np1-* | ns16k-* | ns32k-* \+	| open8-* \+	| or1k*-* \+	| or32-* \+	| orion-* \+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \+	| pru-* \+	| pyramid-* \+	| riscv-* | riscv32-* | riscv64-* \+	| rl78-* | romp-* | rs6000-* | rx-* \+	| score-* \+	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* | she[lb]-* | sh[lb]e-* \+	| sh[1234]e[lb]-* |  sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-* \+	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \+	| sparclite-* \+	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \+	| spu-* \+	| tahoe-* \+	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \+	| tron-* \+	| ubicom32-* \+	| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \+	| vax-* \+	| visium-* \+	| wasm32-* \+	| we32k-* \+	| x86-* | x86_64-* | xc16x-* | xgate-* | xps100-* \+	| xstormy16-* | xtensa*-* \+	| ymp-* \+	| z8k-* | z80-*)+		;;+	# Recognize the basic CPU types without company name, with glob match.+	xtensa*)+		basic_machine=$basic_machine-unknown+		;;+	# Recognize the various machine names and aliases which stand+	# for a CPU type and a company and sometimes even an OS.+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)+		basic_machine=m68000-att+		;;+	3b*)+		basic_machine=we32k-att+		;;+	amd64)+		basic_machine=x86_64-pc+		;;+	amd64-*)+		basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	amiga | amiga-*)+		basic_machine=m68k-unknown+		;;+	blackfin-*)+		basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		os=linux+		;;+	bluegene*)+		basic_machine=powerpc-ibm+		os=cnk+		;;+	c54x-*)+		basic_machine=tic54x-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	c55x-*)+		basic_machine=tic55x-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	c6x-*)+		basic_machine=tic6x-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	c90)+		basic_machine=c90-cray+		os=${os:-unicos}+		;;+	cr16 | cr16-*)+		basic_machine=cr16-unknown+		os=${os:-elf}+		;;+	crisv32 | crisv32-* | etraxfs*)+		basic_machine=crisv32-axis+		;;+	cris | cris-* | etrax*)+		basic_machine=cris-axis+		;;+	crx)+		basic_machine=crx-unknown+		os=${os:-elf}+		;;+	da30 | da30-*)+		basic_machine=m68k-da30+		;;+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)+		basic_machine=mips-dec+		;;+	decsystem10* | dec10*)+		basic_machine=pdp10-dec+		os=tops10+		;;+	decsystem20* | dec20*)+		basic_machine=pdp10-dec+		os=tops20+		;;+	delta | 3300 | motorola-3300 | motorola-delta \+	      | 3300-motorola | delta-motorola)+		basic_machine=m68k-motorola+		;;+	dpx20 | dpx20-*)+		basic_machine=rs6000-bull+		os=${os:-bosx}+		;;+	dpx2*)+		basic_machine=m68k-bull+		os=sysv3+		;;+	e500v[12])+		basic_machine=powerpc-unknown+		os=$os"spe"+		;;+	e500v[12]-*)+		basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		os=$os"spe"+		;;+	encore | umax | mmax)+		basic_machine=ns32k-encore+		;;+	elxsi)+		basic_machine=elxsi-elxsi+		os=${os:-bsd}+		;;+	fx2800)+		basic_machine=i860-alliant+		;;+	genix)+		basic_machine=ns32k-ns+		;;+	h3050r* | hiux*)+		basic_machine=hppa1.1-hitachi+		os=hiuxwe2+		;;+	hp300-*)+		basic_machine=m68k-hp+		;;+	hp3k9[0-9][0-9] | hp9[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	hp9k2[0-9][0-9] | hp9k31[0-9])+		basic_machine=m68000-hp+		;;+	hp9k3[2-9][0-9])+		basic_machine=m68k-hp+		;;+	hp9k6[0-9][0-9] | hp6[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	hp9k7[0-79][0-9] | hp7[0-79][0-9])+		basic_machine=hppa1.1-hp+		;;+	hp9k78[0-9] | hp78[0-9])+		# FIXME: really hppa2.0-hp+		basic_machine=hppa1.1-hp+		;;+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)+		# FIXME: really hppa2.0-hp+		basic_machine=hppa1.1-hp+		;;+	hp9k8[0-9][13679] | hp8[0-9][13679])+		basic_machine=hppa1.1-hp+		;;+	hp9k8[0-9][0-9] | hp8[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	i*86v32)+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`+		os=sysv32+		;;+	i*86v4*)+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`+		os=sysv4+		;;+	i*86v)+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`+		os=sysv+		;;+	i*86sol2)+		basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`+		os=solaris2+		;;+	j90 | j90-cray)+		basic_machine=j90-cray+		os=${os:-unicos}+		;;+	iris | iris4d)+		basic_machine=mips-sgi+		case $os in+		    irix*)+			;;+		    *)+			os=irix4+			;;+		esac+		;;+	leon-*|leon[3-9]-*)+		basic_machine=sparc-`echo "$basic_machine" | sed 's/-.*//'`+		;;+	m68knommu-*)+		basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		os=linux+		;;+	microblaze*)+		basic_machine=microblaze-xilinx+		;;+	miniframe)+		basic_machine=m68000-convergent+		;;+	*mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)+		basic_machine=m68k-atari+		os=mint+		;;+	mips3*-*)+		basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`+		;;+	mips3*)+		basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`-unknown+		;;+	ms1-*)+		basic_machine=`echo "$basic_machine" | sed -e 's/ms1-/mt-/'`+		;;+	news-3600 | risc-news)+		basic_machine=mips-sony+		os=newsos+		;;+	next | m*-next)+		basic_machine=m68k-next+		case $os in+		    nextstep* )+			;;+		    ns2*)+		      os=nextstep2+			;;+		    *)+		      os=nextstep3+			;;+		esac+		;;+	np1)+		basic_machine=np1-gould+		;;+	neo-tandem)+		basic_machine=neo-tandem+		;;+	nse-tandem)+		basic_machine=nse-tandem+		;;+	nsr-tandem)+		basic_machine=nsr-tandem+		;;+	nsv-tandem)+		basic_machine=nsv-tandem+		;;+	nsx-tandem)+		basic_machine=nsx-tandem+		;;+	op50n-* | op60c-*)+		basic_machine=hppa1.1-oki+		os=proelf+		;;+	openrisc | openrisc-*)+		basic_machine=or32-unknown+		;;+	pa-hitachi)+		basic_machine=hppa1.1-hitachi+		os=hiuxwe2+		;;+	parisc-*)+		basic_machine=hppa-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		os=linux+		;;+	pbd)+		basic_machine=sparc-tti+		;;+	pbb)+		basic_machine=m68k-tti+		;;+	pc532 | pc532-*)+		basic_machine=ns32k-pc532+		;;+	pc98)+		basic_machine=i386-pc+		;;+	pc98-*)+		basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	pentium | p5 | k5 | k6 | nexgen | viac3)+		basic_machine=i586-pc+		;;+	pentiumpro | p6 | 6x86 | athlon | athlon_*)+		basic_machine=i686-pc+		;;+	pentiumii | pentium2 | pentiumiii | pentium3)+		basic_machine=i686-pc+		;;+	pentium4)+		basic_machine=i786-pc+		;;+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)+		basic_machine=i586-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	pentiumpro-* | p6-* | 6x86-* | athlon-*)+		basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)+		basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	pentium4-*)+		basic_machine=i786-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	pn)+		basic_machine=pn-gould+		;;+	power)	basic_machine=power-ibm+		;;+	ppc | ppcbe)	basic_machine=powerpc-unknown+		;;+	ppc-* | ppcbe-*)+		basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	ppcle | powerpclittle)+		basic_machine=powerpcle-unknown+		;;+	ppcle-* | powerpclittle-*)+		basic_machine=powerpcle-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	ppc64)	basic_machine=powerpc64-unknown+		;;+	ppc64-*) basic_machine=powerpc64-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	ppc64le | powerpc64little)+		basic_machine=powerpc64le-unknown+		;;+	ppc64le-* | powerpc64little-*)+		basic_machine=powerpc64le-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	ps2)+		basic_machine=i386-ibm+		;;+	rm[46]00)+		basic_machine=mips-siemens+		;;+	rtpc | rtpc-*)+		basic_machine=romp-ibm+		;;+	s390 | s390-*)+		basic_machine=s390-ibm+		;;+	s390x | s390x-*)+		basic_machine=s390x-ibm+		;;+	sb1)+		basic_machine=mipsisa64sb1-unknown+		;;+	sb1el)+		basic_machine=mipsisa64sb1el-unknown+		;;+	sde)+		basic_machine=mipsisa32-sde+		os=${os:-elf}+		;;+	sequent)+		basic_machine=i386-sequent+		;;+	sh5el)+		basic_machine=sh5le-unknown+		;;+	sh5el-*)+		basic_machine=sh5le-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	simso-wrs)+		basic_machine=sparclite-wrs+		os=vxworks+		;;+	spur)+		basic_machine=spur-unknown+		;;+	strongarm-* | thumb-*)+		basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'`+		;;+	tile*-*)+		;;+	tile*)+		basic_machine=$basic_machine-unknown+		os=${os:-linux-gnu}+		;;+	tx39)+		basic_machine=mipstx39-unknown+		;;+	tx39el)+		basic_machine=mipstx39el-unknown+		;;+	tower | tower-32)+		basic_machine=m68k-ncr+		;;+	vpp*|vx|vx-*)+		basic_machine=f301-fujitsu+		;;+	w65*)+		basic_machine=w65-wdc+		os=none+		;;+	w89k-*)+		basic_machine=hppa1.1-winbond+		os=proelf+		;;+	x64)+		basic_machine=x86_64-pc+		;;+	xscale-* | xscalee[bl]-*)+		basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'`+		;;+	none)+		basic_machine=none-none+		;;++	*)+		echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2+		exit 1+		;;+esac++# Here we canonicalize certain aliases for manufacturers.+case $basic_machine in+	*-digital*)+		basic_machine=`echo "$basic_machine" | sed 's/digital.*/dec/'`+		;;+	*-commodore*)+		basic_machine=`echo "$basic_machine" | sed 's/commodore.*/cbm/'`+		;;+	*)+		;;+esac++# Decode manufacturer-specific aliases for certain operating systems.++if [ x$os != x ]+then+case $os in+	# First match some system type aliases that might get confused+	# with valid system types.+	# solaris* is a basic system type, with this one exception.+	auroraux)+		os=auroraux+		;;+	bluegene*)+		os=cnk+		;;+	solaris1 | solaris1.*)+		os=`echo $os | sed -e 's|solaris1|sunos4|'`+		;;+	solaris)+		os=solaris2+		;;+	unixware*)+		os=sysv4.2uw+		;;+	gnu/linux*)+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`+		;;+	# es1800 is here to avoid being matched by es* (a different OS)+	es1800*)+		os=ose+		;;+	# Some version numbers need modification+	chorusos*)+		os=chorusos+		;;+	isc)+		os=isc2.2+		;;+	sco6)+		os=sco5v6+		;;+	sco5)+		os=sco3.2v5+		;;+	sco4)+		os=sco3.2v4+		;;+	sco3.2.[4-9]*)+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`+		;;+	sco3.2v[4-9]* | sco5v6*)+		# Don't forget version if it is 3.2v4 or newer.+		;;+	scout)+		# Don't match below+		;;+	sco*)+		os=sco3.2v2+		;;+	psos*)+		os=psos+		;;+	# Now accept the basic system types.+	# The portable systems comes first.+	# Each alternative MUST end in a * to match a version number.+	# sysv* is not here because it comes later, after sysvr4.+	gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \+	     | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\+	     | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \+	     | sym* | kopensolaris* | plan9* \+	     | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \+	     | aos* | aros* | cloudabi* | sortix* \+	     | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \+	     | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \+	     | knetbsd* | mirbsd* | netbsd* \+	     | bitrig* | openbsd* | solidbsd* | libertybsd* \+	     | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \+	     | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \+	     | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \+	     | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \+	     | chorusrdb* | cegcc* | glidix* \+	     | cygwin* | msys* | pe* | moss* | proelf* | rtems* \+	     | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \+	     | linux-newlib* | linux-musl* | linux-uclibc* \+	     | uxpv* | beos* | mpeix* | udk* | moxiebox* \+	     | interix* | uwin* | mks* | rhapsody* | darwin* \+	     | openstep* | oskit* | conix* | pw32* | nonstopux* \+	     | storm-chaos* | tops10* | tenex* | tops20* | its* \+	     | os2* | vos* | palmos* | uclinux* | nucleus* \+	     | morphos* | superux* | rtmk* | windiss* \+	     | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \+	     | skyos* | haiku* | rdos* | toppers* | drops* | es* \+	     | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \+	     | midnightbsd*)+	# Remember, each alternative MUST END IN *, to match a version number.+		;;+	qnx*)+		case $basic_machine in+		    x86-* | i*86-*)+			;;+		    *)+			os=nto-$os+			;;+		esac+		;;+	hiux*)+		os=hiuxwe2+		;;+	nto-qnx*)+		;;+	nto*)+		os=`echo $os | sed -e 's|nto|nto-qnx|'`+		;;+	sim | xray | os68k* | v88r* \+	    | windows* | osx | abug | netware* | os9* \+	    | macos* | mpw* | magic* | mmixware* | mon960* | lnews*)+		;;+	linux-dietlibc)+		os=linux-dietlibc+		;;+	linux*)+		os=`echo $os | sed -e 's|linux|linux-gnu|'`+		;;+	lynx*178)+		os=lynxos178+		;;+	lynx*5)+		os=lynxos5+		;;+	lynx*)+		os=lynxos+		;;+	mac*)+		os=`echo "$os" | sed -e 's|mac|macos|'`+		;;+	opened*)+		os=openedition+		;;+	os400*)+		os=os400+		;;+	sunos5*)+		os=`echo "$os" | sed -e 's|sunos5|solaris2|'`+		;;+	sunos6*)+		os=`echo "$os" | sed -e 's|sunos6|solaris3|'`+		;;+	wince*)+		os=wince+		;;+	utek*)+		os=bsd+		;;+	dynix*)+		os=bsd+		;;+	acis*)+		os=aos+		;;+	atheos*)+		os=atheos+		;;+	syllable*)+		os=syllable+		;;+	386bsd)+		os=bsd+		;;+	ctix* | uts*)+		os=sysv+		;;+	nova*)+		os=rtmk-nova+		;;+	ns2)+		os=nextstep2+		;;+	nsk*)+		os=nsk+		;;+	# Preserve the version number of sinix5.+	sinix5.*)+		os=`echo $os | sed -e 's|sinix|sysv|'`+		;;+	sinix*)+		os=sysv4+		;;+	tpf*)+		os=tpf+		;;+	triton*)+		os=sysv3+		;;+	oss*)+		os=sysv3+		;;+	svr4*)+		os=sysv4+		;;+	svr3)+		os=sysv3+		;;+	sysvr4)+		os=sysv4+		;;+	# This must come after sysvr4.+	sysv*)+		;;+	ose*)+		os=ose+		;;+	*mint | mint[0-9]* | *MiNT | MiNT[0-9]*)+		os=mint+		;;+	zvmoe)+		os=zvmoe+		;;+	dicos*)+		os=dicos+		;;+	pikeos*)+		# Until real need of OS specific support for+		# particular features comes up, bare metal+		# configurations are quite functional.+		case $basic_machine in+		    arm*)+			os=eabi+			;;+		    *)+			os=elf+			;;+		esac+		;;+	nacl*)+		;;+	ios)+		;;+	none)+		;;+	*-eabi)+		;;+	*)+		echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2+		exit 1+		;;+esac+else++# Here we handle the default operating systems that come with various machines.+# The value should be what the vendor currently ships out the door with their+# machine or put another way, the most popular os provided with the machine.++# Note that if you're going to try to match "-MANUFACTURER" here (say,+# "-sun"), then you have to tell the case statement up towards the top+# that MANUFACTURER isn't an operating system.  Otherwise, code above+# will signal an error saying that MANUFACTURER isn't an operating+# system, and we'll never get to this point.++case $basic_machine in+	score-*)+		os=elf+		;;+	spu-*)+		os=elf+		;;+	*-acorn)+		os=riscix1.2+		;;+	arm*-rebel)+		os=linux+		;;+	arm*-semi)+		os=aout+		;;+	c4x-* | tic4x-*)+		os=coff+		;;+	c8051-*)+		os=elf+		;;+	clipper-intergraph)+		os=clix+		;;+	hexagon-*)+		os=elf+		;;+	tic54x-*)+		os=coff+		;;+	tic55x-*)+		os=coff+		;;+	tic6x-*)+		os=coff+		;;+	# This must come before the *-dec entry.+	pdp10-*)+		os=tops20+		;;+	pdp11-*)+		os=none+		;;+	*-dec | vax-*)+		os=ultrix4.2+		;;+	m68*-apollo)+		os=domain+		;;+	i386-sun)+		os=sunos4.0.2+		;;+	m68000-sun)+		os=sunos3+		;;+	m68*-cisco)+		os=aout+		;;+	mep-*)+		os=elf+		;;+	mips*-cisco)+		os=elf+		;;+	mips*-*)+		os=elf+		;;+	or32-*)+		os=coff+		;;+	*-tti)	# must be before sparc entry or we get the wrong os.+		os=sysv3+		;;+	sparc-* | *-sun)+		os=sunos4.1.1+		;;+	pru-*)+		os=elf+		;;+	*-be)+		os=beos+		;;+	*-ibm)+		os=aix+		;;+	*-knuth)+		os=mmixware+		;;+	*-wec)+		os=proelf+		;;+	*-winbond)+		os=proelf+		;;+	*-oki)+		os=proelf+		;;+	*-hp)+		os=hpux+		;;+	*-hitachi)+		os=hiux+		;;+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)+		os=sysv+		;;+	*-cbm)+		os=amigaos+		;;+	*-dg)+		os=dgux+		;;+	*-dolphin)+		os=sysv3+		;;+	m68k-ccur)+		os=rtu+		;;+	m88k-omron*)+		os=luna+		;;+	*-next)+		os=nextstep+		;;+	*-sequent)+		os=ptx+		;;+	*-crds)+		os=unos+		;;+	*-ns)+		os=genix+		;;+	i370-*)+		os=mvs+		;;+	*-gould)+		os=sysv+		;;+	*-highlevel)+		os=bsd+		;;+	*-encore)+		os=bsd+		;;+	*-sgi)+		os=irix+		;;+	*-siemens)+		os=sysv4+		;;+	*-masscomp)+		os=rtu+		;;+	f30[01]-fujitsu | f700-fujitsu)+		os=uxpv+		;;+	*-rom68k)+		os=coff+		;;+	*-*bug)+		os=coff+		;;+	*-apple)+		os=macos+		;;+	*-atari*)+		os=mint+		;;+	*-wrs)+		os=vxworks+		;;+	*)+		os=none+		;;+esac+fi++# Here we handle the case where we know the os, and the CPU type, but not the+# manufacturer.  We pick the logical manufacturer.+vendor=unknown+case $basic_machine in+	*-unknown)+		case $os in+			riscix*)+				vendor=acorn+				;;+			sunos*)+				vendor=sun+				;;+			cnk*|-aix*)+				vendor=ibm+				;;+			beos*)+				vendor=be+				;;+			hpux*)+				vendor=hp+				;;+			mpeix*)+				vendor=hp+				;;+			hiux*)+				vendor=hitachi+				;;+			unos*)+				vendor=crds+				;;+			dgux*)+				vendor=dg+				;;+			luna*)+				vendor=omron+				;;+			genix*)+				vendor=ns+				;;+			clix*)+				vendor=intergraph+				;;+			mvs* | opened*)+				vendor=ibm+				;;+			os400*)+				vendor=ibm+				;;+			ptx*)+				vendor=sequent+				;;+			tpf*)+				vendor=ibm+				;;+			vxsim* | vxworks* | windiss*)+				vendor=wrs+				;;+			aux*)+				vendor=apple+				;;+			hms*)+				vendor=hitachi+				;;+			mpw* | macos*)+				vendor=apple+				;;+			*mint | mint[0-9]* | *MiNT | MiNT[0-9]*)+				vendor=atari+				;;+			vos*)+				vendor=stratus+				;;+		esac+		basic_machine=`echo "$basic_machine" | sed "s/unknown/$vendor/"`+		;;+esac++echo "$basic_machine-$os"+exit++# Local variables:+# eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'"
data/nix/configure.ac view
@@ -64,6 +64,7 @@ AC_PROG_CPP AX_CXX_COMPILE_STDCXX_14 +AC_CHECK_TOOL([AR], [ar])  # Use 64-bit file system calls so that we can support files > 2 GiB. AC_SYS_LARGEFILE@@ -127,8 +128,6 @@ NEED_PROG(gzip, gzip) NEED_PROG(xz, xz) AC_PATH_PROG(dot, dot)-AC_PATH_PROG(pv, pv, pv)-AC_PATH_PROGS(brotli, brotli bro, bro) AC_PATH_PROG(lsof, lsof, lsof)  @@ -152,9 +151,9 @@  # Look for libbz2, a required dependency. AC_CHECK_LIB([bz2], [BZ2_bzWriteOpen], [true],-  [AC_MSG_ERROR([Nix requires libbz2, which is part of bzip2.  See http://www.bzip.org/.])])+  [AC_MSG_ERROR([Nix requires libbz2, which is part of bzip2.  See https://web.archive.org/web/20180624184756/http://www.bzip.org/.])]) AC_CHECK_HEADERS([bzlib.h], [true],-  [AC_MSG_ERROR([Nix requires libbz2, which is part of bzip2.  See http://www.bzip.org/.])])+  [AC_MSG_ERROR([Nix requires libbz2, which is part of bzip2.  See https://web.archive.org/web/20180624184756/http://www.bzip.org/.])])   # Look for SQLite, a required dependency.@@ -164,6 +163,8 @@ # Look for libcurl, a required dependency. PKG_CHECK_MODULES([LIBCURL], [libcurl], [CXXFLAGS="$LIBCURL_CFLAGS $CXXFLAGS"]) +# Look for editline, a required dependency.+PKG_CHECK_MODULES([EDITLINE], [libeditline], [CXXFLAGS="$EDITLINE_CFLAGS $CXXFLAGS"])  # Look for libsodium, an optional dependency. PKG_CHECK_MODULES([SODIUM], [libsodium],@@ -179,13 +180,10 @@   [AC_DEFINE([HAVE_LZMA_MT], [1], [xz multithreaded compression support])])  -# Look for libbrotli{enc,dec}, optional dependencies-PKG_CHECK_MODULES([LIBBROTLI], [libbrotlienc libbrotlidec],-  [AC_DEFINE([HAVE_BROTLI], [1], [Whether to use libbrotli.])-   CXXFLAGS="$LIBBROTLI_CFLAGS $CXXFLAGS"]-   have_brotli=1], [have_brotli=])-AC_SUBST(HAVE_BROTLI, [$have_brotli])+# Look for libbrotli{enc,dec}.+PKG_CHECK_MODULES([LIBBROTLI], [libbrotlienc libbrotlidec], [CXXFLAGS="$LIBBROTLI_CFLAGS $CXXFLAGS"]) + # Look for libseccomp, required for Linux sandboxing. if test "$sys_name" = linux; then   AC_ARG_ENABLE([seccomp-sandboxing],@@ -232,12 +230,6 @@ fi  -AC_ARG_ENABLE(init-state, AC_HELP_STRING([--disable-init-state],-  [do not initialise DB etc. in `make install']),-  init_state=$enableval, init_state=yes)-#AM_CONDITIONAL(INIT_STATE, test "$init_state" = "yes")-- # documentation generation switch AC_ARG_ENABLE(doc-gen, AC_HELP_STRING([--disable-doc-gen],   [disable documentation generation]),@@ -260,11 +252,6 @@ fi  -# Figure out the extension of dynamic libraries.-eval dynlib_suffix=$shrext_cmds-AC_SUBST(dynlib_suffix)-- # Do we have GNU tar? AC_MSG_CHECKING([if you have a recent GNU tar]) if $tar --version 2> /dev/null | grep -q GNU && tar cvf /dev/null --warning=no-timestamp ./config.log > /dev/null; then@@ -280,6 +267,15 @@   [path of a statically-linked shell to use as /bin/sh in sandboxes]),   sandbox_shell=$withval) AC_SUBST(sandbox_shell)++AC_ARG_ENABLE(shared, AC_HELP_STRING([--enable-shared],+  [Build shared libraries for Nix [default=yes]]),+  shared=$enableval, shared=yes)+if test "$shared" = yes; then+  AC_SUBST(BUILD_SHARED_LIBS, 1, [Whether to build shared libraries.])+else+  AC_SUBST(BUILD_SHARED_LIBS, 0, [Whether to build shared libraries.])+fi   # Expand all variables in config.status.
data/nix/corepkgs/fetchurl.nix view
@@ -1,10 +1,14 @@ { system ? "" # obsolete , url+, hash ? "" # an SRI ash++# Legacy hash specification , md5 ? "", sha1 ? "", sha256 ? "", sha512 ? "" , outputHash ?-    if sha512 != "" then sha512 else if sha1 != "" then sha1 else if md5 != "" then md5 else sha256+    if hash != "" then hash else if sha512 != "" then sha512 else if sha1 != "" then sha1 else if md5 != "" then md5 else sha256 , outputHashAlgo ?-    if sha512 != "" then "sha512" else if sha1 != "" then "sha1" else if md5 != "" then "md5" else "sha256"+    if hash != "" then "" else if sha512 != "" then "sha512" else if sha1 != "" then "sha1" else if md5 != "" then "md5" else "sha256"+ , executable ? false , unpack ? false , name ? baseNameOf (toString url)
data/nix/local.mk view
@@ -6,7 +6,7 @@  clean-files += Makefile.config -GLOBAL_CXXFLAGS += -I . -I src -I src/libutil -I src/libstore -I src/libmain -I src/libexpr+GLOBAL_CXXFLAGS += -I . -I src -I src/libutil -I src/libstore -I src/libmain -I src/libexpr -I src/nix  $(foreach i, config.h $(call rwildcard, src/lib*, *.hh), \   $(eval $(call install-file-in, $(i), $(includedir)/nix, 0644)))
data/nix/maintainers/upload-release.pl view
@@ -76,16 +76,23 @@      write_file("$dstFile.sha256", $sha256_expected); +    if (! -e "$dstFile.asc") {+        system("gpg2 --detach-sign --armor $dstFile") == 0 or die "unable to sign $dstFile\n";+    }+     return ($dstFile, $sha256_expected); }  downloadFile("tarball", "2"); # .tar.bz2 my ($tarball, $tarballHash) = downloadFile("tarball", "3"); # .tar.xz-my ($tarball_i686_linux, $tarball_i686_linux_hash) = downloadFile("binaryTarball.i686-linux", "1");-my ($tarball_x86_64_linux, $tarball_x86_64_linux_hash) = downloadFile("binaryTarball.x86_64-linux", "1");-my ($tarball_aarch64_linux, $tarball_aarch64_linux_hash) = downloadFile("binaryTarball.aarch64-linux", "1");-my ($tarball_x86_64_darwin, $tarball_x86_64_darwin_hash) = downloadFile("binaryTarball.x86_64-darwin", "1");+downloadFile("binaryTarball.i686-linux", "1");+downloadFile("binaryTarball.x86_64-linux", "1");+downloadFile("binaryTarball.aarch64-linux", "1");+downloadFile("binaryTarball.x86_64-darwin", "1");+downloadFile("installerScript", "1"); +exit if $version =~ /pre/;+ # Update Nixpkgs in a very hacky way. system("cd $nixpkgsDir && git pull") == 0 or die; my $oldName = `nix-instantiate --eval $nixpkgsDir -A nix.name`; chomp $oldName;@@ -144,17 +151,6 @@ write_file("$siteDir/nix-release.tt",            "[%-\n" .            "latestNixVersion = \"$version\"\n" .-           "nix_hash_i686_linux = \"$tarball_i686_linux_hash\"\n" .-           "nix_hash_x86_64_linux = \"$tarball_x86_64_linux_hash\"\n" .-           "nix_hash_aarch64_linux = \"$tarball_aarch64_linux_hash\"\n" .-           "nix_hash_x86_64_darwin = \"$tarball_x86_64_darwin_hash\"\n" .            "-%]\n");--system("cd $siteDir && nix-shell --run 'make nix/install nix/install.sig'") == 0 or die;--copy("$siteDir/nix/install", "$siteDir/nix/install-$version") or die;-copy("$siteDir/nix/install.sig", "$siteDir/nix/install-$version.sig") or die;--system("cd $siteDir && git add nix/install-$version nix/install-$version.sig") == 0 or die;  system("cd $siteDir && git commit -a -m 'Nix $version released'") == 0 or die;
data/nix/mk/libraries.mk view
@@ -125,7 +125,7 @@     $(1)_PATH := $$(_d)/$$($(1)_NAME).a      $$($(1)_PATH): $$($(1)_OBJS) | $$(_d)/-	$(trace-ar) ar crs $$@ $$?+	$(trace-ar) $(AR) crs $$@ $$?      $(1)_LDFLAGS_USE += $$($(1)_PATH) $$($(1)_LDFLAGS)
data/nix/nix.spec.in view
@@ -3,33 +3,47 @@ %global nixbld_user "nix-builder-" %global nixbld_group "nixbld" +# NOTE: BUILD on EL7 requires+# - Centos / RHEL7 software collection repository +#   yum install centos-release-scl+#+# - Recent boost backport+#   curl https://copr.fedorainfracloud.org/coprs/whosthere/boost/repo/epel-7/whosthere-boost-epel-7.repo -o /etc/yum.repos.d/whosthere-boost-epel-7.repo+#++# Disable documentation generation+# necessary on some platforms+%bcond_without docgen+ Summary: The Nix software deployment system Name: nix Version: @PACKAGE_VERSION@ Release: 2%{?dist} License: LGPLv2+-%if 0%{?rhel} && 0%{?rhel} < 7 Group: Applications/System-%endif URL: http://nixos.org/ Source0: %{name}-%{version}.tar.bz2-%if 0%{?el5}-BuildRoot: %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX)-%endif+ Requires: curl Requires: bzip2 Requires: gzip Requires: xz-Requires: libseccomp-Requires: boost-context+BuildRequires: bison+BuildRequires: boost-devel >= 1.60 BuildRequires: bzip2-devel-BuildRequires: sqlite-devel++# for RHEL <= 7, we need software collections for a C++14 compatible compatible compiler+%if 0%{?rhel}+BuildRequires: devtoolset-7-gcc+BuildRequires: devtoolset-7-gcc-c+++%endif++BuildRequires: flex BuildRequires: libcurl-devel BuildRequires: libseccomp-devel-BuildRequires: boost-devel--# Hack to make that shitty RPM scanning hack shut up.-Provides: perl(Nix::SSH)+BuildRequires: openssl-devel+BuildRequires: sqlite-devel+BuildRequires: xz-devel  %description Nix is a purely functional package manager. It allows multiple@@ -41,9 +55,6 @@  %package        devel Summary:        Development files for %{name}-%if 0%{?rhel} && 0%{?rhel} < 7-Group:          Development/Libraries-%endif Requires:       %{name}%{?_isa} = %{version}-%{release}  %description   devel@@ -53,9 +64,6 @@  %package doc Summary:        Documentation files for %{name}-%if 0%{?rhel} && 0%{?rhel} < 7-Group:          Documentation-%endif BuildArch:      noarch Requires:       %{name} = %{version}-%{release} @@ -67,20 +75,25 @@   %build+%if 0%{?rhel}+source /opt/rh/devtoolset-7/enable +%endif extraFlags= # - override docdir so large documentation files are owned by the #   -doc subpackage # - set localstatedir by hand to the preferred nix value %configure --localstatedir=/nix/var \+	   %{!?without_docgen:--disable-doc-gen} \            --docdir=%{_defaultdocdir}/%{name}-doc-%{version} \            $extraFlags-make -j$NIX_BUILD_CORES -l$NIX_BUILD_CORES+make V=1 %{?_smp_mflags}   %install-%if 0%{?el5}-rm -rf $RPM_BUILD_ROOT+%if 0%{?rhel}+source /opt/rh/devtoolset-7/enable  %endif+ make DESTDIR=$RPM_BUILD_ROOT install  find $RPM_BUILD_ROOT -name '*.la' -exec rm -f {} ';'@@ -130,6 +143,7 @@ %endif  %files+%license COPYING %{_bindir}/nix* %{_libdir}/*.so %{_prefix}/libexec/*@@ -138,9 +152,11 @@ %{_prefix}/lib/systemd/system/nix-daemon.service %endif %{_datadir}/nix-%{_mandir}/man1/*.1*-%{_mandir}/man5/*.5*-%{_mandir}/man8/*.8*+#%if ! %{without docgen}+#%{_mandir}/man1/*.1*+#%{_mandir}/man5/*.5*+#%{_mandir}/man8/*.8*+#%endif %config(noreplace) %{_sysconfdir}/profile.d/nix.sh %config(noreplace) %{_sysconfdir}/profile.d/nix-daemon.sh /nix@@ -149,6 +165,9 @@ %{_includedir}/nix %{_prefix}/lib/pkgconfig/*.pc -%files doc-%docdir %{_defaultdocdir}/%{name}-doc-%{version}-%{_defaultdocdir}/%{name}-doc-%{version}++#%if ! %{without docgen}+#%files doc+#%docdir %{_defaultdocdir}/%{name}-doc-%{version}+#%{_defaultdocdir}/%{name}-doc-%{version}+#%endif
data/nix/perl/lib/Nix/Store.xs view
@@ -27,7 +27,7 @@     static std::shared_ptr<Store> _store;     if (!_store) {         try {-            settings.loadConfFile();+            loadConfFile();             settings.lockCPU = false;             _store = openStore();         } catch (Error & e) {
data/nix/release-common.nix view
@@ -30,7 +30,7 @@   });    configureFlags =-    [ "--disable-init-state"+    [       "--enable-gc"     ] ++ lib.optionals stdenv.isLinux [       "--with-sandbox-shell=${sh}/bin/busybox"@@ -49,7 +49,7 @@    buildDeps =     [ curl-      bzip2 xz brotli+      bzip2 xz brotli editline       openssl pkgconfig sqlite boehmgc       boost @@ -57,13 +57,20 @@       git       mercurial     ]-    ++ lib.optional stdenv.isLinux libseccomp+    ++ lib.optionals stdenv.isLinux [libseccomp utillinuxMinimal]     ++ lib.optional (stdenv.isLinux || stdenv.isDarwin) libsodium     ++ lib.optional (stdenv.isLinux || stdenv.isDarwin)-      (aws-sdk-cpp.override {-        apis = ["s3"];+      ((aws-sdk-cpp.override {+        apis = ["s3" "transfer"];         customMemoryManagement = false;-      });+      }).overrideDerivation (args: {+        /*+        patches = args.patches or [] ++ [ (fetchpatch {+          url = https://github.com/edolstra/aws-sdk-cpp/commit/3e07e1f1aae41b4c8b340735ff9e8c735f0c063f.patch;+          sha256 = "1pij0v449p166f9l29x7ppzk8j7g9k9mp15ilh5qxp29c7fnvxy2";+        }) ];+        */+      }));    perlDeps =     [ perl
data/nix/release.nix view
@@ -1,5 +1,5 @@ { nix ? builtins.fetchGit ./.-, nixpkgs ? builtins.fetchGit { url = https://github.com/NixOS/nixpkgs-channels.git; ref = "nixos-18.03"; }+, nixpkgs ? builtins.fetchGit { url = https://github.com/NixOS/nixpkgs-channels.git; ref = "nixos-18.09"; } , officialRelease ? false , systems ? [ "x86_64-linux" "i686-linux" "x86_64-darwin" "aarch64-linux" ] }:@@ -67,6 +67,14 @@          buildInputs = buildDeps; +        preConfigure =+          # Copy libboost_context so we don't get all of Boost in our closure.+          # https://github.com/NixOS/nixpkgs/issues/45462+          ''+            mkdir -p $out/lib+            cp ${boost}/lib/libboost_context* $out/lib+          '';+         configureFlags = configureFlags ++           [ "--sysconfdir=/etc" ]; @@ -74,8 +82,6 @@          makeFlags = "profiledir=$(out)/etc/profile.d"; -        preBuild = "unset NIX_INDENT_MAKE";-         installFlags = "sysconfdir=$(out)/etc";          doInstallCheck = true;@@ -103,8 +109,6 @@         enableParallelBuilding = true;          postUnpack = "sourceRoot=$sourceRoot/perl";--        preBuild = "unset NIX_INDENT_MAKE";       });  @@ -189,10 +193,6 @@          buildInputs = buildDeps; -        configureFlags = ''-          --disable-init-state-        '';-         dontInstall = false;          doInstallCheck = true;@@ -206,14 +206,14 @@       };  -    rpm_fedora27x86_64 = makeRPM_x86_64 (diskImageFunsFun: diskImageFunsFun.fedora27x86_64) [ ];+    #rpm_fedora27x86_64 = makeRPM_x86_64 (diskImageFunsFun: diskImageFunsFun.fedora27x86_64) [ ];       #deb_debian8i386 = makeDeb_i686 (diskImageFuns: diskImageFuns.debian8i386) [ "libsodium-dev" ] [ "libsodium13" ];     #deb_debian8x86_64 = makeDeb_x86_64 (diskImageFunsFun: diskImageFunsFun.debian8x86_64) [ "libsodium-dev" ] [ "libsodium13" ]; -    deb_ubuntu1710i386 = makeDeb_i686 (diskImageFuns: diskImageFuns.ubuntu1710i386) [ ] [ "libsodium18" ];-    deb_ubuntu1710x86_64 = makeDeb_x86_64 (diskImageFuns: diskImageFuns.ubuntu1710x86_64) [ ] [ "libsodium18" "libboost-context1.62.0" ];+    #deb_ubuntu1710i386 = makeDeb_i686 (diskImageFuns: diskImageFuns.ubuntu1710i386) [ ] [ "libsodium18" ];+    #deb_ubuntu1710x86_64 = makeDeb_x86_64 (diskImageFuns: diskImageFuns.ubuntu1710x86_64) [ ] [ "libsodium18" "libboost-context1.62.0" ];       # System tests.@@ -241,6 +241,7 @@         { diskImage = vmTools.diskImages.ubuntu1204x86_64;         }         ''+          set -x           useradd -m alice           su - alice -c 'tar xf ${binaryTarball.x86_64-linux}/*.tar.*'           mkdir /dest-nix@@ -249,6 +250,17 @@           su - alice -c '_NIX_INSTALLER_TEST=1 ./nix-*/install'           su - alice -c 'nix-store --verify'           su - alice -c 'PAGER= nix-store -qR ${build.x86_64-linux}'++          # Check whether 'nix upgrade-nix' works.+          cat > /tmp/paths.nix <<EOF+          {+            x86_64-linux = "${build.x86_64-linux}";+          }+          EOF+          su - alice -c 'nix upgrade-nix -vvv --nix-store-paths-url file:///tmp/paths.nix'+          (! [ -L /home/alice/.profile-1-link ])+          su - alice -c 'PAGER= nix-store -qR ${build.x86_64-linux}'+           mkdir -p $out/nix-support           touch $out/nix-support/hydra-build-products           umount /nix@@ -266,7 +278,6 @@       pkgs.runCommand "eval-nixos" { buildInputs = [ build.x86_64-linux ]; }         ''           export NIX_STATE_DIR=$TMPDIR-          nix-store --init            nix-instantiate ${nixpkgs}/nixos/release-combined.nix -A tested --dry-run \             --arg nixpkgs '{ outPath = ${nixpkgs}; revCount = 123; shortRev = "abcdefgh"; }'@@ -275,6 +286,24 @@         '';  +    installerScript =+      pkgs.runCommand "installer-script"+        { buildInputs = [ build.x86_64-linux ];+        }+        ''+          mkdir -p $out/nix-support++          substitute ${./scripts/install.in} $out/install \+            ${pkgs.lib.concatMapStrings+              (system: "--replace '@binaryTarball_${system}@' $(nix hash-file --base16 --type sha256 ${binaryTarball.${system}}/*.tar.bz2) ")+              [ "x86_64-linux" "i686-linux" "x86_64-darwin" "aarch64-linux" ]+            } \+            --replace '@nixVersion@' ${build.x86_64-linux.src.version}++          echo "file installer $out/install" >> $out/nix-support/hydra-build-products+        '';++     # Aggregate job containing the release-critical jobs.     release = pkgs.releaseTools.aggregate {       name = "nix-${tarball.version}";@@ -284,14 +313,17 @@           build.i686-linux           build.x86_64-darwin           build.x86_64-linux+          build.aarch64-linux           binaryTarball.i686-linux           binaryTarball.x86_64-darwin           binaryTarball.x86_64-linux+          binaryTarball.aarch64-linux           tests.remoteBuilds           tests.nix-copy-closure           tests.binaryTarball           tests.evalNixpkgs           tests.evalNixOS+          installerScript         ];     }; @@ -311,7 +343,7 @@       src = jobs.tarball;       diskImage = (diskImageFun vmTools.diskImageFuns)         { extraPackages =-            [ "sqlite" "sqlite-devel" "bzip2-devel" "libcurl-devel" "openssl-devel" "xz-devel" "libseccomp-devel" "libsodium-devel" "boost-devel" ]+            [ "sqlite" "sqlite-devel" "bzip2-devel" "libcurl-devel" "openssl-devel" "xz-devel" "libseccomp-devel" "libsodium-devel" "boost-devel" "bison" "flex" ]             ++ extraPackages; };       # At most 2047MB can be simulated in qemu-system-i386       memSize = 2047;
data/nix/scripts/install-multi-user.sh view
@@ -674,9 +674,6 @@ EOF         fi -        _sudo "to initialize the Nix Database" \-              $NIX_INSTALLED_NIX/bin/nix-store --init-         cat ./.reginfo \             | _sudo "to load data for the first time in to the Nix Database" \                    "$NIX_INSTALLED_NIX/bin/nix-store" --load-db@@ -727,11 +724,17 @@     _sudo "to installing a bootstrapping Nix in to the default Profile" \           HOME="$ROOT_HOME" "$NIX_INSTALLED_NIX/bin/nix-env" -i "$NIX_INSTALLED_NIX" -    _sudo "to installing a bootstrapping SSL certificate just for Nix in to the default Profile" \-          HOME="$ROOT_HOME" "$NIX_INSTALLED_NIX/bin/nix-env" -i "$NIX_INSTALLED_CACERT"+    if [ -z "${NIX_SSL_CERT_FILE:-}" ] || ! [ -f "${NIX_SSL_CERT_FILE:-}" ]; then+        _sudo "to installing a bootstrapping SSL certificate just for Nix in to the default Profile" \+              HOME="$ROOT_HOME" "$NIX_INSTALLED_NIX/bin/nix-env" -i "$NIX_INSTALLED_CACERT"+        export NIX_SSL_CERT_FILE=/nix/var/nix/profiles/default/etc/ssl/certs/ca-bundle.crt+    fi +    # Have to explicitly pass NIX_SSL_CERT_FILE as part of the sudo call,+    # otherwise it will be lost in environments where sudo doesn't pass+    # all the environment variables by default.     _sudo "to update the default channel in the default profile" \-          HOME="$ROOT_HOME" NIX_SSL_CERT_FILE=/nix/var/nix/profiles/default/etc/ssl/certs/ca-bundle.crt "$NIX_INSTALLED_NIX/bin/nix-channel" --update nixpkgs+          HOME="$ROOT_HOME" NIX_SSL_CERT_FILE="$NIX_SSL_CERT_FILE" "$NIX_INSTALLED_NIX/bin/nix-channel" --update nixpkgs }
data/nix/scripts/install-nix-from-closure.sh view
@@ -30,15 +30,14 @@     fi fi -# Determine if we should punt to the single-user installer or not+# Determine if we could use the multi-user installer or not if [ "$(uname -s)" = "Darwin" ]; then-    INSTALL_MODE=daemon+    echo "Note: a multi-user installation is possible. See https://nixos.org/nix/manual/#sect-multi-user-installation" >&2 elif [ "$(uname -s)" = "Linux" ] && [ -e /run/systemd/system ]; then-    INSTALL_MODE=daemon-else-    INSTALL_MODE=no-daemon+    echo "Note: a multi-user installation is possible. See https://nixos.org/nix/manual/#sect-multi-user-installation" >&2 fi +INSTALL_MODE=no-daemon # Trivially handle the --daemon / --no-daemon options if [ "x${1:-}" = "x--no-daemon" ]; then     INSTALL_MODE=no-daemon@@ -47,14 +46,18 @@ elif [ "x${1:-}" != "x" ]; then     (         echo "Nix Installer [--daemon|--no-daemon]"++        echo "Choose installation method."         echo ""-        echo " --daemon:    Force the installer to use the Daemon"-        echo "              based installer, even though it may not"-        echo "              work."+        echo " --daemon:    Installs and configures a background daemon that manages the store,"+        echo "              providing multi-user support and better isolation for local builds."+        echo "              Both for security and reproducibility, this method is recommended if"+        echo "              supported on your platform."+        echo "              See https://nixos.org/nix/manual/#sect-multi-user-installation"         echo ""-        echo " --no-daemon: Force a no-daemon, single-user"-        echo "              installation even when the preferred"-        echo "              method is with the daemon."+        echo " --no-daemon: Simple, single-user installation that does not require root and is"+        echo "              trivial to uninstall."+        echo "              (default)"         echo ""     ) >&2     exit@@ -105,12 +108,6 @@     fi done echo "" >&2--echo "initialising Nix database..." >&2-if ! $nix/bin/nix-store --init; then-    echo "$0: failed to initialize the Nix database" >&2-    exit 1-fi  if ! "$nix/bin/nix-store" --load-db < "$self/.reginfo"; then     echo "$0: unable to register valid paths" >&2
data/nix/scripts/nix-profile-daemon.sh.in view
@@ -1,5 +1,5 @@ # Only execute this file once per shell.-if [ -n "$__ETC_PROFILE_NIX_SOURCED" ]; then return; fi+if [ -n "${__ETC_PROFILE_NIX_SOURCED:-}" ]; then return; fi __ETC_PROFILE_NIX_SOURCED=1  # Set up secure multi-user builds: non-root users build through the@@ -49,6 +49,26 @@   fi fi -export NIX_SSL_CERT_FILE="@localstatedir@/nix/profiles/default/etc/ssl/certs/ca-bundle.crt"-export NIX_PATH="@localstatedir@/nix/profiles/per-user/root/channels"-export PATH="$HOME/.nix-profile/bin:$HOME/.nix-profile/lib/kde4/libexec:@localstatedir@/nix/profiles/default/bin:@localstatedir@/nix/profiles/default:@localstatedir@/nix/profiles/default/lib/kde4/libexec:$PATH"++# Set $NIX_SSL_CERT_FILE so that Nixpkgs applications like curl work.+if [ ! -z "${NIX_SSL_CERT_FILE:-}" ]; then+    : # Allow users to override the NIX_SSL_CERT_FILE+elif [ -e /etc/ssl/certs/ca-certificates.crt ]; then # NixOS, Ubuntu, Debian, Gentoo, Arch+    export NIX_SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt+elif [ -e /etc/ssl/ca-bundle.pem ]; then # openSUSE Tumbleweed+    export NIX_SSL_CERT_FILE=/etc/ssl/ca-bundle.pem+elif [ -e /etc/ssl/certs/ca-bundle.crt ]; then # Old NixOS+    export NIX_SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt+elif [ -e /etc/pki/tls/certs/ca-bundle.crt ]; then # Fedora, CentOS+    export NIX_SSL_CERT_FILE=/etc/pki/tls/certs/ca-bundle.crt+else+  # Fall back to what is in the nix profiles, favouring whatever is defined last.+  for i in $NIX_PROFILES; do+    if [ -e $i/etc/ssl/certs/ca-bundle.crt ]; then+      export NIX_SSL_CERT_FILE=$i/etc/ssl/certs/ca-bundle.crt+    fi+  done+fi++export NIX_PATH="nixpkgs=@localstatedir@/nix/profiles/per-user/root/channels/nixpkgs:@localstatedir@/nix/profiles/per-user/root/channels"+export PATH="$HOME/.nix-profile/bin:@localstatedir@/nix/profiles/default/bin:$PATH"
data/nix/scripts/nix-profile.sh.in view
@@ -75,7 +75,7 @@         export NIX_SSL_CERT_FILE="$NIX_LINK/etc/ca-bundle.crt"     fi -    if [ -n "${MANPATH}" ]; then+    if [ -n "${MANPATH-}" ]; then         export MANPATH="$NIX_LINK/share/man:$MANPATH"     fi
data/nix/shell.nix view
@@ -1,6 +1,6 @@ { useClang ? false }: -with import (builtins.fetchGit { url = https://github.com/NixOS/nixpkgs-channels.git; ref = "nixos-18.03"; }) {};+with import (builtins.fetchGit { url = https://github.com/NixOS/nixpkgs-channels.git; ref = "nixos-18.09"; }) {};  with import ./release-common.nix { inherit pkgs; };
data/nix/tests/binary-cache.sh view
@@ -52,9 +52,6 @@ basicTests  -unset _NIX_FORCE_HTTP_BINARY_CACHE_STORE-- # Test whether Nix notices if the NAR doesn't match the hash in the NAR info. clearStore @@ -79,20 +76,31 @@ fi  -# Test whether fallback works if we have cached info but the-# corresponding NAR has disappeared.+# Test whether fallback works if a NAR has disappeared. This does not require --fallback. clearStore -nix-build --substituters "file://$cacheDir" dependencies.nix --dry-run # get info+mv $cacheDir/nar $cacheDir/nar2 -mkdir $cacheDir/tmp-mv $cacheDir/*.nar* $cacheDir/tmp/+nix-build --substituters "file://$cacheDir" --no-require-sigs dependencies.nix -o $TEST_ROOT/result -NIX_DEBUG_SUBST=1 nix-build --substituters "file://$cacheDir" dependencies.nix -o $TEST_ROOT/result --fallback+mv $cacheDir/nar2 $cacheDir/nar -mv $cacheDir/tmp/* $cacheDir/ +# Test whether fallback works if a NAR is corrupted. This does require --fallback.+clearStore +mv $cacheDir/nar $cacheDir/nar2+mkdir $cacheDir/nar+for i in $(cd $cacheDir/nar2 && echo *); do touch $cacheDir/nar/$i; done++(! nix-build --substituters "file://$cacheDir" --no-require-sigs dependencies.nix -o $TEST_ROOT/result)++nix-build --substituters "file://$cacheDir" --no-require-sigs dependencies.nix -o $TEST_ROOT/result --fallback++rm -rf $cacheDir/nar+mv $cacheDir/nar2 $cacheDir/nar++ # Test whether building works if the binary cache contains an # incomplete closure. clearStore@@ -107,6 +115,7 @@  # Create a signed binary cache. clearCache+clearCacheCache  declare -a res=($(nix-store --generate-binary-cache-key test.nixos.org-1 $TEST_ROOT/sk1 $TEST_ROOT/pk1 )) publicKey="$(cat $TEST_ROOT/pk1)"@@ -117,7 +126,7 @@ res=($(nix-store --generate-binary-cache-key foo.nixos.org-1 $TEST_ROOT/sk3 $TEST_ROOT/pk3)) otherKey="$(cat $TEST_ROOT/pk3)" -nix copy --to file://$cacheDir?secret-key=$TEST_ROOT/sk1 $outPath+_NIX_FORCE_HTTP_BINARY_CACHE_STORE= nix copy --to file://$cacheDir?secret-key=$TEST_ROOT/sk1 $outPath   # Downloading should fail if we don't provide a key.
data/nix/tests/brotli.sh view
@@ -1,10 +1,5 @@ source common.sh --# Only test if we found brotli libraries-# (CLI tool is likely unavailable if libraries are missing)-if [ -n "$HAVE_BROTLI" ]; then- clearStore clearCache @@ -24,5 +19,3 @@ HASH2=$(nix hash-path $outPath)  [[ $HASH = $HASH2 ]]--fi # HAVE_BROTLI
data/nix/tests/build-remote.sh view
@@ -11,7 +11,8 @@  nix build -f build-hook.nix -o $TEST_ROOT/result --max-jobs 0 \   --sandbox-paths /nix/store --sandbox-build-dir /build-tmp \-  --builders "$TEST_ROOT/store0; $TEST_ROOT/store1 - - 1 1 foo"+  --builders "$TEST_ROOT/store0; $TEST_ROOT/store1 - - 1 1 foo" \+  --system-features foo  outPath=$TEST_ROOT/result
data/nix/tests/check-refs.sh view
@@ -1,5 +1,7 @@ source common.sh +clearStore+ RESULT=$TEST_ROOT/result  dep=$(nix-build -o $RESULT check-refs.nix -A dep)
data/nix/tests/check-reqs.sh view
@@ -1,5 +1,7 @@ source common.sh +clearStore+ RESULT=$TEST_ROOT/result  nix-build -o $RESULT check-reqs.nix -A test1
data/nix/tests/common.sh.in view
@@ -31,7 +31,6 @@ export SHELL="@bash@" export PAGER=cat export HAVE_SODIUM="@HAVE_SODIUM@"-export HAVE_BROTLI="@HAVE_BROTLI@"  export version=@PACKAGE_VERSION@ export system=@system@@@ -86,19 +85,14 @@     trap "" EXIT } -canUseSandbox() {-    if [[ $(uname) != Linux ]]; then return 1; fi+if [[ $(uname) == Linux ]] && [[ -L /proc/self/ns/user ]] && unshare --user true; then+    _canUseSandbox=1+fi -    if [ ! -L /proc/self/ns/user ]; then-        echo "Kernel doesn't support user namespaces, skipping this test..."+canUseSandbox() {+    if [[ ! $_canUseSandbox ]]; then+        echo "Sandboxing not supported, skipping this test..."         return 1-    fi--    if [ -e /proc/sys/kernel/unprivileged_userns_clone ]; then-        if [ "$(cat /proc/sys/kernel/unprivileged_userns_clone)" != 1 ]; then-            echo "Unprivileged user namespaces disabled by sysctl, skipping this test..."-            return 1-        fi     fi      return 0
data/nix/tests/fetchGit.sh view
@@ -9,7 +9,7 @@  repo=$TEST_ROOT/git -rm -rf $repo ${repo}-tmp $TEST_HOME/.cache/nix/git+rm -rf $repo ${repo}-tmp $TEST_HOME/.cache/nix/gitv2  git init $repo git -C $repo config user.email "foobar@example.com"@@ -129,7 +129,7 @@   # Nuke the cache-rm -rf $TEST_HOME/.cache/nix/git+rm -rf $TEST_HOME/.cache/nix/gitv2  # Try again, but without 'git' on PATH NIX=$(command -v nix)
data/nix/tests/fetchurl.sh view
@@ -18,6 +18,17 @@  cmp $outPath fetchurl.sh +# Now using an SRI hash.+clearStore++hash=$(nix hash-file ./fetchurl.sh)++[[ $hash =~ ^sha256- ]]++outPath=$(nix-build '<nix/fetchurl.nix>' --argstr url file://$(pwd)/fetchurl.sh --argstr hash $hash --no-out-link --hashed-mirrors '')++cmp $outPath fetchurl.sh+ # Test the hashed mirror feature. clearStore
data/nix/tests/hash.sh view
@@ -2,7 +2,7 @@  try () {     printf "%s" "$2" > $TEST_ROOT/vector-    hash=$(nix-hash $EXTRA --flat --type "$1" $TEST_ROOT/vector)+    hash=$(nix hash-file --base16 $EXTRA --type "$1" $TEST_ROOT/vector)     if test "$hash" != "$3"; then         echo "hash $1, expected $3, got $hash"         exit 1@@ -33,6 +33,12 @@ try sha256 "abc" "1b8m03r63zqhnjf7l5wnldhh7c134ap5vpj0850ymkq1iyzicy5s" EXTRA= +EXTRA=--sri+try sha512 "" "sha512-z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg=="+try sha512 "abc" "sha512-3a81oZNherrMQXNJriBBMRLm+k6JqX6iCp7u5ktV05ohkpkqJ0/BqDa6PCOj/uu9RU1EI2Q86A4qmslPpUyknw=="+try sha512 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" "sha512-IEqPxt2oLwoM7XvrjgikFlfBbvRosiioJ5vjMacDwzWW/RXBOxsH+aodO+pXeJygMa2Fx6cd1wNU7GMSOMo0RQ=="+try sha256 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" "sha256-JI1qYdIGOLjlwCaTDD5gOaM85Flk/yFn9uzt1BnbBsE="+ try2 () {     hash=$(nix-hash --type "$1" $TEST_ROOT/hash-path)     if test "$hash" != "$2"; then@@ -65,11 +71,15 @@ try3() {     h64=$(nix to-base64 --type "$1" "$2")     [ "$h64" = "$4" ]+    sri=$(nix to-sri --type "$1" "$2")+    [ "$sri" = "$1-$4" ]     h32=$(nix-hash --type "$1" --to-base32 "$2")     [ "$h32" = "$3" ]     h16=$(nix-hash --type "$1" --to-base16 "$h32")     [ "$h16" = "$2" ]     h16=$(nix to-base16 --type "$1" "$h64")+    [ "$h16" = "$2" ]+    h16=$(nix to-base16 "$sri")     [ "$h16" = "$2" ] } try3 sha1 "800d59cfcd3c05e900cb4e214be48f6b886a08df" "vw46m23bizj4n8afrc0fj19wrp7mj3c0" "gA1Zz808BekAy04hS+SPa4hqCN8="
data/nix/tests/init.sh view
@@ -16,6 +16,7 @@ cat > "$NIX_CONF_DIR"/nix.conf <<EOF build-users-group = keep-derivations = false+sandbox = false include nix.conf.extra EOF
data/nix/tests/lang/eval-okay-arithmetic.exp view
@@ -1,1 +1,1 @@-2188+2216
data/nix/tests/lang/eval-okay-arithmetic.nix view
@@ -26,6 +26,10 @@       (56088 / 123 / 2)       (3 + 4 * const 5 0 - 6 / id 2) +      (builtins.bitAnd 12 10) # 0b1100 & 0b1010 =  8+      (builtins.bitOr  12 10) # 0b1100 | 0b1010 = 14+      (builtins.bitXor 12 10) # 0b1100 ^ 0b1010 =  6+       (if 3 < 7 then 1 else err)       (if 7 < 3 then err else 1)       (if 3 < 3 then err else 1)
data/nix/tests/lang/eval-okay-builtins-add.exp view
@@ -1,1 +1,1 @@-[ 5 4 "int" "tt" "float" 4.0 ]+[ 5 4 "int" "tt" "float" 4 ]
data/nix/tests/local.mk view
@@ -25,7 +25,8 @@   pure-eval.sh \   check.sh \   plugins.sh \-  search.sh+  search.sh \+  nix-copy-ssh.sh   # parallel.sh  install-tests += $(foreach x, $(nix_tests), tests/$(x))
data/nix/tests/nix-shell.sh view
@@ -4,11 +4,18 @@  # Test nix-shell -A export IMPURE_VAR=foo+export SELECTED_IMPURE_VAR=baz export NIX_BUILD_SHELL=$SHELL output=$(nix-shell --pure shell.nix -A shellDrv --run \     'echo "$IMPURE_VAR - $VAR_FROM_STDENV_SETUP - $VAR_FROM_NIX"')  [ "$output" = " - foo - bar" ]++# Test --keep+output=$(nix-shell --pure --keep SELECTED_IMPURE_VAR shell.nix -A shellDrv --run \+    'echo "$IMPURE_VAR - $VAR_FROM_STDENV_SETUP - $VAR_FROM_NIX - $SELECTED_IMPURE_VAR"')++[ "$output" = " - foo - bar - baz" ]  # Test nix-shell on a .drv [[ $(nix-shell --pure $(nix-instantiate shell.nix -A shellDrv) --run \
data/nix/tests/plugins/plugintest.cc view
@@ -1,16 +1,21 @@-#include "globals.hh"+#include "config.hh" #include "primops.hh"  using namespace nix; -static BaseSetting<bool> settingSet{false, "setting-set",+struct MySettings : Config+{+    Setting<bool> settingSet{this, false, "setting-set",         "Whether the plugin-defined setting was set"};+}; -static RegisterSetting rs(&settingSet);+MySettings mySettings; +static GlobalConfig::Register rs(&mySettings);+ static void prim_anotherNull (EvalState & state, const Pos & pos, Value ** args, Value & v) {-    if (settingSet)+    if (mySettings.settingSet)         mkNull(v);     else         mkBool(v, false);
data/nix/tests/remote-builds.nix view
@@ -8,8 +8,8 @@  let -  # The configuration of the build slaves.-  slave =+  # The configuration of the remote builders.+  builder =     { config, pkgs, ... }:     { services.openssh.enable = true;       virtualisation.writableStore = true;@@ -36,21 +36,21 @@ {    nodes =-    { slave1 = slave;-      slave2 = slave;+    { builder1 = builder;+      builder2 = builder;        client =         { config, pkgs, ... }:         { nix.maxJobs = 0; # force remote building           nix.distributedBuilds = true;           nix.buildMachines =-            [ { hostName = "slave1";+            [ { hostName = "builder1";                 sshUser = "root";                 sshKey = "/root/.ssh/id_ed25519";                 system = "i686-linux";                 maxJobs = 1;               }-              { hostName = "slave2";+              { hostName = "builder2";                 sshUser = "root";                 sshKey = "/root/.ssh/id_ed25519";                 system = "i686-linux";@@ -75,33 +75,33 @@       $client->copyFileFromHost("key", "/root/.ssh/id_ed25519");       $client->succeed("chmod 600 /root/.ssh/id_ed25519"); -      # Install the SSH key on the slaves.+      # Install the SSH key on the builders.       $client->waitForUnit("network.target");-      foreach my $slave ($slave1, $slave2) {-          $slave->succeed("mkdir -p -m 700 /root/.ssh");-          $slave->copyFileFromHost("key.pub", "/root/.ssh/authorized_keys");-          $slave->waitForUnit("sshd");-          $client->succeed("ssh -o StrictHostKeyChecking=no " . $slave->name() . " 'echo hello world'");+      foreach my $builder ($builder1, $builder2) {+          $builder->succeed("mkdir -p -m 700 /root/.ssh");+          $builder->copyFileFromHost("key.pub", "/root/.ssh/authorized_keys");+          $builder->waitForUnit("sshd");+          $client->succeed("ssh -o StrictHostKeyChecking=no " . $builder->name() . " 'echo hello world'");       } -      # Perform a build and check that it was performed on the slave.+      # Perform a build and check that it was performed on the builder.       my $out = $client->succeed(         "nix-build ${expr nodes.client.config 1} 2> build-output",         "grep -q Hello build-output"       );-      $slave1->succeed("test -e $out");+      $builder1->succeed("test -e $out");        # And a parallel build.       my ($out1, $out2) = split /\s/,           $client->succeed('nix-store -r $(nix-instantiate ${expr nodes.client.config 2})\!out $(nix-instantiate ${expr nodes.client.config 3})\!out');-      $slave1->succeed("test -e $out1 -o -e $out2");-      $slave2->succeed("test -e $out1 -o -e $out2");+      $builder1->succeed("test -e $out1 -o -e $out2");+      $builder2->succeed("test -e $out1 -o -e $out2");        # And a failing build.       $client->fail("nix-build ${expr nodes.client.config 5}"); -      # Test whether the build hook automatically skips unavailable slaves.-      $slave1->block;+      # Test whether the build hook automatically skips unavailable builders.+      $builder1->block;       $client->succeed("nix-build ${expr nodes.client.config 4}");     '';
data/nix/tests/restricted.sh view
@@ -38,3 +38,14 @@ nix-instantiate --eval --restrict-eval $TEST_ROOT/restricted.nix -I $TEST_ROOT -I .  [[ $(nix eval --raw --restrict-eval -I . '(builtins.readFile "${import ./simple.nix}/hello")') == 'Hello World!' ]]++# Check whether we can leak symlink information through directory traversal.+traverseDir="$(pwd)/restricted-traverse-me"+ln -sfn "$(pwd)/restricted-secret" "$(pwd)/restricted-innocent"+mkdir -p "$traverseDir"+goUp="..$(echo "$traverseDir" | sed -e 's,[^/]\+,..,g')"+output="$(nix eval --raw --restrict-eval -I "$traverseDir" \+    "(builtins.readFile \"$traverseDir/$goUp$(pwd)/restricted-innocent\")" \+    2>&1 || :)"+echo "$output" | grep "is forbidden"+! echo "$output" | grep -F restricted-secret
data/nix/tests/search.sh view
@@ -30,7 +30,7 @@ (( $(nix search nosuchpackageexists | wc -l) == 0 ))  # Search for multiple arguments-(( $(nix search hello empty | wc -l) == 5 ))+(( $(nix search hello empty | wc -l) == 3 ))  # Multiple arguments will not exist (( $(nix search hello broken | wc -l) == 0 ))
data/nix/tests/signing.sh view
@@ -62,6 +62,10 @@ nix verify $outPathCA nix verify $outPathCA --sigs-needed 1000 +# Check that signing a content-addressed path doesn't overflow validSigs+nix sign-paths --key-file $TEST_ROOT/sk1 $outPathCA+nix verify -r $outPathCA --sigs-needed 1000 --trusted-public-keys $pk1+ # Copy to a binary cache. nix copy --to file://$cacheDir $outPath2
data/nix/version view
@@ -1,1 +1,1 @@-2.1+2.3
hnix.cabal view
@@ -1,11 +1,5 @@--- This file has been generated from package.yaml by hpack version 0.27.0.------ see: https://github.com/sol/hpack------ hash: ba0f61f8a049f6970ff03fd924cfed6fc1251eceb90547c1be8051226c453632- name:           hnix-version:        0.5.2+version:        0.6.0 synopsis:       Haskell implementation of the Nix language description:    Haskell implementation of the Nix language. category:       System, Data, Nix@@ -17,7 +11,6 @@ license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10- extra-source-files:     data/let-comments-multiline.nix     data/let-comments.nix@@ -401,12 +394,12 @@     data/simple-pretty.nix     data/simple.nix     LICENSE-    package.yaml     README.md     tests/eval-compare/builtins.split-01.nix     tests/eval-compare/builtins.split-02.nix     tests/eval-compare/builtins.split-03.nix     tests/eval-compare/builtins.split-04.nix+    tests/eval-compare/builtins.string.store.nix     tests/eval-compare/ind-string-01.nix     tests/eval-compare/ind-string-02.nix     tests/eval-compare/ind-string-03.nix@@ -439,17 +432,14 @@   manual: True   default: False -flag tracing-  description: Enable full debug tracing-  manual: True-  default: False- library   exposed-modules:       Nix       Nix.Atoms       Nix.Builtins       Nix.Cache+      Nix.Cited+      Nix.Cited.Basic       Nix.Context       Nix.Convert       Nix.Effects@@ -460,6 +450,9 @@       Nix.Expr.Types       Nix.Expr.Types.Annotated       Nix.Frames+      Nix.Fresh+      Nix.Fresh.Basic+      Nix.Json       Nix.Lint       Nix.Normal       Nix.Options@@ -469,15 +462,20 @@       Nix.Render       Nix.Render.Frame       Nix.Scope+      Nix.String       Nix.Strings       Nix.TH       Nix.Thunk+      Nix.Thunk.Basic+      Nix.Thunk.Standard       Nix.Type.Assumption       Nix.Type.Env       Nix.Type.Infer       Nix.Type.Type       Nix.Utils       Nix.Value+      Nix.Value.Equal+      Nix.Var       Nix.XML   other-modules:       Paths_hnix@@ -486,30 +484,37 @@   ghc-options: -Wall   build-depends:       aeson-    , ansi-wl-pprint     , array >=0.4 && <0.6     , base >=4.9 && <5     , binary     , bytestring+    , comonad     , containers     , data-fix     , deepseq >=1.4.2 && <1.5+    , dependent-sum     , deriving-compat >=0.3 && <0.6     , directory     , exceptions     , filepath+    , free     , hashing+    , hnix-store-core     , http-client     , http-client-tls     , http-types     , interpolate     , lens-family-th     , logict-    , megaparsec >=6.5 && <7.0+    , megaparsec >=7.0 && <7.1+    , monad-control     , monadlist     , mtl     , optparse-applicative+    , parser-combinators+    , prettyprinter     , process+    , ref-tf     , regex-tdfa     , regex-tdfa-text     , scientific@@ -521,14 +526,13 @@     , these     , time     , transformers+    , transformers-base     , unix     , unordered-containers >=0.2.9 && <0.3     , vector     , xml   if flag(optimize)     ghc-options: -fexpose-all-unfoldings -fspecialise-aggressively -O2-  if flag(tracing)-    cpp-options: -DENABLE_TRACING=1   if os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)     build-depends:         compact@@ -548,9 +552,9 @@     build-depends:         lens-family >=1.2.2       , lens-family-core >=1.2.2-  if impl(ghc < 8.4.0) && !flag(profiling)-    build-depends:-        ghc-datasize+  -- if impl(ghc < 8.4.0) && !flag(profiling)+  --   build-depends:+  --       ghc-datasize   if impl(ghcjs)     build-depends:         hashable >=1.2.4 && <1.3@@ -570,12 +574,12 @@       Paths_hnix   hs-source-dirs:       main-  ghc-options: -Wall+  ghc-options: -Wall -rtsopts   build-depends:       aeson-    , ansi-wl-pprint     , base >=4.9 && <5     , bytestring+    , comonad     , containers     , data-fix     , deepseq >=1.4.2 && <1.5@@ -587,6 +591,8 @@     , mtl     , optparse-applicative     , pretty-show+    , prettyprinter+    , ref-tf     , repline     , template-haskell     , text@@ -595,8 +601,6 @@     , unordered-containers >=0.2.9 && <0.3   if flag(optimize)     ghc-options: -fexpose-all-unfoldings -fspecialise-aggressively -O2-  if flag(tracing)-    cpp-options: -DENABLE_TRACING=1   if os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)     build-depends:         compact@@ -632,12 +636,12 @@   build-depends:       Diff     , Glob-    , ansi-wl-pprint     , base >=4.9 && <5     , bytestring     , containers     , data-fix     , deepseq >=1.4.2 && <1.5+    , dependent-sum     , directory     , exceptions     , filepath@@ -646,10 +650,11 @@     , hedgehog     , hnix     , interpolate-    , megaparsec+    , megaparsec >=7.0 && <7.1     , mtl     , optparse-applicative     , pretty-show+    , prettyprinter     , process     , split     , tasty@@ -665,8 +670,6 @@     , unordered-containers >=0.2.9 && <0.3   if flag(optimize)     ghc-options: -fexpose-all-unfoldings -fspecialise-aggressively -O2-  if flag(tracing)-    cpp-options: -DENABLE_TRACING=1   if os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)     build-depends:         compact@@ -683,7 +686,6 @@   else     buildable: True   default-language: Haskell2010-  build-tool-depends: hspec-discover:hspec-discover == 2.*  benchmark hnix-benchmarks   type: exitcode-stdio-1.0@@ -695,8 +697,7 @@       benchmarks   ghc-options: -Wall   build-depends:-      ansi-wl-pprint-    , base >=4.9 && <5+      base >=4.9 && <5     , bytestring     , containers     , criterion@@ -715,8 +716,6 @@     , unordered-containers >=0.2.9 && <0.3   if flag(optimize)     ghc-options: -fexpose-all-unfoldings -fspecialise-aggressively -O2-  if flag(tracing)-    cpp-options: -DENABLE_TRACING=1   if os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)     build-depends:         compact
main/Main.hs view
@@ -4,218 +4,223 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}  module Main where -import qualified Control.DeepSeq as Deep-import qualified Control.Exception as Exc+import           Control.Comonad                ( extract )+import qualified Control.DeepSeq               as Deep+import qualified Control.Exception             as Exc import           Control.Monad import           Control.Monad.Catch import           Control.Monad.IO.Class -- import           Control.Monad.ST-import qualified Data.Aeson.Encoding as A-import qualified Data.Aeson.Text as A-import qualified Data.HashMap.Lazy as M-import qualified Data.Map as Map-import           Data.List (sortOn)-import           Data.Maybe (fromJust)+import qualified Data.Aeson.Text               as A+import qualified Data.HashMap.Lazy             as M+import qualified Data.Map                      as Map+import           Data.List                      ( sortOn )+import           Data.Maybe                     ( fromJust ) import           Data.Time-import qualified Data.Text as Text-import qualified Data.Text.IO as Text-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text                     as Text+import qualified Data.Text.IO                  as Text+import qualified Data.Text.Lazy.IO             as TL+import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Text import           Nix import           Nix.Convert-import qualified Nix.Eval as Eval+import qualified Nix.Eval                      as Eval+import           Nix.Json -- import           Nix.Lint import           Nix.Options.Parser-import qualified Nix.Type.Env as Env-import qualified Nix.Type.Infer as HM+import           Nix.Thunk.Basic+import           Nix.Thunk.Standard+import qualified Nix.Type.Env                  as Env+import qualified Nix.Type.Infer                as HM import           Nix.Utils-import           Options.Applicative hiding (ParserResult(..))+import           Nix.Var+import           Options.Applicative     hiding ( ParserResult(..) ) import qualified Repl import           System.FilePath import           System.IO-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))-import qualified Text.Show.Pretty as PS+import qualified Text.Show.Pretty              as PS  main :: IO () main = do-    time <- liftIO getCurrentTime-    opts <- execParser (nixOptionsInfo time)-    runLazyM opts $ case readFrom opts of-        Just path -> do-            let file = addExtension (dropExtension path) "nix"-            process opts (Just file) =<< liftIO (readCache path)-        Nothing -> case expression opts of-            Just s -> handleResult opts Nothing (parseNixTextLoc s)-            Nothing  -> case fromFile opts of-                Just "-" ->-                    mapM_ (processFile opts)-                        =<< (lines <$> liftIO getContents)-                Just path ->-                    mapM_ (processFile opts)-                        =<< (lines <$> liftIO (readFile path))-                Nothing -> case filePaths opts of-                    [] -> Repl.shell (pure ())-                    ["-"] ->-                        handleResult opts Nothing . parseNixTextLoc-                            =<< liftIO Text.getContents-                    paths ->-                        mapM_ (processFile opts) paths-  where-    processFile opts path = do-        eres <- parseNixFileLoc path-        handleResult opts (Just path) eres--    handleResult opts mpath = \case-        Failure err ->-            (if ignoreErrors opts-             then liftIO . hPutStrLn stderr-             else errorWithoutStackTrace) $ "Parse failed: " ++ show err--        Success expr -> do-            when (check opts) $ do-                expr' <- liftIO (reduceExpr mpath expr)-                case HM.inferTop Env.empty [("it", stripAnnotation expr')] of-                    Left err ->-                        errorWithoutStackTrace $ "Type error: " ++ PS.ppShow err-                    Right ty ->-                        liftIO $ putStrLn $ "Type of expression: "-                            ++ PS.ppShow (fromJust (Map.lookup "it" (Env.types ty)))--                -- liftIO $ putStrLn $ runST $-                --     runLintM opts . renderSymbolic =<< lint opts expr--            catch (process opts mpath expr) $ \case-                NixException frames ->-                    errorWithoutStackTrace . show-                        =<< renderFrames @(NThunk (Lazy IO)) frames--            when (repl opts) $ Repl.shell (pure ())--    process opts mpath expr-        | evaluate opts, tracing opts =-              evaluateExpression mpath-                  Nix.nixTracingEvalExprLoc printer expr--        | evaluate opts, Just path <- reduce opts =-              evaluateExpression mpath (reduction path) printer expr--        | evaluate opts, not (null (arg opts) && null (argstr opts)) =-              evaluateExpression mpath-                  Nix.nixEvalExprLoc printer expr--        | evaluate opts =-              processResult printer =<< Nix.nixEvalExprLoc mpath expr+  time <- getCurrentTime+  opts <- execParser (nixOptionsInfo time)+  runStandardIO opts $ case readFrom opts of+    Just path -> do+      let file = addExtension (dropExtension path) "nixc"+      process opts (Just file) =<< liftIO (readCache path)+    Nothing -> case expression opts of+      Just s  -> handleResult opts Nothing (parseNixTextLoc s)+      Nothing -> case fromFile opts of+        Just "-" -> mapM_ (processFile opts) =<< (lines <$> liftIO getContents)+        Just path ->+          mapM_ (processFile opts) =<< (lines <$> liftIO (readFile path))+        Nothing -> case filePaths opts of+          [] -> withNixContext Nothing $ Repl.main+          ["-"] ->+            handleResult opts Nothing+              .   parseNixTextLoc+              =<< liftIO Text.getContents+          paths -> mapM_ (processFile opts) paths+ where+  processFile opts path = do+    eres <- parseNixFileLoc path+    handleResult opts (Just path) eres -        | xml opts =-              error "Rendering expression trees to XML is not yet implemented"+  handleResult opts mpath = \case+    Failure err ->+      (if ignoreErrors opts+          then liftIO . hPutStrLn stderr+          else errorWithoutStackTrace+        )+        $  "Parse failed: "+        ++ show err -        | json opts =-              liftIO $ TL.putStrLn $-                  A.encodeToLazyText (stripAnnotation expr)+    Success expr -> do+      when (check opts) $ do+        expr' <- liftIO (reduceExpr mpath expr)+        case HM.inferTop Env.empty [("it", stripAnnotation expr')] of+          Left  err -> errorWithoutStackTrace $ "Type error: " ++ PS.ppShow err+          Right ty  -> liftIO $ putStrLn $ "Type of expression: " ++ PS.ppShow+            (fromJust (Map.lookup "it" (Env.types ty))) -        | verbose opts >= DebugInfo =-              liftIO $ putStr $ PS.ppShow $ stripAnnotation expr+          -- liftIO $ putStrLn $ runST $+          --     runLintM opts . renderSymbolic =<< lint opts expr -        | cache opts, Just path <- mpath =-              liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr+      catch (process opts mpath expr) $ \case+        NixException frames ->+          errorWithoutStackTrace+            .   show+            =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames -        | parseOnly opts =-              void $ liftIO $ Exc.evaluate $ Deep.force expr+      when (repl opts) $ withNixContext Nothing $ Repl.main -        | otherwise =-              liftIO $ displayIO stdout-                  . renderPretty 0.4 80-                  . prettyNix-                  . stripAnnotation $ expr-      where-        printer :: forall e m. (MonadNix e m, MonadIO m, Typeable m)-                => NValue m -> m ()-        printer-            | finder opts =-              fromValue @(AttrSet (NThunk m)) >=> findAttrs-            | xml opts =-              liftIO . putStrLn . toXML <=< normalForm-            | json opts =-              liftIO . TL.putStrLn-                     . TL.decodeUtf8-                     . A.encodingToLazyByteString-                     . toEncodingSorted-                     <=< fromNix-            | strict opts =-              liftIO . print . prettyNValueNF <=< normalForm-            | values opts  =-              liftIO . print <=< prettyNValueProv-            | otherwise  =-              liftIO . print <=< prettyNValue-          where-            findAttrs = go ""-              where-                go prefix s = do-                    xs <- forM (sortOn fst (M.toList s))-                        $ \(k, nv@(NThunk _ t)) -> case t of-                            Value v -> pure (k, Just v)-                            Thunk _ _ ref -> do-                                let path = prefix ++ Text.unpack k-                                    (_, descend) = filterEntry path k-                                val <- readVar ref-                                case val of-                                    Computed _ -> pure (k, Nothing)-                                    _ | descend   -> (k,) <$> forceEntry path nv-                                      | otherwise -> pure (k, Nothing)+  process opts mpath expr+    | evaluate opts+    , tracing opts+    = evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr+    | evaluate opts+    , Just path <- reduce opts+    = evaluateExpression mpath (reduction path) printer expr+    | evaluate opts+    , not (null (arg opts) && null (argstr opts))+    = evaluateExpression mpath Nix.nixEvalExprLoc printer expr+    | evaluate opts+    = processResult printer =<< Nix.nixEvalExprLoc mpath expr+    | xml opts+    = error "Rendering expression trees to XML is not yet implemented"+    | json opts+    = liftIO $ TL.putStrLn $ A.encodeToLazyText (stripAnnotation expr)+    | verbose opts >= DebugInfo+    = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr+    | cache opts+    , Just path <- mpath+    = liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr+    | parseOnly opts+    = void $ liftIO $ Exc.evaluate $ Deep.force expr+    | otherwise+    = liftIO+      $ renderIO stdout+      . layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)+      . prettyNix+      . stripAnnotation+      $ expr+   where+    printer+      | finder opts+      = fromValue @(AttrSet (StandardThunk IO)) >=> findAttrs+      | xml opts+      = liftIO+        .   putStrLn+        .   Text.unpack+        .   principledStringIgnoreContext+        .   toXML+        <=< normalForm+      | json opts+      = liftIO+        .   Text.putStrLn+        .   principledStringIgnoreContext+        <=< nvalueToJSONNixString+      | strict opts+      = liftIO . print . prettyNValueNF <=< normalForm+      | values opts+      = liftIO . print <=< prettyNValueProv+      | otherwise+      = liftIO . print <=< prettyNValue+     where+      findAttrs = go ""+       where+        go prefix s = do+          xs <-+            forM (sortOn fst (M.toList s))+              $ \(k, nv@(StdThunk (extract -> t))) -> case t of+                  Value v       -> pure (k, Just v)+                  Thunk _ _ ref -> do+                    let path         = prefix ++ Text.unpack k+                        (_, descend) = filterEntry path k+                    val <- readVar @(StandardT IO) ref+                    case val of+                      Computed _ -> pure (k, Nothing)+                      _ | descend   -> (k, ) <$> forceEntry path nv+                        | otherwise -> pure (k, Nothing) -                    forM_ xs $ \(k, mv) -> do-                        let path = prefix ++ Text.unpack k-                            (report, descend) = filterEntry path k-                        when report $ do-                            liftIO $ putStrLn path-                            when descend $ case mv of-                                Nothing -> return ()-                                Just v -> case v of-                                    NVSet s' _ -> go (path ++ ".") s'-                                    _ -> return ()-                  where-                    filterEntry path k = case (path, k) of-                        ("stdenv", "stdenv")           -> (True,  True)-                        (_,        "stdenv")           -> (False, False)-                        (_,        "out")              -> (True,  False)-                        (_,        "src")              -> (True,  False)-                        (_,        "mirrorsFile")      -> (True,  False)-                        (_,        "buildPhase")       -> (True,  False)-                        (_,        "builder")          -> (False,  False)-                        (_,        "drvPath")          -> (False,  False)-                        (_,        "outPath")          -> (False,  False)-                        (_,        "__impureHostDeps") -> (False,  False)-                        (_,        "__sandboxProfile") -> (False,  False)-                        ("pkgs",   "pkgs")             -> (True,  True)-                        (_,        "pkgs")             -> (False, False)-                        (_,        "drvAttrs")         -> (False, False)-                        _ -> (True, True)+          forM_ xs $ \(k, mv) -> do+            let path              = prefix ++ Text.unpack k+                (report, descend) = filterEntry path k+            when report $ do+              liftIO $ putStrLn path+              when descend $ case mv of+                Nothing -> return ()+                Just v  -> case v of+                  NVSet s' _ -> go (path ++ ".") s'+                  _          -> return ()+         where+          filterEntry path k = case (path, k) of+            ("stdenv", "stdenv"          ) -> (True, True)+            (_       , "stdenv"          ) -> (False, False)+            (_       , "out"             ) -> (True, False)+            (_       , "src"             ) -> (True, False)+            (_       , "mirrorsFile"     ) -> (True, False)+            (_       , "buildPhase"      ) -> (True, False)+            (_       , "builder"         ) -> (False, False)+            (_       , "drvPath"         ) -> (False, False)+            (_       , "outPath"         ) -> (False, False)+            (_       , "__impureHostDeps") -> (False, False)+            (_       , "__sandboxProfile") -> (False, False)+            ("pkgs"  , "pkgs"            ) -> (True, True)+            (_       , "pkgs"            ) -> (False, False)+            (_       , "drvAttrs"        ) -> (False, False)+            _                              -> (True, True) -                    forceEntry k v = catch (Just <$> force v pure)-                        $ \(NixException frames) -> do-                              liftIO . putStrLn-                                     . ("Exception forcing " ++)-                                     . (k ++)-                                     . (": " ++) . show-                                  =<< renderFrames @(NThunk (Lazy IO)) frames-                              return Nothing+          forceEntry k v =+            catch (Just <$> force v pure) $ \(NixException frames) -> do+              liftIO+                .   putStrLn+                .   ("Exception forcing " ++)+                .   (k ++)+                .   (": " ++)+                .   show+                =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames+              return Nothing -    reduction path mp x = do-        eres <- Nix.withNixContext mp $-            Nix.reducingEvalExpr (Eval.eval . annotated . getCompose) mp x-        handleReduced path eres+  reduction path mp x = do+    eres <- Nix.withNixContext mp+      $ Nix.reducingEvalExpr (Eval.eval . annotated . getCompose) mp x+    handleReduced path eres -    handleReduced :: (MonadThrow m, MonadIO m)-                  => FilePath-                  -> (NExprLoc, Either SomeException (NValue m))-                  -> m (NValue m)-    handleReduced path (expr', eres) = do-        liftIO $ do-            putStrLn $ "Wrote winnowed expression tree to " ++ path-            writeFile path $ show $ prettyNix (stripAnnotation expr')-        case eres of-            Left err -> throwM err-            Right v  -> return v+  handleReduced+    :: (MonadThrow m, MonadIO m)+    => FilePath+    -> (NExprLoc, Either SomeException (NValue t f m))+    -> m (NValue t f m)+  handleReduced path (expr', eres) = do+    liftIO $ do+      putStrLn $ "Wrote winnowed expression tree to " ++ path+      writeFile path $ show $ prettyNix (stripAnnotation expr')+    case eres of+      Left  err -> throwM err+      Right v   -> return v
main/Repl.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -21,22 +22,33 @@  module Repl where -import           Nix+import           Nix                     hiding ( exec+                                                , try+                                                )+import           Nix.Cited import           Nix.Convert import           Nix.Eval import           Nix.Scope-import qualified Nix.Type.Env as Env+import qualified Nix.Type.Env                  as Env import           Nix.Type.Infer import           Nix.Utils -import qualified Data.HashMap.Lazy as M-import           Data.List (isPrefixOf, foldl')-import qualified Data.Map as Map+import           Control.Comonad+import qualified Data.HashMap.Lazy             as M+import           Data.List                      ( isPrefixOf+                                                , foldl'+                                                )+import qualified Data.Map                      as Map import           Data.Monoid-import           Data.Text (unpack, pack)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+import           Data.Text                      ( unpack+                                                , pack+                                                )+import qualified Data.Text                     as Text+import qualified Data.Text.IO                  as Text+import           Data.Version                   ( showVersion )+import           Paths_hnix                     ( version ) +import           Control.Monad.Catch import           Control.Monad.Identity import           Control.Monad.Reader import           Control.Monad.State.Strict@@ -46,23 +58,36 @@ import           System.Environment import           System.Exit ++main :: (MonadNix e t f m, MonadIO m, MonadException m) => m ()+main = flip evalStateT initState+#if MIN_VERSION_repline(0, 2, 0)+    $ evalRepl (return prefix) cmd options (Just ':') completer welcomeText+#else+    $ evalRepl prefix cmd options completer welcomeText+#endif+ where+  prefix = "hnix> "+  welcomeText =+    liftIO+      $  putStrLn+      $  "Welcome to hnix "+      <> showVersion version+      <> ". For help type :help\n"+ ------------------------------------------------------------------------------- -- Types ------------------------------------------------------------------------------- -data TermEnv--data IState = IState-  { -- tyctx :: Env.Env  -- Type environment-  -- ,-    tmctx :: TermEnv  -- Value environment+newtype IState t f m = IState+  { tmctx :: AttrSet (NValue t f m)  -- Value environment   } -initState :: IState-initState = IState {-Env.empty-} undefined+initState :: MonadIO m => IState t f m+initState = IState M.empty -type Repl e m a = HaskelineT (StateT IState m) a-hoistErr :: MonadIO m => Result a -> Repl e m a+type Repl e t f m = HaskelineT (StateT (IState t f m) m)+hoistErr :: MonadIO m => Result a -> Repl e t f m a hoistErr (Success val) = return val hoistErr (Failure err) = do   liftIO $ print err@@ -72,75 +97,85 @@ -- Execution ------------------------------------------------------------------------------- -exec :: forall e m. (MonadNix e m, MonadIO m, MonadException m)-     => Bool -> Text.Text -> Repl e m ()+exec+  :: forall e t f m+   . (MonadNix e t f m, MonadIO m, MonadException m)+  => Bool+  -> Text.Text+  -> Repl e t f m (NValue t f m) exec update source = do   -- Get the current interpreter state-  st <- get+  st   <- get    -- Parser ( returns AST )+  -- TODO: parse <var> = <expr>   expr <- hoistErr $ parseNixTextLoc source    -- Type Inference ( returns Typing Environment )   -- tyctx' <- hoistErr $ inferTop (tyctx st) expr -  -- Create the new environment-  let st' = st { tmctx = tmctx st -- foldl' evalDef (tmctx st) expr-               -- , tyctx = tyctx' <> tyctx st-               }+  -- TODO: track scope with (tmctx st)+  mVal <- lift $ lift $ try $ pushScope @t M.empty (evalExprLoc expr) -  -- Update the interpreter state-  when update (put st')+  case mVal of+    Left (NixException frames) -> do+      lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames+      abort+    Right val -> do+      -- Update the interpreter state+      when update $ do+        -- Create the new environment+        put st { tmctx = tmctx st } -- TODO: M.insert key val (tmctx st)+      return val -  -- If a value is entered, print it.++cmd+  :: (MonadNix e t f m, MonadIO m, MonadException m)+  => String+  -> Repl e t f m ()+cmd source = do+  val <- exec True (Text.pack source)   lift $ lift $ do-    -- jww (2018-04-12): Once the user is able to establish definitions in-    -- the repl, they should be passed here.-    pushScope @(NThunk m) M.empty $ catch (go expr) $ \case-      NixException frames -> do-        liftIO . print =<< renderFrames @(NThunk m) frames- where-  go expr = do-    val <- evalExprLoc expr     opts :: Nix.Options <- asks (view hasLens)-    if | strict opts ->-         liftIO . print . prettyNValueNF =<< normalForm val-       | values opts ->-         liftIO . print =<< prettyNValueProv val-       | otherwise ->-         liftIO . print =<< prettyNValue val--cmd :: (MonadNix e m, MonadIO m, MonadException m) => String -> Repl e m ()-cmd source = exec True (Text.pack source)-+    if+      | strict opts -> liftIO . print . prettyNValueNF =<< normalForm val+      | values opts -> liftIO . print =<< prettyNValueProv val+      | otherwise   -> liftIO . print =<< prettyNValue val ------------------------------------------------------------------------------- -- Commands -------------------------------------------------------------------------------  -- :browse command-browse :: MonadNix e m => [String] -> Repl e m ()+browse :: MonadNix e t f m => [String] -> Repl e t f m () browse _ = do   st <- get   undefined   -- liftIO $ mapM_ putStrLn $ ppenv (tyctx st)  -- :load command-load :: (MonadNix e m, MonadIO m, MonadException m) => [String] -> Repl e m ()+load+  :: (MonadNix e t f m, MonadIO m, MonadException m)+  => [String]+  -> Repl e t f m () load args = do   contents <- liftIO $ Text.readFile (unwords args)-  exec True contents+  void $ exec True contents  -- :type command--- typeof :: [String] -> Repl e m ()--- typeof args = do---   st <- get---   let arg = unwords args---   case Env.lookup (pack arg) (tyctx st) of---     Just val -> liftIO $ putStrLn $ undefined -- ppsignature (arg, val)---     Nothing -> exec False (Text.pack arg)+typeof+  :: (MonadNix e t f m, MonadException m, MonadIO m)+  => [String]+  -> Repl e t f m ()+typeof args = do+  st  <- get+  val <- case M.lookup line (tmctx st) of+    Just val -> return val+    Nothing  -> exec False line+  liftIO $ putStrLn $ describeValue . valueType . extract . _nValue $ val+  where line = Text.pack (unwords args)  -- :quit command-quit :: (MonadNix e m, MonadIO m) => a -> Repl e m ()+quit :: (MonadNix e t f m, MonadIO m) => a -> Repl e t f m () quit _ = liftIO exitSuccess  -------------------------------------------------------------------------------@@ -149,48 +184,46 @@  -- Prefix tab completer defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]-defaultMatcher = [-    (":load"  , fileCompleter)+defaultMatcher =+  [(":load", fileCompleter)   --, (":type"  , values)-  ]+                           ]  -- Default tab completer-comp :: (Monad m, MonadState IState m) => WordCompleter m+comp :: Monad m => WordCompleter m comp n = do   let cmds = [":load", ":type", ":browse", ":quit"]   -- Env.TypeEnv ctx <- gets tyctx   -- let defs = map unpack $ Map.keys ctx-  return $ filter (isPrefixOf n) (cmds {-++ defs-})+  return $ filter (isPrefixOf n) (cmds {-++ defs-}+                                      ) -options :: (MonadNix e m, MonadIO m, MonadException m)-        => [(String, [String] -> Repl e m ())]-options = [-    ("load"   , load)-  , ("browse" , browse)-  , ("quit"   , quit)-  -- , ("type"   , Repl.typeof)+options+  :: (MonadNix e t f m, MonadIO m, MonadException m)+  => [(String, [String] -> Repl e t f m ())]+options =+  [ ( "load"+    , load+    )+  --, ("browse" , browse)+  , ("quit", quit)+  , ("type", typeof)+  , ("help", help)   ] ----------------------------------------------------------------------------------- Entry Point--------------------------------------------------------------------------------+help+  :: forall e t f m+   . (MonadNix e t f m, MonadIO m, MonadException m)+  => [String]+  -> Repl e t f m ()+help _ = liftIO $ do+  putStrLn "Available commands:\n"+  mapM_ putStrLn $ map (\o -> ":" ++ (fst o)) (options @e @t @f @m) -completer :: (MonadNix e m, MonadIO m) => CompleterStyle (StateT IState m)+completer+  :: (MonadNix e t f m, MonadIO m)+  => CompleterStyle (StateT (IState t f m) m) completer = Prefix (wordCompleter comp) defaultMatcher -shell :: (MonadNix e m, MonadIO m, MonadException m) => Repl e m a -> m ()-shell pre = flip evalStateT initState $-    evalRepl "hnix> " cmd options completer pre ----------------------------------------------------------------------------------- Toplevel-------------------------------------------------------------------------------- --- main :: IO ()--- main = do---   args <- getArgs---   case args of---     []      -> shell (return ())---     [fname] -> shell (load [fname])---     ["test", fname] -> shell (load [fname] >> browse [] >> quit ())---     _ -> putStrLn "invalid arguments"
− package.yaml 
@@ -1,214 +0,0 @@-name:       hnix-version:    0.5.2-synopsis:   Haskell implementation of the Nix language-github:     haskell-nix/hnix-author:     John Wiegley-maintainer: johnw@newartisans.com-category:   System, Data, Nix-license:    BSD3--description:-  Haskell implementation of the Nix language.--extra-source-files:-  - LICENSE-  - README.md-  - package.yaml-  - data/*-  - data/nix/*-  - data/nix/corepkgs/*-  - data/nix/config/*-  - data/nix/perl/*-  - data/nix/perl/lib/Nix/*-  - data/nix/tests/*-  - data/nix/tests/plugins/*-  - data/nix/tests/lang/*-  - data/nix/tests/lang/readDir/*-  - data/nix/tests/lang/readDir/foo/*-  - data/nix/tests/lang/dir2/*-  - data/nix/tests/lang/dir4/*-  - data/nix/tests/lang/dir3/*-  - data/nix/tests/lang/dir1/*-  - data/nix/maintainers/*-  - data/nix/mk/*-  - data/nix/scripts/*-  - tests/eval-compare/*--flags:-  tracing:-    description: Enable full debug tracing-    manual: True-    default: False--  profiling:-    description: Enable profiling-    manual: True-    default: False--  optimize:-    description: Enable all optimization flags-    manual: True-    default: False--ghc-options:-  - -Wall--dependencies:-  - base                        >= 4.9 && < 5-  - ansi-wl-pprint-  - bytestring-  - containers-  - data-fix-  - deepseq                     >= 1.4.2 && < 1.5-  - exceptions-  - filepath-  - hashing-  - mtl-  - optparse-applicative-  - template-haskell-  - text-  - time-  - transformers-  - unordered-containers        >= 0.2.9 && < 0.3--when:-  - condition: flag(optimize)-    ghc-options:-      - -fexpose-all-unfoldings-      - -fspecialise-aggressively-      - -O2--  - condition: flag(tracing)-    cpp-options: -DENABLE_TRACING=1--  - condition: "os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)"-    dependencies:-      - compact--  - condition: "!impl(ghcjs)"-    dependencies:-      - base16-bytestring-      - cryptohash-md5-      - cryptohash-sha1-      - cryptohash-sha256-      - cryptohash-sha512-      - serialise--library:-  source-dirs: src-  dependencies:-    - aeson-    - ansi-wl-pprint-    - array                     >= 0.4   && < 0.6-    - binary-    - deriving-compat           >= 0.3   && < 0.6-    - directory-    - http-types-    - http-client-    - http-client-tls-    - interpolate-    - lens-family-th-    - logict-    - megaparsec                >= 6.5   && < 7.0-    - monadlist-    - process-    - regex-tdfa-    - regex-tdfa-text-    - scientific-    - semigroups                >= 0.18  && < 0.19-    - split-    - syb-    - these-    - unix-    - vector-    - xml-  when:-    - condition: "impl(ghc < 8.1)"-      then:-        dependencies:-          - lens-family       == 1.2.1-          - lens-family-core  == 1.2.1-      else:-        dependencies:-          - lens-family       >= 1.2.2-          - lens-family-core  >= 1.2.2--    - condition: "impl(ghc < 8.4.0) && !flag(profiling)"-      dependencies:-        - ghc-datasize--    - condition: "impl(ghcjs)"-      then:-        dependencies:-          - hashable >= 1.2.4 && < 1.3-      else:-        exposed-modules:-          - Nix.Options.Parser-        dependencies:-          - hashable >= 1.2.5 && < 1.3-          - haskeline-          - pretty-show--executables:-  hnix:-    source-dirs: main-    main: Main.hs-    dependencies:-      - hnix-      - aeson-      - pretty-show-      - repline-      - haskeline-    when:-      - condition: "impl(ghcjs)"-        then:-          buildable: false-        else:-          buildable: true--tests:-  hnix-tests:-    source-dirs: tests-    main: Main.hs-    ghc-options: -threaded-    verbatim:-      build-tool-depends:-        hspec-discover:hspec-discover == 2.*-    dependencies:-      - hnix-      - Glob-      - directory-      - interpolate-      - process-      - split-      - tasty-      - tasty-hedgehog-      - tasty-hunit-      - tasty-th-      - unix-      - hedgehog-      - generic-random-      - Diff-      - megaparsec-      - tasty-quickcheck-      - pretty-show-    when:-      - condition: "impl(ghcjs)"-        then:-          buildable: false-        else:-          buildable: true--benchmarks:-  hnix-benchmarks:-    source-dirs: benchmarks-    main: Main.hs-    dependencies:-      - hnix-      - criterion-    when:-      - condition: "impl(ghcjs)"-        then:-          buildable: false-        else:-          buildable: true
src/Nix.hs view
@@ -4,83 +4,86 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Nix (module Nix.Cache,-            module Nix.Exec,-            module Nix.Expr,-            module Nix.Frames,-            module Nix.Render.Frame,-            module Nix.Normal,-            module Nix.Options,-            module Nix.Parser,-            module Nix.Pretty,-            module Nix.Reduce,-            module Nix.Thunk,-            module Nix.Value,-            module Nix.XML,-            withNixContext,-            nixEvalExpr, nixEvalExprLoc, nixTracingEvalExprLoc,-            evaluateExpression, processResult) where+module Nix+  ( module Nix.Cache+  , module Nix.Exec+  , module Nix.Expr+  , module Nix.Frames+  , module Nix.Render.Frame+  , module Nix.Normal+  , module Nix.Options+  , module Nix.String+  , module Nix.Parser+  , module Nix.Pretty+  , module Nix.Reduce+  , module Nix.Thunk+  , module Nix.Value+  , module Nix.XML+  , withNixContext+  , nixEvalExpr+  , nixEvalExprLoc+  , nixTracingEvalExprLoc+  , evaluateExpression+  , processResult+  )+where  import           Control.Applicative-import           Control.Arrow (second)+import           Control.Arrow                  ( second ) import           Control.Monad.Reader import           Data.Fix-import qualified Data.HashMap.Lazy as M-import qualified Data.Text as Text-import qualified Data.Text.Read as Text+import qualified Data.HashMap.Lazy             as M+import qualified Data.Text                     as Text+import qualified Data.Text.Read                as Text import           Nix.Builtins import           Nix.Cache-import qualified Nix.Eval as Eval+import qualified Nix.Eval                      as Eval import           Nix.Exec import           Nix.Expr import           Nix.Frames+import           Nix.String import           Nix.Normal import           Nix.Options import           Nix.Parser import           Nix.Pretty import           Nix.Reduce import           Nix.Render.Frame-import           Nix.Scope import           Nix.Thunk import           Nix.Utils import           Nix.Value import           Nix.XML --- | Evaluate a nix expression in the default context-withNixContext :: forall e m r. (MonadNix e m, Has e Options)-               => Maybe FilePath -> m r -> m r-withNixContext mpath action = do-    base <- builtins-    opts :: Options <- asks (view hasLens)-    let i = value @(NValue m) @(NThunk m) @m $ nvList $-            map (value @(NValue m) @(NThunk m) @m-                     . flip nvStr mempty . Text.pack) (include opts)-    pushScope (M.singleton "__includes" i) $-        pushScopes base $ case mpath of-            Nothing -> action-            Just path -> do-                traceM $ "Setting __cur_file = " ++ show path-                let ref = value @(NValue m) @(NThunk m) @m $ nvPath path-                pushScope (M.singleton "__cur_file" ref) action- -- | This is the entry point for all evaluations, whatever the expression tree --   type. It sets up the common Nix environment and applies the --   transformations, allowing them to be easily composed.-nixEval :: (MonadNix e m, Has e Options, Functor f)-        => Maybe FilePath -> Transform f (m a) -> Alg f (m a) -> Fix f -> m a+nixEval+  :: (MonadNix e t f m, Has e Options, Functor g)+  => Maybe FilePath+  -> Transform g (m a)+  -> Alg g (m a)+  -> Fix g+  -> m a nixEval mpath xform alg = withNixContext mpath . adi alg xform  -- | Evaluate a nix expression in the default context-nixEvalExpr :: forall e m. (MonadNix e m, Has e Options)-            => Maybe FilePath -> NExpr -> m (NValue m)+nixEvalExpr+  :: (MonadNix e t f m, Has e Options)+  => Maybe FilePath+  -> NExpr+  -> m (NValue t f m) nixEvalExpr mpath = nixEval mpath id Eval.eval  -- | Evaluate a nix expression in the default context-nixEvalExprLoc :: forall e m. (MonadNix e m, Has e Options)-               => Maybe FilePath -> NExprLoc -> m (NValue m)-nixEvalExprLoc mpath =-    nixEval mpath (Eval.addStackFrames @(NThunk m) . Eval.addSourcePositions)-            (Eval.eval . annotated . getCompose)+nixEvalExprLoc+  :: forall e t f m+   . (MonadNix e t f m, Has e Options)+  => Maybe FilePath+  -> NExprLoc+  -> m (NValue t f m)+nixEvalExprLoc mpath = nixEval+  mpath+  (Eval.addStackFrames @t . Eval.addSourcePositions)+  (Eval.eval . annotated . getCompose)  -- | Evaluate a nix expression with tracing in the default context. Note that --   this function doesn't do any tracing itself, but 'evalExprLoc' will be@@ -88,64 +91,78 @@ --   'MonadNix'). All this function does is provide the right type class --   context. nixTracingEvalExprLoc-    :: forall e m. (MonadNix e m, Has e Options, MonadIO m, Alternative m)-    => Maybe FilePath -> NExprLoc -> m (NValue m)+  :: (MonadNix e t f m, Has e Options, MonadIO m, Alternative m)+  => Maybe FilePath+  -> NExprLoc+  -> m (NValue t f m) nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc  evaluateExpression-    :: (MonadNix e m, Has e Options)-    => Maybe FilePath-    -> (Maybe FilePath -> NExprLoc -> m (NValue m))-    -> (NValue m -> m a)-    -> NExprLoc-    -> m a+  :: (MonadNix e t f m, Has e Options)+  => Maybe FilePath+  -> (Maybe FilePath -> NExprLoc -> m (NValue t f m))+  -> (NValue t f m -> m a)+  -> NExprLoc+  -> m a evaluateExpression mpath evaluator handler expr = do-    opts :: Options <- asks (view hasLens)-    args <- traverse (traverse eval') $-        map (second parseArg) (arg opts) ++-        map (second mkStr) (argstr opts)-    compute evaluator expr (argmap args) handler-  where-    parseArg s = case parseNixText s of-        Success x -> x-        Failure err -> errorWithoutStackTrace (show err)+  opts :: Options <- asks (view hasLens)+  args <- traverse (traverse eval') $ map (second parseArg) (arg opts) ++ map+    (second mkStr)+    (argstr opts)+  compute evaluator expr (argmap args) handler+ where+  parseArg s = case parseNixText s of+    Success x   -> x+    Failure err -> errorWithoutStackTrace (show err) -    eval' = (normalForm =<<) . nixEvalExpr mpath+  eval' = (normalForm =<<) . nixEvalExpr mpath -    argmap args = embed $ Fix $ NVSetF (M.fromList args) mempty+  argmap args = pure $ nvSet (M.fromList args') mempty+    where args' = map (fmap (wrapValue . nValueFromNF)) args -    compute ev x args p = do-         f <- ev mpath x-         processResult p =<< case f of-             NVClosure _ g -> g args-             _ -> pure f+  compute ev x args p = do+    f :: NValue t f m <- ev mpath x+    processResult p =<< case f of+      NVClosure _ g -> force ?? pure =<< g args+      _             -> pure f -processResult :: forall e m a. (MonadNix e m, Has e Options)-              => (NValue m -> m a) -> NValue m -> m a+processResult+  :: forall e t f m a+   . (MonadNix e t f m, Has e Options)+  => (NValue t f m -> m a)+  -> NValue t f m+  -> m a processResult h val = do-    opts :: Options <- asks (view hasLens)-    case attr opts of-        Nothing -> h val-        Just (Text.splitOn "." -> keys) -> go keys val-  where-    go :: [Text.Text] -> NValue m -> m a-    go [] v = h v-    go ((Text.decimal -> Right (n,"")):ks) v = case v of-        NVList xs -> case ks of-            [] -> force @(NValue m) @(NThunk m) (xs !! n) h-            _  -> force (xs !! n) (go ks)-        _ -> errorWithoutStackTrace $-                "Expected a list for selector '" ++ show n-                    ++ "', but got: " ++ show v-    go (k:ks) v = case v of-        NVSet xs _ -> case M.lookup k xs of-            Nothing ->-                errorWithoutStackTrace $-                    "Set does not contain key '"-                        ++ Text.unpack k ++ "'"-            Just v' -> case ks of-                [] -> force v' h-                _  -> force v' (go ks)-        _ -> errorWithoutStackTrace $-            "Expected a set for selector '" ++ Text.unpack k-                ++ "', but got: " ++ show v+  opts :: Options <- asks (view hasLens)+  case attr opts of+    Nothing                         -> h val+    Just (Text.splitOn "." -> keys) -> go keys val+ where+  go :: [Text.Text] -> NValue t f m -> m a+  go [] v = h v+  go ((Text.decimal -> Right (n,"")) : ks) v = case v of+    NVList xs -> case ks of+      [] -> force @t @m @(NValue t f m) (xs !! n) h+      _  -> force (xs !! n) (go ks)+    _ ->+      errorWithoutStackTrace+        $  "Expected a list for selector '"+        ++ show n+        ++ "', but got: "+        ++ show v+  go (k : ks) v = case v of+    NVSet xs _ -> case M.lookup k xs of+      Nothing ->+        errorWithoutStackTrace+          $  "Set does not contain key '"+          ++ Text.unpack k+          ++ "'"+      Just v' -> case ks of+        [] -> force v' h+        _  -> force v' (go ks)+    _ ->+      errorWithoutStackTrace+        $  "Expected a set for selector '"+        ++ Text.unpack k+        ++ "', but got: "+        ++ show v
src/Nix/Atoms.hs view
@@ -9,11 +9,13 @@ #ifdef MIN_VERSION_serialise import Codec.Serialise #endif-import Control.DeepSeq-import Data.Data-import Data.Hashable-import Data.Text (Text, pack)-import GHC.Generics+import           Control.DeepSeq+import           Data.Data+import           Data.Hashable+import           Data.Text                      ( Text+                                                , pack+                                                )+import           GHC.Generics  -- | Atoms are values that evaluate to themselves. This means that -- they appear in both the parsed AST (in the form of literals) and@@ -37,7 +39,15 @@  -- | Translate an atom into its nix representation. atomText :: NAtom -> Text-atomText (NInt i)   = pack (show i)+atomText (NInt   i) = pack (show i) atomText (NFloat f) = pack (show f)-atomText (NBool b)  = if b then "true" else "false"+atomText (NBool  b) = if b then "true" else "false" atomText NNull      = "null"++++++++
src/Nix/Builtins.hs view
@@ -21,1028 +21,1517 @@ {-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -module Nix.Builtins (builtins) where--import           Control.Monad-import           Control.Monad.Catch-import           Control.Monad.ListM (sortByM)-import           Control.Monad.Reader (asks)---- Using package imports here because there is a bug in cabal2nix that forces--- us to put the hashing package in the unconditional dependency list.--- See https://github.com/NixOS/cabal2nix/issues/348 for more info-#if MIN_VERSION_hashing(0, 1, 0)-import           Crypto.Hash-import qualified "hashing" Crypto.Hash.MD5 as MD5-import qualified "hashing" Crypto.Hash.SHA1 as SHA1-import qualified "hashing" Crypto.Hash.SHA256 as SHA256-import qualified "hashing" Crypto.Hash.SHA512 as SHA512-#else-import           Data.ByteString.Base16 as Base16-import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5-import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1-import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256-import qualified "cryptohash-sha512" Crypto.Hash.SHA512 as SHA512-#endif--import qualified Data.Aeson as A-import qualified Data.Aeson.Encoding as A-import           Data.Align (alignWith)-import           Data.Array-import           Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LBS-import           Data.Char (isDigit)-import           Data.Coerce-import           Data.Fix-import           Data.Foldable (foldrM)-import qualified Data.HashMap.Lazy as M-import           Data.List-import           Data.Maybe-import           Data.Semigroup-import           Data.Set (Set)-import qualified Data.Set as S-import           Data.String.Interpolate.IsString-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Text.Encoding-import qualified Data.Text.Lazy as LazyText-import qualified Data.Text.Lazy.Builder as Builder-import           Data.These (fromThese)-import qualified Data.Time.Clock.POSIX as Time-import           Data.Traversable (mapM)-import           Nix.Atoms-import           Nix.Convert-import           Nix.Effects-import qualified Nix.Eval as Eval-import           Nix.Exec-import           Nix.Expr.Types-import           Nix.Expr.Types.Annotated-import           Nix.Frames-import           Nix.Normal-import           Nix.Options-import           Nix.Parser-import           Nix.Render-import           Nix.Scope-import           Nix.Thunk-import           Nix.Utils-import           Nix.Value-import           Nix.XML-import           System.FilePath-import           System.Posix.Files-import           Text.Regex.TDFA--builtins :: (MonadNix e m, Scoped e (NThunk m) m)-         => m (Scopes m (NThunk m))-builtins = do-    ref <- thunk $ flip nvSet M.empty <$> buildMap-    lst <- ([("builtins", ref)] ++) <$> topLevelBuiltins-    pushScope (M.fromList lst) currentScopes-  where-    buildMap = M.fromList . map mapping <$> builtinsList-    topLevelBuiltins = map mapping <$> fullBuiltinsList--    fullBuiltinsList = map go <$> builtinsList-      where-        go b@(Builtin TopLevel _) = b-        go (Builtin Normal (name, builtin)) =-            Builtin TopLevel ("__" <> name, builtin)--data BuiltinType = Normal | TopLevel-data Builtin m = Builtin-    { _kind   :: BuiltinType-    , mapping :: (Text, NThunk m)-    }--valueThunk :: forall e m. MonadNix e m => NValue m -> NThunk m-valueThunk = value @_ @_ @m--force' :: forall e m. MonadNix e m => NThunk m -> m (NValue m)-force' = force ?? pure--builtinsList :: forall e m. MonadNix e m => m [ Builtin m ]-builtinsList = sequence [-      do version <- toValue ("2.0" :: Text)-         pure $ Builtin Normal ("nixVersion", version)--    , do version <- toValue (5 :: Int)-         pure $ Builtin Normal ("langVersion", version)--    , add0 Normal   "nixPath"                    nixPath-    , add  TopLevel "abort"                      throw_ -- for now-    , add2 Normal   "add"                        add_-    , add2 Normal   "all"                        all_-    , add2 Normal   "any"                        any_-    , add  Normal   "attrNames"                  attrNames-    , add  Normal   "attrValues"                 attrValues-    , add  TopLevel "baseNameOf"                 baseNameOf-    , add2 Normal   "catAttrs"                   catAttrs-    , add2 Normal   "compareVersions"            compareVersions_-    , add  Normal   "concatLists"                concatLists-    , add' Normal   "concatStringsSep"           (arity2 Text.intercalate)-    , add0 Normal   "currentSystem"              currentSystem-    , add0 Normal   "currentTime"                currentTime_-    , add2 Normal   "deepSeq"                    deepSeq--    , add0 TopLevel "derivation" $(do-          -- This is compiled in so that we only parse and evaluate it once,-          -- at compile-time.-          let Success expr = parseNixText [i|-    /* This is the implementation of the ‘derivation’ builtin function.-       It's actually a wrapper around the ‘derivationStrict’ primop. */--    drvAttrs @ { outputs ? [ "out" ], ... }:--    let--      strict = derivationStrict drvAttrs;--      commonAttrs = drvAttrs // (builtins.listToAttrs outputsList) //-        { all = map (x: x.value) outputsList;-          inherit drvAttrs;-        };--      outputToAttrListElement = outputName:-        { name = outputName;-          value = commonAttrs // {-            outPath = builtins.getAttr outputName strict;-            drvPath = strict.drvPath;-            type = "derivation";-            inherit outputName;-          };-        };--      outputsList = map outputToAttrListElement outputs;--    in (builtins.head outputsList).value|]-          [| cata Eval.eval expr |]-      )--    , add  TopLevel "derivationStrict"           derivationStrict_-    , add  TopLevel "dirOf"                      dirOf-    , add2 Normal   "div"                        div_-    , add2 Normal   "elem"                       elem_-    , add2 Normal   "elemAt"                     elemAt_-    , add  Normal   "exec"                       exec_-    , add0 Normal   "false"                      (return $ nvConstant $ NBool False)-    , add  Normal   "fetchTarball"               fetchTarball-    , add  Normal   "fetchurl"                   fetchurl-    , add2 Normal   "filter"                     filter_-    , add3 Normal   "foldl'"                     foldl'_-    , add  Normal   "fromJSON"                   fromJSON-    , add  Normal   "functionArgs"               functionArgs-    , add2 Normal   "genList"                    genList-    , add  Normal   "genericClosure"             genericClosure-    , add2 Normal   "getAttr"                    getAttr-    , add  Normal   "getEnv"                     getEnv_-    , add2 Normal   "hasAttr"                    hasAttr-    , add  Normal   "hasContext"                 hasContext-    , add' Normal   "hashString"                 hashString-    , add  Normal   "head"                       head_-    , add  TopLevel "import"                     import_-    , add2 Normal   "intersectAttrs"             intersectAttrs-    , add  Normal   "isAttrs"                    isAttrs-    , add  Normal   "isBool"                     isBool-    , add  Normal   "isFloat"                    isFloat-    , add  Normal   "isFunction"                 isFunction-    , add  Normal   "isInt"                      isInt-    , add  Normal   "isList"                     isList-    , add  TopLevel "isNull"                     isNull-    , add  Normal   "isString"                   isString-    , add  Normal   "length"                     length_-    , add2 Normal   "lessThan"                   lessThan-    , add  Normal   "listToAttrs"                listToAttrs-    , add2 TopLevel "map"                        map_-    , add2 Normal   "match"                      match_-    , add2 Normal   "mul"                        mul_-    , add0 Normal   "null"                       (return $ nvConstant NNull)-    , add  Normal   "parseDrvName"               parseDrvName-    , add2 Normal   "partition"                  partition_-    , add  Normal   "pathExists"                 pathExists_-    , add  TopLevel "placeholder"                placeHolder-    , add  Normal   "readDir"                    readDir_-    , add  Normal   "readFile"                   readFile_-    , add2 Normal   "findFile"                   findFile_-    , add2 TopLevel "removeAttrs"                removeAttrs-    , add3 Normal   "replaceStrings"             replaceStrings-    , add2 TopLevel "scopedImport"               scopedImport-    , add2 Normal   "seq"                        seq_-    , add2 Normal   "sort"                       sort_-    , add2 Normal   "split"                      split_-    , add  Normal   "splitVersion"               splitVersion_-    , add0 Normal   "storeDir"                   (return $ nvPath "/nix/store")-    , add' Normal   "stringLength"               (arity1 Text.length)-    , add' Normal   "sub"                        (arity2 ((-) @Integer))-    , add' Normal   "substring"                  substring-    , add  Normal   "tail"                       tail_-    , add0 Normal   "true"                       (return $ nvConstant $ NBool True)-    , add  TopLevel "throw"                      throw_-    , add' Normal   "toJSON"-      (arity1 $ decodeUtf8 . LBS.toStrict . A.encodingToLazyByteString-                           . toEncodingSorted)-    , add2 Normal   "toFile"                     toFile-    , add  Normal   "toPath"                     toPath-    , add  TopLevel "toString"                   toString-    , add  Normal   "toXML"                      toXML_-    , add2 TopLevel "trace"                      trace_-    , add  Normal   "tryEval"                    tryEval-    , add  Normal   "typeOf"                     typeOf-    , add  Normal   "unsafeDiscardStringContext" unsafeDiscardStringContext-    , add2 Normal   "unsafeGetAttrPos"           unsafeGetAttrPos-    , add  Normal   "valueSize"                  getRecursiveSize-  ]-  where-    wrap t n f = Builtin t (n, f)--    arity1 f = Prim . pure . f-    arity2 f = ((Prim . pure) .) . f--    mkThunk n = thunk . withFrame Info-        (ErrorCall $ "While calling builtin " ++ Text.unpack n ++ "\n")--    add0 t n v = wrap t n <$> mkThunk n v-    add  t n v = wrap t n <$> mkThunk n (builtin  (Text.unpack n) v)-    add2 t n v = wrap t n <$> mkThunk n (builtin2 (Text.unpack n) v)-    add3 t n v = wrap t n <$> mkThunk n (builtin3 (Text.unpack n) v)--    add' :: ToBuiltin m a => BuiltinType -> Text -> a -> m (Builtin m)-    add' t n v = wrap t n <$> mkThunk n (toBuiltin (Text.unpack n) v)---- Primops--foldNixPath :: forall e m r. MonadNix e m-            => (FilePath -> Maybe String -> r -> m r) -> r -> m r-foldNixPath f z = do-    mres <- lookupVar @_ @(NThunk m) "__includes"-    dirs <- case mres of-        Nothing -> return []-        Just v  -> fromNix @[Text] v-    menv <- getEnvVar "NIX_PATH"-    foldrM go z $ dirs ++ case menv of-        Nothing -> []-        Just str -> Text.splitOn ":" (Text.pack str)-  where-    go x rest = case Text.splitOn "=" x of-        [p]    -> f (Text.unpack p) Nothing rest-        [n, p] -> f (Text.unpack p) (Just (Text.unpack n)) rest-        _ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " ++ show x--nixPath :: MonadNix e m => m (NValue m)-nixPath = fmap nvList $ flip foldNixPath [] $ \p mn rest ->-    pure $ valueThunk-        (flip nvSet mempty $ M.fromList-            [ ("path",   valueThunk $ nvPath p)-            , ("prefix", valueThunk $-                   nvStr (Text.pack (fromMaybe "" mn)) mempty) ]) : rest--toString :: MonadNix e m => m (NValue m) -> m (NValue m)-toString str = str >>= coerceToString False >>= toNix . Text.pack--hasAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-hasAttr x y =-    fromValue @Text x >>= \key ->-    fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->-        toNix $ M.member key aset--attrsetGet :: MonadNix e m => Text -> AttrSet t -> m t-attrsetGet k s = case M.lookup k s of-    Just v -> pure v-    Nothing ->-        throwError $ ErrorCall $ "Attribute '" ++ Text.unpack k ++ "' required"--hasContext :: MonadNix e m => m (NValue m) -> m (NValue m)-hasContext =-    toNix . not . null . (appEndo ?? []) . snd <=< fromValue @(Text, DList Text)--getAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-getAttr x y =-    fromValue @Text x >>= \key ->-    fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->-        attrsetGet key aset >>= force'--unsafeGetAttrPos :: forall e m. MonadNix e m-                 => m (NValue m) -> m (NValue m) -> m (NValue m)-unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of-    (NVStr key _, NVSet _ apos) -> case M.lookup key apos of-        Nothing -> pure $ nvConstant NNull-        Just delta -> toValue delta-    (x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPos: "-                 ++ show (x, y)---- This function is a bit special in that it doesn't care about the contents--- of the list.-length_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-length_ = toValue . (length :: [NThunk m] -> Int) <=< fromValue--add_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of-    (NVConstant (NInt x),   NVConstant (NInt y))   ->-        toNix ( x + y :: Integer)-    (NVConstant (NFloat x), NVConstant (NInt y))   -> toNix (x + fromInteger y)-    (NVConstant (NInt x),   NVConstant (NFloat y)) -> toNix (fromInteger x + y)-    (NVConstant (NFloat x), NVConstant (NFloat y)) -> toNix (x + y)-    (_, _) ->-        throwError $ Addition x' y'--mul_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of-    (NVConstant (NInt x),   NVConstant (NInt y))   ->-        toNix ( x * y :: Integer)-    (NVConstant (NFloat x), NVConstant (NInt y))   -> toNix (x * fromInteger y)-    (NVConstant (NInt x),   NVConstant (NFloat y)) -> toNix (fromInteger x * y)-    (NVConstant (NFloat x), NVConstant (NFloat y)) -> toNix (x * y)-    (_, _) ->-        throwError $ Multiplication x' y'--div_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of-    (NVConstant (NInt x),   NVConstant (NInt y))   | y /= 0 ->-        toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)-    (NVConstant (NFloat x), NVConstant (NInt y))   | y /= 0 ->-        toNix (x / fromInteger y)-    (NVConstant (NInt x),   NVConstant (NFloat y)) | y /= 0 -> -        toNix (fromInteger x / y)-    (NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 -> -        toNix (x / y)-    (_, _) ->-        throwError $ Division x' y'--anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool-anyM _ []       = return False-anyM p (x:xs)   = do-        q <- p x-        if q then return True-             else anyM p xs--any_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-any_ fun xs = fun >>= \f ->-    toNix <=< anyM fromValue <=< mapM ((f `callFunc`) . force')-          <=< fromValue $ xs--allM :: Monad m => (a -> m Bool) -> [a] -> m Bool-allM _ []       = return True-allM p (x:xs)   = do-        q <- p x-        if q then allM p xs-             else return False--all_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-all_ fun xs = fun >>= \f ->-    toNix <=< allM fromValue <=< mapM ((f `callFunc`) . force')-          <=< fromValue $ xs--foldl'_ :: forall e m. MonadNix e m-        => m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m)-foldl'_ fun z xs =-    fun >>= \f -> fromValue @[NThunk m] xs >>= foldl' (go f) z-  where-    go f b a = f `callFunc` b >>= (`callFunc` force' a)--head_ :: MonadNix e m => m (NValue m) -> m (NValue m)-head_ = fromValue >=> \case-    [] -> throwError $ ErrorCall "builtins.head: empty list"-    h:_ -> force' h--tail_ :: MonadNix e m => m (NValue m) -> m (NValue m)-tail_ = fromValue >=> \case-    [] -> throwError $ ErrorCall "builtins.tail: empty list"-    _:t -> return $ nvList t--data VersionComponent-   = VersionComponent_Pre -- ^ The string "pre"-   | VersionComponent_String Text -- ^ A string other than "pre"-   | VersionComponent_Number Integer -- ^ A number-   deriving (Show, Read, Eq, Ord)--versionComponentToString :: VersionComponent -> Text-versionComponentToString = \case-  VersionComponent_Pre -> "pre"-  VersionComponent_String s -> s-  VersionComponent_Number n -> Text.pack $ show n---- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44-versionComponentSeparators :: String-versionComponentSeparators = ".-"--splitVersion :: Text -> [VersionComponent]-splitVersion s = case Text.uncons s of-    Nothing -> []-    Just (h, t)-      | h `elem` versionComponentSeparators -> splitVersion t-      | isDigit h ->-          let (digits, rest) = Text.span isDigit s-          in VersionComponent_Number (read $ Text.unpack digits) : splitVersion rest-      | otherwise ->-          let (chars, rest) = Text.span (\c -> not $ isDigit c || c `elem` versionComponentSeparators) s-              thisComponent = case chars of-                  "pre" -> VersionComponent_Pre-                  x -> VersionComponent_String x-          in thisComponent : splitVersion rest--splitVersion_ :: MonadNix e m => m (NValue m) -> m (NValue m)-splitVersion_ = fromValue >=> \s -> do-    let vals = flip map (splitVersion s) $ \c ->-            valueThunk $ nvStr (versionComponentToString c) mempty-    return $ nvList vals--compareVersions :: Text -> Text -> Ordering-compareVersions s1 s2 =-    mconcat $ alignWith f (splitVersion s1) (splitVersion s2)-  where-    z = VersionComponent_String ""-    f = uncurry compare . fromThese z z--compareVersions_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-compareVersions_ t1 t2 =-    fromValue t1 >>= \s1 ->-    fromValue t2 >>= \s2 ->-        return $ nvConstant $ NInt $ case compareVersions s1 s2 of-            LT -> -1-            EQ -> 0-            GT -> 1--splitDrvName :: Text -> (Text, Text)-splitDrvName s =-    let sep = "-"-        pieces = Text.splitOn sep s-        isFirstVersionPiece p = case Text.uncons p of-            Just (h, _) | isDigit h -> True-            _ -> False-        -- Like 'break', but always puts the first item into the first result-        -- list-        breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])-        breakAfterFirstItem f = \case-            h : t ->-                let (a, b) = break f t-                in (h : a, b)-            [] -> ([], [])-        (namePieces, versionPieces) =-          breakAfterFirstItem isFirstVersionPiece pieces-    in (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)--parseDrvName :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-parseDrvName = fromValue >=> \(s :: Text) -> do-    let (name :: Text, version :: Text) = splitDrvName s-    -- jww (2018-04-15): There should be an easier way to write this.-    (toValue =<<) $ sequence $ M.fromList-        [ ("name" :: Text, thunk (toValue @_ @_ @(NValue m) name))-        , ("version",     thunk (toValue version)) ]--match_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-match_ pat str =-    fromValue pat >>= \p ->-    fromValue str >>= \s -> do-        let re = makeRegex (encodeUtf8 p) :: Regex-        case matchOnceText re (encodeUtf8 s) of-            Just ("", sarr, "") -> do-                let s = map fst (elems sarr)-                nvList <$> traverse (toValue . decodeUtf8)-                    (if length s > 1 then tail s else s)-            _ -> pure $ nvConstant NNull--split_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-split_ pat str =-    fromValue pat >>= \p ->-    fromValue str >>= \s -> do-        let re = makeRegex (encodeUtf8 p) :: Regex-            haystack = encodeUtf8 s-        return $ nvList $-            splitMatches 0 (map elems $ matchAllText re haystack) haystack--splitMatches-  :: forall e m. MonadNix e m-  => Int-  -> [[(ByteString, (Int, Int))]]-  -> ByteString-  -> [NThunk m]-splitMatches _ [] haystack = [thunkStr haystack]-splitMatches _ ([]:_) _ = error "Error in splitMatches: this should never happen!"-splitMatches numDropped (((_,(start,len)):captures):mts) haystack =-    thunkStr before : caps : splitMatches (numDropped + relStart + len) mts (B.drop len rest)-  where-    relStart = max 0 start - numDropped-    (before,rest) = B.splitAt relStart haystack-    caps = valueThunk $ nvList (map f captures)-    f (a,(s,_)) = if s < 0 then valueThunk (nvConstant NNull) else thunkStr a--thunkStr s = valueThunk (nvStr (decodeUtf8 s) mempty)--substring :: MonadNix e m => Int -> Int -> Text -> Prim m Text-substring start len str = Prim $-    if start < 0 --NOTE: negative values of 'len' are OK-    then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start-    else pure $ Text.take len $ Text.drop start str--attrNames :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-attrNames = fromValue @(ValueSet m) >=> toNix . sort . M.keys--attrValues :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-attrValues = fromValue @(ValueSet m) >=>-    toValue . fmap snd . sortOn (fst @Text @(NThunk m)) . M.toList--map_ :: forall e m. MonadNix e m-     => m (NValue m) -> m (NValue m) -> m (NValue m)-map_ fun xs = fun >>= \f ->-    toNix <=< traverse (thunk . withFrame Debug-                                    (ErrorCall "While applying f in map:\n")-                              . (f `callFunc`) . force')-          <=< fromValue @[NThunk m] $ xs--filter_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-filter_ fun xs = fun >>= \f ->-    toNix <=< filterM (fromValue <=< callFunc f . force')-          <=< fromValue @[NThunk m] $ xs--catAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-catAttrs attrName xs =-    fromValue @Text attrName >>= \n ->-    fromValue @[NThunk m] xs >>= \l ->-        fmap (nvList . catMaybes) $-            forM l $ fmap (M.lookup n) . fromValue--baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m)-baseNameOf x = x >>= \case-    NVStr path ctx -> pure $ nvStr (Text.pack $ takeFileName $ Text.unpack path) ctx-    NVPath path -> pure $ nvPath $ takeFileName path-    v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v--dirOf :: MonadNix e m => m (NValue m) -> m (NValue m)-dirOf x = x >>= \case-    NVStr path ctx -> pure $ nvStr (Text.pack $ takeDirectory $ Text.unpack path) ctx-    NVPath path -> pure $ nvPath $ takeDirectory path-    v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v---- jww (2018-04-28): This should only be a string argument, and not coerced?-unsafeDiscardStringContext :: MonadNix e m => m (NValue m) -> m (NValue m)-unsafeDiscardStringContext = fromValue @Text >=> toNix--seq_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-seq_ a b = a >> b--deepSeq :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-deepSeq a b = do-    -- We evaluate 'a' only for its effects, so data cycles are ignored.-    _ <- normalFormBy (forceEffects . coerce . _baseThunk) 0 =<< a--    -- Then we evaluate the other argument to deepseq, thus this function-    -- should always produce a result (unlike applying 'deepseq' on infinitely-    -- recursive data structures in Haskell).-    b--elem_ :: forall e m. MonadNix e m-      => m (NValue m) -> m (NValue m) -> m (NValue m)-elem_ x xs = x >>= \x' ->-    toValue <=< anyM (valueEq x' <=< force') <=< fromValue @[NThunk m] $ xs--elemAt :: [a] -> Int -> Maybe a-elemAt ls i = case drop i ls of-   [] -> Nothing-   a:_ -> Just a--elemAt_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-elemAt_ xs n = fromValue n >>= \n' -> fromValue xs >>= \xs' ->-    case elemAt xs' n' of-      Just a -> force' a-      Nothing -> throwError $ ErrorCall $ "builtins.elem: Index " ++ show n'-          ++ " too large for list of length " ++ show (length xs')--genList :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-genList generator = fromValue @Integer >=> \n ->-    if n >= 0-    then generator >>= \f ->-        toNix =<< forM [0 .. n - 1] (\i -> thunk $ f `callFunc` toNix i)-    else throwError $ ErrorCall $ "builtins.genList: Expected a non-negative number, got "-             ++ show n--genericClosure :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-genericClosure = fromValue @(AttrSet (NThunk m)) >=> \s ->-    case (M.lookup "startSet" s, M.lookup "operator" s) of-      (Nothing, Nothing) ->-          throwError $ ErrorCall $-              "builtins.genericClosure: "-                  ++ "Attributes 'startSet' and 'operator' required"-      (Nothing, Just _) ->-          throwError $ ErrorCall $-              "builtins.genericClosure: Attribute 'startSet' required"-      (Just _, Nothing) ->-          throwError $ ErrorCall $-              "builtins.genericClosure: Attribute 'operator' required"-      (Just startSet, Just operator) ->-          fromValue @[NThunk m] startSet >>= \ss ->-          force operator $ \op ->-              toValue @[NThunk m] =<< snd <$> go op ss S.empty-  where-    go :: NValue m -> [NThunk m] -> Set (NValue m)-       -> m (Set (NValue m), [NThunk m])-    go _ [] ks = pure (ks, [])-    go op (t:ts) ks =-        force t $ \v -> fromValue @(AttrSet (NThunk m)) t >>= \s ->-            case M.lookup "key" s of-                Nothing ->-                    throwError $ ErrorCall $-                        "builtins.genericClosure: Attribute 'key' required"-                Just k -> force k $ \k' ->-                    if S.member k' ks-                        then go op ts ks-                        else do-                            ys <- fromValue @[NThunk m] =<< (op `callFunc` pure v)-                            case S.toList ks of-                                []  -> checkComparable k' k'-                                j:_ -> checkComparable k' j-                            fmap (t:) <$> go op (ts ++ ys) (S.insert k' ks)--replaceStrings :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m)-replaceStrings tfrom tto ts =-    fromNix tfrom >>= \(from :: [Text]) ->-    fromNix tto   >>= \(to   :: [Text]) ->-    fromValue ts  >>= \(s    :: Text) -> do-        when (length from /= length to) $-            throwError $ ErrorCall $-                "'from' and 'to' arguments to 'replaceStrings'"-                    ++ " have different lengths"-        let lookupPrefix s = do-                (prefix, replacement) <--                    find ((`Text.isPrefixOf` s) . fst) $ zip from to-                let rest = Text.drop (Text.length prefix) s-                return (prefix, replacement, rest)-            finish = LazyText.toStrict . Builder.toLazyText-            go orig result = case lookupPrefix orig of-                Nothing -> case Text.uncons orig of-                    Nothing -> finish result-                    Just (h, t) -> go t $ result <> Builder.singleton h-                Just (prefix, replacement, rest) -> case prefix of-                    "" -> case Text.uncons rest of-                        Nothing -> finish $ result <> Builder.fromText replacement-                        Just (h, t) -> go t $ mconcat-                            [ result-                            , Builder.fromText replacement-                            , Builder.singleton h-                            ]-                    _ -> go rest $ result <> Builder.fromText replacement-        toNix $ go s mempty--removeAttrs :: forall e m. MonadNix e m-            => m (NValue m) -> m (NValue m) -> m (NValue m)-removeAttrs set = fromNix >=> \(toRemove :: [Text]) ->-    fromValue @(AttrSet (NThunk m),-                AttrSet SourcePos) set >>= \(m, p) ->-        toNix (go m toRemove, go p toRemove)-  where-    go = foldl' (flip M.delete)--intersectAttrs :: forall e m. MonadNix e m-               => m (NValue m) -> m (NValue m) -> m (NValue m)-intersectAttrs set1 set2 =-    fromValue @(AttrSet (NThunk m),-                AttrSet SourcePos) set1 >>= \(s1, p1) ->-    fromValue @(AttrSet (NThunk m),-                AttrSet SourcePos) set2 >>= \(s2, p2) ->-        return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)--functionArgs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-functionArgs fun = fun >>= \case-    NVClosure p _ -> toValue @(AttrSet (NThunk m)) $-        valueThunk . nvConstant . NBool <$>-            case p of-                Param name -> M.singleton name False-                ParamSet s _ _ -> isJust <$> M.fromList s-    v -> throwError $ ErrorCall $-            "builtins.functionArgs: expected function, got " ++ show v--toFile :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-toFile name s = do-    name' <- fromValue name-    s' <- fromValue s-    mres <- toFile_ (Text.unpack name') (Text.unpack s')-    toNix $ Text.pack $ unStorePath mres--toPath :: MonadNix e m => m (NValue m) -> m (NValue m)-toPath = fromValue @Path >=> toNix @Path--pathExists_ :: MonadNix e m => m (NValue m) -> m (NValue m)-pathExists_ path = path >>= \case-    NVPath p  -> toNix =<< pathExists p-    NVStr s _ -> toNix =<< pathExists (Text.unpack s)-    v -> throwError $ ErrorCall $-            "builtins.pathExists: expected path, got " ++ show v--hasKind :: forall a e m. (MonadNix e m, FromValue a m (NValue m))-        => m (NValue m) -> m (NValue m)-hasKind = fromValueMay >=> toNix . \case Just (_ :: a) -> True; _ -> False--isAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isAttrs = hasKind @(ValueSet m)--isList :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isList = hasKind @[NThunk m]--isString :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isString = hasKind @Text--isInt :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isInt = hasKind @Int--isFloat :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isFloat = hasKind @Float--isBool :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isBool = hasKind @Bool--isNull :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-isNull = hasKind @()--isFunction :: MonadNix e m => m (NValue m) -> m (NValue m)-isFunction func = func >>= \case-    NVClosure {} -> toValue True-    _ -> toValue False--throw_ :: MonadNix e m => m (NValue m) -> m (NValue m)-throw_ = fromValue >=> throwError . ErrorCall . Text.unpack--import_ :: MonadNix e m => m (NValue m) -> m (NValue m)-import_ = fromValue >=> importPath M.empty . getPath--scopedImport :: forall e m. MonadNix e m-             => m (NValue m) -> m (NValue m) -> m (NValue m)-scopedImport aset path =-    fromValue aset >>= \s ->-    fromValue   path >>= \p -> importPath @m s (getPath p)--getEnv_ :: MonadNix e m => m (NValue m) -> m (NValue m)-getEnv_ = fromValue >=> \s -> do-    mres <- getEnvVar (Text.unpack s)-    toNix $ case mres of-        Nothing -> ""-        Just v  -> Text.pack v--sort_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-sort_ comparator xs = comparator >>= \comp ->-    fromValue xs >>= sortByM (cmp comp) >>= toValue-  where-    cmp f a b = do-        isLessThan <- f `callFunc` force' a >>= (`callFunc` force' b)-        fromValue isLessThan >>= \case-            True -> pure LT-            False -> do-                isGreaterThan <- f `callFunc` force' b >>= (`callFunc` force' a)-                fromValue isGreaterThan <&> \case-                    True  -> GT-                    False -> EQ--lessThan :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-lessThan ta tb = ta >>= \va -> tb >>= \vb -> do-    let badType = throwError $ ErrorCall $-            "builtins.lessThan: expected two numbers or two strings, "-                ++ "got " ++ show va ++ " and " ++ show vb-    nvConstant . NBool <$> case (va, vb) of-        (NVConstant ca, NVConstant cb) -> case (ca, cb) of-            (NInt   a, NInt   b) -> pure $ a < b-            (NFloat a, NInt   b) -> pure $ a < fromInteger b-            (NInt   a, NFloat b) -> pure $ fromInteger a < b-            (NFloat a, NFloat b) -> pure $ a < b-            _ -> badType-        (NVStr a _, NVStr b _) -> pure $ a < b-        _ -> badType--concatLists :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-concatLists = fromValue @[NThunk m]-    >=> mapM (fromValue @[NThunk m] >=> pure)-    >=> toValue . concat--listToAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-listToAttrs = fromValue @[NThunk m] >=> \l ->-    fmap (flip nvSet M.empty . M.fromList . reverse) $-        forM l $ fromValue @(AttrSet (NThunk m)) >=> \s -> do-            name <- attrsetGet "name" s-            val  <- attrsetGet "value" s-            fromValue name <&> (, val)--hashString :: MonadNix e m => Text -> Text -> Prim m Text-hashString algo s = Prim $ do-    case algo of-        "md5"    -> pure $-#if MIN_VERSION_hashing(0, 1, 0)-          Text.pack $ show (hash (encodeUtf8 s) :: MD5.MD5)-#else-          decodeUtf8 $ Base16.encode $ MD5.hash $ encodeUtf8 s-#endif-        "sha1"   -> pure $-#if MIN_VERSION_hashing(0, 1, 0)-          Text.pack $ show (hash (encodeUtf8 s) :: SHA1.SHA1)-#else-          decodeUtf8 $ Base16.encode $ SHA1.hash $ encodeUtf8 s-#endif-        "sha256" -> pure $-#if MIN_VERSION_hashing(0, 1, 0)-          Text.pack $ show (hash (encodeUtf8 s) :: SHA256.SHA256)-#else-          decodeUtf8 $ Base16.encode $ SHA256.hash $ encodeUtf8 s-#endif-        "sha512" -> pure $-#if MIN_VERSION_hashing(0, 1, 0)-          Text.pack $ show (hash (encodeUtf8 s) :: SHA512.SHA512)-#else-          decodeUtf8 $ Base16.encode $ SHA512.hash $ encodeUtf8 s-#endif-        _ -> throwError $ ErrorCall $ "builtins.hashString: "-            ++ "expected \"md5\", \"sha1\", \"sha256\", or \"sha512\", got " ++ show algo--placeHolder :: MonadNix e m => m (NValue m) -> m (NValue m)-placeHolder = fromValue @Text >=> \_ -> do-    h <- runPrim (hashString "sha256" "fdasdfas")-    toNix h--absolutePathFromValue :: MonadNix e m => NValue m -> m FilePath-absolutePathFromValue = \case-    NVStr pathText _ -> do-        let path = Text.unpack pathText-        unless (isAbsolute path) $-            throwError $ ErrorCall $ "string " ++ show path ++ " doesn't represent an absolute path"-        pure path-    NVPath path -> pure path-    v -> throwError $ ErrorCall $ "expected a path, got " ++ show v--readFile_ :: MonadNix e m => m (NValue m) -> m (NValue m)-readFile_ path =-    path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix--findFile_ :: forall e m. MonadNix e m-          => m (NValue m) -> m (NValue m) -> m (NValue m)-findFile_ aset filePath =-    aset >>= \aset' ->-    filePath >>= \filePath' ->-    case (aset', filePath') of-      (NVList x, NVStr name _) -> do-          mres <- findPath x (Text.unpack name)-          pure $ nvPath mres-      (NVList _, y)  -> throwError $ ErrorCall $ "expected a string, got " ++ show y-      (x, NVStr _ _) -> throwError $ ErrorCall $ "expected a list, got " ++ show x-      (x, y)         -> throwError $ ErrorCall $ "Invalid types for builtins.findFile: " ++ show (x, y)--data FileType-   = FileTypeRegular-   | FileTypeDirectory-   | FileTypeSymlink-   | FileTypeUnknown-   deriving (Show, Read, Eq, Ord)--instance Applicative m => ToNix FileType m (NValue m) where-    toNix = toNix . \case-        FileTypeRegular   -> "regular" :: Text-        FileTypeDirectory -> "directory"-        FileTypeSymlink   -> "symlink"-        FileTypeUnknown   -> "unknown"--readDir_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-readDir_ pathThunk = do-    path  <- absolutePathFromValue =<< pathThunk-    items <- listDirectory path-    itemsWithTypes <- forM items $ \item -> do-        s <- Nix.Effects.getSymbolicLinkStatus $ path </> item-        let t = if-                | isRegularFile s  -> FileTypeRegular-                | isDirectory s    -> FileTypeDirectory-                | isSymbolicLink s -> FileTypeSymlink-                | otherwise        -> FileTypeUnknown-        pure (Text.pack item, t)-    toNix (M.fromList itemsWithTypes)--fromJSON :: MonadNix e m => m (NValue m) -> m (NValue m)-fromJSON = fromValue >=> \encoded ->-    case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of-        Left jsonError ->-            throwError $ ErrorCall $ "builtins.fromJSON: " ++ jsonError-        Right v -> toValue v--toXML_ :: MonadNix e m => m (NValue m) -> m (NValue m)-toXML_ v = v >>= normalForm >>= \x ->-    pure $ nvStr (Text.pack (toXML x)) mempty--typeOf :: MonadNix e m => m (NValue m) -> m (NValue m)-typeOf v = v >>= toNix @Text . \case-    NVConstant a -> case a of-        NInt _   -> "int"-        NFloat _ -> "float"-        NBool _  -> "bool"-        NNull    -> "null"-    NVStr _ _     -> "string"-    NVList _      -> "list"-    NVSet _ _     -> "set"-    NVClosure {}  -> "lambda"-    NVPath _      -> "path"-    NVBuiltin _ _ -> "lambda"-    _ -> error "Pattern synonyms obscure complete patterns"--tryEval :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-tryEval e = catch (onSuccess <$> e) (pure . onError)-  where-    onSuccess v = flip nvSet M.empty $ M.fromList-        [ ("success", valueThunk (nvConstant (NBool True)))-        , ("value", valueThunk v)-        ]--    onError :: SomeException -> NValue m-    onError _ = flip nvSet M.empty $ M.fromList-        [ ("success", valueThunk (nvConstant (NBool False)))-        , ("value", valueThunk (nvConstant (NBool False)))-        ]--trace_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)-trace_ msg action = do-  traceEffect . Text.unpack =<< fromValue @Text msg-  action--exec_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-exec_ xs = do-  ls <- fromValue @[NThunk m] xs-  xs <- traverse (fromValue @Text . force') ls-  exec (map Text.unpack xs)--fetchTarball :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-fetchTarball v = v >>= \case-    NVSet s _ -> case M.lookup "url" s of-        Nothing -> throwError $ ErrorCall-                      "builtins.fetchTarball: Missing url attribute"-        Just url -> force url $ go (M.lookup "sha256" s)-    v@NVStr {} -> go Nothing v-    v -> throwError $ ErrorCall $-            "builtins.fetchTarball: Expected URI or set, got " ++ show v- where-    go :: Maybe (NThunk m) -> NValue m -> m (NValue m)-    go msha = \case-        NVStr uri _ -> fetch uri msha-        v -> throwError $ ErrorCall $-                "builtins.fetchTarball: Expected URI or string, got " ++ show v--{- jww (2018-04-11): This should be written using pipes in another module-    fetch :: Text -> Maybe (NThunk m) -> m (NValue m)-    fetch uri msha = case takeExtension (Text.unpack uri) of-        ".tgz" -> undefined-        ".gz"  -> undefined-        ".bz2" -> undefined-        ".xz"  -> undefined-        ".tar" -> undefined-        ext -> throwError $ ErrorCall $ "builtins.fetchTarball: Unsupported extension '"-                  ++ ext ++ "'"--}--    fetch :: Text -> Maybe (NThunk m) -> m (NValue m)-    fetch uri Nothing =-        nixInstantiateExpr $ "builtins.fetchTarball \"" ++-            Text.unpack uri ++ "\""-    fetch url (Just m) = fromValue m >>= \sha ->-        nixInstantiateExpr $ "builtins.fetchTarball { "-          ++ "url    = \"" ++ Text.unpack url ++ "\"; "-          ++ "sha256 = \"" ++ Text.unpack sha ++ "\"; }"--fetchurl :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)-fetchurl v = v >>= \case-    NVSet s _ -> attrsetGet "url" s >>= force ?? (go (M.lookup "sha256" s))-    v@NVStr {} -> go Nothing v-    v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or set, got "-            ++ show v- where-    go :: Maybe (NThunk m) -> NValue m -> m (NValue m)-    go _msha = \case-        NVStr uri _ -> getURL uri -- msha-        v -> throwError $ ErrorCall $-                 "builtins.fetchurl: Expected URI or string, got " ++ show v--partition_ :: forall e m. MonadNix e m-           => m (NValue m) -> m (NValue m) -> m (NValue m)-partition_ fun xs = fun >>= \f ->-    fromValue @[NThunk m] xs >>= \l -> do-        let match t = f `callFunc` force' t >>= fmap (, t) . fromValue-        selection <- traverse match l-        let (right, wrong) = partition fst selection-        let makeSide = valueThunk . nvList . map snd-        toValue @(AttrSet (NThunk m)) $-            M.fromList [("right", makeSide right), ("wrong", makeSide wrong)]--currentSystem :: MonadNix e m => m (NValue m)-currentSystem = do-  os <- getCurrentSystemOS-  arch <- getCurrentSystemArch-  return $ nvStr (arch <> "-" <> os) mempty--currentTime_ :: MonadNix e m => m (NValue m)-currentTime_ = do-    opts :: Options <- asks (view hasLens)-    toNix @Integer $ round $ Time.utcTimeToPOSIXSeconds (currentTime opts)--derivationStrict_ :: MonadNix e m => m (NValue m) -> m (NValue m)-derivationStrict_ = (>>= derivationStrict)--newtype Prim m a = Prim { runPrim :: m a }---- | Types that support conversion to nix in a particular monad-class ToBuiltin m a | a -> m where-    toBuiltin :: String -> a -> m (NValue m)--instance (MonadNix e m, ToNix a m (NValue m))-      => ToBuiltin m (Prim m a) where-    toBuiltin _ p = toNix =<< runPrim p--instance (MonadNix e m, FromNix a m (NValue m), ToBuiltin m b)-      => ToBuiltin m (a -> b) where-    toBuiltin name f = return $ nvBuiltin name (fromNix >=> toBuiltin name . f)+module Nix.Builtins (withNixContext, builtins) where++import           Control.Comonad+import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.ListM            ( sortByM )+import           Control.Monad.Reader           ( asks )++-- Using package imports here because there is a bug in cabal2nix that forces+-- us to put the hashing package in the unconditional dependency list.+-- See https://github.com/NixOS/cabal2nix/issues/348 for more info+#if MIN_VERSION_hashing(0, 1, 0)+import "hashing" Crypto.Hash+import qualified "hashing" Crypto.Hash.MD5     as MD5+import qualified "hashing" Crypto.Hash.SHA1    as SHA1+import qualified "hashing" Crypto.Hash.SHA256  as SHA256+import qualified "hashing" Crypto.Hash.SHA512  as SHA512+#else+import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5+import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1+import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256+import qualified "cryptohash-sha512" Crypto.Hash.SHA512 as SHA512+#endif++import qualified Data.Aeson                    as A+import           Data.Align                     ( alignWith )+import           Data.Array+import           Data.Bits+import           Data.ByteString                ( ByteString )+import qualified Data.ByteString               as B+import           Data.ByteString.Base16        as Base16+import           Data.Char                      ( isDigit )+import           Data.Fix+import           Data.Foldable                  ( foldrM )+import qualified Data.HashMap.Lazy             as M+import           Data.List+import           Data.Maybe+import           Data.Scientific+import           Data.Set                       ( Set )+import qualified Data.Set                      as S+import           Data.String.Interpolate.IsString+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text+import           Data.Text.Encoding+import qualified Data.Text.Lazy                as LazyText+import qualified Data.Text.Lazy.Builder        as Builder+import           Data.These                     ( fromThese )+import qualified Data.Time.Clock.POSIX         as Time+import           Data.Traversable               ( for+                                                , mapM+                                                )+import qualified Data.Vector                   as V+import           Nix.Atoms+import           Nix.Convert+import           Nix.Effects+import qualified Nix.Eval                      as Eval+import           Nix.Exec+import           Nix.Expr.Types+import           Nix.Expr.Types.Annotated+import           Nix.Frames+import           Nix.Json+import           Nix.Normal+import           Nix.Options+import           Nix.Parser              hiding ( nixPath )+import           Nix.Render+import           Nix.Scope+import           Nix.String+import           Nix.Thunk+import           Nix.Utils+import           Nix.Value+import           Nix.Value.Equal+import           Nix.XML+import           System.Nix.Internal.Hash       ( printHashBytes32 )+import           System.FilePath+import           System.Posix.Files             ( isRegularFile+                                                , isDirectory+                                                , isSymbolicLink+                                                )+import           Text.Read+import           Text.Regex.TDFA++-- | Evaluate a nix expression in the default context+withNixContext+  :: forall e t f m r+   . (MonadNix e t f m, Has e Options)+  => Maybe FilePath+  -> m r+  -> m r+withNixContext mpath action = do+  base            <- builtins+  opts :: Options <- asks (view hasLens)+  let i = wrapValue @t @m @(NValue t f m) $ nvList $ map+        ( wrapValue @t @m @(NValue t f m)+        . nvStr+        . hackyMakeNixStringWithoutContext+        . Text.pack+        )+        (include opts)+  pushScope (M.singleton "__includes" i) $ pushScopes base $ case mpath of+    Nothing   -> action+    Just path -> do+      traceM $ "Setting __cur_file = " ++ show path+      let ref = wrapValue @t @m @(NValue t f m) $ nvPath path+      pushScope (M.singleton "__cur_file" ref) action++builtins :: (MonadNix e t f m, Scoped t m) => m (Scopes m t)+builtins = do+  ref <- thunk $ flip nvSet M.empty <$> buildMap+  lst <- ([("builtins", ref)] ++) <$> topLevelBuiltins+  pushScope (M.fromList lst) currentScopes+ where+  buildMap         = M.fromList . map mapping <$> builtinsList+  topLevelBuiltins = map mapping <$> fullBuiltinsList++  fullBuiltinsList = map go <$> builtinsList+   where+    go b@(Builtin TopLevel _) = b+    go (Builtin Normal (name, builtin)) =+      Builtin TopLevel ("__" <> name, builtin)++data BuiltinType = Normal | TopLevel+data Builtin t = Builtin+    { _kind   :: BuiltinType+    , mapping :: (Text, t)+    }++valueThunk :: forall e t f m . MonadNix e t f m => NValue t f m -> t+valueThunk = wrapValue @_ @m++force' :: forall e t f m . MonadNix e t f m => t -> m (NValue t f m)+force' = force ?? pure++builtinsList :: forall e t f m . MonadNix e t f m => m [Builtin t]+builtinsList = sequence+  [ do+    version <- toValue (principledMakeNixStringWithoutContext "2.0")+    pure $ Builtin Normal ("nixVersion", wrapValue version)+  , do+    version <- toValue (5 :: Int)+    pure $ Builtin Normal ("langVersion", wrapValue version)++  , add0 Normal   "nixPath"          nixPath+  , add  TopLevel "abort"            throw_ -- for now+  , add2 Normal   "add"              add_+  , add2 Normal   "addErrorContext"  addErrorContext+  , add2 Normal   "all"              all_+  , add2 Normal   "any"              any_+  , add  Normal   "attrNames"        attrNames+  , add  Normal   "attrValues"       attrValues+  , add  TopLevel "baseNameOf"       baseNameOf+  , add2 Normal   "bitAnd"           bitAnd+  , add2 Normal   "bitOr"            bitOr+  , add2 Normal   "bitXor"           bitXor+  , add2 Normal   "catAttrs"         catAttrs+  , add2 Normal   "compareVersions"  compareVersions_+  , add  Normal   "concatLists"      concatLists+  , add' Normal   "concatStringsSep" (arity2 principledIntercalateNixString)+  , add0 Normal   "currentSystem"    currentSystem+  , add0 Normal   "currentTime"      currentTime_+  , add2 Normal   "deepSeq"          deepSeq++    -- This is compiled in so that we only parse and evaluate it once, at+    -- compile-time.+  , add0 TopLevel "derivation" $(do+      let Success expr = parseNixText [i|+        drvAttrs @ { outputs ? [ "out" ], ... }:++        let++          strict = derivationStrict drvAttrs;++          commonAttrs = drvAttrs // (builtins.listToAttrs outputsList) //+            { all = map (x: x.value) outputsList;+              inherit drvAttrs;+            };++          outputToAttrListElement = outputName:+            { name = outputName;+              value = commonAttrs // {+                outPath = builtins.getAttr outputName strict;+                drvPath = strict.drvPath;+                type = "derivation";+                inherit outputName;+              };+            };++          outputsList = map outputToAttrListElement outputs;++        in (builtins.head outputsList).value|]+      [| cata Eval.eval expr |]+    )++  , add  TopLevel "derivationStrict" derivationStrict_+  , add  TopLevel "dirOf"            dirOf+  , add2 Normal   "div"              div_+  , add2 Normal   "elem"             elem_+  , add2 Normal   "elemAt"           elemAt_+  , add  Normal   "exec"             exec_+  , add0 Normal   "false"            (return $ nvConstant $ NBool False)+  , add  Normal   "fetchTarball"     fetchTarball+  , add  Normal   "fetchurl"         fetchurl+  , add2 Normal   "filter"           filter_+  , add3 Normal   "foldl'"           foldl'_+  , add  Normal   "fromJSON"         fromJSON+  , add  Normal   "functionArgs"     functionArgs+  , add2 Normal   "genList"          genList+  , add  Normal   "genericClosure"   genericClosure+  , add2 Normal   "getAttr"          getAttr+  , add  Normal   "getEnv"           getEnv_+  , add2 Normal   "hasAttr"          hasAttr+  , add  Normal   "hasContext"       hasContext+  , add' Normal   "hashString"       hashString+  , add  Normal   "head"             head_+  , add  TopLevel "import"           import_+  , add2 Normal   "intersectAttrs"   intersectAttrs+  , add  Normal   "isAttrs"          isAttrs+  , add  Normal   "isBool"           isBool+  , add  Normal   "isFloat"          isFloat+  , add  Normal   "isFunction"       isFunction+  , add  Normal   "isInt"            isInt+  , add  Normal   "isList"           isList+  , add  TopLevel "isNull"           isNull+  , add  Normal   "isString"         isString+  , add  Normal   "length"           length_+  , add2 Normal   "lessThan"         lessThan+  , add  Normal   "listToAttrs"      listToAttrs+  , add2 TopLevel "map"              map_+  , add2 TopLevel "mapAttrs"         mapAttrs_+  , add2 Normal   "match"            match_+  , add2 Normal   "mul"              mul_+  , add0 Normal   "null"             (return $ nvConstant NNull)+  , add  Normal   "parseDrvName"     parseDrvName+  , add2 Normal   "partition"        partition_+  , add  Normal   "pathExists"       pathExists_+  , add  TopLevel "placeholder"      placeHolder+  , add  Normal   "readDir"          readDir_+  , add  Normal   "readFile"         readFile_+  , add2 Normal   "findFile"         findFile_+  , add2 TopLevel "removeAttrs"      removeAttrs+  , add3 Normal   "replaceStrings"   replaceStrings+  , add2 TopLevel "scopedImport"     scopedImport+  , add2 Normal   "seq"              seq_+  , add2 Normal   "sort"             sort_+  , add2 Normal   "split"            split_+  , add  Normal   "splitVersion"     splitVersion_+  , add0 Normal   "storeDir"         (return $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")+  , add' Normal   "stringLength"     (arity1 $ Text.length . principledStringIgnoreContext)+  , add' Normal   "sub"              (arity2 ((-) @Integer))+  , add' Normal   "substring"        substring+  , add  Normal   "tail"             tail_+  , add0 Normal   "true"             (return $ nvConstant $ NBool True)+  , add  TopLevel "throw"            throw_+  , add  Normal   "toJSON"           prim_toJSON+  , add2 Normal   "toFile"           toFile+  , add  Normal   "toPath"           toPath+  , add  TopLevel "toString"         toString+  , add  Normal   "toXML"            toXML_+  , add2 TopLevel "trace"            trace_+  , add  Normal   "tryEval"          tryEval+  , add  Normal   "typeOf"           typeOf+  , add  Normal   "valueSize"        getRecursiveSize+  , add  Normal   "getContext"                 getContext+  , add2 Normal   "appendContext"              appendContext++  , add2 Normal   "unsafeGetAttrPos"           unsafeGetAttrPos+  , add  Normal   "unsafeDiscardStringContext" unsafeDiscardStringContext+  ]+ where+  wrap t n f = Builtin t (n, f)++  arity1 f = Prim . pure . f+  arity2 f = ((Prim . pure) .) . f++  mkThunk n = thunk . withFrame+    Info+    (ErrorCall $ "While calling builtin " ++ Text.unpack n ++ "\n")++  add0 t n v = wrap t n <$> mkThunk n v+  add t n v = wrap t n <$> mkThunk n (builtin (Text.unpack n) v)+  add2 t n v = wrap t n <$> mkThunk n (builtin2 (Text.unpack n) v)+  add3 t n v = wrap t n <$> mkThunk n (builtin3 (Text.unpack n) v)++  add' :: ToBuiltin t f m a => BuiltinType -> Text -> a -> m (Builtin t)+  add' t n v = wrap t n <$> mkThunk n (toBuiltin (Text.unpack n) v)++-- Primops++foldNixPath+  :: forall e t f m r+   . MonadNix e t f m+  => (FilePath -> Maybe String -> NixPathEntryType -> r -> m r)+  -> r+  -> m r+foldNixPath f z = do+  mres <- lookupVar "__includes"+  dirs <- case mres of+    Nothing -> return []+    Just v  -> force v fromNix+  menv <- getEnvVar "NIX_PATH"+  foldrM go z+    $  map (fromInclude . principledStringIgnoreContext) dirs+    ++ case menv of+         Nothing  -> []+         Just str -> uriAwareSplit (Text.pack str)+ where+  fromInclude x | "://" `Text.isInfixOf` x = (x, PathEntryURI)+                | otherwise                = (x, PathEntryPath)+  go (x, ty) rest = case Text.splitOn "=" x of+    [p] -> f (Text.unpack p) Nothing ty rest+    [n, p] -> f (Text.unpack p) (Just (Text.unpack n)) ty rest+    _ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " ++ show x++nixPath :: MonadNix e t f m => m (NValue t f m)+nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->+  pure+    $ valueThunk+        (flip nvSet mempty $ M.fromList+          [ case ty of+            PathEntryPath -> ("path", valueThunk $ nvPath p)+            PathEntryURI ->+              ( "uri"+              , valueThunk+                $ nvStr (hackyMakeNixStringWithoutContext (Text.pack p))+              )+          , ( "prefix"+            , valueThunk $ nvStr+              (hackyMakeNixStringWithoutContext $ Text.pack (fromMaybe "" mn))+            )+          ]+        )+    : rest++toString :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+toString str = str >>= coerceToString DontCopyToStore CoerceAny >>= toNix++hasAttr+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+hasAttr x y = fromValue x >>= fromStringNoContext >>= \key ->+  fromValue @(AttrSet t, AttrSet SourcePos) y+    >>= \(aset, _) -> toNix $ M.member key aset++attrsetGet :: MonadNix e t f m => Text -> AttrSet t -> m t+attrsetGet k s = case M.lookup k s of+  Just v -> pure v+  Nothing ->+    throwError $ ErrorCall $ "Attribute '" ++ Text.unpack k ++ "' required"++hasContext :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+hasContext = toNix . stringHasContext <=< fromValue++getAttr+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+getAttr x y = fromValue x >>= fromStringNoContext >>= \key ->+  fromValue @(AttrSet t, AttrSet SourcePos) y+    >>= \(aset, _) -> attrsetGet key aset >>= force'++unsafeGetAttrPos+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of+  (NVStr ns, NVSet _ apos) ->+    case M.lookup (hackyStringIgnoreContext ns) apos of+      Nothing    -> pure $ nvConstant NNull+      Just delta -> toValue delta+  (x, y) ->+    throwError+      $  ErrorCall+      $  "Invalid types for builtins.unsafeGetAttrPos: "+      ++ show (x, y)++-- This function is a bit special in that it doesn't care about the contents+-- of the list.+length_+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+length_ = toValue . (length :: [t] -> Int) <=< fromValue++add_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+add_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of+  (NVConstant (NInt   x), NVConstant (NInt y)  ) -> toNix (x + y :: Integer)+  (NVConstant (NFloat x), NVConstant (NInt y)  ) -> toNix (x + fromInteger y)+  (NVConstant (NInt   x), NVConstant (NFloat y)) -> toNix (fromInteger x + y)+  (NVConstant (NFloat x), NVConstant (NFloat y)) -> toNix (x + y)+  (_                    , _                    ) -> throwError $ Addition x' y'++mul_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+mul_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of+  (NVConstant (NInt   x), NVConstant (NInt y)  ) -> toNix (x * y :: Integer)+  (NVConstant (NFloat x), NVConstant (NInt y)  ) -> toNix (x * fromInteger y)+  (NVConstant (NInt   x), NVConstant (NFloat y)) -> toNix (fromInteger x * y)+  (NVConstant (NFloat x), NVConstant (NFloat y)) -> toNix (x * y)+  (_, _) -> throwError $ Multiplication x' y'++div_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of+  (NVConstant (NInt x), NVConstant (NInt y)) | y /= 0 ->+    toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)+  (NVConstant (NFloat x), NVConstant (NInt y)) | y /= 0 ->+    toNix (x / fromInteger y)+  (NVConstant (NInt x), NVConstant (NFloat y)) | y /= 0 ->+    toNix (fromInteger x / y)+  (NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 -> toNix (x / y)+  (_, _) -> throwError $ Division x' y'++anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool+anyM _ []       = return False+anyM p (x : xs) = do+  q <- p x+  if q then return True else anyM p xs++any_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+any_ fun xs = fun >>= \f ->+  toNix <=< anyM fromValue <=< mapM ((f `callFunc`) . force') <=< fromValue $ xs++allM :: Monad m => (a -> m Bool) -> [a] -> m Bool+allM _ []       = return True+allM p (x : xs) = do+  q <- p x+  if q then allM p xs else return False++all_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+all_ fun xs = fun >>= \f ->+  toNix <=< allM fromValue <=< mapM ((f `callFunc`) . force') <=< fromValue $ xs++foldl'_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+foldl'_ fun z xs = fun >>= \f -> fromValue @[t] xs >>= foldl' (go f) z+  where go f b a = f `callFunc` b >>= (`callFunc` force' a)++head_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+head_ = fromValue >=> \case+  []    -> throwError $ ErrorCall "builtins.head: empty list"+  h : _ -> force' h++tail_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+tail_ = fromValue >=> \case+  []    -> throwError $ ErrorCall "builtins.tail: empty list"+  _ : t -> return $ nvList t++data VersionComponent+   = VersionComponent_Pre -- ^ The string "pre"+   | VersionComponent_String Text -- ^ A string other than "pre"+   | VersionComponent_Number Integer -- ^ A number+   deriving (Show, Read, Eq, Ord)++versionComponentToString :: VersionComponent -> Text+versionComponentToString = \case+  VersionComponent_Pre      -> "pre"+  VersionComponent_String s -> s+  VersionComponent_Number n -> Text.pack $ show n++-- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44+versionComponentSeparators :: String+versionComponentSeparators = ".-"++splitVersion :: Text -> [VersionComponent]+splitVersion s = case Text.uncons s of+  Nothing -> []+  Just (h, t)+    | h `elem` versionComponentSeparators+    -> splitVersion t+    | isDigit h+    -> let (digits, rest) = Text.span isDigit s+       in+         VersionComponent_Number+             (fromMaybe (error $ "splitVersion: couldn't parse " <> show digits)+             $ readMaybe+             $ Text.unpack digits+             )+           : splitVersion rest+    | otherwise+    -> let (chars, rest) = Text.span+             (\c -> not $ isDigit c || c `elem` versionComponentSeparators)+             s+           thisComponent = case chars of+             "pre" -> VersionComponent_Pre+             x     -> VersionComponent_String x+       in  thisComponent : splitVersion rest++splitVersion_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+splitVersion_ = fromValue >=> fromStringNoContext >=> \s ->+  return+    $ nvList+    $ flip map (splitVersion s)+    $ valueThunk+    . nvStr+    . principledMakeNixStringWithoutContext+    . versionComponentToString++compareVersions :: Text -> Text -> Ordering+compareVersions s1 s2 = mconcat+  $ alignWith f (splitVersion s1) (splitVersion s2)+ where+  z = VersionComponent_String ""+  f = uncurry compare . fromThese z z++compareVersions_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+compareVersions_ t1 t2 = fromValue t1 >>= fromStringNoContext >>= \s1 ->+  fromValue t2 >>= fromStringNoContext >>= \s2 ->+    return $ nvConstant $ NInt $ case compareVersions s1 s2 of+      LT -> -1+      EQ -> 0+      GT -> 1++splitDrvName :: Text -> (Text, Text)+splitDrvName s =+  let+    sep    = "-"+    pieces = Text.splitOn sep s+    isFirstVersionPiece p = case Text.uncons p of+      Just (h, _) | isDigit h -> True+      _                       -> False+    -- Like 'break', but always puts the first item into the first result+    -- list+    breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])+    breakAfterFirstItem f = \case+      h : t -> let (a, b) = break f t in (h : a, b)+      []    -> ([], [])+    (namePieces, versionPieces) =+      breakAfterFirstItem isFirstVersionPiece pieces+  in+    (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)++parseDrvName+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+parseDrvName = fromValue >=> fromStringNoContext >=> \s -> do+  let (name :: Text, version :: Text) = splitDrvName s+  -- jww (2018-04-15): There should be an easier way to write this.+  (toValue =<<) $ sequence $ M.fromList+    [ ( "name" :: Text+      , thunk @t (toValue $ principledMakeNixStringWithoutContext name)+      )+    , ( "version"+      , thunk @t (toValue $ principledMakeNixStringWithoutContext version)+      )+    ]++match_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+match_ pat str = fromValue pat >>= fromStringNoContext >>= \p ->+  fromValue str >>= \ns -> do+        -- NOTE: Currently prim_match in nix/src/libexpr/primops.cc ignores the+        -- context of its second argument. This is probably a bug but we're+        -- going to preserve the behavior here until it is fixed upstream.+        -- Relevant issue: https://github.com/NixOS/nix/issues/2547+    let s  = principledStringIgnoreContext ns++    let re = makeRegex (encodeUtf8 p) :: Regex+    let mkMatch t+          | Text.null t = toValue ()+          | -- Shorthand for Null+            otherwise   = toValue $ principledMakeNixStringWithoutContext t+    case matchOnceText re (encodeUtf8 s) of+      Just ("", sarr, "") -> do+        let s = map fst (elems sarr)+        nvList <$> traverse (fmap wrapValue . mkMatch . decodeUtf8)+                            (if length s > 1 then tail s else s)+      _ -> pure $ nvConstant NNull++split_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+split_ pat str = fromValue pat >>= fromStringNoContext >>= \p ->+  fromValue str >>= \ns -> do+        -- NOTE: Currently prim_split in nix/src/libexpr/primops.cc ignores the+        -- context of its second argument. This is probably a bug but we're+        -- going to preserve the behavior here until it is fixed upstream.+        -- Relevant issue: https://github.com/NixOS/nix/issues/2547+    let s = principledStringIgnoreContext ns+    let re       = makeRegex (encodeUtf8 p) :: Regex+        haystack = encodeUtf8 s+    return $ nvList $ splitMatches 0+                                   (map elems $ matchAllText re haystack)+                                   haystack++splitMatches+  :: forall e t f m+   . MonadNix e t f m+  => Int+  -> [[(ByteString, (Int, Int))]]+  -> ByteString+  -> [t]+splitMatches _ [] haystack = [thunkStr haystack]+splitMatches _ ([] : _) _ =+  error "Error in splitMatches: this should never happen!"+splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack =+  thunkStr before : caps : splitMatches (numDropped + relStart + len)+                                        mts+                                        (B.drop len rest)+ where+  relStart       = max 0 start - numDropped+  (before, rest) = B.splitAt relStart haystack+  caps           = valueThunk $ nvList (map f captures)+  f (a, (s, _)) = if s < 0 then valueThunk (nvConstant NNull) else thunkStr a++thunkStr s =+  valueThunk (nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s)))++substring :: MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString+substring start len str = Prim $ if start < 0 --NOTE: negative values of 'len' are OK+  then+    throwError+    $  ErrorCall+    $  "builtins.substring: negative start position: "+    ++ show start+  else pure $ principledModifyNixContents (Text.take len . Text.drop start) str++attrNames+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+attrNames =+  fromValue @(AttrSet t)+    >=> toNix+    .   map principledMakeNixStringWithoutContext+    .   sort+    .   M.keys++attrValues+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+attrValues =+  fromValue @(AttrSet t)+    >=> toValue+    .   fmap snd+    .   sortOn (fst @Text @t)+    .   M.toList++map_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+map_ fun xs = fun >>= \f ->+  toValue+    <=< traverse+          ( thunk @t+          . withFrame Debug (ErrorCall "While applying f in map:\n")+          . (f `callFunc`)+          . force'+          )+    <=< fromValue @[t]+    $   xs++mapAttrs_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+mapAttrs_ fun xs = fun >>= \f -> fromValue @(AttrSet t) xs >>= \aset -> do+  let pairs = M.toList aset+  values <- for pairs $ \(key, value) ->+    thunk @t+      $   withFrame Debug (ErrorCall "While applying f in mapAttrs:\n")+      $   callFunc+      ??  force' value+      =<< callFunc f (pure (nvStr (principledMakeNixStringWithoutContext key)))+  toValue . M.fromList . zip (map fst pairs) $ values++filter_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+filter_ fun xs = fun >>= \f ->+  toValue+    <=< filterM (fromValue <=< callFunc f . force')+    <=< fromValue @[t]+    $   xs++catAttrs+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+catAttrs attrName xs = fromValue attrName >>= fromStringNoContext >>= \n ->+  fromValue @[t] xs >>= \l ->+    fmap (nvList . catMaybes)+      $ forM l+      $ fmap (M.lookup n)+      . flip force fromValue++baseNameOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+baseNameOf x = do+  ns <- coerceToString DontCopyToStore CoerceStringy =<< x+  pure $ nvStr+    (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)++bitAnd+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+bitAnd x y =+  fromValue @Integer x >>= \a -> fromValue @Integer y >>= \b -> toNix (a .&. b)++bitOr+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+bitOr x y =+  fromValue @Integer x >>= \a -> fromValue @Integer y >>= \b -> toNix (a .|. b)++bitXor+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+bitXor x y = fromValue @Integer x+  >>= \a -> fromValue @Integer y >>= \b -> toNix (a `xor` b)++dirOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+dirOf x = x >>= \case+  NVStr ns -> pure $ nvStr+    (principledModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)+  NVPath path -> pure $ nvPath $ takeDirectory path+  v ->+    throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v++-- jww (2018-04-28): This should only be a string argument, and not coerced?+unsafeDiscardStringContext+  :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+unsafeDiscardStringContext mnv = do+  ns <- fromValue mnv+  toNix $ principledMakeNixStringWithoutContext $ principledStringIgnoreContext+    ns++seq_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+seq_ a b = a >> b++deepSeq+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+deepSeq a b = do+    -- We evaluate 'a' only for its effects, so data cycles are ignored.+  normalForm_ =<< a++  -- Then we evaluate the other argument to deepseq, thus this function+  -- should always produce a result (unlike applying 'deepseq' on infinitely+  -- recursive data structures in Haskell).+  b++elem_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+elem_ x xs = x >>= \x' ->+    toValue <=< anyM (valueEqM x' <=< force') <=< fromValue @[t] $ xs++elemAt :: [a] -> Int -> Maybe a+elemAt ls i = case drop i ls of+  []    -> Nothing+  a : _ -> Just a++elemAt_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+elemAt_ xs n = fromValue n >>= \n' -> fromValue xs >>= \xs' ->+  case elemAt xs' n' of+    Just a -> force' a+    Nothing ->+      throwError+        $  ErrorCall+        $  "builtins.elem: Index "+        ++ show n'+        ++ " too large for list of length "+        ++ show (length xs')++genList+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+genList generator = fromValue @Integer >=> \n -> if n >= 0+  then generator >>= \f ->+    toValue =<< forM [0 .. n - 1] (\i -> thunk @t $ f `callFunc` toNix i)+  else+    throwError+    $  ErrorCall+    $  "builtins.genList: Expected a non-negative number, got "+    ++ show n++-- We wrap values solely to provide an Ord instance for genericClosure+newtype WValue t f m a = WValue (NValue' t f m a)++instance Comonad f => Eq (WValue t f m a) where+  WValue (NVConstant (NFloat x)) == WValue (NVConstant (NInt y)) =+    x == fromInteger y+  WValue (NVConstant (NInt x)) == WValue (NVConstant (NFloat y)) =+    fromInteger x == y+  WValue (NVConstant (NInt   x)) == WValue (NVConstant (NInt   y)) = x == y+  WValue (NVConstant (NFloat x)) == WValue (NVConstant (NFloat y)) = x == y+  WValue (NVPath     x         ) == WValue (NVPath     y         ) = x == y+  WValue (NVStr x) == WValue (NVStr y) =+    hackyStringIgnoreContext x == hackyStringIgnoreContext y+  _ == _ = False++instance Comonad f => Ord (WValue t f m a) where+  WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NInt y)) =+    x <= fromInteger y+  WValue (NVConstant (NInt x)) <= WValue (NVConstant (NFloat y)) =+    fromInteger x <= y+  WValue (NVConstant (NInt   x)) <= WValue (NVConstant (NInt   y)) = x <= y+  WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NFloat y)) = x <= y+  WValue (NVPath     x         ) <= WValue (NVPath     y         ) = x <= y+  WValue (NVStr x) <= WValue (NVStr y) =+    hackyStringIgnoreContext x <= hackyStringIgnoreContext y+  _ <= _ = False++genericClosure+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+genericClosure = fromValue @(AttrSet t) >=> \s ->+  case (M.lookup "startSet" s, M.lookup "operator" s) of+    (Nothing, Nothing) ->+      throwError+        $  ErrorCall+        $  "builtins.genericClosure: "+        ++ "Attributes 'startSet' and 'operator' required"+    (Nothing, Just _) ->+      throwError+        $ ErrorCall+        $ "builtins.genericClosure: Attribute 'startSet' required"+    (Just _, Nothing) ->+      throwError+        $ ErrorCall+        $ "builtins.genericClosure: Attribute 'operator' required"+    (Just startSet, Just operator) ->+      force startSet $ fromValue @[t] >=> \ss ->+        force operator $ \op -> toValue @[t] =<< snd <$> go op ss S.empty+ where+  go+    :: NValue t f m+    -> [t]+    -> Set (WValue t f m t)+    -> m (Set (WValue t f m t), [t])+  go _  []       ks = pure (ks, [])+  go op (t : ts) ks = force t $ \v -> fromValue @(AttrSet t) v >>= \s -> do+    k <- attrsetGet "key" s+    force k $ \k' -> do+      if S.member (WValue k') ks+        then go op ts ks+        else do+          ys <- fromValue @[t] =<< (op `callFunc` pure v)+          case S.toList ks of+            []           -> checkComparable k' k'+            WValue j : _ -> checkComparable k' j+          fmap (t :) <$> go op (ts ++ ys) (S.insert (WValue k') ks)++replaceStrings+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+replaceStrings tfrom tto ts = fromNix tfrom >>= \(nsFrom :: [NixString]) ->+  fromNix tto >>= \(nsTo :: [NixString]) ->+    fromValue ts >>= \(ns :: NixString) -> do+      let from = map principledStringIgnoreContext nsFrom+      when (length nsFrom /= length nsTo)+        $  throwError+        $  ErrorCall+        $  "'from' and 'to' arguments to 'replaceStrings'"+        ++ " have different lengths"+      let+        lookupPrefix s = do+          (prefix, replacement) <- find ((`Text.isPrefixOf` s) . fst)+            $ zip from nsTo+          let rest = Text.drop (Text.length prefix) s+          return (prefix, replacement, rest)+        finish b =+          principledMakeNixString (LazyText.toStrict $ Builder.toLazyText b)+        go orig result ctx = case lookupPrefix orig of+          Nothing -> case Text.uncons orig of+            Nothing     -> finish result ctx+            Just (h, t) -> go t (result <> Builder.singleton h) ctx+          Just (prefix, replacementNS, rest) ->+            let replacement = principledStringIgnoreContext replacementNS+                newCtx      = principledGetContext replacementNS+            in  case prefix of+                  "" -> case Text.uncons rest of+                    Nothing -> finish+                      (result <> Builder.fromText replacement)+                      (ctx <> newCtx)+                    Just (h, t) -> go+                      t+                      (mconcat+                        [ result+                        , Builder.fromText replacement+                        , Builder.singleton h+                        ]+                      )+                      (ctx <> newCtx)+                  _ -> go rest+                          (result <> Builder.fromText replacement)+                          (ctx <> newCtx)+      toNix+        $ go (principledStringIgnoreContext ns) mempty+        $ principledGetContext ns++removeAttrs+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+removeAttrs set = fromNix >=> \(nsToRemove :: [NixString]) ->+  fromValue @(AttrSet t, AttrSet SourcePos) set >>= \(m, p) -> do+    toRemove <- mapM fromStringNoContext nsToRemove+    toNix (go m toRemove, go p toRemove)+  where go = foldl' (flip M.delete)++intersectAttrs+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+intersectAttrs set1 set2 =+  fromValue @(AttrSet t, AttrSet SourcePos) set1 >>= \(s1, p1) ->+    fromValue @(AttrSet t, AttrSet SourcePos) set2 >>= \(s2, p2) ->+      return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)++functionArgs+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+functionArgs fun = fun >>= \case+  NVClosure p _ ->+    toValue @(AttrSet t) $ valueThunk . nvConstant . NBool <$> case p of+      Param name     -> M.singleton name False+      ParamSet s _ _ -> isJust <$> M.fromList s+  v ->+    throwError+      $  ErrorCall+      $  "builtins.functionArgs: expected function, got "+      ++ show v++toFile+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+toFile name s = do+  name' <- fromStringNoContext =<< fromValue name+  s'    <- fromValue s+  -- TODO Using hacky here because we still need to turn the context into+  -- runtime references of the resulting file.+  -- See prim_toFile in nix/src/libexpr/primops.cc+  mres  <- toFile_ (Text.unpack name')+                   (Text.unpack $ hackyStringIgnoreContext s')+  let t  = Text.pack $ unStorePath mres+      sc = StringContext t DirectPath+  toNix $ principledMakeNixStringWithSingletonContext t sc++toPath :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+toPath = fromValue @Path >=> toNix @Path++pathExists_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+pathExists_ path = path >>= \case+  NVPath p  -> toNix =<< pathExists p+  NVStr  ns -> toNix =<< pathExists (Text.unpack (hackyStringIgnoreContext ns))+  v ->+    throwError+      $  ErrorCall+      $  "builtins.pathExists: expected path, got "+      ++ show v++hasKind+  :: forall a e t f m+   . (MonadNix e t f m, FromValue a m (NValue t f m))+  => m (NValue t f m)+  -> m (NValue t f m)+hasKind = fromValueMay >=> toNix . \case+  Just (_ :: a) -> True+  _             -> False++isAttrs+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isAttrs = hasKind @(AttrSet t)++isList+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isList = hasKind @[t]++isString+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isString = hasKind @NixString++isInt+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isInt = hasKind @Int++isFloat+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isFloat = hasKind @Float++isBool+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isBool = hasKind @Bool++isNull+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isNull = hasKind @()++isFunction :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+isFunction func = func >>= \case+  NVClosure{} -> toValue True+  _           -> toValue False++throw_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+throw_ mnv = do+  ns <- coerceToString CopyToStore CoerceStringy =<< mnv+  throwError . ErrorCall . Text.unpack $ principledStringIgnoreContext ns++import_+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+import_ = scopedImport (pure (nvSet M.empty M.empty))++scopedImport+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+scopedImport asetArg pathArg = fromValue @(AttrSet t) asetArg >>= \s ->+  fromValue pathArg >>= \(Path p) -> do+    path  <- pathToDefaultNix @t @f @m p+    mres  <- lookupVar "__cur_file"+    path' <- case mres of+      Nothing -> do+        traceM "No known current directory"+        return path+      Just p -> force p $ fromValue >=> \(Path p') -> do+        traceM $ "Current file being evaluated is: " ++ show p'+        return $ takeDirectory p' </> path+    clearScopes @t+      $ withNixContext (Just path')+      $ pushScope s+      $ importPath @t @f @m path'++getEnv_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do+  mres <- getEnvVar (Text.unpack s)+  toNix $ principledMakeNixStringWithoutContext $ case mres of+    Nothing -> ""+    Just v  -> Text.pack v++sort_+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+sort_ comparator xs = comparator+  >>= \comp -> fromValue xs >>= sortByM (cmp comp) >>= toValue+ where+  cmp f a b = do+    isLessThan <- f `callFunc` force' a >>= (`callFunc` force' b)+    fromValue isLessThan >>= \case+      True  -> pure LT+      False -> do+        isGreaterThan <- f `callFunc` force' b >>= (`callFunc` force' a)+        fromValue isGreaterThan <&> \case+          True  -> GT+          False -> EQ++lessThan+  :: MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+lessThan ta tb = ta >>= \va -> tb >>= \vb -> do+  let badType =+        throwError+          $  ErrorCall+          $  "builtins.lessThan: expected two numbers or two strings, "+          ++ "got "+          ++ show va+          ++ " and "+          ++ show vb+  nvConstant . NBool <$> case (va, vb) of+    (NVConstant ca, NVConstant cb) -> case (ca, cb) of+      (NInt   a, NInt b  ) -> pure $ a < b+      (NFloat a, NInt b  ) -> pure $ a < fromInteger b+      (NInt   a, NFloat b) -> pure $ fromInteger a < b+      (NFloat a, NFloat b) -> pure $ a < b+      _                    -> badType+    (NVStr a, NVStr b) ->+      pure $ principledStringIgnoreContext a < principledStringIgnoreContext b+    _ -> badType++concatLists+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+concatLists =+  fromValue @[t]+    >=> mapM (flip force $ fromValue @[t] >=> pure)+    >=> toValue+    .   concat++listToAttrs+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+listToAttrs = fromValue @[t] >=> \l ->+  fmap (flip nvSet M.empty . M.fromList . reverse)+    $   forM l+    $   flip force+    $   fromValue @(AttrSet t)+    >=> \s -> do+          t <- attrsetGet "name" s+          force t $ fromValue >=> \n -> do+            name <- fromStringNoContext n+            val  <- attrsetGet "value" s+            pure (name, val)++-- prim_hashString from nix/src/libexpr/primops.cc+-- fail if context in the algo arg+-- propagate context from the s arg+hashString+  :: MonadNix e t f m => NixString -> NixString -> Prim m NixString+hashString nsAlgo ns = Prim $ do+  algo <- fromStringNoContext nsAlgo+  let f g = pure $ principledModifyNixContents g ns+  case algo of+    "md5" ->+      f $ \s ->+#if MIN_VERSION_hashing(0, 1, 0)+                Text.pack $ show (hash (encodeUtf8 s) :: MD5.MD5)+#else+          decodeUtf8 $ Base16.encode $ MD5.hash $ encodeUtf8 s+#endif+    "sha1" ->+      f $ \s ->+#if MIN_VERSION_hashing(0, 1, 0)+                Text.pack $ show (hash (encodeUtf8 s) :: SHA1.SHA1)+#else+          decodeUtf8 $ Base16.encode $ SHA1.hash $ encodeUtf8 s+#endif+    "sha256" ->+      f $ \s ->+#if MIN_VERSION_hashing(0, 1, 0)+                Text.pack $ show (hash (encodeUtf8 s) :: SHA256.SHA256)+#else+          decodeUtf8 $ Base16.encode $ SHA256.hash $ encodeUtf8 s+#endif+    "sha512" ->+      f $ \s ->+#if MIN_VERSION_hashing(0, 1, 0)+                Text.pack $ show (hash (encodeUtf8 s) :: SHA512.SHA512)+#else+          decodeUtf8 $ Base16.encode $ SHA512.hash $ encodeUtf8 s+#endif+    _ ->+      throwError+        $  ErrorCall+        $  "builtins.hashString: "+        ++ "expected \"md5\", \"sha1\", \"sha256\", or \"sha512\", got "+        ++ show algo++placeHolder :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+placeHolder = fromValue >=> fromStringNoContext >=> \t -> do+  h <- runPrim+    (hashString (principledMakeNixStringWithoutContext "sha256")+                (principledMakeNixStringWithoutContext ("nix-output:" <> t))+    )+  toNix+    $ principledMakeNixStringWithoutContext+    $ Text.cons '/'+    $ printHashBytes32+    $ fst             -- The result coming out of hashString is base16 encoded+    $ Base16.decode+    $ encodeUtf8+    $ principledStringIgnoreContext h++absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m FilePath+absolutePathFromValue = \case+  NVStr ns -> do+    let path = Text.unpack $ hackyStringIgnoreContext ns+    unless (isAbsolute path)+      $  throwError+      $  ErrorCall+      $  "string "+      ++ show path+      ++ " doesn't represent an absolute path"+    pure path+  NVPath path -> pure path+  v           -> throwError $ ErrorCall $ "expected a path, got " ++ show v++readFile_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+readFile_ path =+  path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix++findFile_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+findFile_ aset filePath = aset >>= \aset' -> filePath >>= \filePath' ->+  case (aset', filePath') of+    (NVList x, NVStr ns) -> do+      mres <- findPath @t @f @m x (Text.unpack (hackyStringIgnoreContext ns))+      pure $ nvPath mres+    (NVList _, y) ->+      throwError $ ErrorCall $ "expected a string, got " ++ show y+    (x, NVStr _) -> throwError $ ErrorCall $ "expected a list, got " ++ show x+    (x, y) ->+      throwError $ ErrorCall $ "Invalid types for builtins.findFile: " ++ show+        (x, y)++data FileType+   = FileTypeRegular+   | FileTypeDirectory+   | FileTypeSymlink+   | FileTypeUnknown+   deriving (Show, Read, Eq, Ord)++instance Convertible e t f m => ToNix FileType m (NValue t f m) where+  toNix = toNix . principledMakeNixStringWithoutContext . \case+    FileTypeRegular   -> "regular" :: Text+    FileTypeDirectory -> "directory"+    FileTypeSymlink   -> "symlink"+    FileTypeUnknown   -> "unknown"++readDir_+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+readDir_ pathThunk = do+  path           <- absolutePathFromValue =<< pathThunk+  items          <- listDirectory path+  itemsWithTypes <- forM items $ \item -> do+    s <- getSymbolicLinkStatus $ path </> item+    let t = if+          | isRegularFile s  -> FileTypeRegular+          | isDirectory s    -> FileTypeDirectory+          | isSymbolicLink s -> FileTypeSymlink+          | otherwise        -> FileTypeUnknown+    pure (Text.pack item, t)+  toNix (M.fromList itemsWithTypes)++fromJSON+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->+  case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of+    Left jsonError ->+      throwError $ ErrorCall $ "builtins.fromJSON: " ++ jsonError+    Right v -> jsonToNValue v+ where+  jsonToNValue = \case+    A.Object m -> flip nvSet M.empty <$> traverse (thunk . jsonToNValue) m+    A.Array  l -> nvList <$> traverse+      (\x ->+        thunk @t @m @(NValue t f m)+          . whileForcingThunk @t @f (CoercionFromJson @t @f @m x)+          . jsonToNValue+          $ x+      )+      (V.toList l)+    A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s+    A.Number n -> pure $ nvConstant $ case floatingOrInteger n of+      Left  r -> NFloat r+      Right i -> NInt i+    A.Bool b -> pure $ nvConstant $ NBool b+    A.Null   -> pure $ nvConstant NNull++prim_toJSON :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+prim_toJSON x = x >>= nvalueToJSONNixString >>= pure . nvStr++toXML_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+toXML_ v = v >>= normalForm >>= pure . nvStr . toXML++typeOf :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case+  NVConstant a -> case a of+    NInt   _ -> "int"+    NFloat _ -> "float"+    NBool  _ -> "bool"+    NNull    -> "null"+  NVStr  _      -> "string"+  NVList _      -> "list"+  NVSet _ _     -> "set"+  NVClosure{}   -> "lambda"+  NVPath _      -> "path"+  NVBuiltin _ _ -> "lambda"+  _             -> error "Pattern synonyms obscure complete patterns"++tryEval+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+tryEval e = catch (onSuccess <$> e) (pure . onError)+ where+  onSuccess v = flip nvSet M.empty $ M.fromList+    [("success", valueThunk (nvConstant (NBool True))), ("value", valueThunk v)]++  onError :: SomeException -> NValue t f m+  onError _ = flip nvSet M.empty $ M.fromList+    [ ("success", valueThunk (nvConstant (NBool False)))+    , ("value"  , valueThunk (nvConstant (NBool False)))+    ]++trace_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+trace_ msg action = do+  traceEffect @t @f @m+    .   Text.unpack+    .   principledStringIgnoreContext+    =<< fromValue msg+  action++-- TODO: remember error context+addErrorContext+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+addErrorContext _ action = action++exec_+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+exec_ xs = do+  ls <- fromValue @[t] xs+  xs <- traverse (coerceToString DontCopyToStore CoerceStringy <=< force') ls+  -- TODO Still need to do something with the context here+  -- See prim_exec in nix/src/libexpr/primops.cc+  -- Requires the implementation of EvalState::realiseContext+  exec (map (Text.unpack . hackyStringIgnoreContext) xs)++fetchurl+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+fetchurl v = v >>= \case+  NVSet s _ -> attrsetGet "url" s >>= force ?? (go (M.lookup "sha256" s))+  v@NVStr{} -> go Nothing v+  v ->+    throwError+      $  ErrorCall+      $  "builtins.fetchurl: Expected URI or set, got "+      ++ show v+ where+  go :: Maybe t -> NValue t f m -> m (NValue t f m)+  go _msha = \case+    NVStr ns -> noContextAttrs ns >>= getURL >>= \case -- msha+      Left  e -> throwError e+      Right p -> toValue p+    v ->+      throwError+        $  ErrorCall+        $  "builtins.fetchurl: Expected URI or string, got "+        ++ show v++  noContextAttrs ns = case principledGetStringNoContext ns of+    Nothing ->+      throwError $ ErrorCall $ "builtins.fetchurl: unsupported arguments to url"+    Just t -> pure t++partition_+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+partition_ fun xs = fun >>= \f -> fromValue @[t] xs >>= \l -> do+  let match t = f `callFunc` force' t >>= fmap (, t) . fromValue+  selection <- traverse match l+  let (right, wrong) = partition fst selection+  let makeSide       = valueThunk . nvList . map snd+  toValue @(AttrSet t)+    $ M.fromList [("right", makeSide right), ("wrong", makeSide wrong)]++currentSystem :: MonadNix e t f m => m (NValue t f m)+currentSystem = do+  os   <- getCurrentSystemOS+  arch <- getCurrentSystemArch+  return $ nvStr $ principledMakeNixStringWithoutContext (arch <> "-" <> os)++currentTime_ :: MonadNix e t f m => m (NValue t f m)+currentTime_ = do+  opts :: Options <- asks (view hasLens)+  toNix @Integer $ round $ Time.utcTimeToPOSIXSeconds (currentTime opts)++derivationStrict_ :: MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+derivationStrict_ = (>>= derivationStrict)++getContext+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+getContext x = x >>= \x' -> case x' of+  (NVStr ns) -> do+    let context =+          getNixLikeContext $ toNixLikeContext $ principledGetContext ns+    valued :: M.HashMap Text (NValue t f m) <- sequenceA $ M.map toValue context+    pure $ flip nvSet M.empty $ M.map wrapValue valued+  x ->+    throwError $ ErrorCall $ "Invalid type for builtins.getContext: " ++ show x++appendContext+  :: forall e t f m+   . MonadNix e t f m+  => m (NValue t f m)+  -> m (NValue t f m)+  -> m (NValue t f m)+appendContext x y = x >>= \x' -> y >>= \y' -> case (x', y') of+  (NVStr ns, NVSet attrs _) -> do+    newContextValues <- forM attrs $ force' >=> \case+      NVSet attrs _ -> do+        -- TODO: Fail for unexpected keys.+        path <- maybe (return False) (force ?? fromValue)+          $ M.lookup "path" attrs+        allOutputs <- maybe (return False) (force ?? fromValue)+          $ M.lookup "allOutputs" attrs+        outputs <- case M.lookup "outputs" attrs of+          Nothing -> return []+          Just os -> force' os >>= \case+            NVList vs ->+              forM vs $ fmap principledStringIgnoreContext . fromNix . force'+            x ->+              throwError+                $ ErrorCall+                $ "Invalid types for context value outputs in builtins.appendContext: "+                ++ show x+        return $ NixLikeContextValue path allOutputs outputs+      x ->+        throwError+          $  ErrorCall+          $  "Invalid types for context value in builtins.appendContext: "+          ++ show x+    toValue+      $ principledMakeNixString (principledStringIgnoreContext ns)+      $ fromNixLikeContext+      $ NixLikeContext+      $ M.unionWith (<>) newContextValues+      $ getNixLikeContext+      $ toNixLikeContext+      $ principledGetContext ns+  (x, y) ->+    throwError+      $  ErrorCall+      $  "Invalid types for builtins.appendContext: "+      ++ show (x, y)++newtype Prim m a = Prim { runPrim :: m a }++-- | Types that support conversion to nix in a particular monad+class ToBuiltin t f m a | a -> m where+    toBuiltin :: String -> a -> m (NValue t f m)++instance (MonadNix e t f m, ToNix a m (NValue t f m))+      => ToBuiltin t f m (Prim m a) where+  toBuiltin _ p = toNix =<< runPrim p++instance ( MonadNix e t f m+         , FromNix a m (NValue t f m)+         , ToBuiltin t f m b)+      => ToBuiltin t f m (a -> b) where+  toBuiltin name f =+    return $ nvBuiltin name (fromNix >=> fmap wrapValue . toBuiltin name . f)
src/Nix/Cache.hs view
@@ -2,7 +2,7 @@  module Nix.Cache where -import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy          as BS import           Nix.Expr.Types.Annotated  #if defined (__linux__) && MIN_VERSION_base(4, 10, 0)@@ -14,7 +14,7 @@ import qualified Data.Compact.Serialize as C #endif #ifdef MIN_VERSION_serialise-import qualified Codec.Serialise as S+import qualified Codec.Serialise               as S #endif  readCache :: FilePath -> IO NExprLoc@@ -26,10 +26,10 @@         Right expr -> return $ C.getCompact expr #else #ifdef MIN_VERSION_serialise-    eres <- S.deserialiseOrFail <$> BS.readFile path-    case eres of-        Left err -> error $ "Error reading cache file: " ++ show err-        Right expr -> return expr+  eres <- S.deserialiseOrFail <$> BS.readFile path+  case eres of+    Left  err  -> error $ "Error reading cache file: " ++ show err+    Right expr -> return expr #else     error "readCache not implemented for this platform" #endif@@ -41,7 +41,7 @@     C.writeCompact path =<< C.compact expr #else #ifdef MIN_VERSION_serialise-    BS.writeFile path (S.serialise expr)+  BS.writeFile path (S.serialise expr) #else     error "writeCache not implemented for this platform" #endif
+ src/Nix/Cited.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -Wno-missing-signatures #-}++module Nix.Cited where++import           Control.Comonad+import           Control.Comonad.Env+import           Data.Typeable                  ( Typeable )+import           GHC.Generics+import           Lens.Family2.TH++import           Nix.Expr.Types.Annotated+import           Nix.Scope++data Provenance t m v = Provenance+    { _lexicalScope :: Scopes m t+    , _originExpr   :: NExprLocF (Maybe v)+      -- ^ When calling the function x: x + 2 with argument x = 3, the+      --   'originExpr' for the resulting value will be 3 + 2, while the+      --   'contextExpr' will be @(x: x + 2) 3@, preserving not only the+      --   result of the call, but what was called and with what arguments.+    }+    deriving (Generic, Typeable, Show)++data NCited t m v a = NCited+    { _provenance :: [Provenance t m v]+    , _cited      :: a+    }+    deriving (Generic, Typeable, Functor, Foldable, Traversable, Show)++instance Applicative (NCited t m v) where+  pure = NCited []+  NCited xs f <*> NCited ys x = NCited (xs <> ys) (f x)++instance Comonad (NCited t m v) where+  duplicate p = NCited (_provenance p) p+  extract = _cited++instance ComonadEnv [Provenance t m v] (NCited t m v) where+  ask = _provenance++$(makeLenses ''Provenance)+$(makeLenses ''NCited)++class HasCitations t m v a where+    citations :: a -> [Provenance t m v]+    addProvenance :: Provenance t m v -> a -> a++instance HasCitations t m v (NCited t m v a) where+  citations = _provenance+  addProvenance x (NCited p v) = (NCited (x : p) v)++class HasCitations1 t m v f where+    citations1 :: f a -> [Provenance t m v]+    addProvenance1 :: Provenance t m v -> f a -> f a
+ src/Nix/Cited/Basic.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++module Nix.Cited.Basic where++import           Control.Comonad                ( Comonad )+import           Control.Comonad.Env            ( ComonadEnv )+import           Control.Monad.Catch     hiding ( catchJust )+import           Control.Monad.Reader+import           Data.Fix+import           GHC.Generics+import           Nix.Cited+import           Nix.Eval                      as Eval+import           Nix.Exec+import           Nix.Expr+import           Nix.Frames+import           Nix.Options+import           Nix.Thunk+import           Nix.Utils+import           Nix.Value++newtype Cited t f m a = Cited { getCited :: NCited t m (NValue t f m) a }+  deriving+    ( Generic+    , Typeable+    , Functor+    , Applicative+    , Foldable+    , Traversable+    , Comonad+    , ComonadEnv [Provenance t m (NValue t f m)]+    )++instance HasCitations1 t m (NValue t f m) (Cited t f m) where+  citations1 (Cited c) = citations c+  addProvenance1 x (Cited c) = Cited (addProvenance x c)++instance ( Has e Options+         , Framed e m+         , MonadThunk t m v+         , Typeable m+         , Typeable u+         , MonadCatch m+         )+  => MonadThunk (Cited u f m t) m v where+  thunk mv = do+    opts :: Options <- asks (view hasLens)++    if thunks opts+      then do+        frames :: Frames <- asks (view hasLens)++        -- Gather the current evaluation context at the time of thunk+        -- creation, and record it along with the thunk.+        let go (fromException ->+                    Just (EvaluatingExpr scope+                             (Fix (Compose (Ann s e))))) =+                let e' = Compose (Ann s (Nothing <$ e))+                in [Provenance scope e']+            go _ = []+            ps = concatMap (go . frame) frames++        fmap (Cited . NCited ps) . thunk $ mv+      else fmap (Cited . NCited []) . thunk $ mv++  thunkId (Cited (NCited _ t)) = thunkId @_ @m t++  query (Cited (NCited _ t)) = query t+  queryM (Cited (NCited _ t)) = queryM t++  -- | The ThunkLoop exception is thrown as an exception with MonadThrow,+  --   which does not capture the current stack frame information to provide+  --   it in a NixException, so we catch and re-throw it here using+  --   'throwError' from Frames.hs.+  force (Cited (NCited ps t)) f =+    catch go (throwError @ThunkLoop)+   where+    go = case ps of+      [] -> force t f+      Provenance scope e@(Compose (Ann s _)) : _ ->+        withFrame Info (ForcingExpr scope (wrapExprLoc s e)) (force t f)++  forceEff (Cited (NCited ps t)) f = catch+    go+    (throwError @ThunkLoop)+   where+    go = case ps of+      [] -> forceEff t f+      Provenance scope e@(Compose (Ann s _)) : _ ->+        withFrame Info (ForcingExpr scope (wrapExprLoc s e)) (forceEff t f)++  wrapValue = Cited . NCited [] . wrapValue+  getValue (Cited (NCited _ v)) = getValue v
src/Nix/Context.hs view
@@ -4,30 +4,32 @@  module Nix.Context where -import Nix.Options-import Nix.Scope-import Nix.Frames-import Nix.Utils-import Nix.Expr.Types.Annotated (SrcSpan, nullSpan)+import           Nix.Options+import           Nix.Scope+import           Nix.Frames+import           Nix.Utils+import           Nix.Expr.Types.Annotated       ( SrcSpan+                                                , nullSpan+                                                ) -data Context m v = Context-    { scopes  :: Scopes m v+data Context m t = Context+    { scopes  :: Scopes m t     , source  :: SrcSpan     , frames  :: Frames     , options :: Options     } -instance Has (Context m v) (Scopes m v) where-    hasLens f (Context x y z w) = (\x' -> Context x' y z w) <$> f x+instance Has (Context m t) (Scopes m t) where+  hasLens f (Context x y z w) = (\x' -> Context x' y z w) <$> f x -instance Has (Context m v) SrcSpan where-    hasLens f (Context x y z w) = (\y' -> Context x y' z w) <$> f y+instance Has (Context m t) SrcSpan where+  hasLens f (Context x y z w) = (\y' -> Context x y' z w) <$> f y -instance Has (Context m v) Frames where-    hasLens f (Context x y z w) = (\z' -> Context x y z' w) <$> f z+instance Has (Context m t) Frames where+  hasLens f (Context x y z w) = (\z' -> Context x y z' w) <$> f z -instance Has (Context m v) Options where-    hasLens f (Context x y z w) = (\w' -> Context x y z w') <$> f w+instance Has (Context m t) Options where+  hasLens f (Context x y z w) = (\w' -> Context x y z w') <$> f w -newContext :: Options -> Context m v+newContext :: Options -> Context m t newContext = Context emptyScopes nullSpan []
src/Nix/Convert.hs view
@@ -11,6 +11,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-}  {-# OPTIONS_GHC -Wno-missing-signatures #-}@@ -26,432 +28,392 @@ module Nix.Convert where  import           Control.Monad-import           Data.Aeson (toJSON)-import qualified Data.Aeson as A+import           Control.Monad.Catch import           Data.ByteString-import           Data.Fix-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M-import           Data.Scientific-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Text.Encoding (encodeUtf8, decodeUtf8)-import qualified Data.Vector as V+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M+import           Data.Maybe+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text+import           Data.Text.Encoding             ( encodeUtf8+                                                , decodeUtf8+                                                ) import           Nix.Atoms import           Nix.Effects import           Nix.Expr.Types import           Nix.Expr.Types.Annotated import           Nix.Frames-import           Nix.Normal+import           Nix.String import           Nix.Thunk-import           Nix.Utils import           Nix.Value +{-++IMPORTANT NOTE++We used to have Text instances of FromValue, ToValue, FromNix, and ToNix.+However, we're removing these instances because they are dangerous due to the+fact that they hide the way string contexts are handled. It's better to have to+explicitly handle string context in a way that is appropriate for the situation.++Do not add these instances back!++-}+ class FromValue a m v where     fromValue    :: v -> m a     fromValueMay :: v -> m (Maybe a) -type Convertible e m = (Framed e m, MonadVar m, Typeable m)--instance Convertible e m => FromValue () m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF NNull) -> pure $ Just ()-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TNull v--instance Convertible e m-      => FromValue () m (NValue m) where-    fromValueMay = \case-        NVConstant NNull -> pure $ Just ()-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TNull v+type Convertible e t f m+  = (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m) -instance Convertible e m-      => FromValue Bool m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF (NBool b)) -> pure $ Just b-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TBool v+instance Convertible e t f m => FromValue () m (NValueNF t f m) where+  fromValueMay = \case+    NVConstantNF NNull -> pure $ Just ()+    _                  -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TNull v -instance Convertible e m-      => FromValue Bool m (NValue m) where-    fromValueMay = \case-        NVConstant (NBool b) -> pure $ Just b-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TBool v+instance Convertible e t f m => FromValue () m (NValue t f m) where+  fromValueMay = \case+    NVConstant NNull -> pure $ Just ()+    _                -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TNull v -instance Convertible e m-      => FromValue Int m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF (NInt b)) -> pure $ Just (fromInteger b)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TInt v+instance Convertible e t f m => FromValue Bool m (NValueNF t f m) where+  fromValueMay = \case+    NVConstantNF (NBool b) -> pure $ Just b+    _                      -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TBool v -instance Convertible e m-      => FromValue Int m (NValue m) where-    fromValueMay = \case-        NVConstant (NInt b) -> pure $ Just (fromInteger b)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TInt v+instance Convertible e t f m => FromValue Bool m (NValue t f m) where+  fromValueMay = \case+    NVConstant (NBool b) -> pure $ Just b+    _                    -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TBool v -instance Convertible e m-      => FromValue Integer m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF (NInt b)) -> pure $ Just b-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TInt v+instance Convertible e t f m => FromValue Int m (NValueNF t f m) where+  fromValueMay = \case+    NVConstantNF (NInt b) -> pure $ Just (fromInteger b)+    _                     -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TInt v -instance Convertible e m-      => FromValue Integer m (NValue m) where-    fromValueMay = \case-        NVConstant (NInt b) -> pure $ Just b-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TInt v+instance Convertible e t f m => FromValue Int m (NValue t f m) where+  fromValueMay = \case+    NVConstant (NInt b) -> pure $ Just (fromInteger b)+    _                   -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TInt v -instance Convertible e m-      => FromValue Float m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF (NFloat b)) -> pure $ Just b-        Fix (NVConstantF (NInt i)) -> pure $ Just (fromInteger i)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TFloat v+instance Convertible e t f m => FromValue Integer m (NValueNF t f m) where+  fromValueMay = \case+    NVConstantNF (NInt b) -> pure $ Just b+    _                     -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TInt v -instance Convertible e m-      => FromValue Float m (NValue m) where-    fromValueMay = \case-        NVConstant (NFloat b) -> pure $ Just b-        NVConstant (NInt i) -> pure $ Just (fromInteger i)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TFloat v+instance Convertible e t f m => FromValue Integer m (NValue t f m) where+  fromValueMay = \case+    NVConstant (NInt b) -> pure $ Just b+    _                   -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TInt v -instance (Convertible e m, MonadEffects m)-      => FromValue Text m (NValueNF m) where-    fromValueMay = \case-        Fix (NVStrF t _) -> pure $ Just t-        Fix (NVPathF p) -> Just . Text.pack . unStorePath <$> addPath p-        Fix (NVSetF s _) -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fromValueMay @Text p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TString v+instance Convertible e t f m => FromValue Float m (NValueNF t f m) where+  fromValueMay = \case+    NVConstantNF (NFloat b) -> pure $ Just b+    NVConstantNF (NInt   i) -> pure $ Just (fromInteger i)+    _                       -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TFloat v -instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)-      => FromValue Text m (NValue m) where-    fromValueMay = \case-        NVStr t _ -> pure $ Just t-        NVPath p -> Just . Text.pack . unStorePath <$> addPath p-        NVSet s _ -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fromValueMay @Text p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TString v+instance Convertible e t f m => FromValue Float m (NValue t f m) where+  fromValueMay = \case+    NVConstant (NFloat b) -> pure $ Just b+    NVConstant (NInt   i) -> pure $ Just (fromInteger i)+    _                     -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TFloat v -instance (Convertible e m, MonadEffects m)-      => FromValue (Text, DList Text) m (NValueNF m) where-    fromValueMay = \case-        Fix (NVStrF t d) -> pure $ Just (t, d)-        Fix (NVPathF p) -> Just . (,mempty) . Text.pack . unStorePath <$> addPath p-        Fix (NVSetF s _) -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fmap (,mempty) <$> fromValueMay @Text p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TString v+instance (Convertible e t f m, MonadEffects t f m)+      => FromValue NixString m (NValueNF t f m) where+  fromValueMay = \case+    NVStrNF ns -> pure $ Just ns+    NVPathNF p ->+      Just+        .   hackyMakeNixStringWithoutContext+        .   Text.pack+        .   unStorePath+        <$> addPath p+    NVSetNF s _ -> case M.lookup "outPath" s of+      Nothing -> pure Nothing+      Just p  -> fromValueMay p+    _ -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF (TString NoContext) v -instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)-      => FromValue (Text, DList Text) m (NValue m) where-    fromValueMay = \case-        NVStr t d -> pure $ Just (t, d)-        NVPath p -> Just . (,mempty) . Text.pack . unStorePath <$> addPath p-        NVSet s _ -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fmap (,mempty) <$> fromValueMay @Text p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TString v+instance (Convertible e t f m, MonadEffects t f m)+      => FromValue NixString m (NValue t f m) where+  fromValueMay = \case+    NVStr ns -> pure $ Just ns+    NVPath p ->+      Just+        .   hackyMakeNixStringWithoutContext+        .   Text.pack+        .   unStorePath+        <$> addPath p+    NVSet s _ -> case M.lookup "outPath" s of+      Nothing -> pure Nothing+      Just p  -> force p fromValueMay+    _ -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation (TString NoContext) v -instance Convertible e m-      => FromValue ByteString m (NValueNF m) where-    fromValueMay = \case-        Fix (NVStrF t _) -> pure $ Just (encodeUtf8 t)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TString v+instance Convertible e t f m+      => FromValue ByteString m (NValueNF t f m) where+  fromValueMay = \case+    NVStrNF ns -> pure $ encodeUtf8 <$> hackyGetStringNoContext ns+    _          -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF (TString NoContext) v -instance Convertible e m-      => FromValue ByteString m (NValue m) where-    fromValueMay = \case-        NVStr t _ -> pure $ Just (encodeUtf8 t)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TString v+instance Convertible e t f m+      => FromValue ByteString m (NValue t f m) where+  fromValueMay = \case+    NVStr ns -> pure $ encodeUtf8 <$> hackyGetStringNoContext ns+    _        -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation (TString NoContext) v  newtype Path = Path { getPath :: FilePath }     deriving Show -instance Convertible e m => FromValue Path m (NValueNF m) where-    fromValueMay = \case-        Fix (NVPathF p) -> pure $ Just (Path p)-        Fix (NVStrF s _) -> pure $ Just (Path (Text.unpack s))-        Fix (NVSetF s _) -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fromValueMay @Path p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TPath v--instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)-      => FromValue Path m (NValue m) where-    fromValueMay = \case-        NVPath p -> pure $ Just (Path p)-        NVStr s _ -> pure $ Just (Path (Text.unpack s))-        NVSet s _ -> case M.lookup "outPath" s of-            Nothing -> pure Nothing-            Just p -> fromValueMay @Path p-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TPath v+instance Convertible e t f m => FromValue Path m (NValueNF t f m) where+  fromValueMay = \case+    NVPathNF p  -> pure $ Just (Path p)+    NVStrNF  ns -> pure $ Path . Text.unpack <$> hackyGetStringNoContext ns+    NVSetNF s _ -> case M.lookup "outPath" s of+      Nothing -> pure Nothing+      Just p  -> fromValueMay @Path p+    _ -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TPath v -instance (Convertible e m, FromValue a m (NValueNF m), Show a)-      => FromValue [a] m (NValueNF m) where-    fromValueMay = \case-        Fix (NVListF l) -> sequence <$> traverse fromValueMay l-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TList v+instance Convertible e t f m => FromValue Path m (NValue t f m) where+  fromValueMay = \case+    NVPath p  -> pure $ Just (Path p)+    NVStr  ns -> pure $ Path . Text.unpack <$> hackyGetStringNoContext ns+    NVSet s _ -> case M.lookup "outPath" s of+      Nothing -> pure Nothing+      Just p  -> force p $ fromValueMay @Path+    _ -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TPath v -instance Convertible e m => FromValue [NThunk m] m (NValue m) where-    fromValueMay = \case-        NVList l -> pure $ Just l-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TList v+instance (Convertible e t f m, FromValue a m (NValueNF t f m), Show a)+      => FromValue [a] m (NValueNF t f m) where+  fromValueMay = \case+    NVListNF l -> sequence <$> traverse fromValueMay l+    _          -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TList v -instance Convertible e m-      => FromValue (HashMap Text (NValueNF m)) m (NValueNF m) where-    fromValueMay = \case-        Fix (NVSetF s _) -> pure $ Just s-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TSet v+instance Convertible e t f m => FromValue [t] m (NValue t f m) where+  fromValueMay = \case+    NVList l -> pure $ Just l+    _        -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TList v -instance Convertible e m-      => FromValue (HashMap Text (NThunk m)) m (NValue m) where-    fromValueMay = \case-        NVSet s _ -> pure $ Just s-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TSet v+instance Convertible e t f m+      => FromValue (HashMap Text (NValueNF t f m)) m (NValueNF t f m) where+  fromValueMay = \case+    NVSetNF s _ -> pure $ Just s+    _           -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TSet v -instance Convertible e m-      => FromValue (HashMap Text (NValueNF m),-                 HashMap Text SourcePos) m (NValueNF m) where-    fromValueMay = \case-        Fix (NVSetF s p) -> pure $ Just (s, p)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ ExpectationNF TSet v+instance Convertible e t f m+      => FromValue (HashMap Text t) m (NValue t f m) where+  fromValueMay = \case+    NVSet s _ -> pure $ Just s+    _         -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TSet v -instance Convertible e m-      => FromValue (HashMap Text (NThunk m),-                   HashMap Text SourcePos) m (NValue m) where-    fromValueMay = \case-        NVSet s p -> pure $ Just (s, p)-        _ -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TSet v+instance Convertible e t f m+      => FromValue (HashMap Text (NValueNF t f m),+                 HashMap Text SourcePos) m (NValueNF t f m) where+  fromValueMay = \case+    NVSetNF s p -> pure $ Just (s, p)+    _           -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ ExpectationNF TSet v -instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)-      => FromValue (NThunk m) m (NValue m) where-    fromValueMay = pure . Just . value @_ @_ @m-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> error "Impossible, see fromValueMay"+instance Convertible e t f m+      => FromValue (HashMap Text t,+                   HashMap Text SourcePos) m (NValue t f m) where+  fromValueMay = \case+    NVSet s p -> pure $ Just (s, p)+    _         -> pure Nothing+  fromValue v = fromValueMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TSet v  instance (Monad m, FromValue a m v) => FromValue a m (m v) where-    fromValueMay = (>>= fromValueMay)-    fromValue    = (>>= fromValue)--instance (MonadThunk (NValue m) (NThunk m) m, FromValue a m (NValue m))-      => FromValue a m (NThunk m) where-    fromValueMay = force ?? fromValueMay-    fromValue    = force ?? fromValue--instance (Convertible e m, MonadEffects m)-      => FromValue A.Value m (NValueNF m) where-    fromValueMay = \case-        Fix (NVConstantF a) -> pure $ Just $ case a of-            NInt n   -> toJSON n-            NFloat n -> toJSON n-            NBool b  -> toJSON b-            NNull    -> A.Null-        Fix (NVStrF s _)     -> pure $ Just $ toJSON s-        Fix (NVListF l)      -> fmap (A.Array . V.fromList) . sequence-                                  <$> traverse fromValueMay l-        Fix (NVSetF m _)     -> fmap A.Object . sequence <$> traverse fromValueMay m-        Fix NVClosureF {}    -> pure Nothing-        Fix (NVPathF p)      -> Just . toJSON . unStorePath <$> addPath p-        Fix (NVBuiltinF _ _) -> pure Nothing-    fromValue v = fromValueMay v >>= \case-        Just b -> pure b-        _ -> throwError $ CoercionToJsonNF v+  fromValueMay = (>>= fromValueMay)+  fromValue    = (>>= fromValue)  class ToValue a m v where     toValue :: a -> m v -instance Applicative m => ToValue () m (NValueNF m) where-    toValue _ = pure . Fix . NVConstantF $ NNull+instance Convertible e t f m => ToValue () m (NValueNF t f m) where+  toValue _ = pure . nvConstantNF $ NNull -instance Applicative m => ToValue () m (NValue m) where-    toValue _ = pure . nvConstant $ NNull+instance Convertible e t f m => ToValue () m (NValue t f m) where+  toValue _ = pure . nvConstant $ NNull -instance Applicative m => ToValue Bool m (NValueNF m) where-    toValue = pure . Fix . NVConstantF . NBool+instance Convertible e t f m => ToValue Bool m (NValueNF t f m) where+  toValue = pure . nvConstantNF . NBool -instance Applicative m => ToValue Bool m (NValue m) where-    toValue = pure . nvConstant . NBool+instance Convertible e t f m => ToValue Bool m (NValue t f m) where+  toValue = pure . nvConstant . NBool -instance Applicative m => ToValue Int m (NValueNF m) where-    toValue = pure . Fix . NVConstantF . NInt . toInteger+instance Convertible e t f m => ToValue Int m (NValueNF t f m) where+  toValue = pure . nvConstantNF . NInt . toInteger -instance Applicative m => ToValue Int m (NValue m) where-    toValue = pure . nvConstant . NInt . toInteger+instance Convertible e t f m => ToValue Int m (NValue t f m) where+  toValue = pure . nvConstant . NInt . toInteger -instance Applicative m => ToValue Integer m (NValueNF m) where-    toValue = pure . Fix . NVConstantF . NInt+instance Convertible e t f m => ToValue Integer m (NValueNF t f m) where+  toValue = pure . nvConstantNF . NInt -instance Applicative m => ToValue Integer m (NValue m) where-    toValue = pure . nvConstant . NInt+instance Convertible e t f m => ToValue Integer m (NValue t f m) where+  toValue = pure . nvConstant . NInt -instance Applicative m => ToValue Float m (NValueNF m) where-    toValue = pure . Fix . NVConstantF . NFloat+instance Convertible e t f m => ToValue Float m (NValueNF t f m) where+  toValue = pure . nvConstantNF . NFloat -instance Applicative m => ToValue Float m (NValue m) where-    toValue = pure . nvConstant . NFloat+instance Convertible e t f m => ToValue Float m (NValue t f m) where+  toValue = pure . nvConstant . NFloat -instance Applicative m => ToValue Text m (NValueNF m) where-    toValue = pure . Fix . flip NVStrF mempty+instance Convertible e t f m => ToValue NixString m (NValueNF t f m) where+  toValue = pure . nvStrNF -instance Applicative m => ToValue Text m (NValue m) where-    toValue = pure . flip nvStr mempty+instance Convertible e t f m => ToValue NixString m (NValue t f m) where+  toValue = pure . nvStr -instance Applicative m => ToValue (Text, DList Text) m (NValueNF m) where-    toValue = pure . Fix . uncurry NVStrF+instance Convertible e t f m => ToValue ByteString m (NValueNF t f m) where+  toValue = pure . nvStrNF . hackyMakeNixStringWithoutContext . decodeUtf8 -instance Applicative m => ToValue (Text, DList Text) m (NValue m) where-    toValue = pure . uncurry nvStr+instance Convertible e t f m => ToValue ByteString m (NValue t f m) where+  toValue = pure . nvStr . hackyMakeNixStringWithoutContext . decodeUtf8 -instance Applicative m => ToValue ByteString m (NValueNF m) where-    toValue = pure . Fix . flip NVStrF mempty . decodeUtf8+instance Convertible e t f m => ToValue Path m (NValueNF t f m) where+  toValue = pure . nvPathNF . getPath -instance Applicative m => ToValue ByteString m (NValue m) where-    toValue = pure . flip nvStr mempty . decodeUtf8+instance Convertible e t f m => ToValue Path m (NValue t f m) where+  toValue = pure . nvPath . getPath -instance Applicative m => ToValue Path m (NValueNF m) where-    toValue = pure . Fix . NVPathF . getPath+instance Convertible e t f m => ToValue StorePath m (NValueNF t f m) where+  toValue = toValue . Path . unStorePath -instance Applicative m => ToValue Path m (NValue m) where-    toValue = pure . nvPath . getPath+instance Convertible e t f m => ToValue StorePath m (NValue t f m) where+  toValue = toValue . Path . unStorePath -instance MonadThunk (NValue m) (NThunk m) m-      => ToValue SourcePos m (NValue m) where-    toValue (SourcePos f l c) = do-        f' <- toValue (Text.pack f)-        l' <- toValue (unPos l)-        c' <- toValue (unPos c)-        let pos = M.fromList-                [ ("file" :: Text, value @_ @_ @m f')-                , ("line",        value @_ @_ @m l')-                , ("column",      value @_ @_ @m c') ]-        pure $ nvSet pos mempty+instance Convertible e t f m => ToValue SourcePos m (NValue t f m) where+  toValue (SourcePos f l c) = do+    f' <- pure $ nvStr $ principledMakeNixStringWithoutContext (Text.pack f)+    l' <- toValue (unPos l)+    c' <- toValue (unPos c)+    let pos = M.fromList+          [ ("file" :: Text, wrapValue f')+          , ("line"        , wrapValue l')+          , ("column"      , wrapValue c')+          ]+    pure $ nvSet pos mempty -instance (ToValue a m (NValueNF m), Applicative m)-      => ToValue [a] m (NValueNF m) where-    toValue = fmap (Fix . NVListF) . traverse toValue+instance (Convertible e t f m, ToValue a m (NValueNF t f m))+      => ToValue [a] m (NValueNF t f m) where+  toValue = fmap nvListNF . traverse toValue -instance Applicative m => ToValue [NThunk m] m (NValue m) where-    toValue = pure . nvList+instance Convertible e t f m => ToValue [t] m (NValue t f m) where+  toValue = pure . nvList -instance Applicative m-      => ToValue (HashMap Text (NValueNF m)) m (NValueNF m) where-    toValue = pure . Fix . flip NVSetF M.empty+instance Convertible e t f m+      => ToValue (HashMap Text (NValueNF t f m)) m (NValueNF t f m) where+  toValue = pure . flip nvSetNF M.empty -instance Applicative m => ToValue (HashMap Text (NThunk m)) m (NValue m) where-    toValue = pure . flip nvSet M.empty+instance Convertible e t f m => ToValue (HashMap Text t) m (NValue t f m) where+  toValue = pure . flip nvSet M.empty -instance Applicative m => ToValue (HashMap Text (NValueNF m),-                HashMap Text SourcePos) m (NValueNF m) where-    toValue (s, p) = pure $ Fix $ NVSetF s p+instance Convertible e t f m => ToValue (HashMap Text (NValueNF t f m),+                HashMap Text SourcePos) m (NValueNF t f m) where+  toValue (s, p) = pure $ nvSetNF s p -instance Applicative m => ToValue (HashMap Text (NThunk m),-                HashMap Text SourcePos) m (NValue m) where-    toValue (s, p) = pure $ nvSet s p+instance Convertible e t f m => ToValue (HashMap Text t,+                HashMap Text SourcePos) m (NValue t f m) where+  toValue (s, p) = pure $ nvSet s p -instance (MonadThunk (NValue m) (NThunk m) m, ToValue a m (NValue m))-      => ToValue a m (NThunk m) where-    toValue = fmap (value @(NValue m) @_ @m) . toValue+instance Convertible e t f m => ToValue Bool m (NExprF r) where+  toValue = pure . NConstant . NBool -instance Applicative m => ToValue Bool m (NExprF r) where-    toValue = pure . NConstant . NBool+instance Convertible e t f m => ToValue () m (NExprF r) where+  toValue _ = pure . NConstant $ NNull -instance Applicative m => ToValue () m (NExprF r) where-    toValue _ = pure . NConstant $ NNull+instance ( MonadThunk t m (NValue t f m)+         , MonadDataErrorContext t f m+         , Framed e m+         )+    => ToValue NixLikeContextValue m (NValue t f m) where+  toValue nlcv = do+    path <- if nlcvPath nlcv then Just <$> toValue True else return Nothing+    allOutputs <- if nlcvAllOutputs nlcv+      then Just <$> toValue True+      else return Nothing+    outputs <- do+      let outputs =+            fmap principledMakeNixStringWithoutContext $ nlcvOutputs nlcv+      outputsM :: [NValue t f m] <- traverse toValue outputs+      let ts :: [t] = fmap wrapValue outputsM+      case ts of+        [] -> return Nothing+        _  -> Just <$> toValue ts+    pure $ flip nvSet M.empty $ M.fromList $ catMaybes+      [ (\p -> ("path", wrapValue p)) <$> path+      , (\ao -> ("allOutputs", wrapValue ao)) <$> allOutputs+      , (\os -> ("outputs", wrapValue os)) <$> outputs+      ] -whileForcingThunk :: forall s e m r. (Framed e m, Exception s, Typeable m)-                  => s -> m r -> m r+whileForcingThunk+  :: forall t f m s e r . (Exception s, Convertible e t f m) => s -> m r -> m r whileForcingThunk frame =-    withFrame Debug (ForcingThunk @m) . withFrame Debug frame--instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)-      => ToValue A.Value m (NValue m) where-    toValue = \case-        A.Object m -> flip nvSet M.empty-            <$> traverse (thunk . toValue @_ @_ @(NValue m)) m-        A.Array l -> nvList <$>-            traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)-                                 . toValue $ x) (V.toList l)-        A.String s -> pure $ nvStr s mempty-        A.Number n -> pure $ nvConstant $ case floatingOrInteger n of-            Left r -> NFloat r-            Right i -> NInt i-        A.Bool b -> pure $ nvConstant $ NBool b-        A.Null -> pure $ nvConstant NNull+  withFrame Debug (ForcingThunk @t @f @m) . withFrame Debug frame  class FromNix a m v where     fromNix :: v -> m a@@ -462,122 +424,105 @@     default fromNixMay :: FromValue a m v => v -> m (Maybe a)     fromNixMay = fromValueMay -instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m,-          FromNix a m (NValue m))-      => FromNix [a] m (NValue m) where-    fromNixMay = \case-        NVList l -> sequence <$> traverse (`force` fromNixMay) l-        _ -> pure Nothing-    fromNix v = fromNixMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TList v--instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m,-          FromNix a m (NValue m))-      => FromNix (HashMap Text a) m (NValue m) where-    fromNixMay = \case-        NVSet s _ -> sequence <$> traverse (`force` fromNixMay) s-        _ -> pure Nothing-    fromNix v = fromNixMay v >>= \case-        Just b -> pure b-        _ -> throwError $ Expectation TSet v+instance (Convertible e t f m, FromNix a m (NValue t f m))+      => FromNix [a] m (NValue t f m) where+  fromNixMay = \case+    NVList l -> sequence <$> traverse (`force` fromNixMay) l+    _        -> pure Nothing+  fromNix v = fromNixMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TList v -instance Convertible e m => FromNix () m (NValueNF m) where-instance Convertible e m => FromNix () m (NValue m) where-instance Convertible e m => FromNix Bool m (NValueNF m) where-instance Convertible e m => FromNix Bool m (NValue m) where-instance Convertible e m => FromNix Int m (NValueNF m) where-instance Convertible e m => FromNix Int m (NValue m) where-instance Convertible e m => FromNix Integer m (NValueNF m) where-instance Convertible e m => FromNix Integer m (NValue m) where-instance Convertible e m => FromNix Float m (NValueNF m) where-instance Convertible e m => FromNix Float m (NValue m) where-instance (Convertible e m, MonadEffects m) => FromNix Text m (NValueNF m) where-instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix Text m (NValue m) where-instance (Convertible e m, MonadEffects m) => FromNix (Text, DList Text) m (NValueNF m) where-instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix (Text, DList Text) m (NValue m) where-instance Convertible e m => FromNix ByteString m (NValueNF m) where-instance Convertible e m => FromNix ByteString m (NValue m) where-instance Convertible e m => FromNix Path m (NValueNF m) where-instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m) => FromNix Path m (NValue m) where-instance (Convertible e m, FromValue a m (NValueNF m), Show a) => FromNix [a] m (NValueNF m) where-instance Convertible e m => FromNix (HashMap Text (NValueNF m)) m (NValueNF m) where-instance Convertible e m => FromNix (HashMap Text (NValueNF m), HashMap Text SourcePos) m (NValueNF m) where-instance Convertible e m => FromNix (HashMap Text (NThunk m), HashMap Text SourcePos) m (NValue m) where-instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix A.Value m (NValueNF m) where+instance (Convertible e t f m, FromNix a m (NValue t f m))+      => FromNix (HashMap Text a) m (NValue t f m) where+  fromNixMay = \case+    NVSet s _ -> sequence <$> traverse (`force` fromNixMay) s+    _         -> pure Nothing+  fromNix v = fromNixMay v >>= \case+    Just b -> pure b+    _      -> throwError $ Expectation TSet v -instance (Convertible e m, MonadEffects m,-          MonadThunk (NValue m) (NThunk m) m) => FromNix A.Value m (NValue m) where-    fromNixMay = fromNixMay <=< normalForm-    fromNix    = fromNix <=< normalForm+instance Convertible e t f m => FromNix () m (NValueNF t f m) where+instance Convertible e t f m => FromNix () m (NValue t f m) where+instance Convertible e t f m => FromNix Bool m (NValueNF t f m) where+instance Convertible e t f m => FromNix Bool m (NValue t f m) where+instance Convertible e t f m => FromNix Int m (NValueNF t f m) where+instance Convertible e t f m => FromNix Int m (NValue t f m) where+instance Convertible e t f m => FromNix Integer m (NValueNF t f m) where+instance Convertible e t f m => FromNix Integer m (NValue t f m) where+instance Convertible e t f m => FromNix Float m (NValueNF t f m) where+instance Convertible e t f m => FromNix Float m (NValue t f m) where+instance (Convertible e t f m, MonadEffects t f m)+  => FromNix NixString m (NValueNF t f m) where+instance (Convertible e t f m, MonadEffects t f m)+  => FromNix NixString m (NValue t f m) where+instance Convertible e t f m => FromNix ByteString m (NValueNF t f m) where+instance Convertible e t f m => FromNix ByteString m (NValue t f m) where+instance Convertible e t f m => FromNix Path m (NValueNF t f m) where+instance Convertible e t f m => FromNix Path m (NValue t f m) where+instance (Convertible e t f m, FromValue a m (NValueNF t f m), Show a)+  => FromNix [a] m (NValueNF t f m) where+instance Convertible e t f m+  => FromNix (HashMap Text (NValueNF t f m)) m (NValueNF t f m) where+instance Convertible e t f m+  => FromNix (HashMap Text (NValueNF t f m),+             HashMap Text SourcePos) m (NValueNF t f m) where+instance Convertible e t f m+  => FromNix (HashMap Text t, HashMap Text SourcePos) m (NValue t f m) where  instance (Monad m, FromNix a m v) => FromNix a m (m v) where-    fromNixMay = (>>= fromNixMay)-    fromNix    = (>>= fromNix)--instance (MonadThunk (NValue m) (NThunk m) m, FromNix a m (NValue m))-      => FromNix a m (NThunk m) where-    fromNixMay = force ?? fromNixMay-    fromNix    = force ?? fromNix--instance MonadThunk (NValue m) (NThunk m) m-      => FromNix (NThunk m) m (NValue m) where-    fromNixMay = pure . Just . value-    fromNix    = pure . value+  fromNixMay = (>>= fromNixMay)+  fromNix    = (>>= fromNix)  class ToNix a m v where     toNix :: a -> m v     default toNix :: ToValue a m v => a -> m v     toNix = toValue -instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m,-          ToNix a m (NValue m))-      => ToNix [a] m (NValue m) where-    toNix = fmap nvList-        . traverse (thunk . ((\v -> whileForcingThunk (ConcerningValue v) (pure v))-                                <=< toNix))--instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m,-          ToNix a m (NValue m))-      => ToNix (HashMap Text a) m (NValue m) where-    toNix = fmap (flip nvSet M.empty)-        . traverse (thunk . ((\v -> whileForcingThunk (ConcerningValue v) (pure v))-                                <=< toNix))+instance (Convertible e t f m, ToNix a m (NValue t f m))+      => ToNix [a] m (NValue t f m) where+  toNix = fmap nvList . traverse (thunk . go)+   where+    go =+      (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v)) <=< toNix -instance Applicative m => ToNix () m (NValueNF m) where-instance Applicative m => ToNix () m (NValue m) where-instance Applicative m => ToNix Bool m (NValueNF m) where-instance Applicative m => ToNix Bool m (NValue m) where-instance Applicative m => ToNix Int m (NValueNF m) where-instance Applicative m => ToNix Int m (NValue m) where-instance Applicative m => ToNix Integer m (NValueNF m) where-instance Applicative m => ToNix Integer m (NValue m) where-instance Applicative m => ToNix Float m (NValueNF m) where-instance Applicative m => ToNix Float m (NValue m) where-instance Applicative m => ToNix Text m (NValueNF m) where-instance Applicative m => ToNix Text m (NValue m) where-instance Applicative m => ToNix (Text, DList Text) m (NValueNF m) where-instance Applicative m => ToNix (Text, DList Text) m (NValue m) where-instance Applicative m => ToNix ByteString m (NValueNF m) where-instance Applicative m => ToNix ByteString m (NValue m) where-instance Applicative m => ToNix Path m (NValueNF m) where-instance Applicative m => ToNix Path m (NValue m) where-instance Applicative m => ToNix (HashMap Text (NValueNF m)) m (NValueNF m) where-instance Applicative m => ToNix (HashMap Text (NValueNF m), HashMap Text SourcePos) m (NValueNF m) where-instance Applicative m => ToNix (HashMap Text (NThunk m), HashMap Text SourcePos) m (NValue m) where-instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m) => ToNix A.Value m (NValue m) where-instance Applicative m => ToNix Bool m (NExprF r) where-instance Applicative m => ToNix () m (NExprF r) where+instance (Convertible e t f m, ToNix a m (NValue t f m))+      => ToNix (HashMap Text a) m (NValue t f m) where+  toNix = fmap (flip nvSet M.empty) . traverse (thunk . go)+   where+    go =+      (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v)) <=< toNix -instance (MonadThunk (NValue m) (NThunk m) m, ToNix a m (NValue m))-      => ToNix a m (NThunk m) where-    toNix = thunk . toNix+instance Convertible e t f m => ToNix () m (NValueNF t f m) where+instance Convertible e t f m => ToNix () m (NValue t f m) where+instance Convertible e t f m => ToNix Bool m (NValueNF t f m) where+instance Convertible e t f m => ToNix Bool m (NValue t f m) where+instance Convertible e t f m => ToNix Int m (NValueNF t f m) where+instance Convertible e t f m => ToNix Int m (NValue t f m) where+instance Convertible e t f m => ToNix Integer m (NValueNF t f m) where+instance Convertible e t f m => ToNix Integer m (NValue t f m) where+instance Convertible e t f m => ToNix Float m (NValueNF t f m) where+instance Convertible e t f m => ToNix Float m (NValue t f m) where+instance Convertible e t f m => ToNix NixString m (NValueNF t f m) where+instance Convertible e t f m => ToNix NixString m (NValue t f m) where+instance Convertible e t f m => ToNix ByteString m (NValueNF t f m) where+instance Convertible e t f m => ToNix ByteString m (NValue t f m) where+instance Convertible e t f m => ToNix Path m (NValueNF t f m) where+instance Convertible e t f m => ToNix Path m (NValue t f m) where+instance Convertible e t f m+  => ToNix (HashMap Text (NValueNF t f m)) m (NValueNF t f m) where+instance Convertible e t f m+  => ToNix (HashMap Text (NValueNF t f m),+           HashMap Text SourcePos) m (NValueNF t f m) where+instance Convertible e t f m+  => ToNix (HashMap Text t, HashMap Text SourcePos) m (NValue t f m) where -instance (Applicative m, ToNix a m (NValueNF m)) => ToNix [a] m (NValueNF m) where-    toNix = fmap (Fix . NVListF) . traverse toNix+instance Convertible e t f m => ToNix Bool m (NExprF r) where+  toNix = pure . NConstant . NBool -instance MonadThunk (NValue m) (NThunk m) m => ToNix (NThunk m) m (NValue m) where-    toNix = force ?? pure+instance Convertible e t f m => ToNix () m (NExprF r) where+  toNix _ = pure $ NConstant NNull -convertNix :: forall a t m v. (FromNix a m t, ToNix a m v, Monad m) => t -> m v-convertNix = fromNix @a >=> toNix+instance (Convertible e t f m, ToNix a m (NValueNF t f m))+  => ToNix [a] m (NValueNF t f m) where+  toNix = fmap nvListNF . traverse toNix
src/Nix/Effects.hs view
@@ -1,47 +1,258 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+ module Nix.Effects where -import Data.Text (Text)-import Nix.Render-import Nix.Utils-import Nix.Value-import System.Posix.Files+import           Prelude                 hiding ( putStr+                                                , putStrLn+                                                , print+                                                )+import qualified Prelude +import           Control.Monad.Trans+import           Data.Text                      ( Text )+import qualified Data.Text                     as T+import           Network.HTTP.Client     hiding ( path )+import           Network.HTTP.Client.TLS+import           Network.HTTP.Types+import           Nix.Expr+import           Nix.Frames+import           Nix.Parser+import           Nix.Render+import           Nix.Utils+import           Nix.Value+import qualified System.Directory              as S+import           System.Environment+import           System.Exit+import qualified System.Info+import           System.Process+ -- | A path into the nix store newtype StorePath = StorePath { unStorePath :: FilePath } -class MonadFile m => MonadEffects m where-    -- | Import a path into the nix store, and return the resulting path-    addPath :: FilePath -> m StorePath--    toFile_ :: FilePath -> String -> m StorePath-+class (MonadFile m,+       MonadStore m,+       MonadPutStr m,+       MonadHttp m,+       MonadEnv m,+       MonadInstantiate m,+       MonadExec m,+       MonadIntrospect m) => MonadEffects t f m where     -- | Determine the absolute path of relative path in the current context     makeAbsolutePath :: FilePath -> m FilePath     findEnvPath :: String -> m FilePath      -- | Having an explicit list of sets corresponding to the NIX_PATH     -- and a file path try to find an existing path-    findPath :: [NThunk m] -> FilePath -> m FilePath+    findPath :: [t] -> FilePath -> m FilePath -    pathExists :: FilePath -> m Bool-    importPath :: AttrSet (NThunk m) -> FilePath -> m (NValue m)+    importPath :: FilePath -> m (NValue t f m)+    pathToDefaultNix :: FilePath -> m FilePath +    derivationStrict :: NValue t f m -> m (NValue t f m)++    traceEffect :: String -> m ()++class Monad m => MonadIntrospect m where+    recursiveSize :: a -> m Word+    default recursiveSize :: (MonadTrans t, MonadIntrospect m', m ~ t m') => a -> m Word+    recursiveSize = lift . recursiveSize++instance MonadIntrospect IO where+  recursiveSize =+#ifdef MIN_VERSION_ghc_datasize+#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804+recursiveSize+#else+\_ -> return 0+#endif+#else+    \_ -> return 0+#endif++class Monad m => MonadExec m where+    exec' :: [String] -> m (Either ErrorCall NExprLoc)+    default exec' :: (MonadTrans t, MonadExec m', m ~ t m')+                  => [String] -> m (Either ErrorCall NExprLoc)+    exec' = lift . exec'++instance MonadExec IO where+  exec' = \case+    []            -> return $ Left $ ErrorCall "exec: missing program"+    (prog : args) -> do+      (exitCode, out, _) <- liftIO $ readProcessWithExitCode prog args ""+      let t    = T.strip (T.pack out)+      let emsg = "program[" ++ prog ++ "] args=" ++ show args+      case exitCode of+        ExitSuccess -> if T.null t+          then return $ Left $ ErrorCall $ "exec has no output :" ++ emsg+          else case parseNixTextLoc t of+            Failure err ->+              return+                $  Left+                $  ErrorCall+                $  "Error parsing output of exec: "+                ++ show err+                ++ " "+                ++ emsg+            Success v -> return $ Right v+        err ->+          return+            $  Left+            $  ErrorCall+            $  "exec  failed: "+            ++ show err+            ++ " "+            ++ emsg++class Monad m => MonadInstantiate m where+    instantiateExpr :: String -> m (Either ErrorCall NExprLoc)+    default instantiateExpr :: (MonadTrans t, MonadInstantiate m', m ~ t m') => String -> m (Either ErrorCall NExprLoc)+    instantiateExpr = lift . instantiateExpr++instance MonadInstantiate IO where+  instantiateExpr expr = do+    traceM $ "Executing: " ++ show+      ["nix-instantiate", "--eval", "--expr ", expr]+    (exitCode, out, err) <- readProcessWithExitCode "nix-instantiate"+                                                    ["--eval", "--expr", expr]+                                                    ""+    case exitCode of+      ExitSuccess -> case parseNixTextLoc (T.pack out) of+        Failure e ->+          return+            $  Left+            $  ErrorCall+            $  "Error parsing output of nix-instantiate: "+            ++ show e+        Success v -> return $ Right v+      status ->+        return+          $  Left+          $  ErrorCall+          $  "nix-instantiate failed: "+          ++ show status+          ++ ": "+          ++ err++pathExists :: MonadFile m => FilePath -> m Bool+pathExists = doesFileExist++class Monad m => MonadEnv m where     getEnvVar :: String -> m (Maybe String)+    default getEnvVar :: (MonadTrans t, MonadEnv m', m ~ t m') => String -> m (Maybe String)+    getEnvVar = lift . getEnvVar     getCurrentSystemOS :: m Text+    default getCurrentSystemOS :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text+    getCurrentSystemOS = lift getCurrentSystemOS     getCurrentSystemArch :: m Text+    default getCurrentSystemArch :: (MonadTrans t, MonadEnv m', m ~ t m') => m Text+    getCurrentSystemArch = lift getCurrentSystemArch -    listDirectory :: FilePath -> m [FilePath]-    getSymbolicLinkStatus :: FilePath -> m FileStatus+instance MonadEnv IO where+  getEnvVar            = lookupEnv -    derivationStrict :: NValue m -> m (NValue m)+  getCurrentSystemOS   = return $ T.pack System.Info.os -    nixInstantiateExpr :: String -> m (NValue m)+-- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4+  getCurrentSystemArch = return $ T.pack $ case System.Info.arch of+    "i386" -> "i686"+    arch   -> arch -    getURL :: Text -> m (NValue m)+class Monad m => MonadHttp m where+    getURL :: Text -> m (Either ErrorCall StorePath)+    default getURL :: (MonadTrans t, MonadHttp m', m ~ t m') => Text -> m (Either ErrorCall StorePath)+    getURL = lift . getURL -    getRecursiveSize :: a -> m (NValue m)+instance MonadHttp IO where+  getURL url = do+    let urlstr = T.unpack url+    traceM $ "fetching HTTP URL: " ++ urlstr+    req     <- parseRequest urlstr+    manager <- if secure req+      then newTlsManager+      else newManager defaultManagerSettings+    -- print req+    response <- httpLbs (req { method = "GET" }) manager+    let status = statusCode (responseStatus response)+    if status /= 200+      then+        return+        $  Left+        $  ErrorCall+        $  "fail, got "+        ++ show status+        ++ " when fetching url:"+        ++ urlstr+      else -- do+        -- let bstr = responseBody response+        return+        $  Left+        $  ErrorCall+        $  "success in downloading but hnix-store is not yet ready; url = "+        ++ urlstr -    traceEffect :: String -> m () -    exec :: [String] -> m (NValue m)+class Monad m => MonadPutStr m where+    --TODO: Should this be used *only* when the Nix to be evaluated invokes a+    --`trace` operation?+    putStr :: String -> m ()+    default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m ()+    putStr = lift . putStr++putStrLn :: MonadPutStr m => String -> m ()+putStrLn = putStr . (++ "\n")++print :: (MonadPutStr m, Show a) => a -> m ()+print = putStrLn . show++instance MonadPutStr IO where+  putStr = Prelude.putStr++class Monad m => MonadStore m where+    -- | Import a path into the nix store, and return the resulting path+    addPath' :: FilePath -> m (Either ErrorCall StorePath)++    -- | Add a file with the given name and contents to the nix store+    toFile_' :: FilePath -> String -> m (Either ErrorCall StorePath)++instance MonadStore IO where+  addPath' path = do+    (exitCode, out, _) <- readProcessWithExitCode "nix-store" ["--add", path] ""+    case exitCode of+      ExitSuccess -> do+        let dropTrailingLinefeed p = take (length p - 1) p+        return $ Right $ StorePath $ dropTrailingLinefeed out+      _ ->+        return+          $  Left+          $  ErrorCall+          $  "addPath: failed: nix-store --add "+          ++ show path++--TODO: Use a temp directory so we don't overwrite anything important+  toFile_' filepath content = do+    writeFile filepath content+    storepath <- addPath' filepath+    S.removeFile filepath+    return storepath++addPath :: (Framed e m, MonadStore m) => FilePath -> m StorePath+addPath p = either throwError return =<< addPath' p++toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath+toFile_ p contents = either throwError return =<< toFile_' p contents++++++
src/Nix/Eval.hs view
@@ -18,28 +18,32 @@ import           Control.Monad.Fix import           Control.Monad.Reader import           Control.Monad.State.Strict-import           Data.Align.Key (alignWithKey)-import           Data.Either (isRight)-import           Data.Fix (Fix(Fix))-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M-import           Data.List (partition)-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Maybe (fromMaybe, catMaybes)-import           Data.Text (Text)-import           Data.These (These(..))-import           Data.Traversable (for)+import           Data.Align.Key                 ( alignWithKey )+import           Data.Either                    ( isRight )+import           Data.Fix                       ( Fix(Fix) )+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M+import           Data.List                      ( partition )+import           Data.List.NonEmpty             ( NonEmpty(..) )+import           Data.Maybe                     ( fromMaybe+                                                , catMaybes+                                                )+import           Data.Text                      ( Text )+import           Data.These                     ( These(..) )+import           Data.Traversable               ( for ) import           Nix.Atoms import           Nix.Convert import           Nix.Expr import           Nix.Frames+import           Nix.String import           Nix.Scope-import           Nix.Strings (runAntiquoted)+import           Nix.Strings                    ( runAntiquoted ) import           Nix.Thunk import           Nix.Utils -class (Show v, Monad m) => MonadEval v m | v -> m where+class (Show v, Monad m) => MonadEval v m where     freeVariable    :: Text -> m v+    synHole         :: Text -> m v     attrMissing     :: NonEmpty Text -> Maybe v -> m v     evaledSym       :: Text -> v -> m v     evalCurPos      :: m v@@ -75,302 +79,364 @@ -}     evalError :: Exception s => s -> m a -type MonadNixEval e v t m =-    (MonadEval v m,-     Scoped e t m,-     MonadThunk v t m,-     MonadFix m,-     ToValue Bool m v,-     ToValue [t] m v,-     FromValue (Text, DList Text) m v,-     ToValue (AttrSet t, AttrSet SourcePos) m v,-     FromValue (AttrSet t, AttrSet SourcePos) m v)+type MonadNixEval v t m+  = ( MonadEval v m+  , Scoped t m+  , MonadThunk t m v+  , MonadFix m+  , ToValue Bool m v+  , ToValue [t] m v+  , FromValue NixString m v+  , ToValue (AttrSet t, AttrSet SourcePos) m v+  , FromValue (AttrSet t, AttrSet SourcePos) m v+  ) -data EvalFrame m v-    = EvaluatingExpr (Scopes m v) NExprLoc-    | ForcingExpr (Scopes m v) NExprLoc+data EvalFrame m t+    = EvaluatingExpr (Scopes m t) NExprLoc+    | ForcingExpr (Scopes m t) NExprLoc     | Calling String SrcSpan+    | SynHole (SynHoleInfo m t)     deriving (Show, Typeable) -instance (Typeable m, Typeable v) => Exception (EvalFrame m v)+instance (Typeable m, Typeable t) => Exception (EvalFrame m t) -eval :: forall e v t m. MonadNixEval e v t m => NExprF (m v) -> m v+data SynHoleInfo m t = SynHoleInfo+   { _synHoleInfo_expr :: NExprLoc+   , _synHoleInfo_scope :: Scopes m t+   } deriving (Show, Typeable) +instance (Typeable m, Typeable t) => Exception (SynHoleInfo m t)++eval :: forall v t m . MonadNixEval v t m => NExprF (m v) -> m v+ eval (NSym "__curPos") = evalCurPos -eval (NSym var) =-    lookupVar var >>= maybe (freeVariable var) (force ?? evaledSym var)+eval (NSym var       ) = (lookupVar var :: m (Maybe t))+  >>= maybe (freeVariable var) (force ?? evaledSym var) -eval (NConstant x)    = evalConstant x-eval (NStr str)       = evalString str-eval (NLiteralPath p) = evalLiteralPath p-eval (NEnvPath p)     = evalEnvPath p-eval (NUnary op arg)  = evalUnary op =<< arg+eval (NConstant    x      ) = evalConstant x+eval (NStr         str    ) = evalString str+eval (NLiteralPath p      ) = evalLiteralPath p+eval (NEnvPath     p      ) = evalEnvPath p+eval (NUnary op arg       ) = evalUnary op =<< arg  eval (NBinary NApp fun arg) = do-    scope <- currentScopes @_ @t-    fun >>= (`evalApp` withScopes scope arg)+  scope <- currentScopes :: m (Scopes m t)+  fun >>= (`evalApp` withScopes scope arg) -eval (NBinary op larg rarg) = larg >>= evalBinary op ?? rarg+eval (NBinary op   larg rarg) = larg >>= evalBinary op ?? rarg -eval (NSelect aset attr alt) = evalSelect aset attr >>= either go id-  where-    go (s, ks) = fromMaybe (attrMissing ks (Just s)) alt+eval (NSelect aset attr alt ) = evalSelect aset attr >>= either go id+  where go (s, ks) = fromMaybe (attrMissing ks (Just s)) alt  eval (NHasAttr aset attr) = evalSelect aset attr >>= toValue . isRight -eval (NList l) = do-    scope <- currentScopes-    for l (thunk . withScopes @t scope) >>= toValue+eval (NList l           ) = do+  scope <- currentScopes+  for l (thunk @t @m @v . withScopes @t scope) >>= toValue  eval (NSet binds) =-    evalBinds False (desugarBinds (eval . NSet) binds) >>= toValue+  evalBinds False (desugarBinds (eval . NSet) binds) >>= toValue  eval (NRecSet binds) =-    evalBinds True (desugarBinds (eval . NRecSet) binds) >>= toValue+  evalBinds True (desugarBinds (eval . NSet) binds) >>= toValue -eval (NLet binds body) = evalBinds True binds >>= (pushScope ?? body) . fst+eval (NLet binds body    ) = evalBinds True binds >>= (pushScope ?? body) . fst -eval (NIf cond t f) = cond >>= \v -> evalIf v t f+eval (NIf cond t f       ) = cond >>= \v -> evalIf v t f -eval (NWith scope body) = evalWith scope body+eval (NWith   scope  body) = evalWith scope body -eval (NAssert cond body) = cond >>= evalAssert ?? body+eval (NAssert cond   body) = cond >>= evalAssert ?? body -eval (NAbs params body) = do+eval (NAbs    params body) = do     -- It is the environment at the definition site, not the call site, that     -- needs to be used when evaluating the body and default arguments, hence     -- we defer here so the present scope is restored when the parameters and     -- body are forced during application.-    scope <- currentScopes @_ @t-    evalAbs params $ \arg k -> withScopes @t scope $ do-        args <- buildArgument params arg-        pushScope args (k (M.map (`force` pure) args) body)+  scope <- currentScopes :: m (Scopes m t)+  evalAbs params $ \arg k -> withScopes scope $ do+    args <- buildArgument params arg+    pushScope args (k (M.map (`force` pure) args) body) +eval (NSynHole name) = synHole name+ -- | If you know that the 'scope' action will result in an 'AttrSet t', then --   this implementation may be used as an implementation for 'evalWith'.-evalWithAttrSet :: forall e v t m. MonadNixEval e v t m => m v -> m v -> m v+evalWithAttrSet :: forall v t m . MonadNixEval v t m => m v -> m v -> m v evalWithAttrSet aset body = do     -- The scope is deliberately wrapped in a thunk here, since it is     -- evaluated each time a name is looked up within the weak scope, and     -- we want to be sure the action it evaluates is to force a thunk, so     -- its value is only computed once.-    scope <- currentScopes @_ @t-    s <- thunk $ withScopes scope aset-    pushWeakScope ?? body $ force s $-        fmap fst . fromValue @(AttrSet t, AttrSet SourcePos)+  scope <- currentScopes :: m (Scopes m t)+  s     <- thunk @t @m @v $ withScopes scope aset+  pushWeakScope+    ?? body+    $  force s+    $  fmap fst+    .  fromValue @(AttrSet t, AttrSet SourcePos) -attrSetAlter :: forall e v t m. MonadNixEval e v t m-             => [Text]-             -> SourcePos-             -> AttrSet (m v)-             -> AttrSet SourcePos-             -> m v-             -> m (AttrSet (m v), AttrSet SourcePos)+attrSetAlter+  :: forall v t m+   . MonadNixEval v t m+  => [Text]+  -> SourcePos+  -> AttrSet (m v)+  -> AttrSet SourcePos+  -> m v+  -> m (AttrSet (m v), AttrSet SourcePos) attrSetAlter [] _ _ _ _ =-    evalError @v $ ErrorCall "invalid selector with no components"+  evalError @v $ ErrorCall "invalid selector with no components" -attrSetAlter (k:ks) pos m p val = case M.lookup k m of-    Nothing | null ks   -> go-            | otherwise -> recurse M.empty M.empty-    Just x  | null ks   -> go-            | otherwise ->-                x >>= fromValue @(AttrSet t, AttrSet SourcePos)-                  >>= \(st, sp) -> recurse (force ?? pure <$> st) sp-  where-    go = return (M.insert k val m, M.insert k pos p)+attrSetAlter (k : ks) pos m p val = case M.lookup k m of+  Nothing | null ks   -> go+          | otherwise -> recurse M.empty M.empty+  Just x+    | null ks+    -> go+    | otherwise+    -> x >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(st, sp) ->+      recurse (force ?? pure <$> st) sp+ where+  go = return (M.insert k val m, M.insert k pos p) -    recurse st sp = attrSetAlter ks pos st sp val <&> \(st', _) ->-        ( M.insert k (toValue @(AttrSet t, AttrSet SourcePos)-                         =<< (, mempty) . fmap value <$> sequence st') st-        , M.insert k pos sp )+  recurse st sp = attrSetAlter ks pos st sp val <&> \(st', _) ->+    ( M.insert+      k+      (   toValue @(AttrSet t, AttrSet SourcePos)+      =<< (, mempty)+      .   fmap wrapValue+      <$> sequence st'+      )+      st+    , M.insert k pos sp+    ) -desugarBinds :: forall r. ([Binding r] -> r) -> [Binding r] -> [Binding r]+desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r] desugarBinds embed binds = evalState (mapM (go <=< collect) binds) M.empty-  where-    collect :: Binding r-            -> State (HashMap VarName (SourcePos, [Binding r]))-                     (Either VarName (Binding r))-    collect (NamedVar (StaticKey x :| y:ys) val p) = do-        m <- get-        put $ M.insert x ?? m $ case M.lookup x m of-            Nothing     -> (p, [NamedVar (y:|ys) val p])-            Just (q, v) -> (q, NamedVar (y:|ys) val q : v)-        pure $ Left x-    collect x = pure $ Right x+ where+  collect+    :: Binding r+    -> State+         (HashMap VarName (SourcePos, [Binding r]))+         (Either VarName (Binding r))+  collect (NamedVar (StaticKey x :| y : ys) val p) = do+    m <- get+    put $ M.insert x ?? m $ case M.lookup x m of+      Nothing     -> (p, [NamedVar (y :| ys) val p])+      Just (q, v) -> (q, NamedVar (y :| ys) val q : v)+    pure $ Left x+  collect x = pure $ Right x -    go :: Either VarName (Binding r)-       -> State (HashMap VarName (SourcePos, [Binding r]))-                (Binding r)-    go (Right x) = pure x-    go (Left x) = do-        Just (p, v) <- gets $ M.lookup x-        pure $ NamedVar (StaticKey x :| []) (embed v) p+  go+    :: Either VarName (Binding r)+    -> State (HashMap VarName (SourcePos, [Binding r])) (Binding r)+  go (Right x) = pure x+  go (Left  x) = do+    maybeValue <- gets (M.lookup x)+    case maybeValue of+      Nothing     -> fail ("No binding " ++ show x)+      Just (p, v) -> pure $ NamedVar (StaticKey x :| []) (embed v) p -evalBinds :: forall e v t m. MonadNixEval e v t m-          => Bool-          -> [Binding (m v)]-          -> m (AttrSet t, AttrSet SourcePos)+evalBinds+  :: forall v t m+   . MonadNixEval v t m+  => Bool+  -> [Binding (m v)]+  -> m (AttrSet t, AttrSet SourcePos) evalBinds recursive binds = do-    scope <- currentScopes @_ @t-    buildResult scope . concat =<< mapM (go scope) (moveOverridesLast binds)-  where-    moveOverridesLast = (\(x, y) -> y ++ x) .-        partition (\case NamedVar (StaticKey "__overrides" :| []) _ _pos -> True-                         _ -> False)+  scope <- currentScopes :: m (Scopes m t)+  buildResult scope . concat =<< mapM (go scope) (moveOverridesLast binds)+ where+  moveOverridesLast = uncurry (++) . partition+    (\case+      NamedVar (StaticKey "__overrides" :| []) _ _pos -> False+      _ -> True+    ) -    go :: Scopes m t -> Binding (m v) -> m [([Text], SourcePos, m v)]-    go _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =-        finalValue >>= fromValue >>= \(o', p') ->-            -- jww (2018-05-09): What to do with the key position here?-            return $ map (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'),-                                     force v pure))-                         (M.toList o')+  go :: Scopes m t -> Binding (m v) -> m [([Text], SourcePos, m v)]+  go _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =+    finalValue >>= fromValue >>= \(o', p') ->+          -- jww (2018-05-09): What to do with the key position here?+                                              return $ map+      (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'), force @t @m @v v pure))+      (M.toList o') -    go _ (NamedVar pathExpr finalValue pos) = do-        let go :: NAttrPath (m v) -> m ([Text], SourcePos, m v)-            go = \case-                h :| t -> evalSetterKeyName h >>= \case-                    Nothing ->-                        pure ([], nullPos,-                              toValue @(AttrSet t, AttrSet SourcePos)-                                  (mempty, mempty))-                    Just k -> case t of-                        [] -> pure ([k], pos, finalValue)-                        x:xs -> do-                            (restOfPath, _, v) <- go (x:|xs)-                            pure (k : restOfPath, pos, v)-        go pathExpr <&> \case-            -- When there are no path segments, e.g. `${null} = 5;`, we don't-            -- bind anything-            ([], _, _) -> []-            result -> [result]+  go _ (NamedVar pathExpr finalValue pos) = do+    let go :: NAttrPath (m v) -> m ([Text], SourcePos, m v)+        go = \case+          h :| t -> evalSetterKeyName h >>= \case+            Nothing ->+              pure+                ( []+                , nullPos+                , toValue @(AttrSet t, AttrSet SourcePos) (mempty, mempty)+                )+            Just k -> case t of+              []     -> pure ([k], pos, finalValue)+              x : xs -> do+                (restOfPath, _, v) <- go (x :| xs)+                pure (k : restOfPath, pos, v)+    go pathExpr <&> \case+        -- When there are no path segments, e.g. `${null} = 5;`, we don't+        -- bind anything+      ([], _, _) -> []+      result     -> [result] -    go scope (Inherit ms names pos) = fmap catMaybes $ forM names $-        evalSetterKeyName >=> \case-            Nothing  -> pure Nothing-            Just key -> pure $ Just ([key], pos, do-                mv <- case ms of-                    Nothing -> withScopes scope $ lookupVar key-                    Just s -> s-                        >>= fromValue @(AttrSet t, AttrSet SourcePos)-                        >>= \(s, _) ->-                            clearScopes @t $ pushScope s $ lookupVar key-                case mv of-                    Nothing -> attrMissing (key :| []) Nothing-                    Just v -> force v pure)+  go scope (Inherit ms names pos) =+    fmap catMaybes $ forM names $ evalSetterKeyName >=> \case+      Nothing  -> pure Nothing+      Just key -> pure $ Just+        ( [key]+        , pos+        , do+          mv <- case ms of+            Nothing -> withScopes scope $ lookupVar key+            Just s ->+              s >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(s, _) ->+                clearScopes @t $ pushScope s $ lookupVar key+          case mv of+            Nothing -> attrMissing (key :| []) Nothing+            Just v  -> force v pure+        ) -    buildResult :: Scopes m t-                -> [([Text], SourcePos, m v)]-                -> m (AttrSet t, AttrSet SourcePos)-    buildResult scope bindings = do-        (s, p) <- foldM insert (M.empty, M.empty) bindings-        res <- if recursive-               then loebM (encapsulate <$> s)-               else traverse mkThunk s-        return (res, p)-      where-        mkThunk = thunk . withScopes scope+  buildResult+    :: Scopes m t+    -> [([Text], SourcePos, m v)]+    -> m (AttrSet t, AttrSet SourcePos)+  buildResult scope bindings = do+    (s, p) <- foldM insert (M.empty, M.empty) bindings+    res <- if recursive then loebM (encapsulate <$> s) else traverse mkThunk s+    return (res, p)+   where+    mkThunk = thunk . withScopes scope -        encapsulate f attrs = mkThunk . pushScope attrs $ f+    encapsulate f attrs = mkThunk . pushScope attrs $ f -        insert (m, p) (path, pos, value) = attrSetAlter path pos m p value+    insert (m, p) (path, pos, value) = attrSetAlter path pos m p value -evalSelect :: forall e v t m. MonadNixEval e v t m-           => m v-           -> NAttrPath (m v)-           -> m (Either (v, NonEmpty Text) (m v))+evalSelect+  :: forall v t m+   . MonadNixEval v t m+  => m v+  -> NAttrPath (m v)+  -> m (Either (v, NonEmpty Text) (m v)) evalSelect aset attr = do-    s <- aset-    path <- traverse evalGetterKeyName attr-    extract s path-  where-    extract x path@(k:|ks) = fromValueMay x >>= \case-        Just (s :: AttrSet t, p :: AttrSet SourcePos)-            | Just t <- M.lookup k s -> case ks of-                []   -> pure $ Right $ force t pure-                y:ys -> force t $ extract ?? (y:|ys)-            | otherwise -> Left . (, path) <$> toValue (s, p)-        Nothing -> return $ Left (x, path)+  s    <- aset+  path <- traverse evalGetterKeyName attr+  extract s path+ where+  extract x path@(k :| ks) = fromValueMay x >>= \case+    Just (s :: AttrSet t, p :: AttrSet SourcePos)+      | Just t <- M.lookup k s -> case ks of+        []     -> pure $ Right $ force t pure+        y : ys -> force t $ extract ?? (y :| ys)+      | otherwise -> Left . (, path) <$> toValue (s, p)+    Nothing -> return $ Left (x, path)  -- | Evaluate a component of an attribute path in a context where we are -- *retrieving* a value-evalGetterKeyName :: forall v m. (MonadEval v m, FromValue (Text, DList Text) m v)-                  => NKeyName (m v) -> m Text+evalGetterKeyName+  :: forall v m+   . (MonadEval v m, FromValue NixString m v)+  => NKeyName (m v)+  -> m Text evalGetterKeyName = evalSetterKeyName >=> \case-    Just k -> pure k-    Nothing -> evalError @v $ ErrorCall "value is null while a string was expected"+  Just k -> pure k+  Nothing ->+    evalError @v $ ErrorCall "value is null while a string was expected"  -- | Evaluate a component of an attribute path in a context where we are -- *binding* a value-evalSetterKeyName :: (MonadEval v m, FromValue (Text, DList Text) m v)-                  => NKeyName (m v) -> m (Maybe Text)+evalSetterKeyName+  :: (MonadEval v m, FromValue NixString m v)+  => NKeyName (m v)+  -> m (Maybe Text) evalSetterKeyName = \case-    StaticKey  k -> pure (Just k)-    DynamicKey k -> runAntiquoted "\n" assembleString (>>= fromValueMay) k-        <&> \case Just (t, _) -> Just t-                  _ -> Nothing+  StaticKey k -> pure (Just k)+  DynamicKey k ->+    runAntiquoted "\n" assembleString (>>= fromValueMay) k <&> \case+      Just ns -> Just (hackyStringIgnoreContext ns)+      _       -> Nothing -assembleString :: forall v m. (MonadEval v m, FromValue (Text, DList Text) m v)-               => NString (m v) -> m (Maybe (Text, DList Text))+assembleString+  :: forall v m+   . (MonadEval v m, FromValue NixString m v)+  => NString (m v)+  -> m (Maybe NixString) assembleString = \case-    Indented _   parts -> fromParts parts-    DoubleQuoted parts -> fromParts parts-  where-    fromParts = fmap (fmap mconcat . sequence) . traverse go+  Indented _ parts   -> fromParts parts+  DoubleQuoted parts -> fromParts parts+ where+  fromParts = fmap (fmap principledStringMConcat . sequence) . traverse go -    go = runAntiquoted "\n" (pure . Just . (, mempty)) (>>= fromValueMay)+  go = runAntiquoted "\n"+                     (pure . Just . principledMakeNixStringWithoutContext)+                     (>>= fromValueMay) -buildArgument :: forall e v t m. MonadNixEval e v t m-              => Params (m v) -> m v -> m (AttrSet t)+buildArgument+  :: forall v t m . MonadNixEval v t m => Params (m v) -> m v -> m (AttrSet t) buildArgument params arg = do-    scope <- currentScopes @_ @t-    case params of-        Param name -> M.singleton name <$> thunk (withScopes scope arg)-        ParamSet s isVariadic m ->-            arg >>= fromValue @(AttrSet t, AttrSet SourcePos)-                >>= \(args, _) -> do-                let inject = case m of-                        Nothing -> id-                        Just n -> M.insert n $ const $-                            thunk (withScopes scope arg)-                loebM (inject $ alignWithKey (assemble scope isVariadic)-                                             args (M.fromList s))-  where-    assemble :: Scopes m t-             -> Bool-             -> Text-             -> These t (Maybe (m v))-             -> AttrSet t-             -> m t-    assemble scope isVariadic k = \case-        That Nothing  ->-            const $ evalError @v $ ErrorCall $-                "Missing value for parameter: " ++ show k-        That (Just f) -> \args ->-            thunk $ withScopes scope $ pushScope args f-        This x | isVariadic -> const (pure x)-               | otherwise  ->-                 const $ evalError @v $ ErrorCall $-                     "Unexpected parameter: " ++ show k-        These x _ -> const (pure x)+  scope <- currentScopes :: m (Scopes m t)+  case params of+    Param name -> M.singleton name <$> thunk (withScopes scope arg)+    ParamSet s isVariadic m ->+      arg >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(args, _) -> do+        let inject = case m of+              Nothing -> id+              Just n  -> M.insert n $ const $ thunk (withScopes scope arg)+        loebM+          (inject $ M.mapMaybe id $ alignWithKey (assemble scope isVariadic)+                                                 args+                                                 (M.fromList s)+          )+ where+  assemble+    :: Scopes m t+    -> Bool+    -> Text+    -> These t (Maybe (m v))+    -> Maybe (AttrSet t -> m t)+  assemble scope isVariadic k = \case+    That Nothing ->+      Just+        $  const+        $  evalError @v+        $  ErrorCall+        $  "Missing value for parameter: "+        ++ show k+    That (Just f) ->+      Just $ \args -> thunk $ withScopes scope $ pushScope args f+    This _+      | isVariadic+      -> Nothing+      | otherwise+      -> Just+        $  const+        $  evalError @v+        $  ErrorCall+        $  "Unexpected parameter: "+        ++ show k+    These x _ -> Just (const (pure x)) -addSourcePositions :: (MonadReader e m, Has e SrcSpan)-                   => Transform NExprLocF (m a)+addSourcePositions+  :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a) addSourcePositions f v@(Fix (Compose (Ann ann _))) =-    local (set hasLens ann) (f v)+  local (set hasLens ann) (f v)  addStackFrames-    :: forall t e m a. (Scoped e t m, Framed e m, Typeable t, Typeable m)-    => Transform NExprLocF (m a)+  :: forall t e m a+   . (Scoped t m, Framed e m, Typeable t, Typeable m)+  => Transform NExprLocF (m a) addStackFrames f v = do-    scopes <- currentScopes @e @t-    withFrame Info (EvaluatingExpr scopes v) (f v)+  scopes <- currentScopes :: m (Scopes m t)+  withFrame Info (EvaluatingExpr scopes v) (f v)  framedEvalExprLoc-    :: forall t e v m.-      (MonadNixEval e v t m, Framed e m, Has e SrcSpan,-       Typeable t, Typeable m)-    => NExprLoc -> m v-framedEvalExprLoc = adi (eval . annotated . getCompose)-                        (addStackFrames @t . addSourcePositions)+  :: forall t e v m+   . (MonadNixEval v t m, Framed e m, Has e SrcSpan, Typeable t, Typeable m)+  => NExprLoc+  -> m v+framedEvalExprLoc =+  adi (eval . annotated . getCompose) (addStackFrames @t . addSourcePositions)
src/Nix/Exec.hs view
@@ -26,783 +26,929 @@  module Nix.Exec where -import           Control.Applicative-import           Control.Monad-import           Control.Monad.Catch-import           Control.Monad.Fix-import           Control.Monad.IO.Class-import           Control.Monad.Reader-import           Control.Monad.State.Strict-import           Control.Monad.Trans.Reader (ReaderT(..))-import           Control.Monad.Trans.State.Strict (StateT(..))-import qualified Data.ByteString as BS-import           Data.Coerce-import           Data.Fix-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M-import           Data.IORef-import           Data.List-import qualified Data.List.NonEmpty as NE-import           Data.List.Split-import           Data.Monoid-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Typeable-import           Network.HTTP.Client-import           Network.HTTP.Client.TLS-import           Network.HTTP.Types-import           Nix.Atoms-import           Nix.Context-import           Nix.Convert-import           Nix.Effects-import           Nix.Eval as Eval-import           Nix.Expr-import           Nix.Frames-import           Nix.Normal-import           Nix.Options-import           Nix.Parser-import           Nix.Pretty-import           Nix.Render-import           Nix.Scope-import           Nix.Thunk-import           Nix.Utils-import           Nix.Value-#ifdef MIN_VERSION_haskeline-import           System.Console.Haskeline.MonadException hiding (catch)-#endif-import           System.Directory-import           System.Environment-import           System.Exit (ExitCode (ExitSuccess))-import           System.FilePath-import qualified System.Info-import           System.Posix.Files-import           System.Process (readProcessWithExitCode)-import           Text.PrettyPrint.ANSI.Leijen (text)-import qualified Text.PrettyPrint.ANSI.Leijen as P-#ifdef MIN_VERSION_pretty_show-import qualified Text.Show.Pretty as PS-#endif--#ifdef MIN_VERSION_ghc_datasize-#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804-import           GHC.DataSize-#endif-#endif--type MonadNix e m =-    (Scoped e (NThunk m) m, Framed e m, Has e SrcSpan, Has e Options,-     Typeable m, MonadVar m, MonadEffects m, MonadFix m, MonadCatch m,-     Alternative m)--data ExecFrame m = Assertion SrcSpan (NValue m)-    deriving (Show, Typeable)--instance Typeable m => Exception (ExecFrame m)--nverr :: forall s e m a. (MonadNix e m, Exception s) => s -> m a-nverr = evalError @(NValue m)--currentPos :: forall e m. (MonadReader e m, Has e SrcSpan) => m SrcSpan-currentPos = asks (view hasLens)--wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc-wrapExprLoc span x = Fix (Fix (NSym_ span "<?>") <$ x)--instance MonadNix e m => MonadThunk (NValue m) (NThunk m) m where-    thunk mv = do-        opts :: Options <- asks (view hasLens)--        if thunks opts-            then do-                frames :: Frames <- asks (view hasLens)--                -- Gather the current evaluation context at the time of thunk-                -- creation, and record it along with the thunk.-                let go (fromException ->-                            Just (EvaluatingExpr scope-                                     (Fix (Compose (Ann span e))))) =-                        let e' = Compose (Ann span (Nothing <$ e))-                        in [Provenance scope e']-                    go _ = []-                    ps = concatMap (go . frame) frames--                fmap (NThunk ps . coerce) . buildThunk $ mv-            else-                fmap (NThunk [] . coerce) . buildThunk $ mv--    -- The ThunkLoop exception is thrown as an exception with MonadThrow,-    -- which does not capture the current stack frame information to provide-    -- it in a NixException, so we catch and re-throw it here using-    -- 'throwError' from Frames.hs.-    force (NThunk ps t) f = catch go (throwError @ThunkLoop)-      where-        go = case ps of-            [] -> forceThunk t f-            Provenance scope e@(Compose (Ann span _)):_ ->-                withFrame Info (ForcingExpr scope (wrapExprLoc span e))-                    (forceThunk t f)--    value = NThunk [] . coerce . valueRef--{--prov :: MonadNix e m-     => (NValue m -> Provenance m) -> NValue m -> m (NValue m)-prov p v = do-    opts :: Options <- asks (view hasLens)-    pure $ if values opts-           then addProvenance p v-           else v--}--instance MonadNix e m => MonadEval (NValue m) m where-    freeVariable var =-        nverr $ ErrorCall $ "Undefined variable '" ++ Text.unpack var ++ "'"--    attrMissing ks Nothing =-        evalError @(NValue m) $ ErrorCall $-            "Inheriting unknown attribute: "-                ++ intercalate "." (map Text.unpack (NE.toList ks))--    attrMissing ks (Just s) =-        evalError @(NValue m) $ ErrorCall $ "Could not look up attribute "-            ++ intercalate "." (map Text.unpack (NE.toList ks))-            ++ " in " ++ show s--    evalCurPos = do-        scope <- currentScopes-        span@(SrcSpan delta _) <- currentPos-        addProvenance (\_ -> Provenance scope (NSym_ span "__curPos"))-            <$> toValue delta--    evaledSym name val = do-        scope <- currentScopes-        span <- currentPos-        pure $ addProvenance (const $ Provenance scope (NSym_ span name)) val--    evalConstant c = do-        scope <- currentScopes-        span  <- currentPos-        pure $ nvConstantP (Provenance scope (NConstant_ span c)) c--    evalString = assembleString >=> \case-        Just (s, c) -> do-            scope <- currentScopes-            span  <- currentPos-            pure $ nvStrP (Provenance scope-                           (NStr_ span (DoubleQuoted [Plain s]))) s c-        Nothing -> nverr $ ErrorCall "Failed to assemble string"--    evalLiteralPath p = do-        scope <- currentScopes-        span  <- currentPos-        nvPathP (Provenance scope (NLiteralPath_ span p)) <$> makeAbsolutePath p--    evalEnvPath p = do-        scope <- currentScopes-        span  <- currentPos-        nvPathP (Provenance scope (NEnvPath_ span p)) <$> findEnvPath p--    evalUnary op arg = do-        scope <- currentScopes-        span  <- currentPos-        execUnaryOp scope span op arg--    evalBinary op larg rarg = do-        scope <- currentScopes-        span  <- currentPos-        execBinaryOp scope span op larg rarg--    evalWith c b = do-        scope <- currentScopes-        span <- currentPos-        addProvenance (\b -> Provenance scope (NWith_ span Nothing (Just b)))-            <$> evalWithAttrSet c b--    evalIf c t f = do-        scope <- currentScopes-        span  <- currentPos-        fromValue c >>= \b ->-            if b-            then addProvenance (\t -> Provenance scope (NIf_ span (Just c) (Just t) Nothing)) <$> t-            else addProvenance (\f -> Provenance scope (NIf_ span (Just c) Nothing (Just f))) <$> f--    evalAssert c body = fromValue c >>= \b -> do-        span  <- currentPos-        if b-            then do-                scope <- currentScopes-                addProvenance (\b -> Provenance scope (NAssert_ span (Just c) (Just b))) <$> body-            else nverr $ Assertion span c--    evalApp f x = do-        scope <- currentScopes-        span <- currentPos-        addProvenance (const $ Provenance scope (NBinary_ span NApp (Just f) Nothing))-            <$> callFunc f x--    evalAbs p k = do-        scope <- currentScopes-        span  <- currentPos-        pure $ nvClosureP (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))-            (void p) (\arg -> snd <$> k arg (\_ b -> ((),) <$> b))--    evalError = throwError--infixl 1 `callFunc`-callFunc :: forall e m. (MonadNix e m, Typeable m)-         => NValue m -> m (NValue m) -> m (NValue m)-callFunc fun arg = case fun of-    NVClosure params f -> do-        traceM $ "callFunc:NVFunction taking " ++ show params-        f arg-    NVBuiltin name f -> do-        span <- currentPos-        withFrame Info (Calling @m @(NThunk m) name span) $ f arg-    s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do-        traceM "callFunc:__functor"-        force f $ (`callFunc` pure s) >=> (`callFunc` arg)-    x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x--execUnaryOp :: (Framed e m, MonadVar m)-            => Scopes m (NThunk m) -> SrcSpan -> NUnaryOp -> NValue m-            -> m (NValue m)-execUnaryOp scope span op arg = do-    traceM "NUnary"-    case arg of-        NVConstant c -> case (op, c) of-            (NNeg, NInt   i) -> unaryOp $ NInt   (-i)-            (NNeg, NFloat f) -> unaryOp $ NFloat (-f)-            (NNot, NBool  b) -> unaryOp $ NBool  (not b)-            _ -> throwError $ ErrorCall $-                "unsupported argument type for unary operator " ++ show op-        x -> throwError $ ErrorCall $ "argument to unary operator"-                ++ " must evaluate to an atomic type: " ++ show x-  where-    unaryOp = pure . nvConstantP (Provenance scope (NUnary_ span op (Just arg)))--execBinaryOp-    :: forall e m. (MonadNix e m, MonadEval (NValue m) m)-    => Scopes m (NThunk m)-    -> SrcSpan-    -> NBinaryOp-    -> NValue m-    -> m (NValue m)-    -> m (NValue m)--execBinaryOp scope span NOr larg rarg = fromNix larg >>= \l ->-    if l-    then orOp Nothing True-    else rarg >>= \rval -> fromNix @Bool rval >>= orOp (Just rval)-  where-    orOp r b = pure $-        nvConstantP (Provenance scope (NBinary_ span NOr (Just larg) r)) (NBool b)--execBinaryOp scope span NAnd larg rarg = fromNix larg >>= \l ->-    if l-    then rarg >>= \rval -> fromNix @Bool rval >>= andOp (Just rval)-    else andOp Nothing False-  where-    andOp r b = pure $-        nvConstantP (Provenance scope (NBinary_ span NAnd (Just larg) r)) (NBool b)--execBinaryOp scope span op lval rarg = do-    rval <- rarg-    let bin :: (Provenance m -> a) -> a-        bin f  = f (Provenance scope (NBinary_ span op (Just lval) (Just rval)))-        toBool = pure . bin nvConstantP . NBool-    case (lval, rval) of-        (NVConstant lc, NVConstant rc) -> case (op, lc, rc) of-            (NEq,  _, _)       -> toBool =<< valueEq lval rval-            (NNEq, _, _)       -> toBool . not =<< valueEq lval rval-            (NLt,  l, r)       -> toBool $ l <  r-            (NLte, l, r)       -> toBool $ l <= r-            (NGt,  l, r)       -> toBool $ l >  r-            (NGte, l, r)       -> toBool $ l >= r-            (NAnd,  _, _)      ->-                nverr $ ErrorCall "should be impossible: && is handled above"-            (NOr,   _, _)      ->-                nverr $ ErrorCall "should be impossible: || is handled above"-            (NPlus,  l, r)     -> numBinOp bin (+) l r-            (NMinus, l, r)     -> numBinOp bin (-) l r-            (NMult,  l, r)     -> numBinOp bin (*) l r-            (NDiv,   l, r)     -> numBinOp' bin div (/) l r-            (NImpl,-             NBool l, NBool r) -> toBool $ not l || r-            _                  -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVStr ls lc, NVStr rs rc) -> case op of-            NPlus -> pure $ bin nvStrP (ls `mappend` rs) (lc `mappend` rc)-            NEq   -> toBool =<< valueEq lval rval-            NNEq  -> toBool . not =<< valueEq lval rval-            NLt   -> toBool $ ls <  rs-            NLte  -> toBool $ ls <= rs-            NGt   -> toBool $ ls >  rs-            NGte  -> toBool $ ls >= rs-            _     -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVStr _ _, NVConstant NNull) -> case op of-            NEq  -> toBool =<< valueEq lval (nvStr "" mempty)-            NNEq -> toBool . not =<< valueEq lval (nvStr "" mempty)-            _    -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVConstant NNull, NVStr _ _) -> case op of-            NEq  -> toBool =<< valueEq (nvStr "" mempty) rval-            NNEq -> toBool . not =<< valueEq (nvStr "" mempty) rval-            _    -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVSet ls lp, NVSet rs rp) -> case op of-            NUpdate -> pure $ bin nvSetP (rs `M.union` ls) (rp `M.union` lp)-            NEq     -> toBool =<< valueEq lval rval-            NNEq    -> toBool . not =<< valueEq lval rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVSet ls lp, NVConstant NNull) -> case op of-            NUpdate -> pure $ bin nvSetP ls lp-            NEq     -> toBool =<< valueEq lval (nvSet M.empty M.empty)-            NNEq    -> toBool . not =<< valueEq lval (nvSet M.empty M.empty)-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVConstant NNull, NVSet rs rp) -> case op of-            NUpdate -> pure $ bin nvSetP rs rp-            NEq     -> toBool =<< valueEq (nvSet M.empty M.empty) rval-            NNEq    -> toBool . not =<< valueEq (nvSet M.empty M.empty) rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (ls@NVSet {}, NVStr rs rc) -> case op of-            NPlus   -> (\ls -> bin nvStrP (Text.pack ls `mappend` rs) rc)-                <$> coerceToString False ls-            NEq     -> toBool =<< valueEq lval rval-            NNEq    -> toBool . not =<< valueEq lval rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVStr ls lc, rs@NVSet {}) -> case op of-            NPlus   -> (\rs -> bin nvStrP (ls `mappend` Text.pack rs) lc)-                <$> coerceToString False rs-            NEq     -> toBool =<< valueEq lval rval-            NNEq    -> toBool . not =<< valueEq lval rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVList ls, NVList rs) -> case op of-            NConcat -> pure $ bin nvListP $ ls ++ rs-            NEq     -> toBool =<< valueEq lval rval-            NNEq    -> toBool . not =<< valueEq lval rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVList ls, NVConstant NNull) -> case op of-            NConcat -> pure $ bin nvListP ls-            NEq     -> toBool =<< valueEq lval (nvList [])-            NNEq    -> toBool . not =<< valueEq lval (nvList [])-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVConstant NNull, NVList rs) -> case op of-            NConcat -> pure $ bin nvListP rs-            NEq     -> toBool =<< valueEq (nvList []) rval-            NNEq    -> toBool . not =<< valueEq (nvList []) rval-            _       -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVPath p, NVStr s _) -> case op of-            NEq   -> toBool $ p == Text.unpack s-            NNEq  -> toBool $ p /= Text.unpack s-            NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack s)-            _     -> nverr $ ErrorCall $ unsupportedTypes lval rval--        (NVPath ls, NVPath rs) -> case op of-            NPlus -> bin nvPathP <$> makeAbsolutePath (ls ++ rs)-            _     -> nverr $ ErrorCall $ unsupportedTypes lval rval--        _ -> case op of-            NEq   -> toBool False-            NNEq  -> toBool True-            _ -> nverr $ ErrorCall $ unsupportedTypes lval rval-  where-    unsupportedTypes :: Show a => a -> a -> String-    unsupportedTypes lval rval =-        "Unsupported argument types for binary operator "-            ++ show op ++ ": " ++ show lval ++ ", " ++ show rval--    numBinOp :: (forall r. (Provenance m -> r) -> r)-             -> (forall a. Num a => a -> a -> a) -> NAtom -> NAtom -> m (NValue m)-    numBinOp bin f = numBinOp' bin f f--    numBinOp' :: (forall r. (Provenance m -> r) -> r)-              -> (Integer -> Integer -> Integer)-              -> (Float -> Float -> Float)-              -> NAtom -> NAtom -> m (NValue m)-    numBinOp' bin intF floatF l r = case (l, r) of-        (NInt   li, NInt   ri) -> toInt   $             li `intF`               ri-        (NInt   li, NFloat rf) -> toFloat $ fromInteger li `floatF`             rf-        (NFloat lf, NInt   ri) -> toFloat $             lf `floatF` fromInteger ri-        (NFloat lf, NFloat rf) -> toFloat $             lf `floatF`             rf-        _ -> nverr $ ErrorCall $ unsupportedTypes l r-      where-        toInt   = pure . bin nvConstantP . NInt-        toFloat = pure . bin nvConstantP . NFloat--coerceToString :: MonadNix e m => Bool -> NValue m -> m String-coerceToString copyToStore = go-  where-    go = \case-        NVConstant (NBool b)-            | b               -> pure "1"-            | otherwise       -> pure ""-        NVConstant (NInt n)   -> pure $ show n-        NVConstant (NFloat n) -> pure $ show n-        NVConstant NNull      -> pure ""--        NVStr t _ -> pure $ Text.unpack t-        NVPath p  | copyToStore -> unStorePath <$> addPath p-                  | otherwise   -> pure p-        NVList l  -> unwords <$> traverse (`force` go) l--        v@(NVSet s _) | Just p <- M.lookup "__toString" s ->-            force p $ (`callFunc` pure v) >=> go--        NVSet s _ | Just p <- M.lookup "outPath" s ->-            force p go--        v -> throwError $ ErrorCall $ "Expected a string, but saw: " ++ show v--newtype Lazy m a = Lazy-    { runLazy :: ReaderT (Context (Lazy m) (NThunk (Lazy m)))-                        (StateT (HashMap FilePath NExprLoc) m) a }-    deriving (Functor, Applicative, Alternative, Monad, MonadPlus,-              MonadFix, MonadIO,-              MonadReader (Context (Lazy m) (NThunk (Lazy m))))--instance MonadIO m => MonadVar (Lazy m) where-    type Var (Lazy m) = IORef--    newVar = liftIO . newIORef-    readVar = liftIO . readIORef-    writeVar = (liftIO .) . writeIORef-    atomicModifyVar = (liftIO .) . atomicModifyIORef--instance (MonadIO m, Monad m) => MonadFile m where-    readFile = liftIO . BS.readFile--instance MonadCatch m => MonadCatch (Lazy m) where-    catch (Lazy (ReaderT m)) f = Lazy $ ReaderT $ \e ->-        catch (m e) ((`runReaderT` e) . runLazy . f)--instance MonadThrow m => MonadThrow (Lazy m) where-    throwM = Lazy . throwM--#ifdef MIN_VERSION_haskeline-instance MonadException m => MonadException (Lazy m) where-  controlIO f = Lazy $ controlIO $ \(RunIO run) ->-      let run' = RunIO (fmap Lazy . run . runLazy)-      in runLazy <$> f run'-#endif--instance (MonadFix m, MonadCatch m, MonadIO m, Alternative m,-          MonadPlus m, Typeable m)-      => MonadEffects (Lazy m) where-    addPath path = do-        (exitCode, out, _) <--            liftIO $ readProcessWithExitCode "nix-store" ["--add", path] ""-        case exitCode of-          ExitSuccess -> do-            let dropTrailingLinefeed p = take (length p - 1) p-            return $ StorePath $ dropTrailingLinefeed out-          _ -> throwError $ ErrorCall $-                  "addPath: failed: nix-store --add " ++ show path--    toFile_ filepath content = do-      liftIO $ writeFile filepath content-      storepath <- addPath filepath-      liftIO $ removeFile filepath-      return storepath--    makeAbsolutePath origPath = do-        origPathExpanded <- liftIO $ expandHomePath origPath-        absPath <- if isAbsolute origPathExpanded then pure origPathExpanded else do-            cwd <- do-                mres <- lookupVar @_ @(NThunk (Lazy m)) "__cur_file"-                case mres of-                    Nothing -> liftIO getCurrentDirectory-                    Just v -> force v $ \case-                        NVPath s -> return $ takeDirectory s-                        v -> throwError $ ErrorCall $ "when resolving relative path,"-                                ++ " __cur_file is in scope,"-                                ++ " but is not a path; it is: "-                                ++ show v-            pure $ cwd <///> origPathExpanded-        liftIO $ removeDotDotIndirections <$> canonicalizePath absPath--    findEnvPath = findEnvPathM--    findPath = findPathM--    pathExists = liftIO . fileExist--    importPath scope origPath = do-        path <- liftIO $ pathToDefaultNixFile origPath-        mres <- lookupVar @(Context (Lazy m) (NThunk (Lazy m)))-                         "__cur_file"-        path' <- case mres of-            Nothing  -> do-                traceM "No known current directory"-                return path-            Just p -> fromValue @_ @_ @(NThunk (Lazy m)) p >>= \(Path p') -> do-                traceM $ "Current file being evaluated is: " ++ show p'-                return $ takeDirectory p' </> path--        traceM $ "Importing file " ++ path'-        withFrame Info (ErrorCall $ "While importing file " ++ show path') $ do-            imports <- Lazy $ ReaderT $ const get-            expr <- case M.lookup path' imports of-                Just expr -> pure expr-                Nothing -> do-                    eres <- Lazy $ parseNixFileLoc path'-                    case eres of-                        Failure err  ->-                            throwError $ ErrorCall . show $-                                text "Parse during import failed:" P.</> err-                        Success expr -> do-                            Lazy $ ReaderT $ const $-                                modify (M.insert origPath expr)-                            pure expr--            let ref = value @_ @_ @(Lazy m) (nvPath path')-            -- Use this cookie so that when we evaluate the next-            -- import, we'll remember which directory its containing-            -- file was in.-            pushScope (M.singleton "__cur_file" ref) $-                pushScope scope $ evalExprLoc expr--    getEnvVar = liftIO . lookupEnv--    getCurrentSystemOS = return $ Text.pack System.Info.os--    -- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4-    getCurrentSystemArch = return $ Text.pack $ case System.Info.arch of-      "i386" -> "i686"-      arch -> arch--    listDirectory         = liftIO . System.Directory.listDirectory-    getSymbolicLinkStatus = liftIO . System.Posix.Files.getSymbolicLinkStatus--    derivationStrict = fromValue @(ValueSet (Lazy m)) >=> \s -> do-        nn <- maybe (pure False) fromNix (M.lookup "__ignoreNulls" s)-        s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)-        v' <- normalForm =<< toValue @(ValueSet (Lazy m)) s'-        nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValueNF v')-      where-        mapMaybeM :: (a -> Lazy m (Maybe b)) -> [a] -> Lazy m [b]-        mapMaybeM op = foldr f (return [])-          where f x xs = op x >>= \case-                    Nothing -> xs-                    Just x  -> (x:) <$> xs--        handleEntry ignoreNulls (k, v) = fmap (k,) <$> case k of-            -- The `args' attribute is special: it supplies the command-line-            -- arguments to the builder.-            "args"          -> Just <$> convertNix @[Text] v-            "__ignoreNulls" -> pure Nothing-            _               -> force v $ \case-                NVConstant NNull | ignoreNulls -> pure Nothing-                v' -> Just <$> (toNix =<< Text.pack <$> coerceToString True v')--    nixInstantiateExpr expr = do-        traceM $ "Executing: "-            ++ show ["nix-instantiate", "--eval", "--expr ", expr]-        (exitCode, out, err) <--            liftIO $ readProcessWithExitCode "nix-instantiate"-                [ "--eval", "--expr", expr] ""-        case exitCode of-            ExitSuccess -> case parseNixTextLoc (Text.pack out) of-                Failure err ->-                    throwError $ ErrorCall $-                        "Error parsing output of nix-instantiate: " ++ show err-                Success v -> evalExprLoc v-            status ->-                throwError $ ErrorCall $ "nix-instantiate failed: " ++ show status-                    ++ ": " ++ err--    getRecursiveSize =-#ifdef MIN_VERSION_ghc_datasize-#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804-        toNix @Integer <=< fmap fromIntegral . liftIO . recursiveSize-#else-        const $ toNix (0 :: Integer)-#endif-#else-        const $ toNix (0 :: Integer)-#endif--    getURL url = do-        let urlstr = Text.unpack url-        traceM $ "fetching HTTP URL: " ++ urlstr-        response <- liftIO $ do-          req <- parseRequest urlstr-          manager <--            if secure req-            then newTlsManager-            else newManager defaultManagerSettings-          -- print req-          httpLbs (req { method = "GET" }) manager-          -- return response-        let status = statusCode (responseStatus response)-        if  status /= 200-          then throwError $ ErrorCall $-                 "fail, got " ++ show status ++ " when fetching url:" ++ urlstr-          else -- do-            -- let bstr = responseBody response-            -- liftIO $ print bstr-            throwError $ ErrorCall $-              "success in downloading but hnix-store is not yet ready; url = " ++ urlstr--    traceEffect = liftIO . putStrLn--    exec = \case-      [] -> throwError $ ErrorCall "exec: missing program"-      (prog:args) -> do-        (exitCode, out, _) <--            liftIO $ readProcessWithExitCode prog args ""-        let t = Text.strip (Text.pack out)-        let emsg = "program[" ++ prog ++ "] args=" ++ show args-        case exitCode of-          ExitSuccess ->-            if Text.null t-            then throwError $ ErrorCall $ "exec has no output :" ++ emsg-            else case parseNixTextLoc t of-              Failure err ->-                throwError $ ErrorCall $-                    "Error parsing output of exec: " ++ show err ++ " " ++ emsg-              Success v -> evalExprLoc v-          err -> throwError $ ErrorCall $-                    "exec  failed: " ++ show err ++ " " ++ emsg--runLazyM :: Options -> MonadIO m => Lazy m a -> m a-runLazyM opts = (`evalStateT` M.empty)-              . (`runReaderT` newContext opts)-              . runLazy---- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@.---   This is incorrect on POSIX systems, because if @b@ is a symlink, its---   parent may be a different directory from @a@. See the discussion at---   https://hackage.haskell.org/package/directory-1.3.1.5/docs/System-Directory.html#v:canonicalizePath-removeDotDotIndirections :: FilePath -> FilePath-removeDotDotIndirections = intercalate "/" . go [] . splitOn "/"-    where go s [] = reverse s-          go (_:s) ("..":rest) = go s rest-          go s (this:rest) = go (this:s) rest--expandHomePath :: FilePath -> IO FilePath-expandHomePath ('~' : xs) = flip (++) xs <$> getHomeDirectory-expandHomePath p = return p---- Given a path, determine the nix file to load-pathToDefaultNixFile :: FilePath -> IO FilePath-pathToDefaultNixFile p = do-    isDir <- doesDirectoryExist p-    pure $ if isDir then p </> "default.nix" else p--infixr 9 <///>-(<///>) :: FilePath -> FilePath -> FilePath-x <///> y | isAbsolute y || "." `isPrefixOf` y = x </> y-          | otherwise = joinByLargestOverlap x y-  where-    joinByLargestOverlap (splitDirectories -> xs) (splitDirectories -> ys) =-        joinPath $ head [ xs ++ drop (length tx) ys-                        | tx <- tails xs, tx `elem` inits ys ]--findPathBy :: forall e m. (MonadNix e m, MonadIO m) =>-            (FilePath -> m (Maybe FilePath)) ->-            [NThunk m] -> FilePath -> m FilePath-findPathBy finder l name = do-    mpath <- foldM go Nothing l-    case mpath of-        Nothing ->-            throwError $ ErrorCall $ "file '" ++ name-                ++ "' was not found in the Nix search path"-                ++ " (add it using $NIX_PATH or -I)"-        Just path -> return path-    where-      go :: Maybe FilePath -> NThunk m -> m (Maybe FilePath)-      go p@(Just _) _ = pure p-      go Nothing    l = force l $ fromValue >=>-        \(s :: HashMap Text (NThunk m)) ->-          case M.lookup "path" s of-              Just p -> force p $ fromValue >=> \(Path path) ->-                  case M.lookup "prefix" s of-                      Nothing -> tryPath path Nothing-                      Just pf -> force pf $ fromValueMay >=> \case-                          Just (pfx :: Text) | not (Text.null pfx) ->-                              tryPath path (Just (Text.unpack pfx))-                          _ -> tryPath path Nothing-              Nothing ->-                  throwError $ ErrorCall $ "__nixPath must be a list of attr sets"-                      ++ " with 'path' elements, but saw: " ++ show s--      tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =-          finder $ p <///> joinPath ns-      tryPath p _ = finder $ p <///> name--findPathM :: forall e m. (MonadNix e m, MonadIO m) =>-            [NThunk m] -> FilePath -> m FilePath-findPathM l name = findPathBy path l name-    where-      path :: (MonadEffects m, MonadIO m) => FilePath -> m (Maybe FilePath)-      path path = do-          path <- makeAbsolutePath path-          exists <- liftIO $ doesPathExist path-          return $ if exists then Just path else Nothing--findEnvPathM :: forall e m. (MonadNix e m, MonadIO m)-             => FilePath -> m FilePath-findEnvPathM name = do-    mres <- lookupVar @_ @(NThunk m) "__nixPath"-    case mres of-        Nothing -> error "impossible"-        Just x -> force x $ fromValue >=> \(l :: [NThunk m]) ->-          findPathBy nixFilePath l name-    where-      nixFilePath :: (MonadEffects m, MonadIO m) => FilePath -> m (Maybe FilePath)-      nixFilePath path = do-          path <- makeAbsolutePath path-          exists <- liftIO $ doesDirectoryExist path-          path' <- if exists-                  then makeAbsolutePath $ path </> "default.nix"-                  else return path-          exists <- liftIO $ doesFileExist path'-          return $ if exists then Just path' else Nothing--addTracing :: (MonadNix e m, Has e Options, MonadIO m,-              MonadReader Int n, Alternative n)-           => Alg NExprLocF (m a) -> Alg NExprLocF (n (m a))-addTracing k v = do-    depth <- ask-    guard (depth < 2000)-    local succ $ do-        v'@(Compose (Ann span x)) <- sequence v-        return $ do-            opts :: Options <- asks (view hasLens)-            let rendered =-                    if verbose opts >= Chatty-#ifdef MIN_VERSION_pretty_show-                    then text $ PS.ppShow (void x)-#else-                    then text $ show (void x)-#endif-                    else prettyNix (Fix (Fix (NSym "?") <$ x))-                msg x = text ("eval: " ++ replicate depth ' ') <> x-            loc <- renderLocation span (msg rendered <> text " ...\n")-            liftIO $ putStr $ show loc-            res <- k v'-            liftIO $ print $ msg rendered <> text " ...done"-            return res--evalExprLoc :: forall e m. (MonadNix e m, Has e Options, MonadIO m)-            => NExprLoc -> m (NValue m)-evalExprLoc expr = do-    opts :: Options <- asks (view hasLens)-    if tracing opts-        then join . (`runReaderT` (0 :: Int)) $-             adi (addTracing phi)-                 (raise (addStackFrames @(NThunk m) . addSourcePositions))-                 expr-        else adi phi (addStackFrames @(NThunk m) . addSourcePositions) expr-  where-    phi = Eval.eval @_ @(NValue m) @(NThunk m) @m . annotated . getCompose-    raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x+import           Prelude                 hiding ( putStr+                                                , putStrLn+                                                , print+                                                )++import           Control.Applicative+import           Control.Monad+import           Control.Monad.Catch     hiding ( catchJust )+import           Control.Monad.Fix+import           Control.Monad.Reader+import           Control.Monad.Ref+import           Control.Monad.State.Strict+import           Control.Monad.Trans.Reader     ( ReaderT(..) )+import           Control.Monad.Trans.State.Strict+                                                ( StateT(..) )+import           Data.Fix+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M+import           Data.List+import qualified Data.List.NonEmpty            as NE+import           Data.List.Split+import           Data.Maybe                     ( maybeToList )+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text+import           Data.Text.Prettyprint.Doc+import           Data.Typeable+import           Nix.Atoms+import           Nix.Cited+import           Nix.Context+import           Nix.Convert+import           Nix.Effects+import           Nix.Eval                      as Eval+import           Nix.Expr+import           Nix.Frames+import           Nix.Normal+import           Nix.Options+import           Nix.Parser+import           Nix.Pretty+import           Nix.Render+import           Nix.Scope+import           Nix.String+import           Nix.Thunk+import           Nix.Utils+import           Nix.Value+import           Nix.Value.Equal+#ifdef MIN_VERSION_haskeline+import           System.Console.Haskeline.MonadException hiding(catch)+#endif+import           System.FilePath+#ifdef MIN_VERSION_pretty_show+import qualified Text.Show.Pretty as PS+#endif++#ifdef MIN_VERSION_ghc_datasize+#if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804+import           GHC.DataSize+#endif+#endif++type MonadCited t f m+  = (HasCitations1 t m (NValue t f m) f, MonadDataContext f m)++nvConstantP+  :: MonadCited t f m => Provenance t m (NValue t f m) -> NAtom -> NValue t f m+nvConstantP p x = addProvenance p (nvConstant x)++nvStrP+  :: MonadCited t f m+  => Provenance t m (NValue t f m)+  -> NixString+  -> NValue t f m+nvStrP p ns = addProvenance p (nvStr ns)++nvPathP+  :: MonadCited t f m+  => Provenance t m (NValue t f m)+  -> FilePath+  -> NValue t f m+nvPathP p x = addProvenance p (nvPath x)++nvListP+  :: MonadCited t f m => Provenance t m (NValue t f m) -> [t] -> NValue t f m+nvListP p l = addProvenance p (nvList l)++nvSetP+  :: MonadCited t f m+  => Provenance t m (NValue t f m)+  -> AttrSet t+  -> AttrSet SourcePos+  -> NValue t f m+nvSetP p s x = addProvenance p (nvSet s x)++nvClosureP+  :: MonadCited t f m+  => Provenance t m (NValue t f m)+  -> Params ()+  -> (m (NValue t f m) -> m t)+  -> NValue t f m+nvClosureP p x f = addProvenance p (nvClosure x f)++nvBuiltinP+  :: MonadCited t f m+  => Provenance t m (NValue t f m)+  -> String+  -> (m (NValue t f m) -> m t)+  -> NValue t f m+nvBuiltinP p name f = addProvenance p (nvBuiltin name f)++type MonadCitedThunks t f m+  = ( MonadThunk t m (NValue t f m)+  , MonadDataErrorContext t f m+  , HasCitations1 t m (NValue t f m) f+  )++type MonadNix e t f m+  = ( Has e SrcSpan+  , Has e Options+  , Scoped t m+  , Framed e m+  , MonadFix m+  , MonadCatch m+  , MonadThrow m+  , Alternative m+  , MonadEffects t f m+  , MonadCitedThunks t f m+  )++data ExecFrame t f m = Assertion SrcSpan (NValue t f m)+    deriving (Show, Typeable)++instance MonadDataErrorContext t f m => Exception (ExecFrame t f m)++nverr :: forall e t f s m a . (MonadNix e t f m, Exception s) => s -> m a+nverr = evalError @(NValue t f m)++currentPos :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan+currentPos = asks (view hasLens)++wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc+wrapExprLoc span x = Fix (Fix (NSym_ span "<?>") <$ x)++instance MonadNix e t f m => MonadEval (NValue t f m) m where+  freeVariable var =+    nverr @e @t @f+      $  ErrorCall+      $  "Undefined variable '"+      ++ Text.unpack var+      ++ "'"++  synHole name = do+    span  <- currentPos+    scope <- currentScopes+    evalError @(NValue t f m) $ SynHole $ SynHoleInfo+      { _synHoleInfo_expr  = Fix $ NSynHole_ span name+      , _synHoleInfo_scope = scope+      }++  attrMissing ks Nothing =+    evalError @(NValue t f m)+      $  ErrorCall+      $  "Inheriting unknown attribute: "+      ++ intercalate "." (map Text.unpack (NE.toList ks))++  attrMissing ks (Just s) = do+    s' <- prettyNValue s+    evalError @(NValue t f m)+      $  ErrorCall+      $  "Could not look up attribute "+      ++ intercalate "." (map Text.unpack (NE.toList ks))+      ++ " in "+      ++ show s'++  evalCurPos = do+    scope                  <- currentScopes+    span@(SrcSpan delta _) <- currentPos+    addProvenance @_ @_ @(NValue t f m)+        (Provenance scope (NSym_ span "__curPos"))+      <$> toValue delta++  evaledSym name val = do+    scope <- currentScopes+    span  <- currentPos+    pure $ addProvenance @_ @_ @(NValue t f m)+      (Provenance scope (NSym_ span name))+      val++  evalConstant c = do+    scope <- currentScopes+    span  <- currentPos+    pure $ nvConstantP (Provenance scope (NConstant_ span c)) c++  evalString = assembleString >=> \case+    Just ns -> do+      scope <- currentScopes+      span  <- currentPos+      pure $ nvStrP+        (Provenance+          scope+          (NStr_ span (DoubleQuoted [Plain (hackyStringIgnoreContext ns)]))+        )+        ns+    Nothing -> nverr $ ErrorCall "Failed to assemble string"++  evalLiteralPath p = do+    scope <- currentScopes+    span  <- currentPos+    nvPathP (Provenance scope (NLiteralPath_ span p))+      <$> makeAbsolutePath @t @f @m p++  evalEnvPath p = do+    scope <- currentScopes+    span  <- currentPos+    nvPathP (Provenance scope (NEnvPath_ span p)) <$> findEnvPath @t @f @m p++  evalUnary op arg = do+    scope <- currentScopes+    span  <- currentPos+    execUnaryOp scope span op arg++  evalBinary op larg rarg = do+    scope <- currentScopes+    span  <- currentPos+    execBinaryOp scope span op larg rarg++  evalWith c b = do+    scope <- currentScopes+    span  <- currentPos+    (\b -> addProvenance (Provenance scope (NWith_ span Nothing (Just b))) b)+      <$> evalWithAttrSet c b++  evalIf c t f = do+    scope <- currentScopes+    span  <- currentPos+    fromValue c >>= \b -> if b+      then+        (\t -> addProvenance+            (Provenance scope (NIf_ span (Just c) (Just t) Nothing))+            t+          )+          <$> t+      else+        (\f -> addProvenance+            (Provenance scope (NIf_ span (Just c) Nothing (Just f)))+            f+          )+          <$> f++  evalAssert c body = fromValue c >>= \b -> do+    span <- currentPos+    if b+      then do+        scope <- currentScopes+        (\b ->+            addProvenance (Provenance scope (NAssert_ span (Just c) (Just b))) b+          )+          <$> body+      else nverr $ Assertion span c++  evalApp f x = do+    scope <- currentScopes+    span  <- currentPos+    addProvenance (Provenance scope (NBinary_ span NApp (Just f) Nothing))+      <$> callFunc f x++  evalAbs p k = do+    scope <- currentScopes+    span  <- currentPos+    pure $ nvClosureP+      (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))+      (void p)+      (\arg -> wrapValue . snd <$> k arg (\_ b -> ((), ) <$> b))++  evalError = throwError++infixl 1 `callFunc`+callFunc+  :: forall e t f m+   . MonadNix e t f m+  => NValue t f m+  -> m (NValue t f m)+  -> m (NValue t f m)+callFunc fun arg = do+  frames :: Frames <- asks (view hasLens)+  when (length frames > 2000) $ throwError $ ErrorCall+    "Function call stack exhausted"+  case fun of+    NVClosure params f -> do+      traceM $ "callFunc:NVFunction taking " ++ show params+      force ?? pure =<< f arg+    NVBuiltin name f -> do+      span <- currentPos+      force ?? pure =<< withFrame Info (Calling @m @t name span) (f arg)+    s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do+      traceM "callFunc:__functor"+      force f $ (`callFunc` pure s) >=> (`callFunc` arg)+    x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x++execUnaryOp+  :: (Framed e m, MonadCited t f m, Show t)+  => Scopes m t+  -> SrcSpan+  -> NUnaryOp+  -> NValue t f m+  -> m (NValue t f m)+execUnaryOp scope span op arg = do+  traceM "NUnary"+  case arg of+    NVConstant c -> case (op, c) of+      (NNeg, NInt i  ) -> unaryOp $ NInt (-i)+      (NNeg, NFloat f) -> unaryOp $ NFloat (-f)+      (NNot, NBool b ) -> unaryOp $ NBool (not b)+      _ ->+        throwError+          $  ErrorCall+          $  "unsupported argument type for unary operator "+          ++ show op+    x ->+      throwError+        $  ErrorCall+        $  "argument to unary operator"+        ++ " must evaluate to an atomic type: "+        ++ show x+ where+  unaryOp = pure . nvConstantP (Provenance scope (NUnary_ span op (Just arg)))++execBinaryOp+  :: forall e t f m+   . (MonadNix e t f m, MonadEval (NValue t f m) m)+  => Scopes m t+  -> SrcSpan+  -> NBinaryOp+  -> NValue t f m+  -> m (NValue t f m)+  -> m (NValue t f m)++execBinaryOp scope span NOr larg rarg = fromNix larg >>= \l -> if l+  then orOp Nothing True+  else rarg >>= \rval -> fromNix @Bool rval >>= orOp (Just rval)+ where+  orOp r b = pure $ nvConstantP+    (Provenance scope (NBinary_ span NOr (Just larg) r))+    (NBool b)++execBinaryOp scope span NAnd larg rarg = fromNix larg >>= \l -> if l+  then rarg >>= \rval -> fromNix @Bool rval >>= andOp (Just rval)+  else andOp Nothing False+ where+  andOp r b = pure $ nvConstantP+    (Provenance scope (NBinary_ span NAnd (Just larg) r))+    (NBool b)++execBinaryOp scope span op lval rarg = do+  rval <- rarg+  let bin :: (Provenance t m (NValue t f m) -> a) -> a+      bin f = f (Provenance scope (NBinary_ span op (Just lval) (Just rval)))+      toBool = pure . bin nvConstantP . NBool+  case (lval, rval) of+    (NVConstant lc, NVConstant rc) -> case (op, lc, rc) of+      (NEq , _, _) -> toBool =<< valueEqM lval rval+      (NNEq, _, _) -> toBool . not =<< valueEqM lval rval+      (NLt , l, r) -> toBool $ l < r+      (NLte, l, r) -> toBool $ l <= r+      (NGt , l, r) -> toBool $ l > r+      (NGte, l, r) -> toBool $ l >= r+      (NAnd, _, _) ->+        nverr $ ErrorCall "should be impossible: && is handled above"+      (NOr, _, _) ->+        nverr $ ErrorCall "should be impossible: || is handled above"+      (NPlus , l      , r      ) -> numBinOp bin (+) l r+      (NMinus, l      , r      ) -> numBinOp bin (-) l r+      (NMult , l      , r      ) -> numBinOp bin (*) l r+      (NDiv  , l      , r      ) -> numBinOp' bin div (/) l r+      (NImpl , NBool l, NBool r) -> toBool $ not l || r+      _ -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVStr ls, NVStr rs) -> case op of+      NPlus -> pure $ bin nvStrP (ls `principledStringMappend` rs)+      NEq   -> toBool =<< valueEqM lval rval+      NNEq  -> toBool . not =<< valueEqM lval rval+      NLt   -> toBool $ ls < rs+      NLte  -> toBool $ ls <= rs+      NGt   -> toBool $ ls > rs+      NGte  -> toBool $ ls >= rs+      _     -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVStr _, NVConstant NNull) -> case op of+      NEq  -> toBool False+      NNEq -> toBool True+      _    -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVConstant NNull, NVStr _) -> case op of+      NEq  -> toBool False+      NNEq -> toBool True+      _    -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVSet ls lp, NVSet rs rp) -> case op of+      NUpdate -> pure $ bin nvSetP (rs `M.union` ls) (rp `M.union` lp)+      NEq     -> toBool =<< valueEqM lval rval+      NNEq    -> toBool . not =<< valueEqM lval rval+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVSet ls lp, NVConstant NNull) -> case op of+      NUpdate -> pure $ bin nvSetP ls lp+      NEq     -> toBool =<< valueEqM lval (nvSet M.empty M.empty)+      NNEq    -> toBool . not =<< valueEqM lval (nvSet M.empty M.empty)+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVConstant NNull, NVSet rs rp) -> case op of+      NUpdate -> pure $ bin nvSetP rs rp+      NEq     -> toBool =<< valueEqM (nvSet M.empty M.empty) rval+      NNEq    -> toBool . not =<< valueEqM (nvSet M.empty M.empty) rval+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (ls@NVSet{}, NVStr rs) -> case op of+      NPlus ->+        (\ls2 -> bin nvStrP (ls2 `principledStringMappend` rs))+          <$> coerceToString DontCopyToStore CoerceStringy ls+      NEq  -> toBool =<< valueEqM lval rval+      NNEq -> toBool . not =<< valueEqM lval rval+      _    -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVStr ls, rs@NVSet{}) -> case op of+      NPlus ->+        (\rs2 -> bin nvStrP (ls `principledStringMappend` rs2))+          <$> coerceToString DontCopyToStore CoerceStringy rs+      NEq  -> toBool =<< valueEqM lval rval+      NNEq -> toBool . not =<< valueEqM lval rval+      _    -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVList ls, NVList rs) -> case op of+      NConcat -> pure $ bin nvListP $ ls ++ rs+      NEq     -> toBool =<< valueEqM lval rval+      NNEq    -> toBool . not =<< valueEqM lval rval+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVList ls, NVConstant NNull) -> case op of+      NConcat -> pure $ bin nvListP ls+      NEq     -> toBool =<< valueEqM lval (nvList [])+      NNEq    -> toBool . not =<< valueEqM lval (nvList [])+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVConstant NNull, NVList rs) -> case op of+      NConcat -> pure $ bin nvListP rs+      NEq     -> toBool =<< valueEqM (nvList []) rval+      NNEq    -> toBool . not =<< valueEqM (nvList []) rval+      _       -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVPath p, NVStr ns) -> case op of+      NEq   -> toBool False -- From eqValues in nix/src/libexpr/eval.cc+      NNEq  -> toBool True+      NPlus -> bin nvPathP <$> makeAbsolutePath @t @f+        (p `mappend` Text.unpack (hackyStringIgnoreContext ns))+      _ -> nverr $ ErrorCall $ unsupportedTypes lval rval++    (NVPath ls, NVPath rs) -> case op of+      NPlus -> bin nvPathP <$> makeAbsolutePath @t @f (ls ++ rs)+      _     -> nverr $ ErrorCall $ unsupportedTypes lval rval++    _ -> case op of+      NEq  -> toBool False+      NNEq -> toBool True+      _    -> nverr $ ErrorCall $ unsupportedTypes lval rval+ where+  unsupportedTypes :: Show a => a -> a -> String+  unsupportedTypes lval rval =+    "Unsupported argument types for binary operator "+      ++ show op+      ++ ": "+      ++ show lval+      ++ ", "+      ++ show rval++  numBinOp+    :: (forall r . (Provenance t m (NValue t f m) -> r) -> r)+    -> (forall a . Num a => a -> a -> a)+    -> NAtom+    -> NAtom+    -> m (NValue t f m)+  numBinOp bin f = numBinOp' bin f f++  numBinOp'+    :: (forall r . (Provenance t m (NValue t f m) -> r) -> r)+    -> (Integer -> Integer -> Integer)+    -> (Float -> Float -> Float)+    -> NAtom+    -> NAtom+    -> m (NValue t f m)+  numBinOp' bin intF floatF l r = case (l, r) of+    (NInt   li, NInt ri  ) -> toInt $ li `intF` ri+    (NInt   li, NFloat rf) -> toFloat $ fromInteger li `floatF` rf+    (NFloat lf, NInt ri  ) -> toFloat $ lf `floatF` fromInteger ri+    (NFloat lf, NFloat rf) -> toFloat $ lf `floatF` rf+    _                      -> nverr $ ErrorCall $ unsupportedTypes l r+   where+    toInt   = pure . bin nvConstantP . NInt+    toFloat = pure . bin nvConstantP . NFloat++-- | Data type to avoid boolean blindness on what used to be called coerceMore+data CoercionLevel+  = CoerceStringy+  -- ^ Coerce only stringlike types: strings, paths, and appropriate sets+  | CoerceAny+  -- ^ Coerce everything but functions+  deriving (Eq,Ord,Enum,Bounded)++-- | Data type to avoid boolean blindness on what used to be called copyToStore+data CopyToStoreMode+  = CopyToStore+  -- ^ Add paths to the store as they are encountered+  | DontCopyToStore+  -- ^ Add paths to the store as they are encountered+  deriving (Eq,Ord,Enum,Bounded)++coerceToString+  :: MonadNix e t f m+  => CopyToStoreMode+  -> CoercionLevel+  -> NValue t f m+  -> m NixString+coerceToString ctsm clevel = go+ where+  go = \case+    NVConstant (NBool b)+      |+        -- TODO Return a singleton for "" and "1"+        b && clevel == CoerceAny -> pure+      $  principledMakeNixStringWithoutContext "1"+      | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""+    NVConstant (NInt n) | clevel == CoerceAny ->+      pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n+    NVConstant (NFloat n) | clevel == CoerceAny ->+      pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n+    NVConstant NNull | clevel == CoerceAny ->+      pure $ principledMakeNixStringWithoutContext ""+    NVStr ns -> pure ns+    NVPath p+      | ctsm == CopyToStore -> storePathToNixString <$> addPath p+      | otherwise -> pure $ principledMakeNixStringWithoutContext $ Text.pack p+    NVList l | clevel == CoerceAny ->+      nixStringUnwords <$> traverse (`force` go) l++    v@(NVSet s _) | Just p <- M.lookup "__toString" s ->+      force p $ (`callFunc` pure v) >=> go++    NVSet s _ | Just p <- M.lookup "outPath" s -> force p go++    v -> throwError $ ErrorCall $ "Expected a string, but saw: " ++ show v++  nixStringUnwords =+    principledIntercalateNixString (principledMakeNixStringWithoutContext " ")+  storePathToNixString :: StorePath -> NixString+  storePathToNixString sp = principledMakeNixStringWithSingletonContext+    t+    (StringContext t DirectPath)+    where t = Text.pack $ unStorePath sp++fromStringNoContext :: MonadNix e t f m => NixString -> m Text+fromStringNoContext ns = case principledGetStringNoContext ns of+  Just str -> return str+  Nothing  -> throwError $ ErrorCall "expected string with no context"++newtype Lazy t (f :: * -> *) m a = Lazy+    { runLazy :: ReaderT (Context (Lazy t f m) t)+                        (StateT (HashMap FilePath NExprLoc) m) a }+    deriving+        ( Functor+        , Applicative+        , Alternative+        , Monad+        , MonadPlus+        , MonadFix+        , MonadIO+        , MonadCatch+        , MonadThrow+        , MonadReader (Context (Lazy t f m) t)+        )++instance MonadTrans (Lazy t f) where+  lift = Lazy . lift . lift++instance MonadRef m => MonadRef (Lazy t f m) where+  type Ref (Lazy t f m) = Ref m+  newRef  = lift . newRef+  readRef = lift . readRef+  writeRef r = lift . writeRef r++instance MonadAtomicRef m => MonadAtomicRef (Lazy t f m) where+  atomicModifyRef r = lift . atomicModifyRef r++instance (MonadFile m, Monad m) => MonadFile (Lazy t f m)++#ifdef MIN_VERSION_haskeline+instance MonadException m => MonadException (Lazy t f m) where+  controlIO f = Lazy $ controlIO $ \(RunIO run) ->+      let run' = RunIO (fmap Lazy . run . runLazy)+      in runLazy <$> f run'+#endif++instance MonadStore m => MonadStore (Lazy t f m) where+  addPath' = lift . addPath'+  toFile_' n = lift . toFile_' n++instance MonadPutStr m => MonadPutStr (Lazy t f m)+instance MonadHttp m => MonadHttp (Lazy t f m)+instance MonadEnv m => MonadEnv (Lazy t f m)+instance MonadInstantiate m => MonadInstantiate (Lazy t f m)+instance MonadExec m => MonadExec (Lazy t f m)+instance MonadIntrospect m => MonadIntrospect (Lazy t f m)++instance MonadThunkId m => MonadThunkId (Lazy t f m) where+  type ThunkId (Lazy t f m) = ThunkId m++instance ( MonadFix m+         , MonadCatch m+         , MonadFile m+         , MonadStore m+         , MonadPutStr m+         , MonadHttp m+         , MonadEnv m+         , MonadInstantiate m+         , MonadExec m+         , MonadIntrospect m+         , Alternative m+         , MonadPlus m+         , MonadCitedThunks t f (Lazy t f m)+        )+         => MonadEffects t f (Lazy t f m) where+  makeAbsolutePath origPath = do+    origPathExpanded <- expandHomePath origPath+    absPath          <- if isAbsolute origPathExpanded+      then pure origPathExpanded+      else do+        cwd <- do+          mres <- lookupVar "__cur_file"+          case mres of+            Nothing -> getCurrentDirectory+            Just v  -> force v $ \case+              NVPath s -> return $ takeDirectory s+              v ->+                throwError+                  $  ErrorCall+                  $  "when resolving relative path,"+                  ++ " __cur_file is in scope,"+                  ++ " but is not a path; it is: "+                  ++ show v+        pure $ cwd <///> origPathExpanded+    removeDotDotIndirections <$> canonicalizePath absPath++-- Given a path, determine the nix file to load+  pathToDefaultNix = pathToDefaultNixFile++  findEnvPath      = findEnvPathM+  findPath         = findPathM++  importPath path = do+    traceM $ "Importing file " ++ path+    withFrame Info (ErrorCall $ "While importing file " ++ show path) $ do+      imports <- Lazy $ ReaderT $ const get+      evalExprLoc =<< case M.lookup path imports of+        Just expr -> pure expr+        Nothing   -> do+          eres <- parseNixFileLoc path+          case eres of+            Failure err ->+              throwError+                $ ErrorCall+                . show+                $ fillSep+                $ ["Parse during import failed:", err]+            Success expr -> do+              Lazy $ ReaderT $ const $ modify (M.insert path expr)+              pure expr++  derivationStrict = fromValue @(AttrSet t) >=> \s -> do+    nn <- maybe (pure False) (force ?? fromNix) (M.lookup "__ignoreNulls" s)+    s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)+    v' <- normalForm =<< toValue @(AttrSet t) @_ @(NValue t f (Lazy t f m)) s'+    nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValueNF v')+   where+    mapMaybeM :: (a -> Lazy t f m (Maybe b)) -> [a] -> Lazy t f m [b]+    mapMaybeM op = foldr f (return [])+      where f x xs = op x >>= (<$> xs) . (++) . maybeToList++    handleEntry :: Bool -> (Text, t) -> Lazy t f m (Maybe (Text, t))+    handleEntry ignoreNulls (k, v) = fmap (k, ) <$> case k of+        -- The `args' attribute is special: it supplies the command-line+        -- arguments to the builder.+        -- TODO This use of coerceToString is probably not right and may+        -- not have the right arguments.+      "args"          -> force v $ fmap Just . coerceNixList+      "__ignoreNulls" -> pure Nothing+      _               -> force v $ \case+        NVConstant NNull | ignoreNulls -> pure Nothing+        v'                             -> Just <$> coerceNix v'+     where+      coerceNix :: NValue t f (Lazy t f m) -> Lazy t f m t+      coerceNix =+        fmap wrapValue . toNix <=< coerceToString CopyToStore CoerceAny++      coerceNixList :: NValue t f (Lazy t f m) -> Lazy t f m t+      coerceNixList v = do+        xs :: [t]                     <- fromValue @[t] v+        ys :: [t]                     <- traverse (\x -> force x coerceNix) xs+        v' :: NValue t f (Lazy t f m) <- toValue @[t] ys+        return $ wrapValue v'++  traceEffect = putStrLn++getRecursiveSize :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m)+getRecursiveSize = fmap (nvConstant . NInt . fromIntegral) . recursiveSize++runLazyM :: Options -> MonadIO m => Lazy t f m a -> m a+runLazyM opts =+  (`evalStateT` M.empty) . (`runReaderT` newContext opts) . runLazy++-- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@.+--   This is incorrect on POSIX systems, because if @b@ is a symlink, its+--   parent may be a different directory from @a@. See the discussion at+--   https://hackage.haskell.org/package/directory-1.3.1.5/docs/System-Directory.html#v:canonicalizePath+removeDotDotIndirections :: FilePath -> FilePath+removeDotDotIndirections = intercalate "/" . go [] . splitOn "/"+ where+  go s       []            = reverse s+  go (_ : s) (".." : rest) = go s rest+  go s       (this : rest) = go (this : s) rest++expandHomePath :: MonadFile m => FilePath -> m FilePath+expandHomePath ('~' : xs) = flip (++) xs <$> getHomeDirectory+expandHomePath p          = return p++-- Given a path, determine the nix file to load+pathToDefaultNixFile :: MonadFile m => FilePath -> m FilePath+pathToDefaultNixFile p = do+  isDir <- doesDirectoryExist p+  pure $ if isDir then p </> "default.nix" else p++infixr 9 <///>+(<///>) :: FilePath -> FilePath -> FilePath+x <///> y | isAbsolute y || "." `isPrefixOf` y = x </> y+          | otherwise                          = joinByLargestOverlap x y+ where+  joinByLargestOverlap (splitDirectories -> xs) (splitDirectories -> ys) =+    joinPath $ head+      [ xs ++ drop (length tx) ys | tx <- tails xs, tx `elem` inits ys ]++findPathBy+  :: forall e t f m+   . MonadNix e t f m+  => (FilePath -> m (Maybe FilePath))+  -> [t]+  -> FilePath+  -> m FilePath+findPathBy finder l name = do+  mpath <- foldM go Nothing l+  case mpath of+    Nothing ->+      throwError+        $  ErrorCall+        $  "file '"+        ++ name+        ++ "' was not found in the Nix search path"+        ++ " (add it using $NIX_PATH or -I)"+    Just path -> return path+ where+  go :: Maybe FilePath -> t -> m (Maybe FilePath)+  go p@(Just _) _ = pure p+  go Nothing    l = force l $ fromValue >=> \(s :: HashMap Text t) -> do+    p <- resolvePath s+    force p $ fromValue >=> \(Path path) -> case M.lookup "prefix" s of+      Nothing -> tryPath path Nothing+      Just pf -> force pf $ fromValueMay >=> \case+        Just (nsPfx :: NixString) ->+          let pfx = hackyStringIgnoreContext nsPfx+          in  if not (Text.null pfx)+                then tryPath path (Just (Text.unpack pfx))+                else tryPath path Nothing+        _ -> tryPath path Nothing++  tryPath p (Just n) | n' : ns <- splitDirectories name, n == n' =+    finder $ p <///> joinPath ns+  tryPath p _ = finder $ p <///> name++  resolvePath s = case M.lookup "path" s of+    Just t  -> return t+    Nothing -> case M.lookup "uri" s of+      Just ut -> thunk $ fetchTarball (force ut pure)+      Nothing ->+        throwError+          $  ErrorCall+          $  "__nixPath must be a list of attr sets"+          ++ " with 'path' elements, but saw: "+          ++ show s++findPathM :: forall e t f m . MonadNix e t f m => [t] -> FilePath -> m FilePath+findPathM l name = findPathBy path l name+ where+  path :: MonadEffects t f m => FilePath -> m (Maybe FilePath)+  path path = do+    path   <- makeAbsolutePath @t @f path+    exists <- doesPathExist path+    return $ if exists then Just path else Nothing++findEnvPathM :: forall e t f m . MonadNix e t f m => FilePath -> m FilePath+findEnvPathM name = do+  mres <- lookupVar "__nixPath"+  case mres of+    Nothing -> error "impossible"+    Just x ->+      force x $ fromValue >=> \(l :: [t]) -> findPathBy nixFilePath l name+ where+  nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)+  nixFilePath path = do+    path   <- makeAbsolutePath @t @f path+    exists <- doesDirectoryExist path+    path'  <- if exists+      then makeAbsolutePath @t @f $ path </> "default.nix"+      else return path+    exists <- doesFileExist path'+    return $ if exists then Just path' else Nothing++addTracing+  :: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)+  => Alg NExprLocF (m a)+  -> Alg NExprLocF (n (m a))+addTracing k v = do+  depth <- ask+  guard (depth < 2000)+  local succ $ do+    v'@(Compose (Ann span x)) <- sequence v+    return $ do+      opts :: Options <- asks (view hasLens)+      let rendered = if verbose opts >= Chatty+#ifdef MIN_VERSION_pretty_show+                     then pretty $ PS.ppShow (void x)+#else+            then pretty $ show (void x)+#endif+            else prettyNix (Fix (Fix (NSym "?") <$ x))+          msg x = pretty ("eval: " ++ replicate depth ' ') <> x+      loc <- renderLocation span (msg rendered <> " ...\n")+      putStr $ show loc+      res <- k v'+      print $ msg rendered <> " ...done"+      return res++evalExprLoc :: forall e t f m . MonadNix e t f m => NExprLoc -> m (NValue t f m)+evalExprLoc expr = do+  opts :: Options <- asks (view hasLens)+  if tracing opts+    then join . (`runReaderT` (0 :: Int)) $ adi+      (addTracing phi)+      (raise (addStackFrames @t . addSourcePositions))+      expr+    else adi phi (addStackFrames @t . addSourcePositions) expr+ where+  phi = Eval.eval . annotated . getCompose+  raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x++fetchTarball+  :: forall e t f m . MonadNix e t f m => m (NValue t f m) -> m (NValue t f m)+fetchTarball v = v >>= \case+  NVSet s _ -> case M.lookup "url" s of+    Nothing ->+      throwError $ ErrorCall "builtins.fetchTarball: Missing url attribute"+    Just url -> force url $ go (M.lookup "sha256" s)+  v@NVStr{} -> go Nothing v+  v ->+    throwError+      $  ErrorCall+      $  "builtins.fetchTarball: Expected URI or set, got "+      ++ show v+ where+  go :: Maybe t -> NValue t f m -> m (NValue t f m)+  go msha = \case+    NVStr ns -> fetch (hackyStringIgnoreContext ns) msha+    v ->+      throwError+        $  ErrorCall+        $  "builtins.fetchTarball: Expected URI or string, got "+        ++ show v++{- jww (2018-04-11): This should be written using pipes in another module+    fetch :: Text -> Maybe (NThunk m) -> m (NValue t f m)+    fetch uri msha = case takeExtension (Text.unpack uri) of+        ".tgz" -> undefined+        ".gz"  -> undefined+        ".bz2" -> undefined+        ".xz"  -> undefined+        ".tar" -> undefined+        ext -> throwError $ ErrorCall $ "builtins.fetchTarball: Unsupported extension '"+                  ++ ext ++ "'"+-}++  fetch :: Text -> Maybe t -> m (NValue t f m)+  fetch uri Nothing =+    nixInstantiateExpr $ "builtins.fetchTarball \"" ++ Text.unpack uri ++ "\""+  fetch url (Just t) = force t $ fromValue >=> \nsSha ->+    let sha = hackyStringIgnoreContext nsSha+    in  nixInstantiateExpr+          $  "builtins.fetchTarball { "+          ++ "url    = \""+          ++ Text.unpack url+          ++ "\"; "+          ++ "sha256 = \""+          ++ Text.unpack sha+          ++ "\"; }"++exec :: (MonadNix e t f m, MonadInstantiate m) => [String] -> m (NValue t f m)+exec args = either throwError evalExprLoc =<< exec' args++nixInstantiateExpr+  :: (MonadNix e t f m, MonadInstantiate m) => String -> m (NValue t f m)+nixInstantiateExpr s = either throwError evalExprLoc =<< instantiateExpr s++instance Monad m => Scoped t (Lazy t f m) where+  currentScopes = currentScopesReader+  clearScopes   = clearScopesReader @(Lazy t f m) @t+  pushScopes    = pushScopesReader+  lookupVar     = lookupVarReader+++++++
src/Nix/Expr.hs view
@@ -1,10 +1,11 @@ -- | Wraps the expression submodules.-module Nix.Expr (-  module Nix.Expr.Types,-  module Nix.Expr.Types.Annotated,-  module Nix.Expr.Shorthands-  ) where+module Nix.Expr+  ( module Nix.Expr.Types+  , module Nix.Expr.Types.Annotated+  , module Nix.Expr.Shorthands+  )+where -import Nix.Expr.Types-import Nix.Expr.Shorthands-import Nix.Expr.Types.Annotated+import           Nix.Expr.Types+import           Nix.Expr.Shorthands+import           Nix.Expr.Types.Annotated
src/Nix/Expr/Shorthands.hs view
@@ -7,13 +7,12 @@ -- 'Fix' wrapper. module Nix.Expr.Shorthands where -import Data.Fix-import Data.List.NonEmpty (NonEmpty(..))-import Data.Monoid-import Data.Text (Text)-import Nix.Atoms-import Nix.Expr.Types-import Text.Megaparsec.Pos (SourcePos)+import           Data.Fix+import           Data.List.NonEmpty             ( NonEmpty(..) )+import           Data.Text                      ( Text )+import           Nix.Atoms+import           Nix.Expr.Types+import           Text.Megaparsec.Pos            ( SourcePos )  -- | Make an integer literal expression. mkInt :: Integer -> NExpr@@ -33,13 +32,13 @@ mkStr :: Text -> NExpr mkStr = Fix . NStr . DoubleQuoted . \case   "" -> []-  x -> [Plain x]+  x  -> [Plain x]  -- | Make an indented string. mkIndentedStr :: Int -> Text -> NExpr mkIndentedStr w = Fix . NStr . Indented w . \case   "" -> []-  x -> [Plain x]+  x  -> [Plain x]  -- | Make a path. Use 'True' if the path should be read from the -- environment, else 'False'.@@ -48,7 +47,7 @@  mkPathF :: Bool -> FilePath -> NExprF a mkPathF False = NLiteralPath-mkPathF True = NEnvPath+mkPathF True  = NEnvPath  -- | Make a path expression which pulls from the NIX_PATH env variable. mkEnvPath :: FilePath -> NExpr@@ -71,6 +70,12 @@ mkSymF :: Text -> NExprF a mkSymF = NSym +mkSynHole :: Text -> NExpr+mkSynHole = Fix . mkSynHoleF++mkSynHoleF :: Text -> NExprF a+mkSynHoleF = NSynHole+ mkSelector :: Text -> NAttrPath NExpr mkSelector = (:| []) . StaticKey @@ -157,15 +162,15 @@ appendBindings :: [Binding NExpr] -> NExpr -> NExpr appendBindings newBindings (Fix e) = case e of   NLet bindings e' -> Fix $ NLet (bindings <> newBindings) e'-  NSet bindings -> Fix $ NSet (bindings <> newBindings)+  NSet    bindings -> Fix $ NSet (bindings <> newBindings)   NRecSet bindings -> Fix $ NRecSet (bindings <> newBindings)-  _ -> error "Can only append bindings to a set or a let"+  _                -> error "Can only append bindings to a set or a let"  -- | Applies a transformation to the body of a nix function. modifyFunctionBody :: (NExpr -> NExpr) -> NExpr -> NExpr modifyFunctionBody f (Fix e) = case e of   NAbs params body -> Fix $ NAbs params (f body)-  _ -> error "Not a function"+  _                -> error "Not a function"  -- | A let statement with multiple assignments. letsE :: [(Text, NExpr)] -> NExpr -> NExpr@@ -196,8 +201,7 @@ mkBinop op e1 e2 = Fix (NBinary op e1 e2)  -- | Various nix binary operators-($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->),-  ($//), ($+), ($-), ($*), ($/), ($++)+($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)   :: NExpr -> NExpr -> NExpr e1 $== e2 = mkBinop NEq e1 e2 e1 $!= e2 = mkBinop NNEq e1 e2
src/Nix/Expr/Types.hs view
@@ -28,16 +28,16 @@ module Nix.Expr.Types where  #ifdef MIN_VERSION_serialise-import           Codec.Serialise (Serialise)-import qualified Codec.Serialise as Ser+import           Codec.Serialise                ( Serialise )+import qualified Codec.Serialise               as Ser #endif import           Control.Applicative import           Control.DeepSeq import           Control.Monad import           Data.Aeson import           Data.Aeson.TH-import           Data.Binary (Binary)-import qualified Data.Binary as Bin+import           Data.Binary                    ( Binary )+import qualified Data.Binary                   as Bin import           Data.Data import           Data.Eq.Deriving import           Data.Fix@@ -46,13 +46,17 @@ #if MIN_VERSION_hashable(1, 2, 5) import           Data.Hashable.Lifted #endif-import           Data.List (inits, tails)-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import           Data.Maybe (fromMaybe)-import           Data.Monoid+import           Data.List                      ( inits+                                                , tails+                                                )+import           Data.List.NonEmpty             ( NonEmpty(..) )+import qualified Data.List.NonEmpty            as NE+import           Data.Maybe                     ( fromMaybe ) import           Data.Ord.Deriving-import           Data.Text (Text, pack, unpack)+import           Data.Text                      ( Text+                                                , pack+                                                , unpack+                                                ) import           Data.Traversable import           GHC.Exts import           GHC.Generics@@ -65,12 +69,15 @@ import           Text.Read.Deriving import           Text.Show.Deriving #if MIN_VERSION_base(4, 10, 0)-import           Type.Reflection (eqTypeRep)-import qualified Type.Reflection as Reflection+import           Type.Reflection                ( eqTypeRep )+import qualified Type.Reflection               as Reflection #endif  type VarName = Text +hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)+hashAt = flip alterF+ -- unfortunate orphans #if MIN_VERSION_hashable(1, 2, 5) instance Hashable1 NonEmpty@@ -135,9 +142,10 @@   -- evaluate the second argument.   | NAssert !r !r   -- ^ Assert that the first returns true before evaluating the second.+  | NSynHole !VarName+  -- ^ Syntactic hole, e.g. @^foo@ , @^hole_name@   deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor,-            Foldable, Traversable, Show, NFData,-            Hashable)+            Foldable, Traversable, Show, NFData, Hashable)  #if MIN_VERSION_hashable(1, 2, 5) instance Hashable1 NExprF@@ -158,10 +166,10 @@  #if MIN_VERSION_base(4, 10, 0) instance Lift (Fix NExprF) where-    lift = dataToExpQ $ \b ->-        case Reflection.typeOf b `eqTypeRep` Reflection.typeRep @Text of-            Just HRefl -> Just [| pack $(liftString $ unpack b) |]-            Nothing -> Nothing+  lift = dataToExpQ $ \b ->+    case Reflection.typeOf b `eqTypeRep` Reflection.typeRep @Text of+      Just HRefl -> Just [| pack $(liftString $ unpack b) |]+      Nothing    -> Nothing #else instance Lift (Fix NExprF) where     lift = dataToExpQ $ \b -> case cast b of@@ -187,8 +195,7 @@   --   first name, whether that be the first argument to this constructor, or   --   the first member of the list in the second argument.   deriving (Generic, Generic1, Typeable, Data, Ord, Eq, Functor,-            Foldable, Traversable, Show, NFData,-            Hashable)+            Foldable, Traversable, Show, NFData, Hashable)  #if MIN_VERSION_hashable(1, 2, 5) instance Hashable1 Binding@@ -243,12 +250,10 @@ instance Hashable v => Hashable1 (Antiquoted v)  instance Hashable2 Antiquoted where-    liftHashWithSalt2 ha _ salt (Plain a) =-        ha (salt `hashWithSalt` (0 :: Int)) a-    liftHashWithSalt2 _ _ salt EscapedNewline =-        salt `hashWithSalt` (1 :: Int)-    liftHashWithSalt2 _ hb salt (Antiquoted b) =-        hb (salt `hashWithSalt` (2 :: Int)) b+  liftHashWithSalt2 ha _ salt (Plain a) = ha (salt `hashWithSalt` (0 :: Int)) a+  liftHashWithSalt2 _ _ salt EscapedNewline = salt `hashWithSalt` (1 :: Int)+  liftHashWithSalt2 _ hb salt (Antiquoted b) =+    hb (salt `hashWithSalt` (2 :: Int)) b #endif  #if MIN_VERSION_deepseq(1, 4, 3)@@ -287,7 +292,7 @@  -- | For the the 'IsString' instance, we use a plain doublequoted string. instance IsString (NString r) where-  fromString "" = DoubleQuoted []+  fromString ""     = DoubleQuoted []   fromString string = DoubleQuoted [Plain $ pack string]  -- | A 'KeyName' is something that can appear on the left side of an@@ -312,27 +317,26 @@ data NKeyName r   = DynamicKey !(Antiquoted (NString r) r)   | StaticKey !VarName-  deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData,-            Hashable)+  deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData, Hashable)  #ifdef MIN_VERSION_serialise instance Serialise r => Serialise (NKeyName r)  instance Serialise Pos where-    encode x = Ser.encode (unPos x)-    decode = mkPos <$> Ser.decode+  encode x = Ser.encode (unPos x)+  decode = mkPos <$> Ser.decode  instance Serialise SourcePos where-    encode (SourcePos f l c) = Ser.encode f <> Ser.encode l <> Ser.encode c-    decode = SourcePos <$> Ser.decode <*> Ser.decode <*> Ser.decode+  encode (SourcePos f l c) = Ser.encode f <> Ser.encode l <> Ser.encode c+  decode = SourcePos <$> Ser.decode <*> Ser.decode <*> Ser.decode #endif  instance Hashable Pos where-    hashWithSalt salt x = hashWithSalt salt (unPos x)+  hashWithSalt salt x = hashWithSalt salt (unPos x)  instance Hashable SourcePos where-    hashWithSalt salt (SourcePos f l c) =-        salt `hashWithSalt` f `hashWithSalt` l `hashWithSalt` c+  hashWithSalt salt (SourcePos f l c) =+    salt `hashWithSalt` f `hashWithSalt` l `hashWithSalt` c  instance Generic1 NKeyName where   type Rep1 NKeyName = NKeyName@@ -341,10 +345,10 @@  #if MIN_VERSION_deepseq(1, 4, 3) instance NFData1 NKeyName where-    liftRnf _ (StaticKey !_) = ()-    liftRnf _ (DynamicKey (Plain !_)) = ()-    liftRnf _ (DynamicKey EscapedNewline) = ()-    liftRnf k (DynamicKey (Antiquoted r)) = k r+  liftRnf _ (StaticKey  !_            ) = ()+  liftRnf _ (DynamicKey (Plain !_)    ) = ()+  liftRnf _ (DynamicKey EscapedNewline) = ()+  liftRnf k (DynamicKey (Antiquoted r)) = k r #endif  -- | Most key names are just static text, so this instance is convenient.@@ -353,22 +357,26 @@  instance Eq1 NKeyName where   liftEq eq (DynamicKey a) (DynamicKey b) = liftEq2 (liftEq eq) eq a b-  liftEq _ (StaticKey a) (StaticKey b) = a == b-  liftEq _ _ _ = False+  liftEq _  (StaticKey  a) (StaticKey  b) = a == b+  liftEq _  _              _              = False  #if MIN_VERSION_hashable(1, 2, 5) instance Hashable1 NKeyName where   liftHashWithSalt h salt (DynamicKey a) =-      liftHashWithSalt2 (liftHashWithSalt h) h (salt `hashWithSalt` (0 :: Int)) a+    liftHashWithSalt2 (liftHashWithSalt h) h (salt `hashWithSalt` (0 :: Int)) a   liftHashWithSalt _ salt (StaticKey n) =-      salt `hashWithSalt` (1 :: Int) `hashWithSalt` n+    salt `hashWithSalt` (1 :: Int) `hashWithSalt` n #endif  -- Deriving this instance automatically is not possible because @r@ -- occurs not only as last argument in @Antiquoted (NString r) r@ instance Show1 NKeyName where   liftShowsPrec sp sl p = \case-    DynamicKey a -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl) "DynamicKey" p a+    DynamicKey a -> showsUnaryWith+      (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl)+      "DynamicKey"+      p+      a     StaticKey t -> showsUnaryWith showsPrec "StaticKey" p t  -- Deriving this instance automatically is not possible because @r@@@ -385,10 +393,10 @@ -- occurs not only as last argument in @Antiquoted (NString r) r@ instance Traversable NKeyName where   traverse f = \case-    DynamicKey (Plain str)    -> DynamicKey . Plain <$> traverse f str-    DynamicKey (Antiquoted e) -> DynamicKey . Antiquoted <$> f e-    DynamicKey EscapedNewline -> pure $ DynamicKey EscapedNewline-    StaticKey key -> pure (StaticKey key)+    DynamicKey (Plain      str) -> DynamicKey . Plain <$> traverse f str+    DynamicKey (Antiquoted e  ) -> DynamicKey . Antiquoted <$> f e+    DynamicKey EscapedNewline   -> pure $ DynamicKey EscapedNewline+    StaticKey  key              -> pure (StaticKey key)  -- | A selector (for example in a @let@ or an attribute set) is made up -- of strung-together key names.@@ -414,7 +422,7 @@   | NAnd     -- ^ Logical and (&&)   | NOr      -- ^ Logical or (||)   | NImpl    -- ^ Logical implication (->)-  | NUpdate  -- ^ Joining two attribut sets (//)+  | NUpdate  -- ^ Joining two attribute sets (//)   | NPlus    -- ^ Addition (+)   | NMinus   -- ^ Subtraction (-)   | NMult    -- ^ Multiplication (*)@@ -430,7 +438,7 @@  -- | Get the name out of the parameter (there might be none). paramName :: Params r -> Maybe VarName-paramName (Param n) = Just n+paramName (Param n       ) = Just n paramName (ParamSet _ _ n) = n  #if !MIN_VERSION_deepseq(1, 4, 3)@@ -472,8 +480,8 @@ instance Binary a => Binary (NString a) instance Binary a => Binary (Binding a) instance Binary Pos where-    put x = Bin.put (unPos x)-    get = mkPos <$> Bin.get+  put x = Bin.put (unPos x)+  get = mkPos <$> Bin.get instance Binary SourcePos instance Binary a => Binary (NKeyName a) instance Binary a => Binary (Params a)@@ -486,7 +494,7 @@ instance ToJSON a => ToJSON (NString a) instance ToJSON a => ToJSON (Binding a) instance ToJSON Pos where-    toJSON x = toJSON (unPos x)+  toJSON x = toJSON (unPos x) instance ToJSON SourcePos instance ToJSON a => ToJSON (NKeyName a) instance ToJSON a => ToJSON (Params a)@@ -500,7 +508,7 @@ instance FromJSON a => FromJSON (NString a) instance FromJSON a => FromJSON (Binding a) instance FromJSON Pos where-    parseJSON = fmap mkPos . parseJSON+  parseJSON = fmap mkPos . parseJSON instance FromJSON SourcePos instance FromJSON a => FromJSON (NKeyName a) instance FromJSON a => FromJSON (Params a)@@ -525,43 +533,46 @@     fromNExpr :: g r -> (NExprF r, ann)     toNExpr :: (NExprF r, ann) -> g r -ekey :: NExprAnn ann g-     => NonEmpty Text-     -> SourcePos-     -> Lens' (Fix g) (Maybe (Fix g))-ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x =-    case go xs of-        ((v, []):_) -> fromMaybe e <$> f (Just v)-        ((v, r:rest):_) -> ekey (r :| rest) pos f v+ekey+  :: NExprAnn ann g+  => NonEmpty Text+  -> SourcePos+  -> Lens' (Fix g) (Maybe (Fix g))+ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x = case go xs of+  ((v, []      ) : _) -> fromMaybe e <$> f (Just v)+  ((v, r : rest) : _) -> ekey (r :| rest) pos f v -        _ -> f Nothing <&> \case-            Nothing -> e-            Just v  ->-                let entry = NamedVar (NE.map StaticKey keys) v pos-                in Fix (toNExpr (NSet (entry : xs), ann))-  where-    go xs = do-        let keys' = NE.toList keys-        (ks, rest) <- zip (inits keys') (tails keys')-        case ks of-            [] -> empty-            j:js -> do-                NamedVar ns v _p <- xs-                guard $ (j:js) == (NE.toList ns ^.. traverse._StaticKey)-                return (v, rest)+  _                   -> f Nothing <&> \case+    Nothing -> e+    Just v ->+      let entry = NamedVar (NE.map StaticKey keys) v pos+      in  Fix (toNExpr (NSet (entry : xs), ann))+ where+  go xs = do+    let keys' = NE.toList keys+    (ks, rest) <- zip (inits keys') (tails keys')+    case ks of+      []     -> empty+      j : js -> do+        NamedVar ns v _p <- xs+        guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)+        return (v, rest)  ekey _ _ f e = fromMaybe e <$> f Nothing  stripPositionInfo :: NExpr -> NExpr stripPositionInfo = transport phi-  where-    phi (NSet binds)         = NSet (map go binds)-    phi (NRecSet binds)      = NRecSet (map go binds)-    phi (NLet binds body)    = NLet (map go binds) body-    phi x = x+ where+  phi (NSet    binds  ) = NSet (map go binds)+  phi (NRecSet binds  ) = NRecSet (map go binds)+  phi (NLet binds body) = NLet (map go binds) body+  phi x                 = x -    go (NamedVar path r _pos)  = NamedVar path r nullPos-    go (Inherit ms names _pos) = Inherit ms names nullPos+  go (NamedVar path r     _pos) = NamedVar path r nullPos+  go (Inherit  ms   names _pos) = Inherit ms names nullPos  nullPos :: SourcePos nullPos = SourcePos "<string>" (mkPos 1) (mkPos 1)+++
src/Nix/Expr/Types/Annotated.hs view
@@ -18,43 +18,50 @@ module Nix.Expr.Types.Annotated   ( module Nix.Expr.Types.Annotated   , module Data.Functor.Compose-  , SourcePos(..), unPos, mkPos-  )where+  , SourcePos(..)+  , unPos+  , mkPos+  )+where  #ifdef MIN_VERSION_serialise-import Codec.Serialise+import           Codec.Serialise #endif-import Control.DeepSeq-import Data.Aeson (ToJSON(..), FromJSON(..))-import Data.Aeson.TH-import Data.Binary (Binary(..))-import Data.Data-import Data.Eq.Deriving-import Data.Fix-import Data.Function (on)-import Data.Functor.Compose-import Data.Hashable+import           Control.DeepSeq+import           Data.Aeson                     ( ToJSON(..)+                                                , FromJSON(..)+                                                )+import           Data.Aeson.TH+import           Data.Binary                    ( Binary(..) )+import           Data.Data+import           Data.Eq.Deriving+import           Data.Fix+import           Data.Function                  ( on )+import           Data.Functor.Compose+import           Data.Hashable #if MIN_VERSION_hashable(1, 2, 5)-import Data.Hashable.Lifted+import           Data.Hashable.Lifted #endif-import Data.Ord.Deriving-import Data.Semigroup-import Data.Text (Text, pack)-import GHC.Generics-import Nix.Atoms-import Nix.Expr.Types-import Text.Megaparsec (unPos, mkPos)-import Text.Megaparsec.Pos (SourcePos(..))-import Text.Read.Deriving-import Text.Show.Deriving+import           Data.Ord.Deriving+import           Data.Text                      ( Text+                                                , pack+                                                )+import           GHC.Generics+import           Nix.Atoms+import           Nix.Expr.Types+import           Text.Megaparsec                ( unPos+                                                , mkPos+                                                )+import           Text.Megaparsec.Pos            ( SourcePos(..) )+import           Text.Read.Deriving+import           Text.Show.Deriving  -- | A location in a source file data SrcSpan = SrcSpan     { spanBegin :: SourcePos     , spanEnd   :: SourcePos     }-    deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData,-              Hashable)+    deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData, Hashable)  #ifdef MIN_VERSION_serialise instance Serialise SrcSpan@@ -95,8 +102,7 @@ $(deriveJSON2 defaultOptions ''Ann)  instance Semigroup SrcSpan where-  s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2)-                     ((max `on` spanEnd) s1 s2)+  s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2) ((max `on` spanEnd) s1 s2)  type AnnF ann f = Compose (Ann ann) f @@ -132,8 +138,8 @@  #ifdef MIN_VERSION_serialise instance Serialise r => Serialise (Compose (Ann SrcSpan) NExprF r) where-    encode (Compose (Ann ann a)) = encode ann <> encode a-    decode = (Compose .) . Ann <$> decode <*> decode+  encode (Compose (Ann ann a)) = encode ann <> encode a+  decode = (Compose .) . Ann <$> decode <*> decode #endif  pattern AnnE :: forall ann (g :: * -> *). ann@@ -148,32 +154,32 @@  nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)-nUnary _ _ = error "nUnary: unexpected"+nUnary _          _              = error "nUnary: unexpected"  nBinary :: Ann SrcSpan NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =   AnnE (s1 <> s2 <> s3) (NBinary b e1 e2) nBinary _ _ _ = error "nBinary: unexpected" -nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc-           -> NExprLoc+nSelectLoc+  :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of   Nothing               -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)   Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))-  _ -> error "nSelectLoc: unexpected"+  _                     -> error "nSelectLoc: unexpected" nSelectLoc _ _ _ = error "nSelectLoc: unexpected"  nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)-nHasAttr _ _ = error "nHasAttr: unexpected"+nHasAttr _              _            = error "nHasAttr: unexpected"  nApp :: NExprLoc -> NExprLoc -> NExprLoc nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NBinary NApp e1 e2)-nApp _ _ = error "nApp: unexpected"+nApp _              _              = error "nApp: unexpected"  nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)-nAbs _ _ = error "nAbs: unexpected"+nAbs _           _              = error "nAbs: unexpected"  nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc nStr (Ann s1 s) = AnnE s1 (NStr s)@@ -191,6 +197,9 @@  pattern NSym_ :: SrcSpan -> VarName -> NExprLocF r pattern NSym_ ann x = Compose (Ann ann (NSym x))++pattern NSynHole_ :: SrcSpan -> Text -> NExprLocF r+pattern NSynHole_ ann x = Compose (Ann ann (NSynHole x))  pattern NConstant_ :: SrcSpan -> NAtom -> NExprLocF r pattern NConstant_ ann x = Compose (Ann ann (NConstant x))
src/Nix/Frames.hs view
@@ -4,16 +4,26 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -module Nix.Frames (NixLevel(..), Frames, Framed, NixFrame(..),-                   NixException(..), withFrame, throwError,-                   module Data.Typeable,-                   module Control.Exception) where+module Nix.Frames+  ( NixLevel(..)+  , Frames+  , Framed+  , NixFrame(..)+  , NixException(..)+  , withFrame+  , throwError+  , module Data.Typeable+  , module Control.Exception+  )+where -import Control.Exception hiding (catch, evaluate)-import Control.Monad.Catch-import Control.Monad.Reader-import Data.Typeable hiding (typeOf)-import Nix.Utils+import           Control.Exception       hiding ( catch+                                                , evaluate+                                                )+import           Control.Monad.Catch+import           Control.Monad.Reader+import           Data.Typeable           hiding ( typeOf )+import           Nix.Utils  data NixLevel = Fatal | Error | Warning | Info | Debug     deriving (Ord, Eq, Bounded, Enum, Show)@@ -24,8 +34,8 @@     }  instance Show NixFrame where-    show (NixFrame level f) =-        "Nix frame at level " ++ show level ++ ": "++ show f+  show (NixFrame level f) =+    "Nix frame at level " ++ show level ++ ": " ++ show f  type Frames = [NixFrame] @@ -36,11 +46,13 @@  instance Exception NixException -withFrame :: forall s e m a. (Framed e m, Exception s) => NixLevel -> s -> m a -> m a+withFrame+  :: forall s e m a . (Framed e m, Exception s) => NixLevel -> s -> m a -> m a withFrame level f = local (over hasLens (NixFrame level (toException f) :)) -throwError :: forall s e m a. (Framed e m, Exception s, MonadThrow m) => s -> m a+throwError+  :: forall s e m a . (Framed e m, Exception s, MonadThrow m) => s -> m a throwError err = do-    context <- asks (view hasLens)-    traceM "Throwing error..."-    throwM $ NixException (NixFrame Error (toException err):context)+  context <- asks (view hasLens)+  traceM "Throwing error..."+  throwM $ NixException (NixFrame Error (toException err) : context)
+ src/Nix/Fresh.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Nix.Fresh where++import           Control.Applicative+import           Control.Monad.Base+import           Control.Monad.Catch+import           Control.Monad.Except+import           Control.Monad.Reader+import           Control.Monad.Ref+import           Control.Monad.ST+import           Control.Monad.State.Strict+import           Control.Monad.Writer+import           Data.Typeable+#ifdef MIN_VERSION_haskeline+import System.Console.Haskeline.MonadException hiding(catch)+#endif++import           Nix.Var+import           Nix.Thunk++newtype FreshIdT i m a = FreshIdT { unFreshIdT :: ReaderT (Var m i) m a }+  deriving+    ( Functor+    , Applicative+    , Alternative+    , Monad+    , MonadPlus+    , MonadFix+    , MonadRef+    , MonadAtomicRef+    , MonadIO+    , MonadCatch+    , MonadThrow+#ifdef MIN_VERSION_haskeline+    , MonadException+#endif+    )++instance MonadTrans (FreshIdT i) where+  lift = FreshIdT . lift++instance MonadBase b m => MonadBase b (FreshIdT i m) where+  liftBase = FreshIdT . liftBase++-- instance MonadTransControl (FreshIdT i) where+--     type StT (FreshIdT i) a = StT (ReaderT (Var m i)) a+--     liftWith = defaultLiftWith FreshIdT unFreshIdT+--     restoreT = defaultRestoreT FreshIdT++-- instance MonadBaseControl b m => MonadBaseControl b (FreshIdT i m) where+--     type StM (FreshIdT i m) a = ComposeSt (FreshIdT i) m a+--     liftBaseWith     = defaultLiftBaseWith+--     restoreM         = defaultRestoreM++instance ( MonadVar m+         , Eq i+         , Ord i+         , Show i+         , Enum i+         , Typeable i+         )+         => MonadThunkId (FreshIdT i m) where+  type ThunkId (FreshIdT i m) = i+  freshId = FreshIdT $ do+    v <- ask+    atomicModifyVar v (\i -> (succ i, i))++runFreshIdT :: Functor m => Var m i -> FreshIdT i m a -> m a+runFreshIdT i m = runReaderT (unFreshIdT m) i++instance MonadThunkId m => MonadThunkId (ReaderT r m) where+  type ThunkId (ReaderT r m) = ThunkId m+instance (Monoid w, MonadThunkId m) => MonadThunkId (WriterT w m) where+  type ThunkId (WriterT w m) = ThunkId m+instance MonadThunkId m => MonadThunkId (ExceptT e m) where+  type ThunkId (ExceptT e m) = ThunkId m+instance MonadThunkId m => MonadThunkId (StateT s m) where+  type ThunkId (StateT s m) = ThunkId m++-- Orphan instance needed by Infer.hs and Lint.hs++-- Since there's no forking, it's automatically atomic.+instance MonadAtomicRef (ST s) where+  atomicModifyRef r f = do+    v <- readRef r+    let (a, b) = f v+    writeRef r a+    return b+  atomicModifyRef' r f = do+    v <- readRef r+    let (a, b) = f v+    writeRef r $! a+    return b+++++++
+ src/Nix/Fresh/Basic.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Nix.Fresh.Basic where++import           Control.Monad.Reader+import           Nix.Effects+import           Nix.Render+import           Nix.Fresh+import           Nix.Value++type StdIdT = FreshIdT Int++instance MonadFile m => MonadFile (StdIdT m)+instance MonadIntrospect m => MonadIntrospect (StdIdT m)+instance MonadStore m => MonadStore (StdIdT m) where+  addPath' = lift . addPath'+  toFile_' = (lift .) . toFile_'+instance MonadPutStr m => MonadPutStr (StdIdT m)+instance MonadHttp m => MonadHttp (StdIdT m)+instance MonadEnv m => MonadEnv (StdIdT m)+instance MonadInstantiate m => MonadInstantiate (StdIdT m)+instance MonadExec m => MonadExec (StdIdT m)++instance (MonadEffects t f m, MonadDataContext f m)+  => MonadEffects t f (StdIdT m) where+  makeAbsolutePath = lift . makeAbsolutePath @t @f @m+  findEnvPath      = lift . findEnvPath @t @f @m+  findPath         = (lift .) . findPath @t @f @m+  importPath path = do+    i <- FreshIdT ask+    p <- lift $ importPath @t @f @m path+    return $ liftNValue (runFreshIdT i) p+  pathToDefaultNix = lift . pathToDefaultNix @t @f @m+  derivationStrict v = do+    i <- FreshIdT ask+    p <- lift $ derivationStrict @t @f @m (unliftNValue (runFreshIdT i) v)+    return $ liftNValue (runFreshIdT i) p+  traceEffect = lift . traceEffect @t @f @m+
+ src/Nix/Json.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Nix.Json where++import           Control.Monad+import           Control.Monad.Trans+import qualified Data.Aeson                    as A+import qualified Data.Aeson.Encoding           as A+import qualified Data.HashMap.Lazy             as HM+import qualified Data.Text                     as Text+import qualified Data.Text.Lazy                as TL+import qualified Data.Text.Lazy.Encoding       as TL+import qualified Data.Vector                   as V+import           Nix.Atoms+import           Nix.Effects+import           Nix.Exec+import           Nix.Frames+import           Nix.String+import           Nix.Thunk+import           Nix.Utils+import           Nix.Value++nvalueToJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString+nvalueToJSONNixString =+  runWithStringContextT+    . fmap+        ( TL.toStrict+        . TL.decodeUtf8+        . A.encodingToLazyByteString+        . toEncodingSorted+        )+    . nvalueToJSON++nvalueToJSON :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value+nvalueToJSON = \case+  NVConstant (NInt   n) -> pure $ A.toJSON n+  NVConstant (NFloat n) -> pure $ A.toJSON n+  NVConstant (NBool  b) -> pure $ A.toJSON b+  NVConstant NNull      -> pure $ A.Null+  NVStr      ns         -> A.toJSON <$> extractNixString ns+  NVList l ->+    A.Array+      .   V.fromList+      <$> traverse (join . lift . flip force (return . nvalueToJSON)) l+  NVSet m _ -> case HM.lookup "outPath" m of+    Nothing ->+      A.Object <$> traverse (join . lift . flip force (return . nvalueToJSON)) m+    Just outPath -> join $ lift $ force outPath (return . nvalueToJSON)+  NVPath p -> do+    fp <- lift $ unStorePath <$> addPath p+    addSingletonStringContext $ StringContext (Text.pack fp) DirectPath+    return $ A.toJSON fp+  v -> lift $ throwError $ CoercionToJson v
src/Nix/Lint.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -13,6 +13,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}@@ -23,32 +24,35 @@  module Nix.Lint where -import           Control.Exception import           Control.Monad import           Control.Monad.Catch import           Control.Monad.Fix-import           Control.Monad.Reader (MonadReader)+import           Control.Monad.Reader           ( MonadReader )+import           Control.Monad.Ref import           Control.Monad.ST import           Control.Monad.Trans.Reader import           Data.Coerce-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M import           Data.List-import qualified Data.List.NonEmpty as NE-import           Data.STRef-import           Data.Text (Text)-import qualified Data.Text as Text+import qualified Data.List.NonEmpty            as NE+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text import           Nix.Atoms import           Nix.Context import           Nix.Convert-import           Nix.Eval (MonadEval(..))-import qualified Nix.Eval as Eval+import           Nix.Eval                       ( MonadEval(..) )+import qualified Nix.Eval                      as Eval import           Nix.Expr import           Nix.Frames+import           Nix.Fresh+import           Nix.String import           Nix.Options import           Nix.Scope import           Nix.Thunk+import           Nix.Thunk.Basic import           Nix.Utils+import           Nix.Var  data TAtom   = TInt@@ -68,38 +72,38 @@     deriving Functor  compareTypes :: NTypeF m r -> NTypeF m r -> Ordering-compareTypes (TConstant _)   (TConstant _)   = EQ-compareTypes (TConstant _)   _               = LT-compareTypes _               (TConstant _)   = GT-compareTypes TStr            TStr            = EQ-compareTypes TStr            _               = LT-compareTypes _               TStr            = GT-compareTypes (TList _)       (TList _)       = EQ-compareTypes (TList _)       _               = LT-compareTypes _               (TList _)       = GT-compareTypes (TSet _)        (TSet _)        = EQ-compareTypes (TSet _)        _               = LT-compareTypes _               (TSet _)        = GT-compareTypes TClosure {}     TClosure {}     = EQ-compareTypes TClosure {}     _               = LT-compareTypes _               TClosure {}     = GT-compareTypes TPath           TPath           = EQ-compareTypes TPath            _              = LT-compareTypes _               TPath           = GT-compareTypes (TBuiltin _ _)  (TBuiltin _ _)  = EQ+compareTypes (TConstant _)  (TConstant _)  = EQ+compareTypes (TConstant _)  _              = LT+compareTypes _              (TConstant _)  = GT+compareTypes TStr           TStr           = EQ+compareTypes TStr           _              = LT+compareTypes _              TStr           = GT+compareTypes (TList _)      (TList _)      = EQ+compareTypes (TList _)      _              = LT+compareTypes _              (TList _)      = GT+compareTypes (TSet _)       (TSet  _)      = EQ+compareTypes (TSet _)       _              = LT+compareTypes _              (TSet _)       = GT+compareTypes TClosure{}     TClosure{}     = EQ+compareTypes TClosure{}     _              = LT+compareTypes _              TClosure{}     = GT+compareTypes TPath          TPath          = EQ+compareTypes TPath          _              = LT+compareTypes _              TPath          = GT+compareTypes (TBuiltin _ _) (TBuiltin _ _) = EQ  data NSymbolicF r     = NAny     | NMany [r]     deriving (Show, Eq, Ord, Functor, Foldable, Traversable) -newtype SThunk m = SThunk { getSThunk :: Thunk m (Symbolic m) }+newtype SThunk m = SThunk { getSThunk :: NThunkF m (Symbolic m) }  newtype Symbolic m =     Symbolic { getSymbolic :: Var m (NSymbolicF (NTypeF m (SThunk m))) }  instance Show (Symbolic m) where-    show _ = "<symbolic>"+  show _ = "<symbolic>"  everyPossible :: MonadVar m => m (Symbolic m) everyPossible = packSymbolic NAny@@ -107,82 +111,87 @@ mkSymbolic :: MonadVar m => [NTypeF m (SThunk m)] -> m (Symbolic m) mkSymbolic xs = packSymbolic (NMany xs) -packSymbolic :: MonadVar m-             => NSymbolicF (NTypeF m (SThunk m)) -> m (Symbolic m)+packSymbolic :: MonadVar m => NSymbolicF (NTypeF m (SThunk m)) -> m (Symbolic m) packSymbolic = fmap coerce . newVar -unpackSymbolic :: MonadVar m-               => Symbolic m -> m (NSymbolicF (NTypeF m (SThunk m)))+unpackSymbolic+  :: MonadVar m => Symbolic m -> m (NSymbolicF (NTypeF m (SThunk m))) unpackSymbolic = readVar . coerce -type MonadLint e m = (Scoped e (SThunk m) m, Framed e m, MonadVar m)+type MonadLint e m+  = (Scoped (SThunk m) m, Framed e m, MonadVar m, MonadCatch m, MonadThunkId m) -symerr :: forall e m a. MonadLint e m => String -> m a+symerr :: forall e m a . MonadLint e m => String -> m a symerr = evalError @(Symbolic m) . ErrorCall  renderSymbolic :: MonadLint e m => Symbolic m -> m String renderSymbolic = unpackSymbolic >=> \case-    NAny -> return "<any>"-    NMany xs -> fmap (intercalate ", ") $ forM xs $ \case-        TConstant ys  -> fmap (intercalate ", ") $ forM ys $ \case-            TInt   -> return "int"-            TFloat -> return "float"-            TBool  -> return "bool"-            TNull  -> return "null"-        TStr            -> return "string"-        TList r         -> do-            x <- force r renderSymbolic-            return $ "[" ++ x ++ "]"-        TSet Nothing    -> return "<any set>"-        TSet (Just s)   -> do-            x <- traverse (`force` renderSymbolic) s-            return $ "{" ++ show x ++ "}"-        f@(TClosure p) -> do-            (args, sym) <- do-                f' <- mkSymbolic [f]-                lintApp (NAbs (void p) ()) f' everyPossible-            args' <- traverse renderSymbolic args-            sym'  <- renderSymbolic sym-            return $ "(" ++ show args' ++ " -> " ++ sym' ++ ")"-        TPath           -> return "path"-        TBuiltin _n _f    -> return "<builtin function>"+  NAny     -> return "<any>"+  NMany xs -> fmap (intercalate ", ") $ forM xs $ \case+    TConstant ys -> fmap (intercalate ", ") $ forM ys $ \case+      TInt   -> return "int"+      TFloat -> return "float"+      TBool  -> return "bool"+      TNull  -> return "null"+    TStr    -> return "string"+    TList r -> do+      x <- force r renderSymbolic+      return $ "[" ++ x ++ "]"+    TSet Nothing  -> return "<any set>"+    TSet (Just s) -> do+      x <- traverse (`force` renderSymbolic) s+      return $ "{" ++ show x ++ "}"+    f@(TClosure p) -> do+      (args, sym) <- do+        f' <- mkSymbolic [f]+        lintApp (NAbs (void p) ()) f' everyPossible+      args' <- traverse renderSymbolic args+      sym'  <- renderSymbolic sym+      return $ "(" ++ show args' ++ " -> " ++ sym' ++ ")"+    TPath          -> return "path"+    TBuiltin _n _f -> return "<builtin function>"  -- This function is order and uniqueness preserving (of types).-merge :: forall e m. MonadLint e m-      => NExprF () -> [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)]-      -> m [NTypeF m (SThunk m)]+merge+  :: forall e m+   . MonadLint e m+  => NExprF ()+  -> [NTypeF m (SThunk m)]+  -> [NTypeF m (SThunk m)]+  -> m [NTypeF m (SThunk m)] merge context = go-  where-    go :: [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)]-       -> m [NTypeF m (SThunk m)]-    go [] _ = return []-    go _ [] = return []-    go (x:xs) (y:ys) = case (x, y) of-        (TStr,  TStr)  -> (TStr :)  <$> go xs ys-        (TPath, TPath) -> (TPath :) <$> go xs ys-        (TConstant ls, TConstant rs) ->-            (TConstant (ls `intersect` rs) :) <$> go xs ys-        (TList l, TList r) -> force l $ \l' -> force r $ \r' -> do-            m <- thunk $ unify context l' r'-            (TList m :) <$> go xs ys-        (TSet x, TSet Nothing) -> (TSet x :) <$> go xs ys-        (TSet Nothing, TSet x) -> (TSet x :) <$> go xs ys-        (TSet (Just l), TSet (Just r)) -> do-            m <- sequenceA $ M.intersectionWith-                (\i j -> i >>= \i' -> j >>= \j' ->-                        force i' $ \i'' -> force j' $ \j'' ->-                            thunk $ unify context i'' j'')-                (return <$> l) (return <$> r)-            if M.null m-                then go xs ys-                else (TSet (Just m) :) <$> go xs ys-        (TClosure {}, TClosure {}) ->-            throwError $ ErrorCall "Cannot unify functions"-        (TBuiltin _ _, TBuiltin _ _) ->-            throwError $ ErrorCall "Cannot unify builtin functions"-        _ | compareTypes x y == LT -> go xs (y:ys)-          | compareTypes x y == GT -> go (x:xs) ys-          | otherwise              -> error "impossible"+ where+  go+    :: [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)] -> m [NTypeF m (SThunk m)]+  go []       _        = return []+  go _        []       = return []+  go (x : xs) (y : ys) = case (x, y) of+    (TStr , TStr ) -> (TStr :) <$> go xs ys+    (TPath, TPath) -> (TPath :) <$> go xs ys+    (TConstant ls, TConstant rs) ->+      (TConstant (ls `intersect` rs) :) <$> go xs ys+    (TList l, TList r) -> force l $ \l' -> force r $ \r' -> do+      m <- thunk $ unify context l' r'+      (TList m :) <$> go xs ys+    (TSet x       , TSet Nothing ) -> (TSet x :) <$> go xs ys+    (TSet Nothing , TSet x       ) -> (TSet x :) <$> go xs ys+    (TSet (Just l), TSet (Just r)) -> do+      m <- sequenceA $ M.intersectionWith+        (\i j -> i >>= \i' ->+          j+            >>= \j' -> force i'+                  $ \i'' -> force j' $ \j'' -> thunk $ unify context i'' j''+        )+        (return <$> l)+        (return <$> r)+      if M.null m then go xs ys else (TSet (Just m) :) <$> go xs ys+    (TClosure{}, TClosure{}) ->+      throwError $ ErrorCall "Cannot unify functions"+    (TBuiltin _ _, TBuiltin _ _) ->+      throwError $ ErrorCall "Cannot unify builtin functions"+    _ | compareTypes x y == LT -> go xs (y : ys)+      | compareTypes x y == GT -> go (x : xs) ys+      | otherwise              -> error "impossible"  {-     mergeFunctions pl nl fl pr fr xs ys = do@@ -204,31 +213,36 @@ -}  -- | unify raises an error if the result is would be 'NMany []'.-unify :: forall e m. MonadLint e m-      => NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)+unify+  :: forall e m+   . MonadLint e m+  => NExprF ()+  -> Symbolic m+  -> Symbolic m+  -> m (Symbolic m) unify context (Symbolic x) (Symbolic y) = do-    x' <- readVar x-    y' <- readVar y-    case (x', y') of-        (NAny, _) -> do-            writeVar x y'-            return $ Symbolic y-        (_, NAny) -> do-            writeVar y x'-            return $ Symbolic x-        (NMany xs, NMany ys) -> do-            m <- merge context xs ys-            if null m-                then do-                    -- x' <- renderSymbolic (Symbolic x)-                    -- y' <- renderSymbolic (Symbolic y)-                    throwError $ ErrorCall "Cannot unify "-                        -- ++ show x' ++ " with " ++ show y'-                        --  ++ " in context: " ++ show context-                else do-                    writeVar x (NMany m)-                    writeVar y (NMany m)-                    packSymbolic (NMany m)+  x' <- readVar x+  y' <- readVar y+  case (x', y') of+    (NAny, _) -> do+      writeVar x y'+      return $ Symbolic y+    (_, NAny) -> do+      writeVar y x'+      return $ Symbolic x+    (NMany xs, NMany ys) -> do+      m <- merge context xs ys+      if null m+        then do+              -- x' <- renderSymbolic (Symbolic x)+              -- y' <- renderSymbolic (Symbolic y)+          throwError $ ErrorCall "Cannot unify "+                  -- ++ show x' ++ " with " ++ show y'+                  --  ++ " in context: " ++ show context+        else do+          writeVar x (NMany m)+          writeVar y (NMany m)+          packSymbolic (NMany m)  -- These aren't worth defining yet, because once we move to Hindley-Milner, -- we're not going to be managing Symbolic values this way anymore.@@ -237,182 +251,201 @@  instance ToValue [SThunk m] m (Symbolic m) where -instance FromValue (Text, DList Text) m (Symbolic m) where+instance FromValue NixString m (Symbolic m) where  instance FromValue (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where  instance ToValue (AttrSet (SThunk m), AttrSet SourcePos) m (Symbolic m) where -instance MonadLint e m => MonadThunk (Symbolic m) (SThunk m) m where-    thunk = fmap coerce . buildThunk-    force = forceThunk . coerce-    value = coerce . valueRef+instance MonadLint e m => MonadThunk (SThunk m) m (Symbolic m) where+  thunk   = fmap SThunk . thunk+  thunkId = thunkId . getSThunk+  query x b f = query (getSThunk x) b f+  queryM x b f = queryM (getSThunk x) b f+  force     = force . getSThunk+  forceEff  = forceEff . getSThunk+  wrapValue = SThunk . wrapValue+  getValue  = getValue . getSThunk  instance MonadLint e m => MonadEval (Symbolic m) m where-    freeVariable var = symerr $-        "Undefined variable '" ++ Text.unpack var ++ "'"+  freeVariable var = symerr $ "Undefined variable '" ++ Text.unpack var ++ "'" -    attrMissing ks Nothing =-        evalError @(Symbolic m) $ ErrorCall $-            "Inheriting unknown attribute: "-                ++ intercalate "." (map Text.unpack (NE.toList ks))+  attrMissing ks Nothing =+    evalError @(Symbolic m)+      $  ErrorCall+      $  "Inheriting unknown attribute: "+      ++ intercalate "." (map Text.unpack (NE.toList ks)) -    attrMissing ks (Just s) =-        evalError @(Symbolic m) $ ErrorCall $ "Could not look up attribute "-            ++ intercalate "." (map Text.unpack (NE.toList ks))-            ++ " in " ++ show s+  attrMissing ks (Just s) =+    evalError @(Symbolic m)+      $  ErrorCall+      $  "Could not look up attribute "+      ++ intercalate "." (map Text.unpack (NE.toList ks))+      ++ " in "+      ++ show s -    evalCurPos = do-        f <- value <$> mkSymbolic [TPath]-        l <- value <$> mkSymbolic [TConstant [TInt]]-        c <- value <$> mkSymbolic [TConstant [TInt]]-        mkSymbolic [TSet (Just (M.fromList (go f l c)))]-      where-        go f l c =-            [ (Text.pack "file", f)-            , (Text.pack "line", l)-            , (Text.pack "col",  c) ]+  evalCurPos = do+    f <- wrapValue <$> mkSymbolic [TPath]+    l <- wrapValue <$> mkSymbolic [TConstant [TInt]]+    c <- wrapValue <$> mkSymbolic [TConstant [TInt]]+    mkSymbolic [TSet (Just (M.fromList (go f l c)))]+   where+    go f l c =+      [(Text.pack "file", f), (Text.pack "line", l), (Text.pack "col", c)] -    evalConstant c  = mkSymbolic [TConstant [go c]]-      where-        go = \case-          NInt _   -> TInt-          NFloat _ -> TFloat-          NBool _  -> TBool-          NNull    -> TNull+  evalConstant c = mkSymbolic [TConstant [go c]]+   where+    go = \case+      NInt   _ -> TInt+      NFloat _ -> TFloat+      NBool  _ -> TBool+      NNull    -> TNull -    evalString      = const $ mkSymbolic [TStr]-    evalLiteralPath = const $ mkSymbolic [TPath]-    evalEnvPath     = const $ mkSymbolic [TPath]+  evalString      = const $ mkSymbolic [TStr]+  evalLiteralPath = const $ mkSymbolic [TPath]+  evalEnvPath     = const $ mkSymbolic [TPath] -    evalUnary op arg =-        unify (void (NUnary op arg)) arg-            =<< mkSymbolic [TConstant [TInt, TBool]]+  evalUnary op arg =+    unify (void (NUnary op arg)) arg =<< mkSymbolic [TConstant [TInt, TBool]] -    evalBinary = lintBinaryOp+  evalBinary = lintBinaryOp -    evalWith scope body = do-        -- The scope is deliberately wrapped in a thunk here, since it is-        -- evaluated each time a name is looked up within the weak scope, and-        -- we want to be sure the action it evaluates is to force a thunk, so-        -- its value is only computed once.-        s <- thunk scope-        pushWeakScope ?? body $ force s $ unpackSymbolic >=> \case-            NMany [TSet (Just s')] -> return s'-            NMany [TSet Nothing] -> error "NYI: with unknown"-            _ -> throwError $ ErrorCall "scope must be a set in with statement"+  -- The scope is deliberately wrapped in a thunk here, since it is evaluated+  -- each time a name is looked up within the weak scope, and we want to be+  -- sure the action it evaluates is to force a thunk, so its value is only+  -- computed once.+  evalWith scope body = do+    s <- thunk @(SThunk m) @m @(Symbolic m) scope+    pushWeakScope ?? body $ force s $ unpackSymbolic >=> \case+      NMany [TSet (Just s')] -> return s'+      NMany [TSet Nothing] -> error "NYI: with unknown"+      _ -> throwError $ ErrorCall "scope must be a set in with statement" -    evalIf cond t f = do-        t' <- t-        f' <- f-        let e = NIf cond t' f'-        _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]-        unify (void e) t' f'+  evalIf cond t f = do+    t' <- t+    f' <- f+    let e = NIf cond t' f'+    _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]+    unify (void e) t' f' -    evalAssert cond body = do-        body' <- body-        let e = NAssert cond body'-        _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]-        pure body'+  evalAssert cond body = do+    body' <- body+    let e = NAssert cond body'+    _ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]+    pure body' -    evalApp = (fmap snd .) . lintApp (NBinary NApp () ())-    evalAbs params _ = mkSymbolic [TClosure (void params)]+  evalApp = (fmap snd .) . lintApp (NBinary NApp () ())+  evalAbs params _ = mkSymbolic [TClosure (void params)] -    evalError = throwError+  evalError = throwError  lintBinaryOp-    :: forall e m. (MonadLint e m, MonadEval (Symbolic m) m)-    => NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)+  :: forall e m+   . (MonadLint e m, MonadEval (Symbolic m) m)+  => NBinaryOp+  -> Symbolic m+  -> m (Symbolic m)+  -> m (Symbolic m) lintBinaryOp op lsym rarg = do-    rsym <- rarg-    y <- thunk everyPossible-    case op of-        NApp   -> symerr "lintBinaryOp:NApp: should never get here"-        NEq    -> check lsym rsym [ TConstant [TInt, TBool, TNull]-                                 , TStr-                                 , TList y ]-        NNEq   -> check lsym rsym [ TConstant [TInt, TBool, TNull]-                                 , TStr-                                 , TList y ]+  rsym <- rarg+  y    <- thunk everyPossible+  case op of+    NApp    -> symerr "lintBinaryOp:NApp: should never get here"+    NEq     -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]+    NNEq    -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y] -        NLt    -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]-        NLte   -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]-        NGt    -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]-        NGte   -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]+    NLt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]+    NLte    -> check lsym rsym [TConstant [TInt, TBool, TNull]]+    NGt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]+    NGte    -> check lsym rsym [TConstant [TInt, TBool, TNull]] -        NAnd   -> check lsym rsym [ TConstant [TBool] ]-        NOr    -> check lsym rsym [ TConstant [TBool] ]-        NImpl  -> check lsym rsym [ TConstant [TBool] ]+    NAnd    -> check lsym rsym [TConstant [TBool]]+    NOr     -> check lsym rsym [TConstant [TBool]]+    NImpl   -> check lsym rsym [TConstant [TBool]] -        -- jww (2018-04-01): NYI: Allow Path + Str-        NPlus  -> check lsym rsym [ TConstant [TInt], TStr, TPath ]-        NMinus -> check lsym rsym [ TConstant [TInt] ]-        NMult  -> check lsym rsym [ TConstant [TInt] ]-        NDiv   -> check lsym rsym [ TConstant [TInt] ]+    -- jww (2018-04-01): NYI: Allow Path + Str+    NPlus   -> check lsym rsym [TConstant [TInt], TStr, TPath]+    NMinus  -> check lsym rsym [TConstant [TInt]]+    NMult   -> check lsym rsym [TConstant [TInt]]+    NDiv    -> check lsym rsym [TConstant [TInt]] -        NUpdate -> check lsym rsym [ TSet Nothing ]+    NUpdate -> check lsym rsym [TSet Nothing] -        NConcat -> check lsym rsym [ TList y ]-  where-    check lsym rsym xs = do-        let e = NBinary op lsym rsym-        m <- mkSymbolic xs-        _ <- unify (void e) lsym m-        _ <- unify (void e) rsym m-        unify (void e) lsym rsym+    NConcat -> check lsym rsym [TList y]+ where+  check lsym rsym xs = do+    let e = NBinary op lsym rsym+    m <- mkSymbolic xs+    _ <- unify (void e) lsym m+    _ <- unify (void e) rsym m+    unify (void e) lsym rsym  infixl 1 `lintApp`-lintApp :: forall e m. MonadLint e m-        => NExprF () -> Symbolic m -> m (Symbolic m)-        -> m (HashMap VarName (Symbolic m), Symbolic m)+lintApp+  :: forall e m+   . MonadLint e m+  => NExprF ()+  -> Symbolic m+  -> m (Symbolic m)+  -> m (HashMap VarName (Symbolic m), Symbolic m) lintApp context fun arg = unpackSymbolic fun >>= \case-    NAny -> throwError $ ErrorCall-        "Cannot apply something not known to be a function"-    NMany xs -> do-        (args:_, ys) <- fmap unzip $ forM xs $ \case-            TClosure _params -> arg >>= unpackSymbolic >>= \case-                NAny -> do-                    error "NYI"+  NAny ->+    throwError $ ErrorCall "Cannot apply something not known to be a function"+  NMany xs -> do+    (args, ys) <- fmap unzip $ forM xs $ \case+      TClosure _params -> arg >>= unpackSymbolic >>= \case+        NAny -> do+          error "NYI" -                NMany [TSet (Just _)] -> do-                    error "NYI"+        NMany [TSet (Just _)] -> do+          error "NYI" -                NMany _ -> throwError $ ErrorCall "NYI: lintApp NMany not set"-            TBuiltin _ _f -> throwError $ ErrorCall "NYI: lintApp builtin"-            TSet _m -> throwError $ ErrorCall "NYI: lintApp Set"-            _x -> throwError $ ErrorCall "Attempt to call non-function"+        NMany _ -> throwError $ ErrorCall "NYI: lintApp NMany not set"+      TBuiltin _ _f -> throwError $ ErrorCall "NYI: lintApp builtin"+      TSet _m       -> throwError $ ErrorCall "NYI: lintApp Set"+      _x            -> throwError $ ErrorCall "Attempt to call non-function" -        y <- everyPossible-        (args,) <$> foldM (unify context) y ys+    y <- everyPossible+    (head args, ) <$> foldM (unify context) y ys  newtype Lint s a = Lint-    { runLint :: ReaderT (Context (Lint s) (SThunk (Lint s))) (ST s) a }-    deriving (Functor, Applicative, Monad, MonadFix,-              MonadReader (Context (Lint s) (SThunk (Lint s))))--instance MonadVar (Lint s) where-    type Var (Lint s) = STRef s--    newVar x     = Lint $ ReaderT $ \_ -> newSTRef x-    readVar x    = Lint $ ReaderT $ \_ -> readSTRef x-    writeVar x y = Lint $ ReaderT $ \_ -> writeSTRef x y-    atomicModifyVar x f = Lint $ ReaderT $ \_ -> do-        res <- snd . f <$> readSTRef x-        _ <- modifySTRef x (fst . f)-        return res+  { runLint :: ReaderT (Context (Lint s) (SThunk (Lint s))) (FreshIdT Int (ST s)) a }+  deriving+    ( Functor+    , Applicative+    , Monad+    , MonadFix+    , MonadReader (Context (Lint s) (SThunk (Lint s)))+    , MonadThunkId+    , MonadRef+    , MonadAtomicRef+    )  instance MonadThrow (Lint s) where-    throwM e = Lint $ ReaderT $ \_ -> throw e+  throwM e = Lint $ ReaderT $ \_ -> throw e +instance MonadCatch (Lint s) where+  catch _m _h = Lint $ ReaderT $ \_ -> error "Cannot catch in 'Lint s'"+ runLintM :: Options -> Lint s a -> ST s a-runLintM opts = flip runReaderT (newContext opts) . runLint+runLintM opts action = do+  i <- newVar (1 :: Int)+  runFreshIdT i $ flip runReaderT (newContext opts) $ runLint action  symbolicBaseEnv :: Monad m => m (Scopes m (SThunk m)) symbolicBaseEnv = return emptyScopes  lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))-lint opts expr = runLintM opts $-    symbolicBaseEnv-        >>= (`pushScopes`-                adi (Eval.eval . annotated . getCompose)-                    Eval.addSourcePositions expr)+lint opts expr =+  runLintM opts+    $   symbolicBaseEnv+    >>= (`pushScopes` adi (Eval.eval . annotated . getCompose)+                          Eval.addSourcePositions+                          expr+        )++instance Scoped (SThunk (Lint s)) (Lint s) where+  currentScopes = currentScopesReader+  clearScopes   = clearScopesReader @(Lint s) @(SThunk (Lint s))+  pushScopes    = pushScopesReader+  lookupVar     = lookupVarReader
src/Nix/Normal.hs view
@@ -13,86 +13,103 @@ module Nix.Normal where  import           Control.Monad-import           Data.Fix-import qualified Data.HashMap.Lazy as M-import           Data.Text (Text)-import qualified Data.Text as Text-import           Nix.Atoms-import           Nix.Effects+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Reader+import           Control.Monad.Trans.State+import           Data.Set import           Nix.Frames+import           Nix.String import           Nix.Thunk-import           Nix.Utils import           Nix.Value -newtype NormalLoop m = NormalLoop (NValue m)+newtype NormalLoop t f m = NormalLoop (NValue t f m)     deriving Show -instance Typeable m => Exception (NormalLoop m)+instance MonadDataErrorContext t f m => Exception (NormalLoop t f m) -normalFormBy-    :: forall e m. (Framed e m, MonadVar m, Typeable m)-    => (forall r. NThunk m -> (NValue m -> m r) -> m r)-    -> Int-    -> NValue m-    -> m (NValueNF m)-normalFormBy k n v = do-    when (n > 2000) $ throwError $ NormalLoop v-    case v of-        NVConstant a     -> return $ Fix $ NVConstantF a-        NVStr t s        -> return $ Fix $ NVStrF t s-        NVList l         ->-            fmap (Fix . NVListF) $ forM (zip [0..] l) $ \(i :: Int, t) -> do-                traceM $ replicate n ' ' ++ "normalFormBy: List[" ++ show i ++ "]"-                t `k` normalFormBy k (succ n)-        NVSet s p        ->-            fmap (Fix . flip NVSetF p) $ sequence $ flip M.mapWithKey s $ \ky t -> do-                traceM $ replicate n ' ' ++ "normalFormBy: Set{" ++ show ky ++ "}"-                t `k` normalFormBy k (succ n)-        NVClosure p f    -> return $ Fix $ NVClosureF p f-        NVPath fp        -> return $ Fix $ NVPathF fp-        NVBuiltin name f -> return $ Fix $ NVBuiltinF name f-        _ -> error "Pattern synonyms mask complete matches"+normalForm'+  :: forall e t m f+   . ( Framed e m+     , MonadThunk t m (NValue t f m)+     , MonadDataErrorContext t f m+     , Ord (ThunkId m)+     )+  => (forall r . t -> (NValue t f m -> m r) -> m r)+  -> NValue t f m+  -> m (NValueNF t f m)+normalForm' f = run . nValueToNFM run go+ where+  start = 0 :: Int+  table = mempty -normalForm :: (Framed e m, MonadVar m, Typeable m,-              MonadThunk (NValue m) (NThunk m) m)-           => NValue m -> m (NValueNF m)-normalForm = normalFormBy force 0+  run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r+  run = (`evalStateT` table) . (`runReaderT` start) -embed :: forall m. (MonadThunk (NValue m) (NThunk m) m)-      => NValueNF m -> m (NValue m)-embed (Fix x) = case x of-    NVConstantF a     -> return $ nvConstant a-    NVStrF t s        -> return $ nvStr t s-    NVListF l         -> nvList . fmap (value @_ @_ @m)-        <$> traverse embed l-    NVSetF s p        -> flip nvSet p . fmap (value @_ @_ @m)-        <$> traverse embed s-    NVClosureF p f    -> return $ nvClosure p f-    NVPathF fp        -> return $ nvPath fp-    NVBuiltinF name f -> return $ nvBuiltin name f+  go+    :: t+    -> (  NValue t f m+       -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValueNF t f m)+       )+    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValueNF t f m)+  go t k = do+    b <- seen t+    if b+      then return $ pure t+      else do+        i <- ask+        when (i > 2000)+          $ error "Exceeded maximum normalization depth of 2000 levels"+        s         <- lift get+        (res, s') <- lift $ lift $ f t $ \v ->+          (`runStateT` s) . (`runReaderT` i) $ local succ $ k v+        lift $ put s'+        return res -valueText :: forall e m. (Framed e m, MonadEffects m, Typeable m)-          => Bool -> NValueNF m -> m (Text, DList Text)-valueText addPathsToStore = cata phi-  where-    phi :: NValueF m (m (Text, DList Text)) -> m (Text, DList Text)-    phi (NVConstantF a) = pure (atomText a, mempty)-    phi (NVStrF t c)    = pure (t, c)-    phi v@(NVListF _)   = coercionFailed v-    phi v@(NVSetF s _)-      | Just asString <- M.lookup "__asString" s = asString-      | otherwise = coercionFailed v-    phi v@NVClosureF {} = coercionFailed v-    phi (NVPathF originalPath)-        | addPathsToStore = do-            storePath <- addPath originalPath-            pure (Text.pack $ unStorePath storePath, mempty)-        | otherwise = pure (Text.pack originalPath, mempty)-    phi v@(NVBuiltinF _ _) = coercionFailed v+  seen t = case thunkId t of+    Just tid -> lift $ do+      res <- gets (member tid)+      unless res $ modify (insert tid)+      return res+    Nothing -> return False -    coercionFailed v =-        throwError $ Coercion @m (valueType v) TString+normalForm+  :: ( Framed e m+     , MonadThunk t m (NValue t f m)+     , MonadDataErrorContext t f m+     , Ord (ThunkId m)+     )+  => NValue t f m+  -> m (NValueNF t f m)+normalForm = normalForm' force -valueTextNoContext :: (Framed e m, MonadEffects m, Typeable m)-                   => Bool -> NValueNF m -> m Text-valueTextNoContext addPathsToStore = fmap fst . valueText addPathsToStore+normalForm_+  :: ( Framed e m+     , MonadThunk t m (NValue t f m)+     , MonadDataErrorContext t f m+     , Ord (ThunkId m)+     )+  => NValue t f m+  -> m ()+normalForm_ = void <$> normalForm' forceEff++removeEffects+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => NValue t f m+  -> NValueNF t f m+removeEffects = nValueToNF (flip query opaque)++removeEffectsM+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => NValue t f m+  -> m (NValueNF t f m)+removeEffectsM = nValueToNFM id (flip queryM (pure opaque))++opaque+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => NValueNF t f m+opaque = nvStrNF $ principledMakeNixStringWithoutContext "<thunk>"++dethunk+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => t+  -> m (NValueNF t f m)+dethunk t = queryM t (pure opaque) removeEffectsM
src/Nix/Options.hs view
@@ -1,6 +1,6 @@ module Nix.Options where -import           Data.Text (Text)+import           Data.Text                      ( Text ) import           Data.Time  data Options = Options@@ -8,6 +8,7 @@     , tracing      :: Bool     , thunks       :: Bool     , values       :: Bool+    , scopes       :: Bool     , reduce       :: Maybe FilePath     , reduceSets   :: Bool     , reduceLists  :: Bool@@ -36,36 +37,36 @@     deriving Show  defaultOptions :: UTCTime -> Options-defaultOptions current = Options-    { verbose      = ErrorsOnly-    , tracing      = False-    , thunks       = False-    , values       = False-    , reduce       = Nothing-    , reduceSets   = False-    , reduceLists  = False-    , parse        = False-    , parseOnly    = False-    , finder       = False-    , findFile     = Nothing-    , strict       = False-    , evaluate     = False-    , json         = False-    , xml          = False-    , attr         = Nothing-    , include      = []-    , check        = False-    , readFrom     = Nothing-    , cache        = False-    , repl         = False-    , ignoreErrors = False-    , expression   = Nothing-    , arg          = []-    , argstr       = []-    , fromFile     = Nothing-    , currentTime  = current-    , filePaths    = []-    }+defaultOptions current = Options { verbose      = ErrorsOnly+                                 , tracing      = False+                                 , thunks       = False+                                 , values       = False+                                 , scopes       = False+                                 , reduce       = Nothing+                                 , reduceSets   = False+                                 , reduceLists  = False+                                 , parse        = False+                                 , parseOnly    = False+                                 , finder       = False+                                 , findFile     = Nothing+                                 , strict       = False+                                 , evaluate     = False+                                 , json         = False+                                 , xml          = False+                                 , attr         = Nothing+                                 , include      = []+                                 , check        = False+                                 , readFrom     = Nothing+                                 , cache        = False+                                 , repl         = False+                                 , ignoreErrors = False+                                 , expression   = Nothing+                                 , arg          = []+                                 , argstr       = []+                                 , fromFile     = Nothing+                                 , currentTime  = current+                                 , filePaths    = []+                                 }  data Verbosity     = ErrorsOnly
src/Nix/Options/Parser.hs view
@@ -1,14 +1,13 @@ module Nix.Options.Parser where -import           Control.Arrow (second)-import           Data.Char (isDigit)-import           Data.Maybe (fromMaybe)-import           Data.Text (Text)-import qualified Data.Text as Text+import           Control.Arrow                  ( second )+import           Data.Char                      ( isDigit )+import           Data.Maybe                     ( fromMaybe )+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text import           Data.Time import           Nix.Options-import           Options.Applicative hiding (ParserResult(..))-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import           Options.Applicative     hiding ( ParserResult(..) )  decodeVerbosity :: Int -> Verbosity decodeVerbosity 0 = ErrorsOnly@@ -19,109 +18,149 @@ decodeVerbosity _ = Vomit  argPair :: Mod OptionFields (Text, Text) -> Parser (Text, Text)-argPair = option $ str >>= \s ->-    case Text.findIndex (== '=') s of-        Nothing -> errorWithoutStackTrace-            "Format of --arg/--argstr in hnix is: name=expr"-        Just i -> return $ second Text.tail $ Text.splitAt i s+argPair = option $ str >>= \s -> case Text.findIndex (== '=') s of+  Nothing ->+    errorWithoutStackTrace "Format of --arg/--argstr in hnix is: name=expr"+  Just i -> return $ second Text.tail $ Text.splitAt i s  nixOptions :: UTCTime -> Parser Options-nixOptions current = Options-    <$> (fromMaybe ErrorsOnly <$>-         optional-           (option (do a <- str-                       if all isDigit a-                       then pure $ decodeVerbosity (read a)-                       else fail "Argument to -v/--verbose must be a number")-            (   short 'v'-             <> long "verbose"-             <> help "Verbose output")))-    <*> switch-        (   long "trace"-         <> help "Enable tracing code (even more can be seen if built with --flags=tracing)")+nixOptions current =+  Options+    <$> (fromMaybe Informational <$> optional+          (option+            (do+              a <- str+              if all isDigit a+                then pure $ decodeVerbosity (read a)+                else fail "Argument to -v/--verbose must be a number"+            )+            (short 'v' <> long "verbose" <> help "Verbose output")+          )+        )     <*> switch-        (   long "thunks"-         <> help "Enable reporting of thunk tracing as well as regular evaluation")+          (  long "trace"+          <> help+               "Enable tracing code (even more can be seen if built with --flags=tracing)"+          )     <*> switch-        (   long "values"-         <> help "Enable reporting of value provenance in error messages")-    <*> optional (strOption-        (   long "reduce"-         <> help "When done evaluating, output the evaluated part of the expression to FILE"))+          (long "thunks" <> help+            "Enable reporting of thunk tracing as well as regular evaluation"+          )     <*> switch-        (   long "reduce-sets"-         <> help "Reduce set members that aren't used; breaks if hasAttr is used")+          (  long "values"+          <> help "Enable reporting of value provenance in error messages"+          )     <*> switch-        (   long "reduce-lists"-         <> help "Reduce list members that aren't used; breaks if elemAt is used")+          (  long "scopes"+          <> help "Enable reporting of scopes in evaluation traces"+          )+    <*> optional+          (strOption+            (  long "reduce"+            <> help+                 "When done evaluating, output the evaluated part of the expression to FILE"+            )+          )     <*> switch-        (   long "parse"-         <> help "Whether to parse the file (also the default right now)")+          (long "reduce-sets" <> help+            "Reduce set members that aren't used; breaks if hasAttr is used"+          )     <*> switch-        (   long "parse-only"-         <> help "Whether to parse only, no pretty printing or checking")+          (long "reduce-lists" <> help+            "Reduce list members that aren't used; breaks if elemAt is used"+          )     <*> switch-        (   long "find"-         <> help "If selected, find paths within attr trees")-    <*> optional (strOption-        (   long "find-file"-         <> help "Look up the given files in Nix's search path"))+          (  long "parse"+          <> help "Whether to parse the file (also the default right now)"+          )     <*> switch-        (   long "strict"-         <> help "When used with --eval, recursively evaluate list elements and attributes")+          (  long "parse-only"+          <> help "Whether to parse only, no pretty printing or checking"+          )+    <*> switch (long "find" <> help "If selected, find paths within attr trees")+    <*> optional+          (strOption+            (  long "find-file"+            <> help "Look up the given files in Nix's search path"+            )+          )     <*> switch-        (   long "eval"-         <> help "Whether to evaluate, or just pretty-print")+          (  long "strict"+          <> help+               "When used with --eval, recursively evaluate list elements and attributes"+          )+    <*> switch (long "eval" <> help "Whether to evaluate, or just pretty-print")     <*> switch-        (   long "json"-         <> help "Print the resulting value as an JSON representation")+          (  long "json"+          <> help "Print the resulting value as an JSON representation"+          )     <*> switch-        (   long "xml"-         <> help "Print the resulting value as an XML representation")-    <*> optional (strOption-        (   short 'A'-         <> long "attr"-         <> help "Select an attribute from the top-level Nix expression being evaluated"))-    <*> many (strOption-        (   short 'I'-         <> long "include"-         <> help "Add a path to the Nix expression search path"))+          (  long "xml"+          <> help "Print the resulting value as an XML representation"+          )+    <*> optional+          (strOption+            (  short 'A'+            <> long "attr"+            <> help+                 "Select an attribute from the top-level Nix expression being evaluated"+            )+          )+    <*> many+          (strOption+            (short 'I' <> long "include" <> help+              "Add a path to the Nix expression search path"+            )+          )     <*> switch-        (   long "check"-         <> help "Whether to check for syntax errors after parsing")-    <*> optional (strOption-        (   long "read"-         <> help "Read in an expression tree from a binary cache"))+          (  long "check"+          <> help "Whether to check for syntax errors after parsing"+          )+    <*> optional+          (strOption+            (  long "read"+            <> help "Read in an expression tree from a binary cache"+            )+          )     <*> switch-        (   long "cache"-         <> help "Write out the parsed expression tree to a binary cache")+          (  long "cache"+          <> help "Write out the parsed expression tree to a binary cache"+          )     <*> switch-        (   long "repl"-         <> help "After performing any indicated actions, enter the REPL")+          (  long "repl"+          <> help "After performing any indicated actions, enter the REPL"+          )     <*> switch-        (   long "ignore-errors"-         <> help "Continue parsing files, even if there are errors")-    <*> optional (strOption-        (   short 'E'-         <> long "expr"-         <> help "Expression to parse or evaluate"))-    <*> many (argPair-        (   long "arg"-         <> help "Argument to pass to an evaluated lambda"))-    <*> many (argPair-        (   long "argstr"-         <> help "Argument string to pass to an evaluated lambda"))-    <*> optional (strOption-        (   short 'f'-         <> long "file"-         <> help "Parse all of the files given in FILE; - means stdin"))-    <*> option (parseTimeOrError True defaultTimeLocale "%Y/%m/%d %H:%M:%S" <$> str)-        (   long "now"-         <> value current-         <> help "Set current time for testing purposes")+          (  long "ignore-errors"+          <> help "Continue parsing files, even if there are errors"+          )+    <*> optional+          (strOption+            (short 'E' <> long "expr" <> help "Expression to parse or evaluate")+          )+    <*> many+          (argPair+            (long "arg" <> help "Argument to pass to an evaluated lambda")+          )+    <*> many+          (argPair+            (  long "argstr"+            <> help "Argument string to pass to an evaluated lambda"+            )+          )+    <*> optional+          (strOption+            (short 'f' <> long "file" <> help+              "Parse all of the files given in FILE; - means stdin"+            )+          )+    <*> option+          (parseTimeOrError True defaultTimeLocale "%Y/%m/%d %H:%M:%S" <$> str)+          (long "now" <> value current <> help+            "Set current time for testing purposes"+          )     <*> many (strArgument (metavar "FILE" <> help "Path of file to parse"))  nixOptionsInfo :: UTCTime -> ParserInfo Options-nixOptionsInfo current =-    info (helper <*> nixOptions current)-         (fullDesc <> progDesc "" <> header "hnix")+nixOptionsInfo current = info (helper <*> nixOptions current)+                              (fullDesc <> progDesc "" <> header "hnix")
src/Nix/Parser.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor      #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -9,50 +10,82 @@ {-# OPTIONS_GHC -Wno-missing-signatures #-}  module Nix.Parser-    ( parseNixFile-    , parseNixFileLoc-    , parseNixText-    , parseNixTextLoc-    , parseFromFileEx-    , parseFromText-    , Result(..)-    , reservedNames-    , OperatorInfo(..)-    , NSpecialOp(..)-    , NAssoc(..)-    , NOperatorDef-    , getUnaryOperator-    , getBinaryOperator-    , getSpecialOperator-    ) where+  ( parseNixFile+  , parseNixFileLoc+  , parseNixText+  , parseNixTextLoc+  , parseFromFileEx+  , Parser+  , parseFromText+  , Result(..)+  , reservedNames+  , OperatorInfo(..)+  , NSpecialOp(..)+  , NAssoc(..)+  , NOperatorDef+  , getUnaryOperator+  , getBinaryOperator+  , getSpecialOperator+  , nixToplevelForm+  , nixExpr+  , nixSet+  , nixBinders+  , nixSelector+  , nixSym+  , nixPath+  , nixString+  , nixUri+  , nixSearchPath+  , nixFloat+  , nixInt+  , nixBool+  , nixNull+  , symbol+  , whiteSpace+  )+where -import           Control.Applicative hiding (many, some)+import           Prelude                 hiding ( readFile )++import           Control.Applicative     hiding ( many+                                                , some+                                                ) import           Control.DeepSeq import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Char (isAlpha, isDigit, isSpace)-import           Data.Data (Data(..))-import           Data.Foldable (concat)+import           Control.Monad.Combinators.Expr+import           Data.Char                      ( isAlpha+                                                , isDigit+                                                , isSpace+                                                )+import           Data.Data                      ( Data(..) )+import           Data.Foldable                  ( concat ) import           Data.Functor import           Data.Functor.Identity-import           Data.HashSet (HashSet)-import qualified Data.HashSet as HashSet-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as Map-import           Data.Text (Text)-import           Data.Text hiding (map, foldr1, concat, concatMap, zipWith)-import qualified Data.Text.IO as T-import           Data.Typeable (Typeable)+import           Data.HashSet                   ( HashSet )+import qualified Data.HashSet                  as HashSet+import           Data.List.NonEmpty             ( NonEmpty(..) )+import qualified Data.List.NonEmpty            as NE+import qualified Data.Map                      as Map+import           Data.Text                      ( Text )+import           Data.Text               hiding ( map+                                                , foldr1+                                                , concat+                                                , concatMap+                                                , zipWith+                                                )+import           Data.Text.Prettyprint.Doc      ( Doc+                                                , pretty+                                                )+import           Data.Text.Encoding+import           Data.Typeable                  ( Typeable ) import           Data.Void-import           GHC.Generics hiding (Prefix)-import           Nix.Expr hiding (($>))+import           GHC.Generics            hiding ( Prefix )+import           Nix.Expr                hiding ( ($>) )+import           Nix.Render import           Nix.Strings import           Text.Megaparsec import           Text.Megaparsec.Char-import qualified Text.Megaparsec.Char.Lexer as L-import           Text.Megaparsec.Expr-import           Text.PrettyPrint.ANSI.Leijen (Doc, text)+import qualified Text.Megaparsec.Char.Lexer    as L  infixl 3 <+> (<+>) :: MonadPlus m => m a -> m a -> m a@@ -60,16 +93,18 @@  -------------------------------------------------------------------------------- -nixExprLoc :: Parser NExprLoc-nixExprLoc = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)+nixExpr :: Parser NExprLoc+nixExpr = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)  antiStart :: Parser Text antiStart = symbol "${" <?> show ("${" :: String)  nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc) nixAntiquoted p =-        Antiquoted <$> (antiStart *> nixToplevelForm <* symbol "}")-    <+> Plain <$> p+  Antiquoted+    <$> (antiStart *> nixToplevelForm <* symbol "}")+    <+> Plain+    <$> p     <?> "anti-quotation"  selDot :: Parser ()@@ -77,74 +112,87 @@  nixSelect :: Parser NExprLoc -> Parser NExprLoc nixSelect term = do-    res <- build-        <$> term-        <*> optional ((,) <$> (selDot *> nixSelector)-                          <*> optional (reserved "or" *> nixTerm))-    continues <- optional $ lookAhead selDot-    case continues of-        Nothing -> pure res-        Just _  -> nixSelect (pure res)+  res <- build <$> term <*> optional+    ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixTerm))+  continues <- optional $ lookAhead selDot+  case continues of+    Nothing -> pure res+    Just _  -> nixSelect (pure res)  where-  build :: NExprLoc-        -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc)-        -> NExprLoc-  build t Nothing = t-  build t (Just (s,o)) = nSelectLoc t s o+  build+    :: NExprLoc+    -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc)+    -> NExprLoc+  build t Nothing       = t+  build t (Just (s, o)) = nSelectLoc t s o  nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc)) nixSelector = annotateLocation $ do-    (x:xs) <- keyName `sepBy1` selDot-    return $ x :| xs+  (x : xs) <- keyName `sepBy1` selDot+  return $ x :| xs  nixTerm :: Parser NExprLoc nixTerm = do-    c <- try $ lookAhead $ satisfy $ \x ->-        pathChar x ||-        x == '(' ||-        x == '{' ||-        x == '[' ||-        x == '<' ||-        x == '/' ||-        x == '"' ||-        x == '\''-    case c of-        '('  -> nixSelect nixParens-        '{'  -> nixSelect nixSet-        '['  -> nixList-        '<'  -> nixSPath-        '/'  -> nixPath-        '"'  -> nixStringExpr-        '\'' -> nixStringExpr-        _    -> msum $-            [ nixSelect nixSet | c == 'r' ] ++-            [ nixPath | pathChar c ] ++-            if isDigit c-            then [ nixFloat-                 , nixInt ]-            else [ nixUri | isAlpha c ] ++-                 [ nixBool | c == 't' || c == 'f' ] ++-                 [ nixNull | c == 'n' ] ++-                 [ nixSelect nixSym ]+  c <- try $ lookAhead $ satisfy $ \x ->+    pathChar x+      || x+      == '('+      || x+      == '{'+      || x+      == '['+      || x+      == '<'+      || x+      == '/'+      || x+      == '"'+      || x+      == '\''+      || x+      == '^'+  case c of+    '('  -> nixSelect nixParens+    '{'  -> nixSelect nixSet+    '['  -> nixList+    '<'  -> nixSearchPath+    '/'  -> nixPath+    '"'  -> nixString+    '\'' -> nixString+    '^'  -> nixSynHole+    _ ->+      msum+        $  [ nixSelect nixSet | c == 'r' ]+        ++ [ nixPath | pathChar c ]+        ++ if isDigit c+             then [nixFloat, nixInt]+             else+               [ nixUri | isAlpha c ]+               ++ [ nixBool | c == 't' || c == 'f' ]+               ++ [ nixNull | c == 'n' ]+               ++ [nixSelect nixSym]  nixToplevelForm :: Parser NExprLoc-nixToplevelForm = keywords <+> nixLambda <+> nixExprLoc-  where-    keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith+nixToplevelForm = keywords <+> nixLambda <+> nixExpr+  where keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith  nixSym :: Parser NExprLoc nixSym = annotateLocation1 $ mkSymF <$> identifier +nixSynHole :: Parser NExprLoc+nixSynHole = annotateLocation1 $ mkSynHoleF <$> (char '^' >> identifier)+ nixInt :: Parser NExprLoc nixInt = annotateLocation1 (mkIntF <$> integer <?> "integer")  nixFloat :: Parser NExprLoc-nixFloat = annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")+nixFloat =+  annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")  nixBool :: Parser NExprLoc-nixBool = annotateLocation1 (bool "true" True <+>-                             bool "false" False) <?> "bool" where-  bool str b = mkBoolF b <$ reserved str+nixBool =+  annotateLocation1 (bool "true" True <+> bool "false" False) <?> "bool"+  where bool str b = mkBoolF b <$ reserved str  nixNull :: Parser NExprLoc nixNull = annotateLocation1 (mkNullF <$ reserved "null" <?> "null")@@ -156,115 +204,147 @@ nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")  pathChar :: Char -> Bool-pathChar x = isAlpha x || isDigit x || x == '.' || x == '_' || x == '-' || x == '+' || x == '~'+pathChar x =+  isAlpha x+    || isDigit x+    || x+    == '.'+    || x+    == '_'+    || x+    == '-'+    || x+    == '+'+    || x+    == '~'  slash :: Parser Char-slash = try (char '/' <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x)))+slash =+  try+      (  char '/'+      <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x))+      )     <?> "slash"  -- | A path surrounded by angle brackets, indicating that it should be -- looked up in the NIX_PATH environment variable at evaluation.-nixSPath :: Parser NExprLoc-nixSPath = annotateLocation1-    (mkPathF True <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")-         <?> "spath")+nixSearchPath :: Parser NExprLoc+nixSearchPath = annotateLocation1+  (   mkPathF True+  <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")+  <?> "spath"+  )  pathStr :: Parser FilePath-pathStr = lexeme $ liftM2 (++) (many (satisfy pathChar))-    (Prelude.concat <$> some (liftM2 (:) slash (some (satisfy pathChar))))+pathStr = lexeme $ liftM2+  (++)+  (many (satisfy pathChar))+  (Prelude.concat <$> some (liftM2 (:) slash (some (satisfy pathChar))))  nixPath :: Parser NExprLoc nixPath = annotateLocation1 (try (mkPathF False <$> pathStr) <?> "path")  nixLet :: Parser NExprLoc-nixLet = annotateLocation1 (reserved "let"-    *> (letBody <+> letBinders)-    <?> "let block")-  where-    letBinders = NLet-        <$> nixBinders-        <*> (reserved "in" *> nixToplevelForm)-    -- Let expressions `let {..., body = ...}' are just desugared-    -- into `(rec {..., body = ...}).body'.-    letBody = (\x -> NSelect x (StaticKey "body" :| []) Nothing) <$> aset-    aset = annotateLocation1 $ NRecSet <$> braces nixBinders+nixLet = annotateLocation1+  (reserved "let" *> (letBody <+> letBinders) <?> "let block")+ where+  letBinders = NLet <$> nixBinders <*> (reserved "in" *> nixToplevelForm)+  -- Let expressions `let {..., body = ...}' are just desugared+  -- into `(rec {..., body = ...}).body'.+  letBody    = (\x -> NSelect x (StaticKey "body" :| []) Nothing) <$> aset+  aset       = annotateLocation1 $ NRecSet <$> braces nixBinders  nixIf :: Parser NExprLoc-nixIf = annotateLocation1 (NIf-     <$> (reserved "if" *> nixExprLoc)-     <*> (reserved "then" *> nixToplevelForm)-     <*> (reserved "else" *> nixToplevelForm)-     <?> "if")+nixIf = annotateLocation1+  (   NIf+  <$> (reserved "if" *> nixExpr)+  <*> (reserved "then" *> nixToplevelForm)+  <*> (reserved "else" *> nixToplevelForm)+  <?> "if"+  )  nixAssert :: Parser NExprLoc-nixAssert = annotateLocation1 (NAssert-  <$> (reserved "assert" *> nixExprLoc)+nixAssert = annotateLocation1+  (   NAssert+  <$> (reserved "assert" *> nixExpr)   <*> (semi *> nixToplevelForm)-  <?> "assert")+  <?> "assert"+  )  nixWith :: Parser NExprLoc-nixWith = annotateLocation1 (NWith+nixWith = annotateLocation1+  (   NWith   <$> (reserved "with" *> nixToplevelForm)   <*> (semi *> nixToplevelForm)-  <?> "with")+  <?> "with"+  )  nixLambda :: Parser NExprLoc nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixToplevelForm -nixStringExpr :: Parser NExprLoc-nixStringExpr = nStr <$> annotateLocation nixString+nixString :: Parser NExprLoc+nixString = nStr <$> annotateLocation nixString'  nixUri :: Parser NExprLoc nixUri = annotateLocation1 $ lexeme $ try $ do-    start <- letterChar-    protocol <- many $ satisfy $ \x ->-        isAlpha x || isDigit x || x `elem` ("+-." :: String)-    _ <- string ":"-    address  <- some $ satisfy $ \x ->-        isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)-    return $ NStr $-        DoubleQuoted [Plain $ pack $ start : protocol ++ ':' : address]+  start    <- letterChar+  protocol <- many $ satisfy $ \x ->+    isAlpha x || isDigit x || x `elem` ("+-." :: String)+  _       <- string ":"+  address <- some $ satisfy $ \x ->+    isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)+  return $ NStr $ DoubleQuoted+    [Plain $ pack $ start : protocol ++ ':' : address] -nixString :: Parser (NString NExprLoc)-nixString = lexeme (doubleQuoted <+> indented <?> "string")-  where-    doubleQuoted :: Parser (NString NExprLoc)-    doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain-                <$> (doubleQ *> many (stringChar doubleQ (void $ char '\\')-                                                 doubleEscape)-                             <* doubleQ)-                <?> "double quoted string"+nixString' :: Parser (NString NExprLoc)+nixString' = lexeme (doubleQuoted <+> indented <?> "string")+ where+  doubleQuoted :: Parser (NString NExprLoc)+  doubleQuoted =+    DoubleQuoted+      .   removePlainEmpty+      .   mergePlain+      <$> (  doubleQ+          *> many (stringChar doubleQ (void $ char '\\') doubleEscape)+          <* doubleQ+          )+      <?> "double quoted string" -    doubleQ = void (char '"')-    doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)+  doubleQ      = void (char '"')+  doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode) -    indented :: Parser (NString NExprLoc)-    indented = stripIndent-            <$> (indentedQ *> many (stringChar indentedQ indentedQ-                                               indentedEscape)-                           <* indentedQ)-            <?> "indented string"+  indented :: Parser (NString NExprLoc)+  indented =+    stripIndent+      <$> (  indentedQ+          *> many (stringChar indentedQ indentedQ indentedEscape)+          <* indentedQ+          )+      <?> "indented string" -    indentedQ = void (string "''" <?> "\"''\"")-    indentedEscape = try $ do-        indentedQ-        (Plain <$> ("''" <$ char '\'' <+> "$"  <$ char '$')) <+> do-            _ <- char '\\'-            c <- escapeCode-            pure $ if c == '\n'-                   then EscapedNewline-                   else Plain $ singleton c+  indentedQ      = void (string "''" <?> "\"''\"")+  indentedEscape = try $ do+    indentedQ+    (Plain <$> ("''" <$ char '\'' <+> "$" <$ char '$')) <+> do+      _ <- char '\\'+      c <- escapeCode+      pure $ if c == '\n' then EscapedNewline else Plain $ singleton c -    stringChar end escStart esc =-            Antiquoted <$> (antiStart *> nixToplevelForm <* char '}')-        <+> Plain . singleton <$> char '$'-        <+> esc-        <+> Plain . pack <$> some plainChar-     where-       plainChar =-           notFollowedBy (end <+> void (char '$') <+> escStart) *> anyChar+  stringChar end escStart esc =+    Antiquoted+      <$> (antiStart *> nixToplevelForm <* char '}')+      <+> Plain+      .   singleton+      <$> char '$'+      <+> esc+      <+> Plain+      .   pack+      <$> some plainChar+   where+    plainChar =+      notFollowedBy (end <+> void (char '$') <+> escStart) *> anySingle -    escapeCode = msum [ c <$ char e | (c,e) <- escapeCodes ] <+> anyChar+  escapeCode = msum [ c <$ char e | (c, e) <- escapeCodes ] <+> anySingle  -- | Gets all of the arguments for a function. argExpr :: Parser (Params NExprLoc)@@ -273,19 +353,22 @@   -- in the case of, for example `x:y`. Is it a lambda function `x: y`, or   -- a URI `x:y`? Nix syntax says it's the latter. So we need to fail if   -- there's a valid URI parse here.-  onlyname = msum [nixUri >> unexpected (Label ('v' NE.:| "alid uri")),-                     Param <$> identifier]+  onlyname =+    msum+      [ nixUri >> unexpected (Label ('v' NE.:| "alid uri"))+      , Param <$> identifier+      ]    -- Parameters named by an identifier on the left (`args @ {x, y}`)   atLeft = try $ do-    name <- identifier <* symbol "@"+    name               <- identifier <* symbol "@"     (variadic, params) <- params     return $ ParamSet params variadic (Just name)    -- Parameters named by an identifier on the right, or none (`{x, y} @ args`)   atRight = do     (variadic, params) <- params-    name <- optional $ symbol "@" *> identifier+    name               <- optional $ symbol "@" *> identifier     return $ ParamSet params variadic name    -- Return the parameters set.@@ -296,7 +379,7 @@   -- Collects the parameters within curly braces. Returns the parameters and   -- a boolean indicating if the parameters are variadic.   getParams :: Parser ([(Text, Maybe NExprLoc)], Bool)-  getParams = go [] where+  getParams = go []   where     -- Attempt to parse `...`. If this succeeds, stop and return True.     -- Otherwise, attempt to parse an argument, optionally with a     -- default. If this fails, then return what has been accumulated@@ -304,49 +387,49 @@     go acc = ((acc, True) <$ symbol "...") <+> getMore acc     getMore acc =       -- Could be nothing, in which just return what we have so far.-      option (acc, False) $ do+                  option (acc, False) $ do         -- Get an argument name and an optional default.-        pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)-        -- Either return this, or attempt to get a comma and restart.-        option (acc ++ [pair], False) $ comma >> go (acc ++ [pair])+      pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)+      -- Either return this, or attempt to get a comma and restart.+      option (acc ++ [pair], False) $ comma >> go (acc ++ [pair])  nixBinders :: Parser [Binding NExprLoc] nixBinders = (inherit <+> namedVar) `endBy` semi where   inherit = do       -- We can't use 'reserved' here because it would consume the whitespace       -- after the keyword, which is not exactly the semantics of C++ Nix.-      try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))-      p <- getPosition-      x <- whiteSpace *> optional scope-      Inherit x <$> many keyName <*> pure p <?> "inherited binding"+    try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))+    p <- getSourcePos+    x <- whiteSpace *> optional scope+    Inherit x <$> many keyName <*> pure p <?> "inherited binding"   namedVar = do-      p <- getPosition-      NamedVar <$> (annotated <$> nixSelector)-               <*> (equals *> nixToplevelForm)-               <*> pure p-               <?> "variable binding"+    p <- getSourcePos+    NamedVar+      <$> (annotated <$> nixSelector)+      <*> (equals *> nixToplevelForm)+      <*> pure p+      <?> "variable binding"   scope = parens nixToplevelForm <?> "inherit scope"  keyName :: Parser (NKeyName NExprLoc) keyName = dynamicKey <+> staticKey where-  staticKey = StaticKey <$> identifier-  dynamicKey = DynamicKey <$> nixAntiquoted nixString+  staticKey  = StaticKey <$> identifier+  dynamicKey = DynamicKey <$> nixAntiquoted nixString'  nixSet :: Parser NExprLoc-nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set") where-  isRec = (reserved "rec" $> NRecSet <?> "recursive set")-       <+> pure NSet+nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set")+  where isRec = (reserved "rec" $> NRecSet <?> "recursive set") <+> pure NSet -parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)+parseNixFile :: MonadFile m => FilePath -> m (Result NExpr) parseNixFile =-    parseFromFileEx $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof)+  parseFromFileEx $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof) -parseNixFileLoc :: MonadIO m => FilePath -> m (Result NExprLoc)+parseNixFileLoc :: MonadFile m => FilePath -> m (Result NExprLoc) parseNixFileLoc = parseFromFileEx (whiteSpace *> nixToplevelForm <* eof)  parseNixText :: Text -> Result NExpr parseNixText =-    parseFromText $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof)+  parseFromText $ stripAnnotation <$> (whiteSpace *> nixToplevelForm <* eof)  parseNixTextLoc :: Text -> Result NExprLoc parseNixTextLoc = parseFromText (whiteSpace *> nixToplevelForm <* eof)@@ -354,15 +437,14 @@ {- Parser.Library -}  skipLineComment' :: Tokens Text -> Parser ()-skipLineComment' prefix =-  string prefix-      *> void (takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r'))+skipLineComment' prefix = string prefix+  *> void (takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r'))  whiteSpace :: Parser () whiteSpace = L.space space1 lineCmnt blockCmnt-  where-    lineCmnt  = skipLineComment' "#"-    blockCmnt = L.skipBlockComment "/*" "*/"+ where+  lineCmnt  = skipLineComment' "#"+  blockCmnt = L.skipBlockComment "/*" "*/"  lexeme :: Parser a -> Parser a lexeme p = p <* whiteSpace@@ -371,34 +453,57 @@ symbol = lexeme . string  reservedEnd :: Char -> Bool-reservedEnd x = isSpace x ||-    x == '{' || x == '(' || x == '[' ||-    x == '}' || x == ')' || x == ']' ||-    x == ';' || x == ':' || x == '.' ||-    x == '"' || x == '\'' || x == ','+reservedEnd x =+  isSpace x+    || x+    == '{'+    || x+    == '('+    || x+    == '['+    || x+    == '}'+    || x+    == ')'+    || x+    == ']'+    || x+    == ';'+    || x+    == ':'+    || x+    == '.'+    || x+    == '"'+    || x+    == '\''+    || x+    == ','  reserved :: Text -> Parser ()-reserved n = lexeme $ try $-    string n *> lookAhead (void (satisfy reservedEnd) <|> eof)+reserved n =+  lexeme $ try $ string n *> lookAhead (void (satisfy reservedEnd) <|> eof)  identifier = lexeme $ try $ do-    ident <- cons <$> satisfy (\x -> isAlpha x || x == '_')-                 <*> takeWhileP Nothing identLetter-    guard (not (ident `HashSet.member` reservedNames))-    return ident-  where-    identLetter x = isAlpha x || isDigit x || x == '_' || x == '\'' || x == '-'+  ident <-+    cons+    <$> satisfy (\x -> isAlpha x || x == '_')+    <*> takeWhileP Nothing identLetter+  guard (not (ident `HashSet.member` reservedNames))+  return ident+ where+  identLetter x = isAlpha x || isDigit x || x == '_' || x == '\'' || x == '-' -parens    = between (symbol "(") (symbol ")")-braces    = between (symbol "{") (symbol "}")+parens = between (symbol "(") (symbol ")")+braces = between (symbol "{") (symbol "}") -- angles    = between (symbol "<") (symbol ">")-brackets  = between (symbol "[") (symbol "]")-semi      = symbol ";"-comma     = symbol ","+brackets = between (symbol "[") (symbol "]")+semi = symbol ";"+comma = symbol "," -- colon     = symbol ":" -- dot       = symbol "."-equals    = symbol "="-question  = symbol "?"+equals = symbol "="+question = symbol "?"  integer :: Parser Integer integer = lexeme L.decimal@@ -408,28 +513,22 @@  reservedNames :: HashSet Text reservedNames = HashSet.fromList-    [ "let", "in"-    , "if", "then", "else"-    , "assert"-    , "with"-    , "rec"-    , "inherit"-    , "true", "false" ]+  ["let", "in", "if", "then", "else", "assert", "with", "rec", "inherit"]  type Parser = ParsecT Void Text Identity -data Result a = Success a | Failure Doc deriving Show+data Result a = Success a | Failure (Doc Void) deriving (Show, Functor) -parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)+parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a) parseFromFileEx p path = do-    txt <- liftIO (T.readFile path)-    return $ either (Failure . text . parseErrorPretty' txt) Success-           $ parse p path txt+  txt <- decodeUtf8 <$> readFile path+  return $ either (Failure . pretty . errorBundlePretty) Success $ parse p+                                                                         path+                                                                         txt  parseFromText :: Parser a -> Text -> Result a parseFromText p txt =-    either (Failure . text . parseErrorPretty' txt) Success $-        parse p "<string>" txt+  either (Failure . pretty . errorBundlePretty) Success $ parse p "<string>" txt  {- Parser.Operators -} @@ -447,9 +546,9 @@  annotateLocation :: Parser a -> Parser (Ann SrcSpan a) annotateLocation p = do-  begin <- getPosition+  begin <- getSourcePos   res   <- p-  end   <- getPosition+  end   <- getSourcePos   pure $ Ann (SrcSpan begin end) res  annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc@@ -465,23 +564,24 @@  opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a opWithLoc name op f = do-    Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -} operator name-    return $ f (Ann ann op)+  Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -}+                                  operator name+  return $ f (Ann ann op) -binaryN name op = (NBinaryDef name op NAssocNone,-                   InfixN  (opWithLoc name op nBinary))-binaryL name op = (NBinaryDef name op NAssocLeft,-                   InfixL  (opWithLoc name op nBinary))-binaryR name op = (NBinaryDef name op NAssocRight,-                   InfixR  (opWithLoc name op nBinary))-prefix  name op = (NUnaryDef name op,-                   Prefix  (manyUnaryOp (opWithLoc name op nUnary)))+binaryN name op =+  (NBinaryDef name op NAssocNone, InfixN (opWithLoc name op nBinary))+binaryL name op =+  (NBinaryDef name op NAssocLeft, InfixL (opWithLoc name op nBinary))+binaryR name op =+  (NBinaryDef name op NAssocRight, InfixR (opWithLoc name op nBinary))+prefix name op =+  (NUnaryDef name op, Prefix (manyUnaryOp (opWithLoc name op nUnary))) -- postfix name op = (NUnaryDef name op, --                    Postfix (opWithLoc name op nUnary))  nixOperators-    :: Parser (Ann SrcSpan (NAttrPath NExprLoc))-    -> [[(NOperatorDef, Operator Parser NExprLoc)]]+  :: Parser (Ann SrcSpan (NAttrPath NExprLoc))+  -> [[(NOperatorDef, Operator Parser NExprLoc)]] nixOperators selector =   [ -- This is not parsed here, even though technically it's part of the     -- expression table. The problem is that in some cases, such as list@@ -495,28 +595,40 @@     --                    mor <- optional (reserved "or" *> term)     --                    return $ \x -> nSelectLoc x sel mor) ] -    {-  2 -} [ (NBinaryDef " " NApp NAssocLeft,+    {-  2 -}+    [ ( NBinaryDef " " NApp NAssocLeft+      ,                 -- Thanks to Brent Yorgey for showing me this trick!-                InfixL $ nApp <$ symbol "") ]-  , {-  3 -} [ prefix  "-"  NNeg ]-  , {-  4 -} [ (NSpecialDef "?" NHasAttrOp NAssocLeft,-                Postfix $ symbol "?" *> (flip nHasAttr <$> selector)) ]-  , {-  5 -} [ binaryR "++" NConcat ]-  , {-  6 -} [ binaryL "*"  NMult-             , binaryL "/"  NDiv ]-  , {-  7 -} [ binaryL "+"  NPlus-             , binaryL "-"  NMinus ]-  , {-  8 -} [ prefix  "!"  NNot ]-  , {-  9 -} [ binaryR "//" NUpdate ]-  , {- 10 -} [ binaryL "<"  NLt-             , binaryL ">"  NGt-             , binaryL "<=" NLte-             , binaryL ">=" NGte ]-  , {- 11 -} [ binaryN "==" NEq-             , binaryN "!=" NNEq ]-  , {- 12 -} [ binaryL "&&" NAnd ]-  , {- 13 -} [ binaryL "||" NOr ]-  , {- 14 -} [ binaryN "->" NImpl ]+        InfixL $ nApp <$ symbol ""+      )+    ]+  , {-  3 -}+    [prefix "-" NNeg]+  , {-  4 -}+    [ ( NSpecialDef "?" NHasAttrOp NAssocLeft+      , Postfix $ symbol "?" *> (flip nHasAttr <$> selector)+      )+    ]+  , {-  5 -}+    [binaryR "++" NConcat]+  , {-  6 -}+    [binaryL "*" NMult, binaryL "/" NDiv]+  , {-  7 -}+    [binaryL "+" NPlus, binaryL "-" NMinus]+  , {-  8 -}+    [prefix "!" NNot]+  , {-  9 -}+    [binaryR "//" NUpdate]+  , {- 10 -}+    [binaryL "<" NLt, binaryL ">" NGt, binaryL "<=" NLte, binaryL ">=" NGte]+  , {- 11 -}+    [binaryN "==" NEq, binaryN "!=" NNEq]+  , {- 12 -}+    [binaryL "&&" NAnd]+  , {- 13 -}+    [binaryL "||" NOr]+  , {- 14 -}+    [binaryN "->" NImpl]   ]  data OperatorInfo = OperatorInfo@@ -527,25 +639,36 @@  getUnaryOperator :: NUnaryOp -> OperatorInfo getUnaryOperator = (m Map.!) where-  m = Map.fromList $ concat $ zipWith buildEntry [1..]-          (nixOperators (error "unused"))+  m = Map.fromList $ concat $ zipWith buildEntry+                                      [1 ..]+                                      (nixOperators (error "unused"))   buildEntry i = concatMap $ \case     (NUnaryDef name op, _) -> [(op, OperatorInfo i NAssocNone name)]-    _ -> []+    _                      -> []  getBinaryOperator :: NBinaryOp -> OperatorInfo getBinaryOperator = (m Map.!) where-  m = Map.fromList $ concat $ zipWith buildEntry [1..]-          (nixOperators (error "unused"))+  m = Map.fromList $ concat $ zipWith buildEntry+                                      [1 ..]+                                      (nixOperators (error "unused"))   buildEntry i = concatMap $ \case     (NBinaryDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]-    _ -> []+    _                             -> []  getSpecialOperator :: NSpecialOp -> OperatorInfo getSpecialOperator NSelectOp = OperatorInfo 1 NAssocLeft "."-getSpecialOperator o = m Map.! o where-  m = Map.fromList $ concat $ zipWith buildEntry [1..]-          (nixOperators (error "unused"))+getSpecialOperator o         = m Map.! o where+  m = Map.fromList $ concat $ zipWith buildEntry+                                      [1 ..]+                                      (nixOperators (error "unused"))   buildEntry i = concatMap $ \case     (NSpecialDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]-    _ -> []+    _                              -> []++++++++
src/Nix/Pretty.hs view
@@ -1,9 +1,13 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -12,36 +16,49 @@  module Nix.Pretty where -import           Control.Monad+import           Control.Applicative            ( (<|>) )+import           Control.Comonad import           Data.Fix-import           Data.HashMap.Lazy (toList)-import qualified Data.HashMap.Lazy as M-import qualified Data.HashSet as HashSet-import           Data.List (isPrefixOf, sort)-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import           Data.Maybe (isJust, fromMaybe)-import           Data.Text (pack, unpack, replace, strip)-import qualified Data.Text as Text+import           Data.HashMap.Lazy              ( toList )+import qualified Data.HashMap.Lazy             as M+import qualified Data.HashSet                  as HashSet+import           Data.List                      ( isPrefixOf+                                                , sort+                                                )+import           Data.List.NonEmpty             ( NonEmpty(..) )+import qualified Data.List.NonEmpty            as NE+import           Data.Maybe                     ( isJust+                                                , fromMaybe+                                                )+import           Data.Text                      ( pack+                                                , unpack+                                                , replace+                                                , strip+                                                )+import qualified Data.Text                     as Text+import           Data.Text.Prettyprint.Doc import           Nix.Atoms+import           Nix.Cited import           Nix.Expr+import           Nix.Normal import           Nix.Parser+import           Nix.String import           Nix.Strings import           Nix.Thunk #if ENABLE_TRACING import           Nix.Utils #else-import           Nix.Utils hiding ((<$>))+import           Nix.Utils               hiding ( (<$>) ) #endif import           Nix.Value-import           Prelude hiding ((<$>))-import           Text.PrettyPrint.ANSI.Leijen+import           Prelude                 hiding ( (<$>) )+import           Text.Read                      ( readMaybe )  -- | This type represents a pretty printed nix expression -- together with some information about the expression.-data NixDoc = NixDoc+data NixDoc ann = NixDoc   { -- | The rendered expression, without any parentheses.-    withoutParens    :: Doc+    withoutParens    :: Doc ann      -- | The root operator is the operator at the root of     -- the expression tree. For example, in '(a * b) + c', '+' would be the root@@ -52,16 +69,16 @@                     -- we can add brackets appropiately   } -mkNixDoc :: Doc -> OperatorInfo -> NixDoc+mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann mkNixDoc d o = NixDoc { withoutParens = d, rootOp = o, wasPath = False }  -- | A simple expression is never wrapped in parentheses. The expression --   behaves as if its root operator had a precedence higher than all --   other operators (including function application).-simpleExpr :: Doc -> NixDoc+simpleExpr :: Doc ann -> NixDoc ann simpleExpr d = mkNixDoc d (OperatorInfo minBound NAssocNone "simple expr") -pathExpr :: Doc -> NixDoc+pathExpr :: Doc ann -> NixDoc ann pathExpr d = (simpleExpr d) { wasPath = True }  -- | An expression that behaves as if its root operator had a precedence lower@@ -69,9 +86,9 @@ --   parantheses in almost always, but it's still rendered without parentheses --   in cases where parentheses are never required (such as in the LHS of a --   binding).-leastPrecedence :: Doc -> NixDoc+leastPrecedence :: Doc ann -> NixDoc ann leastPrecedence =-    flip mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"+  flip mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"  appOp :: OperatorInfo appOp = getBinaryOperator NApp@@ -85,221 +102,322 @@ hasAttrOp :: OperatorInfo hasAttrOp = getSpecialOperator NHasAttrOp -wrapParens :: OperatorInfo -> NixDoc -> Doc+wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann wrapParens op sub-  | precedence (rootOp sub) < precedence op = withoutParens sub-  | precedence (rootOp sub) == precedence op-    && associativity (rootOp sub) == associativity op-    && associativity op /= NAssocNone = withoutParens sub-  | otherwise = parens $ withoutParens sub+  | precedence (rootOp sub) < precedence op+  = withoutParens sub+  | precedence (rootOp sub)+    == precedence op+    && associativity (rootOp sub)+    == associativity op+    && associativity op+    /= NAssocNone+  = withoutParens sub+  | otherwise+  = parens $ withoutParens sub  -- Used in the selector case to print a path in a selector as -- "${./abc}"-wrapPath :: OperatorInfo -> NixDoc -> Doc-wrapPath op sub =-  if wasPath sub then dquotes (text "$" <> braces (withoutParens sub))-                else wrapParens op sub+wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann+wrapPath op sub = if wasPath sub+  then dquotes $ "$" <> braces (withoutParens sub)+  else wrapParens op sub -prettyString :: NString NixDoc -> Doc+prettyString :: NString (NixDoc ann) -> Doc ann prettyString (DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts-  where prettyPart (Plain t)      = text . concatMap escape . unpack $ t-        prettyPart EscapedNewline = text "''\\n"-        prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)-        escape '"' = "\\\""-        escape x = maybe [x] (('\\':) . (:[])) $ toEscapeCode x-prettyString (Indented _ parts)-  = group $ nest 2 (squote <> squote <$$> content) <$$> squote <> squote  where+  prettyPart (Plain t)      = pretty . concatMap escape . unpack $ t+  prettyPart EscapedNewline = "''\\n"+  prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)+  escape '"' = "\\\""+  escape x   = maybe [x] (('\\' :) . (: [])) $ toEscapeCode x+prettyString (Indented _ parts) = group $ nest 2 $ vcat+  [dsquote, content, dsquote]+ where+  dsquote = squote <> squote   content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts-  stripLastIfEmpty = reverse . f . reverse where+  stripLastIfEmpty = reverse . f . reverse   where     f ([Plain t] : xs) | Text.null (strip t) = xs     f xs = xs   prettyLine = hcat . map prettyPart-  prettyPart (Plain t) = text . unpack . replace "${" "''${" . replace "''" "'''" $ t-  prettyPart EscapedNewline = text "\\n"-  prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)+  prettyPart (Plain t) =+    pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t+  prettyPart EscapedNewline = "\\n"+  prettyPart (Antiquoted r) = "$" <> braces (withoutParens r) -prettyParams :: Params NixDoc -> Doc-prettyParams (Param n) = text $ unpack n+prettyParams :: Params (NixDoc ann) -> Doc ann+prettyParams (Param n           ) = pretty $ unpack n prettyParams (ParamSet s v mname) = prettyParamSet s v <> case mname of-  Nothing -> empty-  Just name | Text.null name -> empty-            | otherwise -> text "@" <> text (unpack name)+  Nothing -> mempty+  Just name | Text.null name -> mempty+            | otherwise      -> "@" <> pretty (unpack name) -prettyParamSet :: ParamSet NixDoc -> Bool -> Doc-prettyParamSet args var =-    encloseSep (lbrace <> space) (align (space <> rbrace)) sep (map prettySetArg args ++ prettyVariadic)-  where-    prettySetArg (n, maybeDef) = case maybeDef of-      Nothing -> text (unpack n)-      Just v -> text (unpack n) <+> text "?" <+> withoutParens v-    prettyVariadic = [text "..." | var]-    sep = align (comma <> space)+prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann+prettyParamSet args var = encloseSep+  (lbrace <> space)+  (align (space <> rbrace))+  sep+  (map prettySetArg args ++ prettyVariadic)+ where+  prettySetArg (n, maybeDef) = case maybeDef of+    Nothing -> pretty (unpack n)+    Just v  -> pretty (unpack n) <+> "?" <+> withoutParens v+  prettyVariadic = [ "..." | var ]+  sep            = align (comma <> space) -prettyBind :: Binding NixDoc -> Doc+prettyBind :: Binding (NixDoc ann) -> Doc ann prettyBind (NamedVar n v _p) =-    prettySelector n <+> equals <+> withoutParens v <> semi-prettyBind (Inherit s ns _p)-  = text "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi- where scope = maybe empty ((<> space) . parens . withoutParens) s+  prettySelector n <+> equals <+> withoutParens v <> semi+prettyBind (Inherit s ns _p) =+  "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi+  where scope = maybe mempty ((<> space) . parens . withoutParens) s -prettyKeyName :: NKeyName NixDoc -> Doc-prettyKeyName (StaticKey "") = dquotes $ text ""-prettyKeyName (StaticKey key)-  | HashSet.member key reservedNames = dquotes $ text $ unpack key-prettyKeyName (StaticKey key) = text . unpack $ key-prettyKeyName (DynamicKey key) =-    runAntiquoted (DoubleQuoted [Plain "\n"])-        prettyString ((text "$" <>) . braces . withoutParens) key+prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann+prettyKeyName (StaticKey "") = dquotes ""+prettyKeyName (StaticKey key) | HashSet.member key reservedNames =+  dquotes $ pretty $ unpack key+prettyKeyName (StaticKey  key) = pretty . unpack $ key+prettyKeyName (DynamicKey key) = runAntiquoted+  (DoubleQuoted [Plain "\n"])+  prettyString+  (("$" <>) . braces . withoutParens)+  key -prettySelector :: NAttrPath NixDoc -> Doc+prettySelector :: NAttrPath (NixDoc ann) -> Doc ann prettySelector = hcat . punctuate dot . map prettyKeyName . NE.toList -prettyAtom :: NAtom -> NixDoc-prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom+prettyAtom :: NAtom -> NixDoc ann+prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom -prettyNix :: NExpr -> Doc+prettyNix :: NExpr -> Doc ann prettyNix = withoutParens . cata exprFNixDoc -prettyOriginExpr :: NExprLocF (Maybe (NValue m)) -> Doc+instance HasCitations1 t m v f+  => HasCitations t m v (NValue' t f m a) where+  citations (NValue f) = citations1 f+  addProvenance x (NValue f) = NValue (addProvenance1 x f)++prettyOriginExpr+  :: forall t f m ann+   . HasCitations1 t m (NValue t f m) f+  => NExprLocF (Maybe (NValue t f m))+  -> Doc ann prettyOriginExpr = withoutParens . go-  where-    go = exprFNixDoc . annotated . getCompose . fmap render+ where+  go = exprFNixDoc . annotated . getCompose . fmap render -    render Nothing = simpleExpr $ text "_"-    render (Just (NValue (reverse -> p:_) _)) = go (_originExpr p)-    render (Just (NValue _ _)) = simpleExpr $ text "?"-        -- simpleExpr $ foldr ((<$>) . parens . indent 2 . withoutParens+  render :: Maybe (NValue t f m) -> NixDoc ann+  render Nothing = simpleExpr $ "_"+  render (Just (reverse . citations @t @m -> p:_)) = go (_originExpr p)+  render _       = simpleExpr "?"+    -- render (Just (NValue (citations -> ps))) =+        -- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . withoutParens         --                           . go . originExpr)         --     mempty (reverse ps) -exprFNixDoc :: NExprF NixDoc -> NixDoc+exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann exprFNixDoc = \case-    NConstant atom -> prettyAtom atom-    NStr str -> simpleExpr $ prettyString str-    NList [] -> simpleExpr $ lbracket <> rbracket-    NList xs -> simpleExpr $ group $-        nest 2 (vsep $ lbracket : map (wrapParens appOpNonAssoc) xs) <$> rbracket-    NSet [] -> simpleExpr $ lbrace <> rbrace-    NSet xs -> simpleExpr $ group $-        nest 2 (vsep $ lbrace : map prettyBind xs) <$> rbrace-    NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace-    NRecSet xs -> simpleExpr $ group $-        nest 2 (vsep $ recPrefix <> lbrace : map prettyBind xs) <$> rbrace-    NAbs args body -> leastPrecedence $-        nest 2 ((prettyParams args <> colon) <$> withoutParens body)-    NBinary NApp fun arg ->-        mkNixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp-    NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep-        [ wrapParens (f NAssocLeft) r1-        , text $ unpack $ operatorName opInfo-        , wrapParens (f NAssocRight) r2+  NConstant atom -> prettyAtom atom+  NStr      str  -> simpleExpr $ prettyString str+  NList     []   -> simpleExpr $ lbracket <> rbracket+  NList xs ->+    simpleExpr+      $ group+      $ nest 2+      $ vsep+      $ concat+      $ [[lbracket], map (wrapParens appOpNonAssoc) xs, [rbracket]]+  NSet [] -> simpleExpr $ lbrace <> rbrace+  NSet xs ->+    simpleExpr+      $ group+      $ nest 2+      $ vsep+      $ concat+      $ [[lbrace], map prettyBind xs, [rbrace]]+  NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace+  NRecSet xs ->+    simpleExpr+      $ group+      $ nest 2+      $ vsep+      $ concat+      $ [[recPrefix <> lbrace], map prettyBind xs, [rbrace]]+  NAbs args body ->+    leastPrecedence+      $ nest 2+      $ vsep+      $ [prettyParams args <> colon, withoutParens body]+  NBinary NApp fun arg ->+    mkNixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp+  NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep+    [ wrapParens (f NAssocLeft) r1+    , pretty $ unpack $ operatorName opInfo+    , wrapParens (f NAssocRight) r2+    ]+   where+    opInfo = getBinaryOperator op+    f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }+        | otherwise                 = opInfo+  NUnary op r1 -> mkNixDoc+    (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1)+    opInfo+    where opInfo = getUnaryOperator op+  NSelect r' attr o ->+    (if isJust o then leastPrecedence else flip mkNixDoc selectOp)+      $  wrapPath selectOp r+      <> dot+      <> prettySelector attr+      <> ordoc+   where+    r     = flip mkNixDoc selectOp $ wrapParens appOpNonAssoc r'+    ordoc = maybe mempty (((space <> "or") <+>) . wrapParens appOpNonAssoc) o+  NHasAttr r attr ->+    mkNixDoc (wrapParens hasAttrOp r <+> "?" <+> prettySelector attr) hasAttrOp+  NEnvPath     p -> simpleExpr $ pretty ("<" ++ p ++ ">")+  NLiteralPath p -> pathExpr $ pretty $ case p of+    "./"  -> "./."+    "../" -> "../."+    ".."  -> "../."+    txt | "/" `isPrefixOf` txt   -> txt+        | "~/" `isPrefixOf` txt  -> txt+        | "./" `isPrefixOf` txt  -> txt+        | "../" `isPrefixOf` txt -> txt+        | otherwise              -> "./" ++ txt+  NSym name -> simpleExpr $ pretty (unpack name)+  NLet binds body ->+    leastPrecedence+      $ group+      $ vsep+      $ [ "let"+        , indent 2 (vsep (map prettyBind binds))+        , "in" <+> withoutParens body         ]-      where-        opInfo = getBinaryOperator op-        f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }-            | otherwise = opInfo-    NUnary op r1 ->-        mkNixDoc (text (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo-      where opInfo = getUnaryOperator op-    NSelect r attr o ->-      (if isJust o then leastPrecedence else flip mkNixDoc selectOp) $-          wrapPath selectOp r <> dot <> prettySelector attr <> ordoc-      where ordoc = maybe empty (((space <> text "or") <+>) . wrapParens selectOp) o-    NHasAttr r attr ->-        mkNixDoc (wrapParens hasAttrOp r <+> text "?" <+> prettySelector attr) hasAttrOp-    NEnvPath p -> simpleExpr $ text ("<" ++ p ++ ">")-    NLiteralPath p -> pathExpr $ text $ case p of-        "./" -> "./."-        "../" -> "../."-        ".." -> "../."-        txt | "/" `isPrefixOf` txt -> txt-            | "~/" `isPrefixOf` txt -> txt-            | "./" `isPrefixOf` txt -> txt-            | "../" `isPrefixOf` txt -> txt-            | otherwise -> "./" ++ txt-    NSym name -> simpleExpr $ text (unpack name)-    NLet binds body -> leastPrecedence $ group $ text "let" <$> indent 2 (-        vsep (map prettyBind binds)) <$> text "in" <+> withoutParens body-    NIf cond trueBody falseBody -> leastPrecedence $-        group $ nest 2 $ (text "if" <+> withoutParens cond) <$>-          (  align (text "then" <+> withoutParens trueBody)-         <$> align (text "else" <+> withoutParens falseBody)-          )-    NWith scope body -> leastPrecedence $-        text "with"  <+> withoutParens scope <> semi <$> align (withoutParens body)-    NAssert cond body -> leastPrecedence $-        text "assert" <+> withoutParens cond <> semi <$> align (withoutParens body)-  where-    recPrefix = text "rec" <> space+  NIf cond trueBody falseBody ->+    leastPrecedence+      $ group+      $ nest 2+      $ vsep+      $ [ "if" <+> withoutParens cond+        , align ("then" <+> withoutParens trueBody)+        , align ("else" <+> withoutParens falseBody)+        ]+  NWith scope body ->+    leastPrecedence+      $ vsep+      $ ["with" <+> withoutParens scope <> semi, align $ withoutParens body]+  NAssert cond body ->+    leastPrecedence+      $ vsep+      $ ["assert" <+> withoutParens cond <> semi, align $ withoutParens body]+  NSynHole name -> simpleExpr $ pretty ("^" <> unpack name)+  where recPrefix = "rec" <> space -prettyNValueNF :: Functor m => NValueNF m -> Doc+valueToExpr :: forall t f m . MonadDataContext f m => NValueNF t f m -> NExpr+valueToExpr = iterNValueNF+  (const (mkStr (principledMakeNixStringWithoutContext "<CYCLE>")))+  phi+ where+  phi :: NValue' t f m NExpr -> NExpr+  phi (NVConstant a ) = Fix $ NConstant a+  phi (NVStr      ns) = mkStr ns+  phi (NVList     l ) = Fix $ NList l+  phi (NVSet s p    ) = Fix $ NSet+    [ NamedVar (StaticKey k :| []) v (fromMaybe nullPos (M.lookup k p))+    | (k, v) <- toList s+    ]+  phi (NVClosure _ _   ) = Fix . NSym . pack $ "<closure>"+  phi (NVPath p        ) = Fix $ NLiteralPath p+  phi (NVBuiltin name _) = Fix . NSym . pack $ "builtins." ++ name+  phi _                  = error "Pattern synonyms foil completeness check"++  mkStr ns = Fix $ NStr $ DoubleQuoted [Plain (hackyStringIgnoreContext ns)]++prettyNValueNF :: MonadDataContext f m => NValueNF t f m -> Doc ann prettyNValueNF = prettyNix . valueToExpr-  where valueToExpr :: Functor m => NValueNF m -> NExpr-        valueToExpr = transport go -        go (NVConstantF a) = NConstant a-        go (NVStrF t _) = NStr (DoubleQuoted [Plain t])-        go (NVListF l) = NList l-        go (NVSetF s p) = NSet-            [ NamedVar (StaticKey k :| []) v (fromMaybe nullPos (M.lookup k p))-            | (k, v) <- toList s ]-        go (NVClosureF _ _) = NSym . pack $ "<closure>"-        go (NVPathF p) = NLiteralPath p-        go (NVBuiltinF name _) = NSym $ Text.pack $ "builtins." ++ name+printNix :: forall t f m . MonadDataContext f m => NValueNF t f m -> String+printNix = iterNValueNF (const "<CYCLE>") phi+ where+  phi :: NValue' t f m String -> String+  phi (NVConstant a ) = unpack $ atomText a+  phi (NVStr      ns) = show $ hackyStringIgnoreContext ns+  phi (NVList     l ) = "[ " ++ unwords l ++ " ]"+  phi (NVSet s _) =+    "{ "+      ++ concat+           [ check (unpack k) ++ " = " ++ v ++ "; "+           | (k, v) <- sort $ toList s+           ]+      ++ "}"+   where+    check v = fromMaybe+      v+      (   (fmap (surround . show) (readMaybe v :: Maybe Int))+      <|> (fmap (surround . show) (readMaybe v :: Maybe Float))+      )+      where surround s = "\"" ++ s ++ "\""+  phi NVClosure{}        = "<<lambda>>"+  phi (NVPath fp       ) = fp+  phi (NVBuiltin name _) = "<<builtin " ++ name ++ ">>"+  phi _                  = error "Pattern synonyms foil completeness check" -printNix :: Functor m => NValueNF m -> String-printNix = cata phi-  where phi :: NValueF m String -> String-        phi (NVConstantF a) = unpack $ atomText a-        phi (NVStrF t _) = show t-        phi (NVListF l) = "[ " ++ unwords l ++ " ]"-        phi (NVSetF s _) =-            "{ " ++ concat [ unpack k ++ " = " ++ v ++ "; "-                           | (k, v) <- sort $ toList s ] ++ "}"-        phi NVClosureF {} = "<<lambda>>"-        phi (NVPathF fp) = fp-        phi (NVBuiltinF name _) = "<<builtin " ++ name ++ ">>"+prettyNValue+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => NValue t f m+  -> m (Doc ann)+prettyNValue = fmap prettyNValueNF . removeEffectsM -removeEffects :: Functor m => NValueF m (NThunk m) -> NValueNF m-removeEffects = Fix . fmap dethunk-  where-    dethunk (NThunk _ (Value v)) = removeEffects (_baseValue v)-    dethunk (NThunk _ _) = Fix $ NVStrF "<thunk>" mempty+prettyNValueProv+  :: forall t f m ann+   . ( HasCitations1 t m (NValue t f m) f+     , MonadThunk t m (NValue t f m)+     , MonadDataContext f m+     )+  => NValue t f m+  -> m (Doc ann)+prettyNValueProv v@(NValue nv) = do+  let ps = citations1 @t @m @(NValue t f m) @f nv+  case ps of+    [] -> prettyNValue v+    ps -> do+      v' <- prettyNValue v+      pure+        $ fillSep+        $ [ v'+          , indent 2+          $ parens+          $ mconcat+          $ "from: "+          : map (prettyOriginExpr . _originExpr) ps+          ] -removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)-removeEffectsM = fmap Fix . traverse dethunk+prettyNThunk+  :: forall t f m ann+   . ( HasCitations t m (NValue t f m) t+     , HasCitations1 t m (NValue t f m) f+     , MonadThunk t m (NValue t f m)+     , MonadDataContext f m+     )+  => t+  -> m (Doc ann)+prettyNThunk t = do+  let ps = citations @t @m @(NValue t f m) @t t+  v' <- prettyNValueNF <$> dethunk t+  pure+    $ fillSep+    $ [ v'+      , indent 2+      $ parens+      $ mconcat+      $ "thunk from: "+      : map (prettyOriginExpr . _originExpr) ps+      ] -prettyNValueF :: MonadVar m => NValueF m (NThunk m) -> m Doc-prettyNValueF = fmap prettyNValueNF . removeEffectsM -prettyNValue :: MonadVar m => NValue m -> m Doc-prettyNValue (NValue _ v) = prettyNValueF v -prettyNValueProv :: MonadVar m => NValue m -> m Doc-prettyNValueProv = \case-    NValue [] v -> prettyNValueF v-    NValue ps v -> do-        v' <- prettyNValueF v-        pure $ v' </> indent 2 (parens (mconcat-            (text "from: " : map (prettyOriginExpr . _originExpr) ps))) -prettyNThunk :: MonadVar m => NThunk m -> m Doc-prettyNThunk = \case-    t@(NThunk ps _) -> do-        v' <- fmap prettyNValueNF (dethunk t)-        pure $ v' </> indent 2 (parens (mconcat-            (text "thunk from: " : map (prettyOriginExpr . _originExpr) ps))) -dethunk :: MonadVar m => NThunk m -> m (NValueNF m)-dethunk = \case-    NThunk _ (Value v) -> removeEffectsM (_baseValue v)-    NThunk _ (Thunk _ active ref) -> do-        nowActive <- atomicModifyVar active (True,)-        if nowActive-            then pure $ Fix $ NVStrF "<thunk>" mempty-            else do-                eres <- readVar ref-                case eres of-                    Computed v -> removeEffectsM (_baseValue v)-                    _ -> pure $ Fix $ NVStrF "<thunk>" mempty+++
src/Nix/Reduce.hs view
@@ -32,31 +32,39 @@ module Nix.Reduce (reduceExpr, reducingEvalExpr) where  import           Control.Applicative-import           Control.Arrow (second)+import           Control.Arrow                  ( second ) import           Control.Monad import           Control.Monad.Catch+import           Control.Monad.Fail import           Control.Monad.Fix import           Control.Monad.IO.Class import           Control.Monad.Reader import           Control.Monad.State.Strict-import           Control.Monad.Trans.Reader (ReaderT(..))-import           Control.Monad.Trans.State.Strict (StateT(..))+import           Control.Monad.Trans.Reader     ( ReaderT(..) )+import           Control.Monad.Trans.State.Strict+                                                ( StateT(..) ) import           Data.Fix -- import           Data.Foldable-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M -- import           Data.HashSet (HashSet) -- import qualified Data.HashSet as S import           Data.IORef-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import           Data.Maybe (fromMaybe, mapMaybe, catMaybes)-import           Data.Text (Text)+import           Data.List.NonEmpty             ( NonEmpty(..) )+import qualified Data.List.NonEmpty            as NE+import           Data.Maybe                     ( fromMaybe+                                                , mapMaybe+                                                , catMaybes+                                                )+import           Data.Text                      ( Text ) import           Nix.Atoms import           Nix.Exec import           Nix.Expr import           Nix.Frames-import           Nix.Options (Options, reduceSets, reduceLists)+import           Nix.Options                    ( Options+                                                , reduceSets+                                                , reduceLists+                                                ) import           Nix.Parser import           Nix.Scope import           Nix.Utils@@ -67,103 +75,116 @@     { runReducer :: ReaderT (Maybe FilePath, Scopes (Reducer m) NExprLoc)                            (StateT (HashMap FilePath NExprLoc) m) a }     deriving (Functor, Applicative, Alternative, Monad, MonadPlus,-              MonadFix, MonadIO,+              MonadFix, MonadIO, MonadFail,               MonadReader (Maybe FilePath, Scopes (Reducer m) NExprLoc),               MonadState (HashMap FilePath NExprLoc))  staticImport-    :: forall e m.-      (MonadIO m, Scoped e NExprLoc m,-       MonadReader (Maybe FilePath, Scopes m NExprLoc) m,-       MonadState (HashMap FilePath NExprLoc) m)-    => SrcSpan -> FilePath -> m NExprLoc+  :: forall m+   . ( MonadIO m+     , Scoped NExprLoc m+     , MonadFail m+     , MonadReader (Maybe FilePath, Scopes m NExprLoc) m+     , MonadState (HashMap FilePath NExprLoc) m+     )+  => SrcSpan+  -> FilePath+  -> m NExprLoc staticImport pann path = do-    mfile <- asks fst-    path  <- liftIO $ pathToDefaultNixFile path-    path' <- liftIO $ pathToDefaultNixFile =<< canonicalizePath-        (maybe path (\p -> takeDirectory p </> path) mfile)+  mfile <- asks fst+  path  <- liftIO $ pathToDefaultNixFile path+  path' <- liftIO $ pathToDefaultNixFile =<< canonicalizePath+    (maybe path (\p -> takeDirectory p </> path) mfile) -    imports <- get-    case M.lookup path' imports of-        Just expr -> pure expr-        Nothing -> go path'-  where-    go path = do-        liftIO $ putStrLn $ "Importing file " ++ path+  imports <- get+  case M.lookup path' imports of+    Just expr -> pure expr+    Nothing   -> go path'+ where+  go path = do+    liftIO $ putStrLn $ "Importing file " ++ path -        eres <- liftIO $ parseNixFileLoc path-        case eres of-            Failure err  -> error $ "Parse failed: " ++ show err-            Success x -> do-                let pos  = SourcePos "Reduce.hs" (mkPos 1) (mkPos 1)-                    span = SrcSpan pos pos-                    cur  = NamedVar (StaticKey "__cur_file" :| [])-                        (Fix (NLiteralPath_ pann path)) pos-                    x'   = Fix (NLet_ span [cur] x)-                modify (M.insert path x')-                local (const (Just path, emptyScopes @m @NExprLoc)) $ do-                    x'' <- cata reduce x'-                    modify (M.insert path x'')-                    return x''+    eres <- liftIO $ parseNixFileLoc path+    case eres of+      Failure err -> error $ "Parse failed: " ++ show err+      Success x   -> do+        let+          pos  = SourcePos "Reduce.hs" (mkPos 1) (mkPos 1)+          span = SrcSpan pos pos+          cur  = NamedVar (StaticKey "__cur_file" :| [])+                          (Fix (NLiteralPath_ pann path))+                          pos+          x' = Fix (NLet_ span [cur] x)+        modify (M.insert path x')+        local (const (Just path, emptyScopes @m @NExprLoc)) $ do+          x'' <- cata reduce x'+          modify (M.insert path x'')+          return x''  -- gatherNames :: NExprLoc -> HashSet VarName -- gatherNames = cata $ \case --     NSym_ _ var -> S.singleton var --     Compose (Ann _ x) -> fold x -reduceExpr :: MonadIO m => Maybe FilePath -> NExprLoc -> m NExprLoc-reduceExpr mpath expr-    = (`evalStateT` M.empty)+reduceExpr+  :: (MonadIO m, MonadFail m) => Maybe FilePath -> NExprLoc -> m NExprLoc+reduceExpr mpath expr =+  (`evalStateT` M.empty)     . (`runReaderT` (mpath, emptyScopes))     . runReducer     $ cata reduce expr -reduce :: forall e m.-           (MonadIO m, Scoped e NExprLoc m,-            MonadReader (Maybe FilePath, Scopes m NExprLoc) m,-            MonadState (HashMap FilePath NExprLoc) m)-       => NExprLocF (m NExprLoc) -> m NExprLoc+reduce+  :: forall m+   . ( MonadIO m+     , Scoped NExprLoc m+     , MonadFail m+     , MonadReader (Maybe FilePath, Scopes m NExprLoc) m+     , MonadState (HashMap FilePath NExprLoc) m+     )+  => NExprLocF (m NExprLoc)+  -> m NExprLoc  -- | Reduce the variable to its value if defined. --   Leave it as it is otherwise. reduce (NSym_ ann var) = lookupVar var <&> \case-    Nothing -> Fix (NSym_ ann var)-    Just v  -> v+  Nothing -> Fix (NSym_ ann var)+  Just v  -> v  -- | Reduce binary and integer negation. reduce (NUnary_ uann op arg) = arg >>= \x -> case (op, x) of-    (NNeg, Fix (NConstant_ cann (NInt n))) ->-        return $ Fix $ NConstant_ cann (NInt (negate n))-    (NNot, Fix (NConstant_ cann (NBool b))) ->-        return $ Fix $ NConstant_ cann (NBool (not b))-    _ -> return $ Fix $ NUnary_ uann op x+  (NNeg, Fix (NConstant_ cann (NInt n))) ->+    return $ Fix $ NConstant_ cann (NInt (negate n))+  (NNot, Fix (NConstant_ cann (NBool b))) ->+    return $ Fix $ NConstant_ cann (NBool (not b))+  _ -> return $ Fix $ NUnary_ uann op x  -- | Reduce function applications. -- --     * Reduce an import to the actual imported expression. -- --     * Reduce a lambda function by adding its name to the local---       scope and recursively reducing its body. +--       scope and recursively reducing its body. reduce (NBinary_ bann NApp fun arg) = fun >>= \case-    f@(Fix (NSym_ _ "import")) -> arg >>= \case-        -- Fix (NEnvPath_     pann origPath) -> staticImport pann origPath-        Fix (NLiteralPath_ pann origPath) -> staticImport pann origPath-        v -> return $ Fix $ NBinary_ bann NApp f v+  f@(Fix (NSym_ _ "import")) -> arg >>= \case+      -- Fix (NEnvPath_     pann origPath) -> staticImport pann origPath+    Fix (NLiteralPath_ pann origPath) -> staticImport pann origPath+    v -> return $ Fix $ NBinary_ bann NApp f v -    Fix (NAbs_ _ (Param name) body) -> do-        x <- arg-        pushScope (M.singleton name x) (cata reduce body)+  Fix (NAbs_ _ (Param name) body) -> do+    x <- arg+    pushScope (M.singleton name x) (cata reduce body) -    f -> Fix . NBinary_ bann NApp f <$> arg+  f -> Fix . NBinary_ bann NApp f <$> arg  -- | Reduce an integer addition to its result. reduce (NBinary_ bann op larg rarg) = do-    lval <- larg-    rval <- rarg-    case (op, lval, rval) of-        (NPlus, Fix (NConstant_ ann (NInt x)), Fix (NConstant_ _ (NInt y))) ->-            return $ Fix (NConstant_ ann (NInt (x + y)))-        _ -> pure $ Fix $ NBinary_ bann op lval rval+  lval <- larg+  rval <- rarg+  case (op, lval, rval) of+    (NPlus, Fix (NConstant_ ann (NInt x)), Fix (NConstant_ _ (NInt y))) ->+      return $ Fix (NConstant_ ann (NInt (x + y)))+    _ -> pure $ Fix $ NBinary_ bann op lval rval  -- | Reduce a select on a Set by substituing the set to the selected value. --@@ -173,70 +194,69 @@ --   2. The selection AttrPath is a list of StaticKeys. --   3. The selected AttrPath exists in the set. reduce base@(NSelect_ _ _ attrs _)-    | sAttrPath $ NE.toList attrs = do-      (NSelect_ _ aset attrs _) <- sequence base-      inspectSet (unFix aset) attrs-    | otherwise = sId-  where-    sId = Fix <$> sequence base-    -- The selection AttrPath is composed of StaticKeys.-    sAttrPath (StaticKey _:xs) = sAttrPath xs-    sAttrPath []               = True-    sAttrPath _                = False-    -- Find appropriate bind in set's binds.-    findBind [] _                = Nothing-    findBind (x:xs) attrs@(a:|_) = case x of-        n@(NamedVar (a':|_) _ _) | a' == a -> Just n-        _                                  -> findBind xs attrs-    -- Follow the attrpath recursively in sets.-    inspectSet (NSet_ _ binds) attrs = case findBind binds attrs of-       Just (NamedVar _ e _) -> case NE.uncons attrs of -               (_,Just attrs) -> inspectSet (unFix e) attrs-               _              -> pure e-       _ -> sId-    inspectSet _ _ = sId+  | sAttrPath $ NE.toList attrs = do+    (NSelect_ _ aset attrs _) <- sequence base+    inspectSet (unFix aset) attrs+  | otherwise = sId+ where+  sId = Fix <$> sequence base+  -- The selection AttrPath is composed of StaticKeys.+  sAttrPath (StaticKey _ : xs) = sAttrPath xs+  sAttrPath []                 = True+  sAttrPath _                  = False+  -- Find appropriate bind in set's binds.+  findBind []       _              = Nothing+  findBind (x : xs) attrs@(a :| _) = case x of+    n@(NamedVar (a' :| _) _ _) | a' == a -> Just n+    _ -> findBind xs attrs+  -- Follow the attrpath recursively in sets.+  inspectSet (NSet_ _ binds) attrs = case findBind binds attrs of+    Just (NamedVar _ e _) -> case NE.uncons attrs of+      (_, Just attrs) -> inspectSet (unFix e) attrs+      _               -> pure e+    _ -> sId+  inspectSet _ _ = sId  -- reduce (NHasAttr aset attr) =  -- | Reduce a set by inlining its binds outside of the set --   if none of the binds inherit the super set. reduce e@(NSet_ ann binds) = do-    let usesInherit = flip any binds $ \case-            Inherit {} -> True-            _ -> False-    if usesInherit-        then clearScopes @NExprLoc $-            Fix . NSet_ ann <$> traverse sequence binds-        else Fix <$> sequence e+  let usesInherit = flip any binds $ \case+        Inherit{} -> True+        _         -> False+  if usesInherit+    then clearScopes @NExprLoc $ Fix . NSet_ ann <$> traverse sequence binds+    else Fix <$> sequence e  -- Encountering a 'rec set' construction eliminates any hope of inlining -- definitions. reduce (NRecSet_ ann binds) =-    clearScopes @NExprLoc $ Fix . NRecSet_ ann <$> traverse sequence binds+  clearScopes @NExprLoc $ Fix . NRecSet_ ann <$> traverse sequence binds  -- Encountering a 'with' construction eliminates any hope of inlining -- definitions. reduce (NWith_ ann scope body) =-    clearScopes @NExprLoc $ fmap Fix $ NWith_ ann <$> scope <*> body+  clearScopes @NExprLoc $ fmap Fix $ NWith_ ann <$> scope <*> body  -- | Reduce a let binds section by pushing lambdas, --   constants and strings to the body scope. reduce (NLet_ ann binds body) = do-    s <- fmap (M.fromList . catMaybes) $ forM binds $ \case-        NamedVar (StaticKey name :| []) def _pos -> def >>= \case-            d@(Fix NAbs_ {})      -> pure $ Just (name, d)-            d@(Fix NConstant_ {}) -> pure $ Just (name, d)-            d@(Fix NStr_ {})      -> pure $ Just (name, d)-            _ -> pure Nothing-        _ -> pure Nothing-    body' <- pushScope s body-    binds' <- traverse sequence binds-    -- let names = gatherNames body'-    -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case-    --     NamedVar (StaticKey name _ :| []) _ ->-    --         name `S.member` names-    --     _ -> True-    pure $ Fix $ NLet_ ann binds' body'+  s <- fmap (M.fromList . catMaybes) $ forM binds $ \case+    NamedVar (StaticKey name :| []) def _pos -> def >>= \case+      d@(Fix NAbs_{}     ) -> pure $ Just (name, d)+      d@(Fix NConstant_{}) -> pure $ Just (name, d)+      d@(Fix NStr_{}     ) -> pure $ Just (name, d)+      _                    -> pure Nothing+    _ -> pure Nothing+  body'  <- pushScope s body+  binds' <- traverse sequence binds+  -- let names = gatherNames body'+  -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case+  --     NamedVar (StaticKey name _ :| []) _ ->+  --         name `S.member` names+  --     _ -> True+  pure $ Fix $ NLet_ ann binds' body'   -- where   --   go m [] = pure m   --   go m (x:xs) = case x of@@ -248,24 +268,24 @@ -- | Reduce an if to the relevant path if --   the condition is a boolean constant. reduce e@(NIf_ _ b t f) = b >>= \case-    Fix (NConstant_ _ (NBool b')) -> if b' then t else f-    _ -> Fix <$> sequence e+  Fix (NConstant_ _ (NBool b')) -> if b' then t else f+  _                             -> Fix <$> sequence e  -- | Reduce an assert atom to its encapsulated --   symbol if the assertion is a boolean constant. reduce e@(NAssert_ _ b body) = b >>= \case-    Fix (NConstant_ _ (NBool b')) | b' -> body-    _ -> Fix <$> sequence e+  Fix (NConstant_ _ (NBool b')) | b' -> body+  _ -> Fix <$> sequence e  reduce (NAbs_ ann params body) = do-    params' <- sequence params-    -- Make sure that variable definitions in scope do not override function-    -- arguments.-    let args = case params' of-            Param name -> M.singleton name (Fix (NSym_ ann name))-            ParamSet pset _ _ ->-                M.fromList $ map (\(k, _) -> (k, Fix (NSym_ ann k))) pset-    Fix . NAbs_ ann params' <$> pushScope args body+  params' <- sequence params+  -- Make sure that variable definitions in scope do not override function+  -- arguments.+  let args = case params' of+        Param name -> M.singleton name (Fix (NSym_ ann name))+        ParamSet pset _ _ ->+          M.fromList $ map (\(k, _) -> (k, Fix (NSym_ ann k))) pset+  Fix . NAbs_ ann params' <$> pushScope args body  reduce v = Fix <$> sequence v @@ -274,136 +294,136 @@     deriving (Functor, Foldable, Traversable)  instance Show (f r) => Show (FlaggedF f r) where-    show (FlaggedF (_, x)) = show x+  show (FlaggedF (_, x)) = show x  type Flagged f = Fix (FlaggedF f) -flagExprLoc :: (MonadIO n, Traversable f)-            => Fix f -> n (Flagged f)+flagExprLoc :: (MonadIO n, Traversable f) => Fix f -> n (Flagged f) flagExprLoc = cataM $ \x -> do-    flag <- liftIO $ newIORef False-    pure $ Fix $ FlaggedF (flag, x)+  flag <- liftIO $ newIORef False+  pure $ Fix $ FlaggedF (flag, x)  -- stripFlags :: Functor f => Flagged f -> Fix f -- stripFlags = cata $ Fix . snd . flagged  pruneTree :: MonadIO n => Options -> Flagged NExprLocF -> n (Maybe NExprLoc) pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do-    used <- liftIO $ readIORef b-    pure $ if used-           then Fix . Compose <$> traverse prune x-           else Nothing-  where-    prune :: NExprF (Maybe NExprLoc) -> Maybe (NExprF NExprLoc)-    prune = \case-        NStr str                  -> Just $ NStr (pruneString str)-        NHasAttr (Just aset) attr -> Just $ NHasAttr aset (NE.map pruneKeyName attr)-        NAbs params (Just body)   -> Just $ NAbs (pruneParams params) body+  used <- liftIO $ readIORef b+  pure $ if used then Fix . Compose <$> traverse prune x else Nothing+ where+  prune :: NExprF (Maybe NExprLoc) -> Maybe (NExprF NExprLoc)+  prune = \case+    NStr str -> Just $ NStr (pruneString str)+    NHasAttr (Just aset) attr ->+      Just $ NHasAttr aset (NE.map pruneKeyName attr)+    NAbs params (Just body) -> Just $ NAbs (pruneParams params) body -        NList l       | reduceLists opts -> Just $ NList   (catMaybes l)-                      | otherwise        -> Just $ NList   (map (fromMaybe nNull) l)-        NSet binds    | reduceSets opts  -> Just $ NSet    (mapMaybe sequence binds)-                      | otherwise        -> Just $ NSet    (map (fmap (fromMaybe nNull)) binds)-        NRecSet binds | reduceSets opts  -> Just $ NRecSet (mapMaybe sequence binds)-                      | otherwise        -> Just $ NRecSet (map (fmap (fromMaybe nNull)) binds)+    NList l | reduceLists opts -> Just $ NList (catMaybes l)+            | otherwise        -> Just $ NList (map (fromMaybe nNull) l)+    NSet binds | reduceSets opts -> Just $ NSet (mapMaybe sequence binds)+               | otherwise -> Just $ NSet (map (fmap (fromMaybe nNull)) binds)+    NRecSet binds+      | reduceSets opts -> Just $ NRecSet (mapMaybe sequence binds)+      | otherwise       -> Just $ NRecSet (map (fmap (fromMaybe nNull)) binds) -        NLet binds (Just body@(Fix (Compose (Ann _ x)))) ->-            Just $ case mapMaybe pruneBinding binds of-                [] -> x-                xs -> NLet xs body+    NLet binds (Just body@(Fix (Compose (Ann _ x)))) ->+      Just $ case mapMaybe pruneBinding binds of+        [] -> x+        xs -> NLet xs body -        NSelect (Just aset) attr alt ->-            Just $ NSelect aset (NE.map pruneKeyName attr) (join alt)+    NSelect (Just aset) attr alt ->+      Just $ NSelect aset (NE.map pruneKeyName attr) (join alt) -        -- These are the only short-circuiting binary operators-        NBinary NAnd (Just (Fix (Compose (Ann _ larg)))) _ -> Just larg-        NBinary NOr  (Just (Fix (Compose (Ann _ larg)))) _ -> Just larg+    -- These are the only short-circuiting binary operators+    NBinary NAnd (Just (Fix (Compose (Ann _ larg)))) _ -> Just larg+    NBinary NOr (Just (Fix (Compose (Ann _ larg)))) _ -> Just larg -        -- If the function was never called, it means its argument was in a-        -- thunk that was forced elsewhere.-        NBinary NApp Nothing (Just _) -> Nothing+    -- If the function was never called, it means its argument was in a+    -- thunk that was forced elsewhere.+    NBinary NApp Nothing (Just _) -> Nothing -        -- The idea behind emitted a binary operator where one side may be-        -- invalid is that we're trying to emit what will reproduce whatever-        -- error the user encountered, which means providing all aspects of-        -- the evaluation path they ultimately followed.-        NBinary op Nothing (Just rarg) -> Just $ NBinary op nNull rarg-        NBinary op (Just larg) Nothing -> Just $ NBinary op larg nNull+    -- The idea behind emitted a binary operator where one side may be+    -- invalid is that we're trying to emit what will reproduce whatever+    -- error the user encountered, which means providing all aspects of+    -- the evaluation path they ultimately followed.+    NBinary op Nothing (Just rarg) -> Just $ NBinary op nNull rarg+    NBinary op (Just larg) Nothing -> Just $ NBinary op larg nNull -        -- If the scope of a with was never referenced, it's not needed-        NWith Nothing (Just (Fix (Compose (Ann _ body)))) -> Just body+    -- If the scope of a with was never referenced, it's not needed+    NWith Nothing (Just (Fix (Compose (Ann _ body)))) -> Just body -        NAssert Nothing _ ->-            error "How can an assert be used, but its condition not?"+    NAssert Nothing _ ->+      error "How can an assert be used, but its condition not?" -        NAssert _ (Just (Fix (Compose (Ann _ body)))) -> Just body-        NAssert (Just cond) _ -> Just $ NAssert cond nNull+    NAssert _ (Just (Fix (Compose (Ann _ body)))) -> Just body+    NAssert (Just cond) _ -> Just $ NAssert cond nNull -        NIf Nothing _ _ ->-            error "How can an if be used, but its condition not?"+    NIf Nothing _ _ -> error "How can an if be used, but its condition not?" -        NIf _ Nothing (Just (Fix (Compose (Ann _ f)))) -> Just f-        NIf _ (Just (Fix (Compose (Ann _ t)))) Nothing -> Just t+    NIf _ Nothing (Just (Fix (Compose (Ann _ f)))) -> Just f+    NIf _ (Just (Fix (Compose (Ann _ t)))) Nothing -> Just t -        x -> sequence x+    x                     -> sequence x -    pruneString :: NString (Maybe NExprLoc) -> NString NExprLoc-    pruneString (DoubleQuoted xs) =-        DoubleQuoted (mapMaybe pruneAntiquotedText xs)-    pruneString (Indented n xs)   =-        Indented n (mapMaybe pruneAntiquotedText xs)+  pruneString :: NString (Maybe NExprLoc) -> NString NExprLoc+  pruneString (DoubleQuoted xs) =+    DoubleQuoted (mapMaybe pruneAntiquotedText xs)+  pruneString (Indented n xs) = Indented n (mapMaybe pruneAntiquotedText xs) -    pruneAntiquotedText-        :: Antiquoted Text (Maybe NExprLoc)-        -> Maybe (Antiquoted Text NExprLoc)-    pruneAntiquotedText (Plain v)             = Just (Plain v)-    pruneAntiquotedText EscapedNewline        = Just EscapedNewline-    pruneAntiquotedText (Antiquoted Nothing)  = Nothing-    pruneAntiquotedText (Antiquoted (Just k)) = Just (Antiquoted k)+  pruneAntiquotedText+    :: Antiquoted Text (Maybe NExprLoc) -> Maybe (Antiquoted Text NExprLoc)+  pruneAntiquotedText (Plain v)             = Just (Plain v)+  pruneAntiquotedText EscapedNewline        = Just EscapedNewline+  pruneAntiquotedText (Antiquoted Nothing ) = Nothing+  pruneAntiquotedText (Antiquoted (Just k)) = Just (Antiquoted k) -    pruneAntiquoted-        :: Antiquoted (NString (Maybe NExprLoc)) (Maybe NExprLoc)-        -> Maybe (Antiquoted (NString NExprLoc) NExprLoc)-    pruneAntiquoted (Plain v)             = Just (Plain (pruneString v))-    pruneAntiquoted EscapedNewline        = Just EscapedNewline-    pruneAntiquoted (Antiquoted Nothing)  = Nothing-    pruneAntiquoted (Antiquoted (Just k)) = Just (Antiquoted k)+  pruneAntiquoted+    :: Antiquoted (NString (Maybe NExprLoc)) (Maybe NExprLoc)+    -> Maybe (Antiquoted (NString NExprLoc) NExprLoc)+  pruneAntiquoted (Plain v)             = Just (Plain (pruneString v))+  pruneAntiquoted EscapedNewline        = Just EscapedNewline+  pruneAntiquoted (Antiquoted Nothing ) = Nothing+  pruneAntiquoted (Antiquoted (Just k)) = Just (Antiquoted k) -    pruneKeyName :: NKeyName (Maybe NExprLoc) -> NKeyName NExprLoc-    pruneKeyName (StaticKey n) = StaticKey n-    pruneKeyName (DynamicKey k)-        | Just k' <- pruneAntiquoted k = DynamicKey k'-        | otherwise = StaticKey "<unused?>"+  pruneKeyName :: NKeyName (Maybe NExprLoc) -> NKeyName NExprLoc+  pruneKeyName (StaticKey n) = StaticKey n+  pruneKeyName (DynamicKey k) | Just k' <- pruneAntiquoted k = DynamicKey k'+                              | otherwise = StaticKey "<unused?>" -    pruneParams :: Params (Maybe NExprLoc) -> Params NExprLoc-    pruneParams (Param n) = Param n-    pruneParams (ParamSet xs b n)-        | reduceSets opts =-              ParamSet (map (second (maybe (Just nNull) Just-                                     . fmap (fromMaybe nNull))) xs) b n-        | otherwise =-              ParamSet (map (second (fmap (fromMaybe nNull))) xs) b n+  pruneParams :: Params (Maybe NExprLoc) -> Params NExprLoc+  pruneParams (Param n) = Param n+  pruneParams (ParamSet xs b n)+    | reduceSets opts = ParamSet+      (map (second (maybe (Just nNull) Just . fmap (fromMaybe nNull))) xs)+      b+      n+    | otherwise = ParamSet (map (second (fmap (fromMaybe nNull))) xs) b n -    pruneBinding :: Binding (Maybe NExprLoc) -> Maybe (Binding NExprLoc)-    pruneBinding (NamedVar _ Nothing _)  = Nothing-    pruneBinding (NamedVar xs (Just x) pos) =-        Just (NamedVar (NE.map pruneKeyName xs) x pos)-    pruneBinding (Inherit _ [] _)  = Nothing-    pruneBinding (Inherit (join -> Nothing) _ _) = Nothing-    pruneBinding (Inherit (join -> m) xs pos) =-        Just (Inherit m (map pruneKeyName xs) pos)+  pruneBinding :: Binding (Maybe NExprLoc) -> Maybe (Binding NExprLoc)+  pruneBinding (NamedVar _ Nothing _) = Nothing+  pruneBinding (NamedVar xs (Just x) pos) =+    Just (NamedVar (NE.map pruneKeyName xs) x pos)+  pruneBinding (Inherit _                 [] _) = Nothing+  pruneBinding (Inherit (join -> Nothing) _  _) = Nothing+  pruneBinding (Inherit (join -> m) xs pos) =+    Just (Inherit m (map pruneKeyName xs) pos)  reducingEvalExpr-    :: (Framed e m, Has e Options, Exception r, MonadCatch m, MonadIO m)-    => (NExprLocF (m a) -> m a)-    -> Maybe FilePath-    -> NExprLoc-    -> m (NExprLoc, Either r a)+  :: (Framed e m, Has e Options, Exception r, MonadCatch m, MonadIO m)+  => (NExprLocF (m a) -> m a)+  -> Maybe FilePath+  -> NExprLoc+  -> m (NExprLoc, Either r a) reducingEvalExpr eval mpath expr = do-    expr'  <- flagExprLoc =<< liftIO (reduceExpr mpath expr)-    eres   <- catch (Right <$> cata (addEvalFlags eval) expr') (pure . Left)-    opts :: Options <- asks (view hasLens)-    expr'' <- pruneTree opts expr'-    return (fromMaybe nNull expr'', eres)-  where-    addEvalFlags k (FlaggedF (b, x)) = liftIO (writeIORef b True) *> k x+  expr'           <- flagExprLoc =<< liftIO (reduceExpr mpath expr)+  eres <- catch (Right <$> cata (addEvalFlags eval) expr') (pure . Left)+  opts :: Options <- asks (view hasLens)+  expr''          <- pruneTree opts expr'+  return (fromMaybe nNull expr'', eres)+  where addEvalFlags k (FlaggedF (b, x)) = liftIO (writeIORef b True) *> k x++instance Monad m => Scoped NExprLoc (Reducer m) where+  currentScopes = currentScopesReader+  clearScopes   = clearScopesReader @(Reducer m) @NExprLoc+  pushScopes    = pushScopesReader+  lookupVar     = lookupVarReader
src/Nix/Render.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -6,30 +7,120 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}  module Nix.Render where -import           Data.ByteString (ByteString)-import           Data.List.NonEmpty (NonEmpty((:|)))-import qualified Data.Set as Set+import           Prelude                 hiding ( readFile )++import           Control.Monad.Trans+import           Data.ByteString                ( ByteString )+import qualified Data.ByteString               as BS+import qualified Data.Set                      as Set+import qualified Data.Text                     as T+import qualified Data.Text.Encoding            as T+import           Data.Text.Prettyprint.Doc import           Data.Void import           Nix.Expr.Types.Annotated+import qualified System.Directory              as S+import qualified System.Posix.Files            as S import           Text.Megaparsec.Error-import           Text.Megaparsec.Pos (SourcePos(..))-import           Text.PrettyPrint.ANSI.Leijen+import           Text.Megaparsec.Pos  class Monad m => MonadFile m where     readFile :: FilePath -> m ByteString+    default readFile :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m ByteString+    readFile = lift . readFile+    listDirectory :: FilePath -> m [FilePath]+    default listDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m [FilePath]+    listDirectory = lift . listDirectory+    getCurrentDirectory :: m FilePath+    default getCurrentDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => m FilePath+    getCurrentDirectory = lift getCurrentDirectory+    canonicalizePath :: FilePath -> m FilePath+    default canonicalizePath :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m FilePath+    canonicalizePath = lift . canonicalizePath+    getHomeDirectory :: m FilePath+    default getHomeDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => m FilePath+    getHomeDirectory = lift getHomeDirectory+    doesPathExist :: FilePath -> m Bool+    default doesPathExist :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m Bool+    doesPathExist = lift . doesPathExist+    doesFileExist :: FilePath -> m Bool+    default doesFileExist :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m Bool+    doesFileExist = lift . doesFileExist+    doesDirectoryExist :: FilePath -> m Bool+    default doesDirectoryExist :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m Bool+    doesDirectoryExist = lift . doesDirectoryExist+    getSymbolicLinkStatus :: FilePath -> m S.FileStatus+    default getSymbolicLinkStatus :: (MonadTrans t, MonadFile m', m ~ t m') => FilePath -> m S.FileStatus+    getSymbolicLinkStatus = lift . getSymbolicLinkStatus -posAndMsg :: SourcePos -> Doc -> ParseError t Void-posAndMsg beg msg =-    FancyError (beg :| [])-        (Set.fromList [ErrorFail (show msg) :: ErrorFancy Void])+instance MonadFile IO where+  readFile              = BS.readFile+  listDirectory         = S.listDirectory+  getCurrentDirectory   = S.getCurrentDirectory+  canonicalizePath      = S.canonicalizePath+  getHomeDirectory      = S.getHomeDirectory+  doesPathExist         = S.doesPathExist+  doesFileExist         = S.doesFileExist+  doesDirectoryExist    = S.doesDirectoryExist+  getSymbolicLinkStatus = S.getSymbolicLinkStatus -renderLocation :: MonadFile m => SrcSpan -> Doc -> m Doc-renderLocation (SrcSpan beg@(SourcePos "<string>" _ _) _) msg =-    return $ text $ init $ parseErrorPretty @Char (posAndMsg beg msg)+posAndMsg :: SourcePos -> Doc a -> ParseError s Void+posAndMsg (SourcePos _ lineNo _) msg = FancyError+  (unPos lineNo)+  (Set.fromList [ErrorFail (show msg) :: ErrorFancy Void]) -renderLocation (SrcSpan beg@(SourcePos path _ _) _) msg = do-    contents <- Nix.Render.readFile path-    return $ text $ init $ parseErrorPretty' contents (posAndMsg beg msg)+renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)+renderLocation (SrcSpan (SourcePos file begLine begCol) (SourcePos file' endLine endCol)) msg+  | file /= "<string>" && file == file'+  = do+    exist <- doesFileExist file+    if exist+      then do+        txt <- sourceContext file begLine begCol endLine endCol msg+        return+          $ vsep+              [ "In file "+              <> errorContext file begLine begCol endLine endCol+              <> ":"+              , txt+              ]+      else return msg+renderLocation (SrcSpan beg end) msg =+  fail+    $  "Don't know how to render range from "+    ++ show beg+    ++ " to "+    ++ show end+    ++ " for error: "+    ++ show msg++errorContext :: FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a+errorContext path bl bc _el _ec =+  pretty path <> ":" <> pretty (unPos bl) <> ":" <> pretty (unPos bc)++sourceContext+  :: MonadFile m => FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)+sourceContext path (unPos -> begLine) (unPos -> _begCol) (unPos -> endLine) (unPos -> _endCol) msg+  = do+    let beg' = max 1 (min begLine (begLine - 3))+        end' = max endLine (endLine + 3)+    ls <-+      map pretty+      .   take (end' - beg')+      .   drop (pred beg')+      .   T.lines+      .   T.decodeUtf8+      <$> readFile path+    let+      nums    = map (show . fst) $ zip [beg' ..] ls+      longest = maximum (map length nums)+      nums'   = flip map nums $ \n -> replicate (longest - length n) ' ' ++ n+      pad n | read n == begLine = "==> " ++ n+            | otherwise         = "    " ++ n+      ls' = zipWith (<+>)+                    (map (pretty . pad) nums')+                    (zipWith (<+>) (repeat "| ") ls)+    pure $ vsep $ ls' ++ [msg]
src/Nix/Render/Frame.hs view
@@ -16,6 +16,7 @@ import           Control.Monad.Reader import           Data.Fix import           Data.Typeable+import           Data.Text.Prettyprint.Doc import           Nix.Eval import           Nix.Exec import           Nix.Expr@@ -28,148 +29,208 @@ import           Nix.Utils import           Nix.Value import           Text.Megaparsec.Pos-import qualified Text.PrettyPrint.ANSI.Leijen as P-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) #ifdef MIN_VERSION_pretty_show import qualified Text.Show.Pretty as PS #endif -renderFrames :: forall v e m.-               (MonadReader e m, Has e Options,-                MonadVar m, MonadFile m, Typeable m, Typeable v)-             => Frames -> m Doc-renderFrames [] = pure mempty-renderFrames (x:xs) = do-    opts :: Options <- asks (view hasLens)-    frames <--        if | verbose opts <= ErrorsOnly ->-             renderFrame @v x-           | verbose opts <= Informational -> do-             f <- renderFrame @v x-             pure $ concatMap go (reverse xs) ++ f-           | otherwise ->-             concat <$> mapM (renderFrame @v) (reverse (x:xs))-    pure $ case frames of-        [] -> mempty-        _  -> foldr1 (P.<$>) frames-  where-    go :: NixFrame -> [Doc]-    go f = case framePos @v @m f of-        Just pos ->-            [text "While evaluating at "-                <> text (sourcePosPretty pos)-                <> colon]-        Nothing -> []+renderFrames+  :: forall v t f e m ann+   . ( MonadReader e m+     , Has e Options+     , MonadFile m+     , MonadCitedThunks t f m+     , Typeable v+     )+  => Frames+  -> m (Doc ann)+renderFrames []       = pure mempty+renderFrames (x : xs) = do+  opts :: Options <- asks (view hasLens)+  frames          <- if+    | verbose opts <= ErrorsOnly -> renderFrame @v @t @f x+    | verbose opts <= Informational -> do+      f <- renderFrame @v @t @f x+      pure $ concatMap go (reverse xs) ++ f+    | otherwise -> concat <$> mapM (renderFrame @v @t @f) (reverse (x : xs))+  pure $ case frames of+    [] -> mempty+    _  -> vsep frames+ where+  go :: NixFrame -> [Doc ann]+  go f = case framePos @v @m f of+    Just pos ->+      ["While evaluating at " <> pretty (sourcePosPretty pos) <> colon]+    Nothing -> [] -framePos :: forall v (m :: * -> *). (Typeable m, Typeable v) => NixFrame-         -> Maybe SourcePos+framePos+  :: forall v (m :: * -> *)+   . (Typeable m, Typeable v)+  => NixFrame+  -> Maybe SourcePos framePos (NixFrame _ f)-    | Just (e :: EvalFrame m v) <- fromException f = case e of-          EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) ->-              Just beg-          _ -> Nothing-    | otherwise = Nothing+  | Just (e :: EvalFrame m v) <- fromException f = case e of+    EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) -> Just beg+    _ -> Nothing+  | otherwise = Nothing -renderFrame :: forall v e m.-              (MonadReader e m, Has e Options, MonadVar m,-               MonadFile m, Typeable m, Typeable v)-            => NixFrame -> m [Doc]+renderFrame+  :: forall v t f e m ann+   . ( MonadReader e m+     , Has e Options+     , MonadFile m+     , MonadCitedThunks t f m+     , Typeable v+     )+  => NixFrame+  -> m [Doc ann] renderFrame (NixFrame level f)-    | Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e-    | Just (e :: ThunkLoop)     <- fromException f = renderThunkLoop level e-    | Just (e :: ValueFrame m)  <- fromException f = renderValueFrame level e-    | Just (_ :: NormalLoop m)  <- fromException f =-      pure [text "<<loop during normalization>>"]-    | Just (e :: ExecFrame m)   <- fromException f = renderExecFrame level e-    | Just (e :: ErrorCall)     <- fromException f = pure [text (show e)]-    | otherwise = error $ "Unrecognized frame: " ++ show f+  | Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e+  | Just (e :: ThunkLoop) <- fromException f = renderThunkLoop level e+  | Just (e :: ValueFrame t f m) <- fromException f = renderValueFrame level e+  | Just (e :: NormalLoop t f m) <- fromException f = renderNormalLoop level e+  | Just (e :: ExecFrame t f m) <- fromException f = renderExecFrame level e+  | Just (e :: ErrorCall) <- fromException f = pure [pretty (show e)]+  | Just (e :: SynHoleInfo m v) <- fromException f = pure [pretty (show e)]+  | otherwise = error $ "Unrecognized frame: " ++ show f  wrapExpr :: NExprF r -> NExpr wrapExpr x = Fix (Fix (NSym "<?>") <$ x) -renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)-                => NixLevel -> EvalFrame m v -> m [Doc]+renderEvalFrame+  :: (MonadReader e m, Has e Options, MonadFile m)+  => NixLevel+  -> EvalFrame m v+  -> m [Doc ann] renderEvalFrame level f = do-    opts :: Options <- asks (view hasLens)-    case f of-        EvaluatingExpr _scope e@(Fix (Compose (Ann ann _))) ->-            fmap (:[]) $ renderLocation ann-                =<< renderExpr level "While evaluating" "Expression" e+  opts :: Options <- asks (view hasLens)+  case f of+    EvaluatingExpr scope e@(Fix (Compose (Ann ann _))) -> do+      let scopeInfo | scopes opts = [pretty $ show scope]+                    | otherwise   = []+      fmap (\x -> scopeInfo ++ [x])+        $   renderLocation ann+        =<< renderExpr level "While evaluating" "Expression" e -        ForcingExpr _scope e@(Fix (Compose (Ann ann _)))-            | thunks opts ->-                  fmap (:[]) $ renderLocation ann-                      =<< renderExpr level "While forcing thunk from"-                                     "Forcing thunk" e+    ForcingExpr _scope e@(Fix (Compose (Ann ann _))) | thunks opts ->+      fmap (: [])+        $   renderLocation ann+        =<< renderExpr level "While forcing thunk from" "Forcing thunk" e -        Calling name ann ->-            fmap (:[]) $ renderLocation ann $-                text "While calling builtins." <> text name+    Calling name ann ->+      fmap (: [])+        $  renderLocation ann+        $  "While calling builtins."+        <> pretty name -        _ -> pure []+    SynHole synfo ->+      sequence+        $ let e@(Fix (Compose (Ann ann _))) = _synHoleInfo_expr synfo+          in  [ renderLocation ann+                =<< renderExpr level "While evaluating" "Syntactic Hole" e+              , pure $ pretty $ show (_synHoleInfo_scope synfo)+              ] -renderExpr :: (MonadReader e m, Has e Options, MonadFile m)-           => NixLevel -> String -> String -> NExprLoc -> m Doc+    ForcingExpr _ _ -> pure []+++renderExpr+  :: (MonadReader e m, Has e Options, MonadFile m)+  => NixLevel+  -> String+  -> String+  -> NExprLoc+  -> m (Doc ann) renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do-    opts :: Options <- asks (view hasLens)-    let rendered-            | verbose opts >= DebugInfo =+  opts :: Options <- asks (view hasLens)+  let rendered+          | verbose opts >= DebugInfo = #ifdef MIN_VERSION_pretty_show-              text (PS.ppShow (stripAnnotation e))+              pretty (PS.ppShow (stripAnnotation e)) #else-              text (show (stripAnnotation e))+              pretty (show (stripAnnotation e)) #endif-            | verbose opts >= Chatty =-              prettyNix (stripAnnotation e)-            | otherwise =-              prettyNix (Fix (Fix (NSym "<?>") <$ x))-    pure $ if verbose opts >= Chatty-           then text (longLabel ++ ":\n>>>>>>>>")-                    P.<$> indent 2 rendered-                    P.<$> text "<<<<<<<<"-           else text shortLabel <> text ": " </> rendered+          | verbose opts >= Chatty = prettyNix (stripAnnotation e)+          | otherwise = prettyNix (Fix (Fix (NSym "<?>") <$ x))+  pure $ if verbose opts >= Chatty+    then+      vsep+        $ [pretty (longLabel ++ ":\n>>>>>>>>"), indent 2 rendered, "<<<<<<<<"]+    else pretty shortLabel <> fillSep [": ", rendered] -renderValueFrame :: (MonadReader e m, Has e Options, MonadFile m)-                 => NixLevel -> ValueFrame m -> m [Doc]-renderValueFrame level = pure . (:[]) . \case-    ForcingThunk       -> text "ForcingThunk"-    ConcerningValue _v -> text "ConcerningValue"-    Comparison _ _     -> text "Comparing"-    Addition _ _       -> text "Adding"-    Division _ _       -> text "Dividing"-    Multiplication _ _ -> text "Multiplying"+renderValueFrame+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)+  => NixLevel+  -> ValueFrame t f m+  -> m [Doc ann]+renderValueFrame level = fmap (: []) . \case+  ForcingThunk       -> pure "ForcingThunk"+  ConcerningValue _v -> pure "ConcerningValue"+  Comparison     _ _ -> pure "Comparing"+  Addition       _ _ -> pure "Adding"+  Division       _ _ -> pure "Dividing"+  Multiplication _ _ -> pure "Multiplying" -    Coercion x y ->-        text desc <> text (describeValue x)-            <> text " to " <> text (describeValue y)-      where-        desc | level <= Error = "Cannot coerce "-             | otherwise     = "While coercing "+  Coercion       x y -> pure+    $ mconcat [desc, pretty (describeValue x), " to ", pretty (describeValue y)]+   where+    desc | level <= Error = "Cannot coerce "+         | otherwise      = "While coercing " -    CoercionToJsonNF _v -> text "CoercionToJsonNF"-    CoercionFromJson _j -> text "CoercionFromJson"-    ExpectationNF _t _v -> text "ExpectationNF"-    Expectation _t _v   -> text "Expectation"+  CoercionToJson v -> do+    v' <- renderValue level "" "" v+    pure $ "CoercionToJson " <> v'+  CoercionFromJson _j -> pure "CoercionFromJson"+  ExpectationNF _t _v -> pure "ExpectationNF"+  Expectation   t  v  -> do+    v' <- renderValue level "" "" v+    pure $ "Saw " <> v' <> " but expected " <> pretty (describeValue t) -renderValue :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)-            => NixLevel -> String -> String -> NValue m -> m Doc+renderValue+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)+  => NixLevel+  -> String+  -> String+  -> NValue t f m+  -> m (Doc ann) renderValue _level _longLabel _shortLabel v = do-    opts :: Options <- asks (view hasLens)-    if values opts-        then prettyNValueProv v-        else prettyNValue v+  opts :: Options <- asks (view hasLens)+  if values opts then prettyNValueProv v else prettyNValue v -renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)-                => NixLevel -> ExecFrame m -> m [Doc]+renderExecFrame+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)+  => NixLevel+  -> ExecFrame t f m+  -> m [Doc ann] renderExecFrame level = \case-    Assertion ann v ->-        fmap (:[]) $ renderLocation ann-            =<< ((text "Assertion failed:" </>)-                     <$> renderValue level "" "" v)+  Assertion ann v ->+    fmap (: [])+      $   renderLocation ann+      =<< (   (\d -> fillSep ["Assertion failed:", d])+          <$> renderValue level "" "" v+          ) -renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)-                => NixLevel -> ThunkLoop -> m [Doc]-renderThunkLoop _level = pure . (:[]) . \case-    ThunkLoop Nothing -> text "<<loop>>"-    ThunkLoop (Just n) ->-        text $ "<<loop forcing thunk #" ++ show n ++ ">>"+renderThunkLoop+  :: (MonadReader e m, Has e Options, MonadFile m, Show (ThunkId m))+  => NixLevel+  -> ThunkLoop+  -> m [Doc ann]+renderThunkLoop _level = pure . (: []) . \case+  ThunkLoop n -> pretty $ "Infinite recursion in thunk " ++ n++renderNormalLoop+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)+  => NixLevel+  -> NormalLoop t f m+  -> m [Doc ann]+renderNormalLoop level = fmap (: []) . \case+  NormalLoop v -> do+    v' <- renderValue level "" "" v+    pure $ "Infinite recursion during normalization forcing " <> v'++++++++
src/Nix/Scope.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -12,72 +15,84 @@  import           Control.Applicative import           Control.Monad.Reader-import qualified Data.HashMap.Lazy as M-import           Data.Semigroup-import           Data.Text (Text)+import qualified Data.HashMap.Lazy             as M+import           Data.Text                      ( Text ) import           Lens.Family2 import           Nix.Utils -newtype Scope a = Scope { getScope :: AttrSet a }-    deriving (Functor, Foldable, Traversable)+newtype Scope t = Scope { getScope :: AttrSet t }+    deriving (Functor, Foldable, Traversable, Eq) -instance Show (Scope a) where-    show (Scope m) = show (M.keys m)+instance Show (Scope t) where+  show (Scope m) = show (M.keys m) -newScope :: AttrSet a -> Scope a+newScope :: AttrSet t -> Scope t newScope = Scope -scopeLookup :: Text -> [Scope v] -> Maybe v+scopeLookup :: Text -> [Scope t] -> Maybe t scopeLookup key = foldr go Nothing-  where-    go (Scope m) rest = M.lookup key m <|> rest+  where go (Scope m) rest = M.lookup key m <|> rest -data Scopes m v = Scopes-    { lexicalScopes :: [Scope v]-    , dynamicScopes :: [m (Scope v)]+data Scopes m t = Scopes+    { lexicalScopes :: [Scope t]+    , dynamicScopes :: [m (Scope t)]     } -instance Show (Scopes m v) where-    show (Scopes m v) =-        "Scopes: " ++ show m ++ ", and "-            ++ show (length v) ++ " with-scopes"--instance Semigroup (Scopes m v) where-    Scopes ls lw <> Scopes rs rw = Scopes (ls <> rs) (lw <> rw)+instance Show (Scopes m t) where+  show (Scopes m t) =+    "Scopes: " ++ show m ++ ", and " ++ show (length t) ++ " with-scopes" -instance Monoid (Scopes m v) where-    mempty  = emptyScopes-    mappend = (<>)+instance Semigroup (Scopes m t) where+  Scopes ls lw <> Scopes rs rw = Scopes (ls <> rs) (lw <> rw) -type Scoped e v m = (MonadReader e m, Has e (Scopes m v))+instance Monoid (Scopes m t) where+  mempty  = emptyScopes+  mappend = (<>) -emptyScopes :: Scopes m v+emptyScopes :: forall m t . Scopes m t emptyScopes = Scopes [] [] -currentScopes :: Scoped e v m => m (Scopes m v)-currentScopes = asks (view hasLens)+class Scoped t m | m -> t where+  currentScopes :: m (Scopes m t)+  clearScopes :: m a -> m a+  pushScopes :: Scopes m t -> m a -> m a+  lookupVar :: Text -> m (Maybe t) -clearScopes :: forall v m e r. Scoped e v m => m r -> m r-clearScopes = local (set hasLens (emptyScopes @m @v))+currentScopesReader+  :: forall m t e . (MonadReader e m, Has e (Scopes m t)) => m (Scopes m t)+currentScopesReader = asks (view hasLens) -pushScope :: forall v m e r. Scoped e v m => AttrSet v -> m r -> m r+clearScopesReader+  :: forall m t e a . (MonadReader e m, Has e (Scopes m t)) => m a -> m a+clearScopesReader = local (set hasLens (emptyScopes @m @t))++pushScope :: Scoped t m => AttrSet t -> m a -> m a pushScope s = pushScopes (Scopes [Scope s] []) -pushWeakScope :: forall v m e r. Scoped e v m => m (AttrSet v) -> m r -> m r+pushWeakScope :: (Functor m, Scoped t m) => m (AttrSet t) -> m a -> m a pushWeakScope s = pushScopes (Scopes [] [Scope <$> s]) -pushScopes :: Scoped e v m => Scopes m v -> m r -> m r-pushScopes s = local (over hasLens (s <>))+pushScopesReader+  :: (MonadReader e m, Has e (Scopes m t)) => Scopes m t -> m a -> m a+pushScopesReader s = local (over hasLens (s <>)) -lookupVar :: forall e v m. (Scoped e v m, Monad m) => Text -> m (Maybe v)-lookupVar k = do-    mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)-    case mres of-        Just sym -> return $ Just sym-        Nothing -> do-            ws <- asks (dynamicScopes . view hasLens)-            foldr (\x -> liftM2 (<|>) (M.lookup k . getScope <$> x))-                  (return Nothing) ws+lookupVarReader+  :: forall m t e . (MonadReader e m, Has e (Scopes m t)) => Text -> m (Maybe t)+lookupVarReader k = do+  mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)+  case mres of+    Just sym -> return $ Just sym+    Nothing  -> do+      ws <- asks (dynamicScopes . view hasLens)+      foldr+        (\x rest -> do+          mres' <- M.lookup k . getScope <$> x+          case mres' of+            Just sym -> return $ Just sym+            Nothing  -> rest+        )+        (return Nothing)+        ws -withScopes :: forall v m e a. Scoped e v m => Scopes m v -> m a -> m a-withScopes scope = clearScopes @v . pushScopes scope+withScopes :: Scoped t m => Scopes m t -> m a -> m a+withScopes scope = clearScopes . pushScopes scope
+ src/Nix/String.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+module Nix.String+  ( NixString+  , principledGetContext+  , principledMakeNixString+  , principledMempty+  , StringContext(..)+  , ContextFlavor(..)+  , NixLikeContext(..)+  , NixLikeContextValue(..)+  , toNixLikeContext+  , fromNixLikeContext+  , stringHasContext+  , principledIntercalateNixString+  , hackyGetStringNoContext+  , principledGetStringNoContext+  , principledStringIgnoreContext+  , hackyStringIgnoreContext+  , hackyMakeNixStringWithoutContext+  , principledMakeNixStringWithoutContext+  , principledMakeNixStringWithSingletonContext+  , principledModifyNixContents+  , principledStringMappend+  , principledStringMempty+  , principledStringMConcat+  , WithStringContext+  , WithStringContextT(..)+  , extractNixString+  , addStringContext+  , addSingletonStringContext+  , runWithStringContextT+  , runWithStringContext+  )+where++import           Control.Monad.Writer+import           Data.Functor.Identity+import qualified Data.HashMap.Lazy             as M+import qualified Data.HashSet                  as S+import           Data.Hashable+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text+import           GHC.Generics++-- {-# WARNING hackyGetStringNoContext, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext "This NixString function needs to be replaced" #-}++-- | A 'ContextFlavor' describes the sum of possible derivations for string contexts+data ContextFlavor =+    DirectPath+  | AllOutputs+  | DerivationOutput !Text+  deriving (Show, Eq, Ord, Generic)++instance Hashable ContextFlavor++-- | A 'StringContext' ...+data StringContext =+  StringContext { scPath :: !Text+                , scFlavor :: !ContextFlavor+                } deriving (Eq, Ord, Show, Generic)++instance Hashable StringContext++data NixString = NixString+  { nsContents :: !Text+  , nsContext :: !(S.HashSet StringContext)+  } deriving (Eq, Ord, Show, Generic)++instance Hashable NixString++newtype NixLikeContext = NixLikeContext+  { getNixLikeContext :: M.HashMap Text NixLikeContextValue+  } deriving (Eq, Ord, Show, Generic)++data NixLikeContextValue = NixLikeContextValue+  { nlcvPath :: !Bool+  , nlcvAllOutputs :: !Bool+  , nlcvOutputs :: ![Text]+  } deriving (Show, Eq, Ord, Generic)++instance Semigroup NixLikeContextValue where+  a <> b = NixLikeContextValue+    { nlcvPath       = nlcvPath a || nlcvPath b+    , nlcvAllOutputs = nlcvAllOutputs a || nlcvAllOutputs b+    , nlcvOutputs    = nlcvOutputs a <> nlcvOutputs b+    }++instance Monoid NixLikeContextValue where+  mempty = NixLikeContextValue False False []++toStringContexts :: (Text, NixLikeContextValue) -> [StringContext]+toStringContexts (path, nlcv) = case nlcv of+  NixLikeContextValue True _ _ -> StringContext path DirectPath+    : toStringContexts (path, nlcv { nlcvPath = False })+  NixLikeContextValue _ True _ -> StringContext path AllOutputs+    : toStringContexts (path, nlcv { nlcvAllOutputs = False })+  NixLikeContextValue _ _ ls | not (null ls) ->+    map (StringContext path . DerivationOutput) ls+  _ -> []++toNixLikeContextValue :: StringContext -> (Text, NixLikeContextValue)+toNixLikeContextValue sc = (,) (scPath sc) $ case scFlavor sc of+  DirectPath         -> NixLikeContextValue True False []+  AllOutputs         -> NixLikeContextValue False True []+  DerivationOutput t -> NixLikeContextValue False False [t]++toNixLikeContext :: S.HashSet StringContext -> NixLikeContext+toNixLikeContext stringContext = NixLikeContext+  $ S.foldr go mempty stringContext+ where+  go sc hm =+    let (t, nlcv) = toNixLikeContextValue sc in M.insertWith (<>) t nlcv hm++fromNixLikeContext :: NixLikeContext -> S.HashSet StringContext+fromNixLikeContext =+  S.fromList . join . map toStringContexts . M.toList . getNixLikeContext++principledGetContext :: NixString -> S.HashSet StringContext+principledGetContext = nsContext++-- | Combine two NixStrings using mappend+principledMempty :: NixString+principledMempty = NixString "" mempty++-- | Combine two NixStrings using mappend+principledStringMappend :: NixString -> NixString -> NixString+principledStringMappend (NixString s1 t1) (NixString s2 t2) =+  NixString (s1 <> s2) (t1 <> t2)++-- | Combine two NixStrings using mappend+hackyStringMappend :: NixString -> NixString -> NixString+hackyStringMappend (NixString s1 t1) (NixString s2 t2) =+  NixString (s1 <> s2) (t1 <> t2)++-- | Combine NixStrings with a separator+principledIntercalateNixString :: NixString -> [NixString] -> NixString+principledIntercalateNixString _   []   = principledMempty+principledIntercalateNixString _   [ns] = ns+principledIntercalateNixString sep nss  = NixString contents ctx+ where+  contents = Text.intercalate (nsContents sep) (map nsContents nss)+  ctx      = S.unions (nsContext sep : map nsContext nss)++-- | Combine NixStrings using mconcat+hackyStringMConcat :: [NixString] -> NixString+hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)++-- | Empty string with empty context.+principledStringMempty :: NixString+principledStringMempty = NixString mempty mempty++-- | Combine NixStrings using mconcat+principledStringMConcat :: [NixString] -> NixString+principledStringMConcat =+  foldr principledStringMappend (NixString mempty mempty)++--instance Semigroup NixString where+  --NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)++--instance Monoid NixString where+--  mempty = NixString mempty mempty+--  mappend = (<>)++-- | Extract the string contents from a NixString that has no context+hackyGetStringNoContext :: NixString -> Maybe Text+hackyGetStringNoContext (NixString s c) | null c    = Just s+                                        | otherwise = Nothing++-- | Extract the string contents from a NixString that has no context+principledGetStringNoContext :: NixString -> Maybe Text+principledGetStringNoContext (NixString s c) | null c    = Just s+                                             | otherwise = Nothing++-- | Extract the string contents from a NixString even if the NixString has an associated context+principledStringIgnoreContext :: NixString -> Text+principledStringIgnoreContext (NixString s _) = s++-- | Extract the string contents from a NixString even if the NixString has an associated context+hackyStringIgnoreContext :: NixString -> Text+hackyStringIgnoreContext (NixString s _) = s++-- | Returns True if the NixString has an associated context+stringHasContext :: NixString -> Bool+stringHasContext (NixString _ c) = not (null c)++-- | Constructs a NixString without a context+hackyMakeNixStringWithoutContext :: Text -> NixString+hackyMakeNixStringWithoutContext = flip NixString mempty++-- | Constructs a NixString without a context+principledMakeNixStringWithoutContext :: Text -> NixString+principledMakeNixStringWithoutContext = flip NixString mempty++-- | Modify the string part of the NixString, leaving the context unchanged+principledModifyNixContents :: (Text -> Text) -> NixString -> NixString+principledModifyNixContents f (NixString s c) = NixString (f s) c++-- | Create a NixString using a singleton context+principledMakeNixStringWithSingletonContext+  :: Text -> StringContext -> NixString+principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)++-- | Create a NixString from a Text and context+principledMakeNixString :: Text -> S.HashSet StringContext -> NixString+principledMakeNixString s c = NixString s c++-- | A monad for accumulating string context while producing a result string.+newtype WithStringContextT m a = WithStringContextT (WriterT (S.HashSet StringContext) m a)+  deriving (Functor, Applicative, Monad, MonadTrans, MonadWriter (S.HashSet StringContext))++type WithStringContext = WithStringContextT Identity++-- | Add 'StringContext's into the resulting set.+addStringContext+  :: Monad m => S.HashSet StringContext -> WithStringContextT m ()+addStringContext = WithStringContextT . tell++-- | Add a 'StringContext' into the resulting set.+addSingletonStringContext :: Monad m => StringContext -> WithStringContextT m ()+addSingletonStringContext = WithStringContextT . tell . S.singleton++-- | Get the contents of a 'NixString' and write its context into the resulting set.+extractNixString :: Monad m => NixString -> WithStringContextT m Text+extractNixString (NixString s c) = WithStringContextT $ tell c >> return s++-- | Run an action producing a string with a context and put those into a 'NixString'.+runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString+runWithStringContextT (WithStringContextT m) =+  uncurry NixString <$> runWriterT m++-- | Run an action producing a string with a context and put those into a 'NixString'.+runWithStringContext :: WithStringContextT Identity Text -> NixString+runWithStringContext = runIdentity . runWithStringContextT
src/Nix/Strings.hs view
@@ -4,27 +4,30 @@ -- | Functions for manipulating nix strings. module Nix.Strings where -import           Data.List (intercalate, dropWhileEnd, inits)-import           Data.Monoid ((<>))-import           Data.Text (Text)-import qualified Data.Text as T-import           Data.Tuple (swap)+import           Data.List                      ( intercalate+                                                , dropWhileEnd+                                                , inits+                                                )+import           Data.Monoid                    ( (<>) )+import           Data.Text                      ( Text )+import qualified Data.Text                     as T+import           Data.Tuple                     ( swap ) import           Nix.Expr  -- | Merge adjacent 'Plain' values with 'mappend'. mergePlain :: [Antiquoted Text r] -> [Antiquoted Text r] mergePlain [] = []-mergePlain (Plain a: EscapedNewline : Plain b: xs) =-    mergePlain (Plain (a <> "\n" <> b) : xs)-mergePlain (Plain a: Plain b: xs) = mergePlain (Plain (a <> b) : xs)-mergePlain (x:xs) = x : mergePlain xs+mergePlain (Plain a : EscapedNewline : Plain b : xs) =+  mergePlain (Plain (a <> "\n" <> b) : xs)+mergePlain (Plain a : Plain b : xs) = mergePlain (Plain (a <> b) : xs)+mergePlain (x                 : xs) = x : mergePlain xs  -- | Remove 'Plain' values equal to 'mempty', as they don't have any -- informational content. removePlainEmpty :: [Antiquoted Text r] -> [Antiquoted Text r] removePlainEmpty = filter f where   f (Plain x) = x /= mempty-  f _ = True+  f _         = True    -- trimEnd xs   --     | null xs = xs@@ -41,12 +44,12 @@ -- | Split a stream representing a string with antiquotes on line breaks. splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]] splitLines = uncurry (flip (:)) . go where-  go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls where-    (l : ls) = T.split (=='\n') t+  go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls   where+    (l : ls) = T.split (== '\n') t     f prefix (finished, current) = ((Plain prefix : current) : finished, [])-  go (Antiquoted a : xs) = (Antiquoted a :) <$> go xs+  go (Antiquoted a   : xs) = (Antiquoted a :) <$> go xs   go (EscapedNewline : xs) = (EscapedNewline :) <$> go xs-  go [] = ([],[])+  go []                    = ([], [])  -- | Join a stream of strings containing antiquotes again. This is the inverse -- of 'splitLines'.@@ -58,52 +61,53 @@ stripIndent [] = Indented 0 [] stripIndent xs =   Indented minIndent-      . removePlainEmpty-      . mergePlain-      . map snd-      . dropWhileEnd cleanup-      . (\ys -> zip (map (\case [] -> Nothing-                                x -> Just (last x))-                        (inits ys)) ys)-      . unsplitLines $ ls'-  where-    ls = stripEmptyOpening $ splitLines xs-    ls' = map (dropSpaces minIndent) ls+    . removePlainEmpty+    . mergePlain+    . map snd+    . dropWhileEnd cleanup+    . (\ys -> zip+        (map+          (\case+            [] -> Nothing+            x  -> Just (last x)+          )+          (inits ys)+        )+        ys+      )+    . unsplitLines+    $ ls'+ where+  ls        = stripEmptyOpening $ splitLines xs+  ls'       = map (dropSpaces minIndent) ls -    minIndent = case stripEmptyLines ls of-      [] -> 0-      nonEmptyLs -> minimum $ map (countSpaces . mergePlain) nonEmptyLs+  minIndent = case stripEmptyLines ls of+    []         -> 0+    nonEmptyLs -> minimum $ map (countSpaces . mergePlain) nonEmptyLs -    stripEmptyLines = filter $ \case-      [Plain t] -> not $ T.null $ T.strip t-      _ -> True+  stripEmptyLines = filter $ \case+    [Plain t] -> not $ T.null $ T.strip t+    _         -> True -    stripEmptyOpening ([Plain t]:ts) | T.null (T.strip t) = ts-    stripEmptyOpening ts = ts+  stripEmptyOpening ([Plain t] : ts) | T.null (T.strip t) = ts+  stripEmptyOpening ts = ts -    countSpaces (Antiquoted _:_) = 0-    countSpaces (EscapedNewline:_) = 0-    countSpaces (Plain t : _) = T.length . T.takeWhile (== ' ') $ t-    countSpaces [] = 0+  countSpaces (Antiquoted _   : _) = 0+  countSpaces (EscapedNewline : _) = 0+  countSpaces (Plain t        : _) = T.length . T.takeWhile (== ' ') $ t+  countSpaces []                   = 0 -    dropSpaces 0 x = x-    dropSpaces n (Plain t : cs) = Plain (T.drop n t) : cs-    dropSpaces _ _ = error "stripIndent: impossible"+  dropSpaces 0 x              = x+  dropSpaces n (Plain t : cs) = Plain (T.drop n t) : cs+  dropSpaces _ _              = error "stripIndent: impossible" -    cleanup (Nothing, Plain y) = T.all (== ' ') y-    cleanup (Just (Plain x), Plain y)-        | "\n" `T.isSuffixOf` x = T.all (== ' ') y-    cleanup _ = False+  cleanup (Nothing, Plain y) = T.all (== ' ') y+  cleanup (Just (Plain x), Plain y) | "\n" `T.isSuffixOf` x = T.all (== ' ') y+  cleanup _                  = False  escapeCodes :: [(Char, Char)] escapeCodes =-  [ ('\n', 'n' )-  , ('\r', 'r' )-  , ('\t', 't' )-  , ('\\', '\\')-  , ('$' , '$' )-  , ('"', '"')-  ]+  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('\\', '\\'), ('$', '$'), ('"', '"')]  fromEscapeCode :: Char -> Maybe Char fromEscapeCode = (`lookup` map swap escapeCodes)
src/Nix/TH.hs view
@@ -9,11 +9,14 @@ module Nix.TH where  import           Data.Fix-import           Data.Foldable import           Data.Generics.Aliases-import           Data.Set (Set)-import qualified Data.Set as Set-import qualified Data.Text as Text+import           Data.Set                       ( Set+                                                , (\\)+                                                )+import qualified Data.Set                      as Set+import qualified Data.Text                     as Text+import           Data.List.NonEmpty             ( NonEmpty(..) )+import           Data.Maybe                     ( mapMaybe ) import           Language.Haskell.TH import           Language.Haskell.TH.Quote import           Nix.Atoms@@ -22,53 +25,103 @@  quoteExprExp :: String -> ExpQ quoteExprExp s = do-    expr <- case parseNixTextLoc (Text.pack s) of-        Failure err -> fail $ show err-        Success e   -> return e-    dataToExpQ (const Nothing `extQ` metaExp (freeVars expr)) expr+  expr <- case parseNixText (Text.pack s) of+    Failure err -> fail $ show err+    Success e   -> return e+  dataToExpQ (const Nothing `extQ` metaExp (freeVars expr)) expr  quoteExprPat :: String -> PatQ quoteExprPat s = do-    expr <- case parseNixTextLoc (Text.pack s) of-        Failure err -> fail $ show err-        Success e   -> return e-    dataToPatQ (const Nothing `extQ` metaPat (freeVars expr)) expr+  expr <- case parseNixText (Text.pack s) of+    Failure err -> fail $ show err+    Success e   -> return e+  dataToPatQ (const Nothing `extQ` metaPat (freeVars expr)) expr -freeVars :: NExprLoc -> Set VarName-freeVars = cata $ \case-    NSym_ _ var -> Set.singleton var-    Compose (Ann _ x) -> fold x+freeVars :: NExpr -> Set VarName+freeVars e = case unFix e of+  (NConstant    _       ) -> Set.empty+  (NStr         string  ) -> foldMap freeVars string+  (NSym         var     ) -> Set.singleton var+  (NList        list    ) -> foldMap freeVars list+  (NSet         bindings) -> foldMap bindFree bindings+  (NRecSet bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings+  (NLiteralPath _       ) -> Set.empty+  (NEnvPath     _       ) -> Set.empty+  (NUnary _ expr        ) -> freeVars expr+  (NBinary _ left right ) -> freeVars left `Set.union` freeVars right+  (NSelect expr path orExpr) ->+    freeVars expr+      `Set.union` pathFree path+      `Set.union` maybe Set.empty freeVars orExpr+  (NHasAttr expr            path) -> freeVars expr `Set.union` pathFree path+  (NAbs     (Param varname) expr) -> Set.delete varname (freeVars expr)+  (NAbs (ParamSet set _ varname) expr) ->+    -- Include all free variables from the expression and the default arguments+    freeVars expr+      `Set.union` Set.unions (mapMaybe (fmap freeVars . snd) set)+    -- But remove the argument name if existing, and all arguments in the parameter set+      \\          maybe Set.empty Set.singleton varname+      \\          Set.fromList (map fst set)+  (NLet bindings expr) ->+    freeVars expr+      `Set.union` foldMap bindFree bindings+      \\          foldMap bindDefs bindings+  (NIf cond th el) ->+    freeVars cond `Set.union` freeVars th `Set.union` freeVars el+  -- Evaluation is needed to find out whether x is a "real" free variable in `with y; x`, we just include it+  -- This also makes sense because its value can be overridden by `x: with y; x`+  (NWith   set       expr) -> freeVars set `Set.union` freeVars expr+  (NAssert assertion expr) -> freeVars assertion `Set.union` freeVars expr+  (NSynHole _            ) -> Set.empty + where++  staticKey :: NKeyName r -> Maybe VarName+  staticKey (StaticKey  varname) = Just varname+  staticKey (DynamicKey _      ) = Nothing++  bindDefs :: Binding r -> Set VarName+  bindDefs (Inherit  Nothing                   _    _) = Set.empty+  bindDefs (Inherit (Just _) keys _) = Set.fromList $ mapMaybe staticKey keys+  bindDefs (NamedVar (StaticKey  varname :| _) _    _) = Set.singleton varname+  bindDefs (NamedVar (DynamicKey _       :| _) _    _) = Set.empty++  bindFree :: Binding NExpr -> Set VarName+  bindFree (Inherit Nothing keys _) = Set.fromList $ mapMaybe staticKey keys+  bindFree (Inherit (Just scope) _ _) = freeVars scope+  bindFree (NamedVar path expr _) = pathFree path `Set.union` freeVars expr++  pathFree :: NAttrPath NExpr -> Set VarName+  pathFree = foldMap (foldMap freeVars)++ class ToExpr a where     toExpr :: a -> NExprLoc  instance ToExpr NExprLoc where-    toExpr = id+  toExpr = id  instance ToExpr VarName where-    toExpr = Fix . NSym_ nullSpan+  toExpr = Fix . NSym_ nullSpan  instance ToExpr Int where-    toExpr = Fix . NConstant_ nullSpan . NInt . fromIntegral+  toExpr = Fix . NConstant_ nullSpan . NInt . fromIntegral  instance ToExpr Integer where-    toExpr = Fix . NConstant_ nullSpan . NInt+  toExpr = Fix . NConstant_ nullSpan . NInt  instance ToExpr Float where-    toExpr = Fix . NConstant_ nullSpan . NFloat+  toExpr = Fix . NConstant_ nullSpan . NFloat  metaExp :: Set VarName -> NExprLoc -> Maybe ExpQ metaExp fvs (Fix (NSym_ _ x)) | x `Set.member` fvs =-    Just [| toExpr $(varE (mkName (Text.unpack x))) |]+  Just [| toExpr $(varE (mkName (Text.unpack x))) |] metaExp _ _ = Nothing  metaPat :: Set VarName -> NExprLoc -> Maybe PatQ metaPat fvs (Fix (NSym_ _ x)) | x `Set.member` fvs =-    Just (varP (mkName (Text.unpack x)))+  Just (varP (mkName (Text.unpack x))) metaPat _ _ = Nothing  nix :: QuasiQuoter-nix = QuasiQuoter-    { quoteExp = quoteExprExp-    , quotePat = quoteExprPat-    }+nix = QuasiQuoter { quoteExp = quoteExprExp, quotePat = quoteExprPat }
src/Nix/Thunk.hs view
@@ -1,111 +1,51 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE CPP #-}--#if ENABLE_TRACING-{-# LANGUAGE BangPatterns #-}-#endif-+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  module Nix.Thunk where -import Control.Exception-import Control.Monad.Catch-import Data.Typeable--#if ENABLE_TRACING-import Data.IORef-import System.IO.Unsafe-import Nix.Utils--counter :: IORef Int-counter = unsafePerformIO $ newIORef 0-{-# NOINLINE counter #-}-#endif--data Deferred m v = Deferred (m v) | Computed v-    deriving (Functor, Foldable, Traversable)+import           Control.Exception              ( Exception )+import           Control.Monad.Trans.Class      ( MonadTrans(..) )+import           Data.Typeable                  ( Typeable ) -class Monad m => MonadVar m where-    type Var m :: * -> *-    newVar :: a -> m (Var m a)-    readVar :: Var m a -> m a-    writeVar :: Var m a -> a -> m ()-    atomicModifyVar :: Var m a -> (a -> (a, b)) -> m b+class ( Monad m+      , Eq (ThunkId m)+      , Ord (ThunkId m)+      , Show (ThunkId m)+      , Typeable (ThunkId m)+      )+      => MonadThunkId m where+  type ThunkId m :: *+  freshId :: m (ThunkId m)+  default freshId+      :: ( MonadThunkId m'+        , MonadTrans t+        , m ~ t m'+        , ThunkId m ~ ThunkId m'+        )+      => m (ThunkId m)+  freshId = lift freshId -class Monad m => MonadThunk v t m | v -> m, v -> t, t -> m, t -> v where+class MonadThunkId m => MonadThunk t m v | t -> m, t -> v where     thunk :: m v -> m t+    -- | Return an identifier for the thunk unless it is a pure value (i.e.,+    --   strictly an encapsulation of some 'v' without any additional+    --   structure). For pure values represented as thunks, returns Nothing.+    thunkId :: t -> Maybe (ThunkId m)+    query :: t -> r -> (v -> r) -> r+    queryM :: t -> m r -> (v -> m r) -> m r     force :: t -> (v -> m r) -> m r-    value :: v -> t+    forceEff :: t -> (v -> m r) -> m r+    wrapValue :: v -> t+    getValue :: t -> Maybe v -data Thunk m v-    = Value v-    | Thunk Int (Var m Bool) (Var m (Deferred m v))+newtype ThunkLoop = ThunkLoop String -- contains rendering of ThunkId+    deriving Typeable -newtype ThunkLoop = ThunkLoop (Maybe Int)-    deriving (Show, Typeable)+instance Show ThunkLoop where+  show (ThunkLoop i) = "ThunkLoop " ++ i  instance Exception ThunkLoop--valueRef :: v -> Thunk m v-valueRef = Value--buildThunk :: MonadVar m => m v -> m (Thunk m v)-buildThunk action =-#if ENABLE_TRACING-    let !x = unsafePerformIO (atomicModifyIORef' counter (\c -> (succ c, c))) in-    Thunk x-#else-    Thunk 0-#endif-        <$> newVar False <*> newVar (Deferred action)--forceThunk :: (MonadVar m, MonadThrow m) => Thunk m v -> (v -> m a) -> m a-forceThunk (Value ref) k = k ref-#if ENABLE_TRACING-forceThunk (Thunk n active ref) k = do-#else-forceThunk (Thunk _ active ref) k = do-#endif-    eres <- readVar ref-    case eres of-        Computed v -> k v-        Deferred action -> do-            nowActive <- atomicModifyVar active (True,)-            if nowActive-                then-#if ENABLE_TRACING-                    throwM $ ThunkLoop (Just n)-#else-                    throwM $ ThunkLoop Nothing-#endif-                else do-#if ENABLE_TRACING-                    traceM $ "Forcing " ++ show n-#endif-                    v <- action-                    writeVar ref (Computed v)-                    _ <- atomicModifyVar active (False,)-                    k v--forceEffects :: MonadVar m => Thunk m v -> (v -> m a) -> m a-forceEffects (Value ref) k = k ref-forceEffects (Thunk _ active ref) k = do-    nowActive <- atomicModifyVar active (True,)-    if nowActive-        then return $ error "forceEffects: a value was expected"-        else do-            eres <- readVar ref-            case eres of-                Computed v -> k v-                Deferred action -> do-                    v <- action-                    writeVar ref (Computed v)-                    _ <- atomicModifyVar active (False,)-                    k v
+ src/Nix/Thunk/Basic.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Nix.Thunk.Basic (NThunkF(..), Deferred(..), MonadBasicThunk) where++import           Control.Exception       hiding ( catch )+import           Control.Monad.Catch++import           Nix.Thunk+import           Nix.Utils+import           Nix.Var++data Deferred m v = Deferred (m v) | Computed v+    deriving (Functor, Foldable, Traversable)++-- | The type of very basic thunks+data NThunkF m v+    = Value v+    | Thunk (ThunkId m) (Var m Bool) (Var m (Deferred m v))++instance (Eq v, Eq (ThunkId m)) => Eq (NThunkF m v) where+  Value x     == Value y     = x == y+  Thunk x _ _ == Thunk y _ _ = x == y+  _           == _           = False              -- jww (2019-03-16): not accurate...++instance Show v => Show (NThunkF m v) where+  show (Value v    ) = show v+  show (Thunk _ _ _) = "<thunk>"++type MonadBasicThunk m = (MonadThunkId m, MonadVar m)++instance (MonadBasicThunk m, MonadCatch m)+  => MonadThunk (NThunkF m v) m v where+  thunk   = buildThunk+  thunkId = \case+    Value _     -> Nothing+    Thunk n _ _ -> Just n+  query     = queryValue+  queryM    = queryThunk+  force     = forceThunk+  forceEff  = forceEffects+  wrapValue = valueRef+  getValue  = thunkValue++valueRef :: v -> NThunkF m v+valueRef = Value++thunkValue :: NThunkF m v -> Maybe v+thunkValue (Value v) = Just v+thunkValue _         = Nothing++buildThunk :: MonadBasicThunk m => m v -> m (NThunkF m v)+buildThunk action = do+  freshThunkId <- freshId+  Thunk freshThunkId <$> newVar False <*> newVar (Deferred action)++queryValue :: MonadVar m => NThunkF m v -> a -> (v -> a) -> a+queryValue (Value v) _ k = k v+queryValue _         n _ = n++queryThunk :: MonadVar m => NThunkF m v -> m a -> (v -> m a) -> m a+queryThunk (Value v           ) _ k = k v+queryThunk (Thunk _ active ref) n k = do+  nowActive <- atomicModifyVar active (True, )+  if nowActive+    then n+    else do+      eres <- readVar ref+      res  <- case eres of+        Computed v -> k v+        _          -> n+      _ <- atomicModifyVar active (False, )+      return res++forceThunk+  :: forall m v a+   . (MonadVar m, MonadThrow m, MonadCatch m, Show (ThunkId m))+  => NThunkF m v+  -> (v -> m a)+  -> m a+forceThunk (Value v           ) k = k v+forceThunk (Thunk n active ref) k = do+  eres <- readVar ref+  case eres of+    Computed v      -> k v+    Deferred action -> do+      nowActive <- atomicModifyVar active (True, )+      if nowActive+        then throwM $ ThunkLoop $ show n+        else do+          traceM $ "Forcing " ++ show n+          v <- catch action $ \(e :: SomeException) -> do+            _ <- atomicModifyVar active (False, )+            throwM e+          _ <- atomicModifyVar active (False, )+          writeVar ref (Computed v)+          k v++forceEffects :: MonadVar m => NThunkF m v -> (v -> m r) -> m r+forceEffects (Value v           ) k = k v+forceEffects (Thunk _ active ref) k = do+  nowActive <- atomicModifyVar active (True, )+  if nowActive+    then return $ error "Loop detected"+    else do+      eres <- readVar ref+      case eres of+        Computed v      -> k v+        Deferred action -> do+          v <- action+          writeVar ref (Computed v)+          _ <- atomicModifyVar active (False, )+          k v
+ src/Nix/Thunk/Standard.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Nix.Thunk.Standard where++import           Control.Comonad                ( Comonad )+import           Control.Comonad.Env            ( ComonadEnv )+import           Control.Monad.Catch     hiding ( catchJust )+import           Control.Monad.Reader+import           Control.Monad.Ref+import           Data.Typeable+import           GHC.Generics+import           Nix.Cited+import           Nix.Cited.Basic+import           Nix.Exec+import           Nix.Fresh+import           Nix.Fresh.Basic+import           Nix.Options+import           Nix.Thunk+import           Nix.Thunk.Basic+import           Nix.Value+import           Nix.Var++newtype StdThunk (u :: (* -> *) -> * -> *) (m :: * -> *) = StdThunk+  { _stdThunk :: StdCited u m (NThunkF (StdLazy u m) (StdValue u m)) }++newtype StdCited u m a = StdCited+    { _stdCited :: Cited (StdThunk u m) (StdCited u m) (StdLazy u m) a }+    deriving+        ( Generic+        , Typeable+        , Functor+        , Applicative+        , Foldable+        , Traversable+        , Comonad+        , ComonadEnv [Provenance (StdThunk u m) (StdLazy u m) (StdValue u m)]+        )++type StdValue u m = NValue (StdThunk u m) (StdCited u m) (StdLazy u m)+type StdValueNF u m = NValueNF (StdThunk u m) (StdCited u m) (StdLazy u m)+-- type StdIdT m     = FreshIdT Int m++type StdLazy u m = Lazy (StdThunk u m) (StdCited u m) (u m)++instance Show (StdThunk u m) where+  show _ = "<thunk>"          -- jww (2019-03-15): NYI++type MonadStdThunk m+  = (MonadVar m, MonadCatch m, MonadThrow m, Typeable m, MonadAtomicRef m)++instance ( MonadStdThunk (u m)+         , MonadThunkId (u m)+         , MonadTrans u+         , Typeable u+         , Typeable m+         )+  => MonadThunk (StdThunk u m) (StdLazy u m) (StdValue u m) where+  thunk   = fmap (StdThunk . StdCited) . thunk+  thunkId = thunkId . _stdCited . _stdThunk+  query x b f = query (_stdCited (_stdThunk x)) b f+  queryM x b f = queryM (_stdCited (_stdThunk x)) b f+  force     = force . _stdCited . _stdThunk+  forceEff  = forceEff . _stdCited . _stdThunk+  wrapValue = StdThunk . StdCited . wrapValue+  getValue  = getValue . _stdCited . _stdThunk++instance HasCitations1 (StdThunk u m) (StdLazy u m) (StdValue u m) (StdCited u m) where+  citations1 (StdCited c) = citations1 c+  addProvenance1 x (StdCited c) = StdCited (addProvenance1 x c)++runStdLazyM+  :: (MonadVar m, MonadIO m, MonadIO (u m))+  => Options+  -> (u m a -> m a)+  -> StdLazy u m a+  -> m a+runStdLazyM opts run action = run $ runLazyM opts action++type StandardThunk m = StdThunk StdIdT m+type StandardValue m = StdValue StdIdT m+type StandardValueNF m = StdValueNF StdIdT m+type StandardT m = StdLazy StdIdT m++runStandard :: (MonadVar m, MonadIO m) => Options -> StdLazy StdIdT m a -> m a+runStandard opts action = do+  i <- newVar (1 :: Int)+  runStdLazyM opts (runFreshIdT i) action++runStandardIO :: Options -> StdLazy StdIdT IO a -> IO a+runStandardIO = runStandard
src/Nix/Type/Assumption.hs view
@@ -1,20 +1,21 @@-module Nix.Type.Assumption (-  Assumption(..),-  empty,-  lookup,-  remove,-  extend,-  keys,-  merge,-  mergeAssumptions,-  singleton,-) where+module Nix.Type.Assumption+  ( Assumption(..)+  , empty+  , lookup+  , remove+  , extend+  , keys+  , merge+  , mergeAssumptions+  , singleton+  )+where -import Prelude hiding (lookup)+import           Prelude                 hiding ( lookup ) -import Nix.Type.Type+import           Nix.Type.Type -import Data.Foldable+import           Data.Foldable  newtype Assumption = Assumption { assumptions :: [(Name, Type)] }   deriving (Eq, Show)
src/Nix/Type/Env.hs view
@@ -1,25 +1,25 @@-module Nix.Type.Env (-  Env(..),-  empty,-  lookup,-  remove,-  extend,-  extends,-  merge,-  mergeEnvs,-  singleton,-  keys,-  fromList,-  toList,-) where+module Nix.Type.Env+  ( Env(..)+  , empty+  , lookup+  , remove+  , extend+  , extends+  , merge+  , mergeEnvs+  , singleton+  , keys+  , fromList+  , toList+  )+where -import           Prelude hiding (lookup)+import           Prelude                 hiding ( lookup )  import           Nix.Type.Type -import           Data.Foldable hiding (toList)-import qualified Data.Map as Map-import           Data.Semigroup+import           Data.Foldable           hiding ( toList )+import qualified Data.Map                      as Map  ------------------------------------------------------------------------------- -- Typing Environment@@ -38,8 +38,7 @@ remove (TypeEnv env) var = TypeEnv (Map.delete var env)  extends :: Env -> [(Name, [Scheme])] -> Env-extends env xs =-    env { types = Map.union (Map.fromList xs) (types env) }+extends env xs = env { types = Map.union (Map.fromList xs) (types env) }  lookup :: Name -> Env -> Maybe [Scheme] lookup key (TypeEnv tys) = Map.lookup key tys@@ -66,5 +65,5 @@   (<>) = merge  instance Monoid Env where-  mempty = empty+  mempty  = empty   mappend = merge
src/Nix/Type/Infer.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -9,66 +11,92 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}  {-# OPTIONS_GHC -Wno-name-shadowing #-} -module Nix.Type.Infer (-  Constraint(..),-  TypeError(..),-  InferError(..),-  Subst(..),-  inferTop-) where+module Nix.Type.Infer+  ( Constraint(..)+  , TypeError(..)+  , InferError(..)+  , Subst(..)+  , inferTop+  )+where  import           Control.Applicative import           Control.Arrow import           Control.Monad.Catch import           Control.Monad.Except+import           Control.Monad.Fail import           Control.Monad.Logic import           Control.Monad.Reader+import           Control.Monad.Ref import           Control.Monad.ST-import           Control.Monad.State+import           Control.Monad.State.Strict import           Data.Fix import           Data.Foldable-import qualified Data.HashMap.Lazy as M-import           Data.List (delete, find, nub, intersect, (\\))-import           Data.Map (Map)-import qualified Data.Map as Map-import           Data.Maybe (fromJust)-import           Data.STRef-import           Data.Semigroup-import qualified Data.Set as Set-import           Data.Text (Text)+import qualified Data.HashMap.Lazy             as M+import           Data.List                      ( delete+                                                , find+                                                , nub+                                                , intersect+                                                , (\\)+                                                )+import           Data.Map                       ( Map )+import qualified Data.Map                      as Map+import           Data.Maybe                     ( fromJust )+import qualified Data.Set                      as Set+import           Data.Text                      ( Text ) import           Nix.Atoms import           Nix.Convert-import           Nix.Eval (MonadEval(..))-import qualified Nix.Eval as Eval+import           Nix.Eval                       ( MonadEval(..) )+import qualified Nix.Eval                      as Eval import           Nix.Expr.Types import           Nix.Expr.Types.Annotated+import           Nix.Fresh+import           Nix.String import           Nix.Scope import           Nix.Thunk-import qualified Nix.Type.Assumption as As+import           Nix.Thunk.Basic+import qualified Nix.Type.Assumption           as As import           Nix.Type.Env-import qualified Nix.Type.Env as Env+import qualified Nix.Type.Env                  as Env import           Nix.Type.Type import           Nix.Utils+import           Nix.Var  ------------------------------------------------------------------------------- -- Classes -------------------------------------------------------------------------------  -- | Inference monad-newtype Infer s a = Infer+newtype InferT s m a = InferT     { getInfer ::-        ReaderT (Set.Set TVar, Scopes (Infer s) (JThunk s))-            (StateT InferState (ExceptT InferError (ST s))) a+        ReaderT (Set.Set TVar, Scopes (InferT s m) (JThunkT s m))+            (StateT InferState (ExceptT InferError m)) a     }-    deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix,-              MonadReader (Set.Set TVar, Scopes (Infer s) (JThunk s)),-              MonadState InferState, MonadError InferError)+    deriving+        ( Functor+        , Applicative+        , Alternative+        , Monad+        , MonadPlus+        , MonadFix+        , MonadReader (Set.Set TVar, Scopes (InferT s m) (JThunkT s m))+        , MonadFail+        , MonadState InferState+        , MonadError InferError+        ) +instance MonadTrans (InferT s) where+  lift = InferT . lift . lift . lift++instance MonadThunkId m => MonadThunkId (InferT s m) where+  type ThunkId (InferT s m) = ThunkId m+ -- | Inference state newtype InferState = InferState { count :: Int } @@ -90,25 +118,27 @@  instance Substitutable TVar where   apply (Subst s) a = tv-    where t = TVar a-          (TVar tv) = Map.findWithDefault t a s+   where+    t         = TVar a+    (TVar tv) = Map.findWithDefault t a s  instance Substitutable Type where-  apply _ (TCon a)           = TCon a-  apply s (TSet b a)         = TSet b (M.map (apply s) a)-  apply s (TList a)          = TList (map (apply s) a)-  apply (Subst s) t@(TVar a) = Map.findWithDefault t a s-  apply s (t1 :~> t2)        = apply s t1 :~> apply s t2-  apply s (TMany ts)         = TMany (map (apply s) ts)+  apply _         (  TCon a   ) = TCon a+  apply s         (  TSet b a ) = TSet b (M.map (apply s) a)+  apply s         (  TList a  ) = TList (map (apply s) a)+  apply (Subst s) t@(TVar  a  ) = Map.findWithDefault t a s+  apply s         (  t1 :~> t2) = apply s t1 :~> apply s t2+  apply s         (  TMany ts ) = TMany (map (apply s) ts)  instance Substitutable Scheme where   apply (Subst s) (Forall as t) = Forall as $ apply s' t     where s' = Subst $ foldr Map.delete s as  instance Substitutable Constraint where-   apply s (EqConst t1 t2)         = EqConst (apply s t1) (apply s t2)-   apply s (ExpInstConst t sc)     = ExpInstConst (apply s t) (apply s sc)-   apply s (ImpInstConst t1 ms t2) = ImpInstConst (apply s t1) (apply s ms) (apply s t2)+  apply s (EqConst      t1 t2) = EqConst (apply s t1) (apply s t2)+  apply s (ExpInstConst t  sc) = ExpInstConst (apply s t) (apply s sc)+  apply s (ImpInstConst t1 ms t2) =+    ImpInstConst (apply s t1) (apply s ms) (apply s t2)  instance Substitutable a => Substitutable [a] where   apply = map . apply@@ -122,11 +152,11 @@  instance FreeTypeVars Type where   ftv TCon{}      = Set.empty-  ftv (TVar a)    = Set.singleton a-  ftv (TSet _ a)  = Set.unions (map ftv (M.elems a))-  ftv (TList a)   = Set.unions (map ftv a)+  ftv (TVar a   ) = Set.singleton a+  ftv (TSet _ a ) = Set.unions (map ftv (M.elems a))+  ftv (TList a  ) = Set.unions (map ftv a)   ftv (t1 :~> t2) = ftv t1 `Set.union` ftv t2-  ftv (TMany ts)  = Set.unions (map ftv ts)+  ftv (TMany ts ) = Set.unions (map ftv ts)  instance FreeTypeVars TVar where   ftv = Set.singleton@@ -135,19 +165,20 @@   ftv (Forall as t) = ftv t `Set.difference` Set.fromList as  instance FreeTypeVars a => FreeTypeVars [a] where-  ftv   = foldr (Set.union . ftv) Set.empty+  ftv = foldr (Set.union . ftv) Set.empty  instance (Ord a, FreeTypeVars a) => FreeTypeVars (Set.Set a) where-  ftv   = foldr (Set.union . ftv) Set.empty+  ftv = foldr (Set.union . ftv) Set.empty   class ActiveTypeVars a where   atv :: a -> Set.Set TVar  instance ActiveTypeVars Constraint where-  atv (EqConst t1 t2)         = ftv t1 `Set.union` ftv t2-  atv (ImpInstConst t1 ms t2) = ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)-  atv (ExpInstConst t s)      = ftv t `Set.union` ftv s+  atv (EqConst t1 t2) = ftv t1 `Set.union` ftv t2+  atv (ImpInstConst t1 ms t2) =+    ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)+  atv (ExpInstConst t s) = ftv t `Set.union` ftv s  instance ActiveTypeVars a => ActiveTypeVars [a] where   atv = foldr (Set.union . atv) Set.empty@@ -172,270 +203,322 @@ instance Exception InferError  instance Semigroup InferError where-    x <> _ = x+  x <> _ = x  instance Monoid InferError where-    mempty  = TypeInferenceAborted-    mappend = (<>)+  mempty  = TypeInferenceAborted+  mappend = (<>)  ------------------------------------------------------------------------------- -- Inference -------------------------------------------------------------------------------  -- | Run the inference monad-runInfer' :: Infer s a -> ST s (Either InferError a)-runInfer' = runExceptT-          . (`evalStateT` initInfer)-          . (`runReaderT` (Set.empty, emptyScopes))-          . getInfer+runInfer' :: MonadInfer m => InferT s m a -> m (Either InferError a)+runInfer' =+  runExceptT+    . (`evalStateT` initInfer)+    . (`runReaderT` (Set.empty, emptyScopes))+    . getInfer -runInfer :: (forall s. Infer s a) -> Either InferError a-runInfer m = runST (runInfer' m)+runInfer :: (forall s . InferT s (FreshIdT Int (ST s)) a) -> Either InferError a+runInfer m = runST $ do+  i <- newVar (1 :: Int)+  runFreshIdT i (runInfer' m) -inferType :: Env -> NExpr -> Infer s [(Subst, Type)]+inferType+  :: forall s m . MonadInfer m => Env -> NExpr -> InferT s m [(Subst, Type)] inferType env ex = do   Judgment as cs t <- infer ex-  let unbounds = Set.fromList (As.keys as) `Set.difference`-                 Set.fromList (Env.keys env)-  unless (Set.null unbounds) $-      typeError $ UnboundVariables (nub (Set.toList unbounds))-  let cs' = [ ExpInstConst t s-            | (x, ss) <- Env.toList env-            , s <- ss-            , t <- As.lookup x as]+  let unbounds =+        Set.fromList (As.keys as) `Set.difference` Set.fromList (Env.keys env)+  unless (Set.null unbounds) $ typeError $ UnboundVariables+    (nub (Set.toList unbounds))+  let cs' =+        [ ExpInstConst t s+        | (x, ss) <- Env.toList env+        , s       <- ss+        , t       <- As.lookup x as+        ]   inferState <- get   let eres = (`evalState` inferState) $ runSolver $ do-          subst <- solve (cs ++ cs')-          return (subst, subst `apply` t)+        subst <- solve (cs ++ cs')+        return (subst, subst `apply` t)   case eres of-      Left errs -> throwError $ TypeInferenceErrors errs-      Right xs  -> pure xs+    Left  errs -> throwError $ TypeInferenceErrors errs+    Right xs   -> pure xs  -- | Solve for the toplevel type of an expression in a given environment inferExpr :: Env -> NExpr -> Either InferError [Scheme] inferExpr env ex = case runInfer (inferType env ex) of-  Left err -> Left err-  Right xs -> Right $ map (\(subst, ty) -> closeOver (subst `apply` ty)) xs+  Left  err -> Left err+  Right xs  -> Right $ map (\(subst, ty) -> closeOver (subst `apply` ty)) xs  -- | Canonicalize and return the polymorphic toplevel type. closeOver :: Type -> Scheme closeOver = normalize . generalize Set.empty -extendMSet :: TVar -> Infer s a -> Infer s a-extendMSet x = Infer . local (first (Set.insert x)) . getInfer+extendMSet :: Monad m => TVar -> InferT s m a -> InferT s m a+extendMSet x = InferT . local (first (Set.insert x)) . getInfer  letters :: [String]-letters = [1..] >>= flip replicateM ['a'..'z']+letters = [1 ..] >>= flip replicateM ['a' .. 'z'] +freshTVar :: MonadState InferState m => m TVar+freshTVar = do+  s <- get+  put s { count = count s + 1 }+  return $ TV (letters !! count s)+ fresh :: MonadState InferState m => m Type-fresh = do-    s <- get-    put s{count = count s + 1}-    return $ TVar $ TV (letters !! count s)+fresh = TVar <$> freshTVar  instantiate :: MonadState InferState m => Scheme -> m Type instantiate (Forall as t) = do-    as' <- mapM (const fresh) as-    let s = Subst $ Map.fromList $ zip as as'-    return $ apply s t+  as' <- mapM (const fresh) as+  let s = Subst $ Map.fromList $ zip as as'+  return $ apply s t  generalize :: Set.Set TVar -> Type -> Scheme-generalize free t  = Forall as t-    where as = Set.toList $ ftv t `Set.difference` free+generalize free t = Forall as t+  where as = Set.toList $ ftv t `Set.difference` free  unops :: Type -> NUnaryOp -> [Constraint] unops u1 = \case-    NNot -> [ EqConst u1 (typeFun [typeBool, typeBool]) ]-    NNeg -> [ EqConst u1 (TMany [ typeFun [typeInt,   typeInt]-                               , typeFun [typeFloat, typeFloat] ]) ]+  NNot -> [EqConst u1 (typeFun [typeBool, typeBool])]+  NNeg ->+    [ EqConst+        u1+        (TMany [typeFun [typeInt, typeInt], typeFun [typeFloat, typeFloat]])+    ]  binops :: Type -> NBinaryOp -> [Constraint] binops u1 = \case-    NApp    -> []                -- this is handled separately+  NApp  -> []                -- this is handled separately -    -- Equality tells you nothing about the types, because any two types are-    -- allowed.-    NEq     -> []-    NNEq    -> []+  -- Equality tells you nothing about the types, because any two types are+  -- allowed.+  NEq   -> []+  NNEq  -> [] -    NGt     -> inequality-    NGte    -> inequality-    NLt     -> inequality-    NLte    -> inequality+  NGt   -> inequality+  NGte  -> inequality+  NLt   -> inequality+  NLte  -> inequality -    NAnd    -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]-    NOr     -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]-    NImpl   -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]+  NAnd  -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])]+  NOr   -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])]+  NImpl -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])] -    NConcat -> [ EqConst u1 (TMany [ typeFun [typeList,   typeList,   typeList]-                                  , typeFun [typeList,   typeNull,   typeList]-                                  , typeFun [typeNull,   typeList,   typeList]-                                  ]) ]+  NConcat ->+    [ EqConst+        u1+        (TMany+          [ typeFun [typeList, typeList, typeList]+          , typeFun [typeList, typeNull, typeList]+          , typeFun [typeNull, typeList, typeList]+          ]+        )+    ] -    NUpdate -> [ EqConst u1 (TMany [ typeFun [typeSet,    typeSet,    typeSet]-                                  , typeFun [typeSet,    typeNull,   typeSet]-                                  , typeFun [typeNull,   typeSet,    typeSet]-                                  ]) ]+  NUpdate ->+    [ EqConst+        u1+        (TMany+          [ typeFun [typeSet, typeSet, typeSet]+          , typeFun [typeSet, typeNull, typeSet]+          , typeFun [typeNull, typeSet, typeSet]+          ]+        )+    ] -    NPlus   -> [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeInt]-                                  , typeFun [typeFloat,  typeFloat,  typeFloat]-                                  , typeFun [typeInt,    typeFloat,  typeFloat]-                                  , typeFun [typeFloat,  typeInt,    typeFloat]-                                  , typeFun [typeString, typeString, typeString]-                                  , typeFun [typePath,   typePath,   typePath]-                                  , typeFun [typeString, typeString, typePath]-                                  ]) ]-    NMinus  -> arithmetic-    NMult   -> arithmetic-    NDiv    -> arithmetic-  where-    inequality =-        [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeBool]-                            , typeFun [typeFloat,  typeFloat,  typeBool]-                            , typeFun [typeInt,    typeFloat,  typeBool]-                            , typeFun [typeFloat,  typeInt,    typeBool]-                            ]) ]+  NPlus ->+    [ EqConst+        u1+        (TMany+          [ typeFun [typeInt, typeInt, typeInt]+          , typeFun [typeFloat, typeFloat, typeFloat]+          , typeFun [typeInt, typeFloat, typeFloat]+          , typeFun [typeFloat, typeInt, typeFloat]+          , typeFun [typeString, typeString, typeString]+          , typeFun [typePath, typePath, typePath]+          , typeFun [typeString, typeString, typePath]+          ]+        )+    ]+  NMinus -> arithmetic+  NMult  -> arithmetic+  NDiv   -> arithmetic+ where+  inequality =+    [ EqConst+        u1+        (TMany+          [ typeFun [typeInt, typeInt, typeBool]+          , typeFun [typeFloat, typeFloat, typeBool]+          , typeFun [typeInt, typeFloat, typeBool]+          , typeFun [typeFloat, typeInt, typeBool]+          ]+        )+    ] -    arithmetic =-        [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeInt]-                            , typeFun [typeFloat,  typeFloat,  typeFloat]-                            , typeFun [typeInt,    typeFloat,  typeFloat]-                            , typeFun [typeFloat,  typeInt,    typeFloat]-                            ]) ]+  arithmetic =+    [ EqConst+        u1+        (TMany+          [ typeFun [typeInt, typeInt, typeInt]+          , typeFun [typeFloat, typeFloat, typeFloat]+          , typeFun [typeInt, typeFloat, typeFloat]+          , typeFun [typeFloat, typeInt, typeFloat]+          ]+        )+    ] -instance MonadVar (Infer s) where-    type Var (Infer s) = STRef s+liftInfer :: Monad m => m a -> InferT s m a+liftInfer = InferT . lift . lift . lift -    newVar x     = Infer $ lift $ lift $ lift $ newSTRef x-    readVar x    = Infer $ lift $ lift $ lift $ readSTRef x-    writeVar x y = Infer $ lift $ lift $ lift $ writeSTRef x y-    atomicModifyVar x f = Infer $ lift $ lift $ lift $ do-        res <- snd . f <$> readSTRef x-        _ <- modifySTRef x (fst . f)-        return res+instance MonadRef m => MonadRef (InferT s m) where+  type Ref (InferT s m) = Ref m+  newRef x = liftInfer $ newRef x+  readRef x = liftInfer $ readRef x+  writeRef x y = liftInfer $ writeRef x y -newtype JThunk s = JThunk (Thunk (Infer s) (Judgment s))+instance MonadAtomicRef m => MonadAtomicRef (InferT s m) where+  atomicModifyRef x f = liftInfer $ do+    res <- snd . f <$> readRef x+    _   <- modifyRef x (fst . f)+    return res -instance MonadThrow (Infer s) where-    throwM = throwError . EvaluationError+newtype JThunkT s m = JThunk (NThunkF (InferT s m) (Judgment s)) -instance MonadCatch (Infer s) where-    catch m h = catchError m $ \case-        EvaluationError e ->-            maybe (error $ "Exception was not an exception: " ++ show e) h-                  (fromException (toException e))-        err -> error $ "Unexpected error: " ++ show err+instance Monad m => MonadThrow (InferT s m) where+  throwM = throwError . EvaluationError -instance MonadThunk (Judgment s) (JThunk s) (Infer s) where-    thunk = fmap JThunk . buildThunk+instance Monad m => MonadCatch (InferT s m) where+  catch m h = catchError m $ \case+    EvaluationError e -> maybe+      (error $ "Exception was not an exception: " ++ show e)+      h+      (fromException (toException e))+    err -> error $ "Unexpected error: " ++ show err -    force (JThunk t) f = catch (forceThunk t f) $ \(_ :: ThunkLoop) ->-        -- If we have a thunk loop, we just don't know the type.-        f =<< Judgment As.empty [] <$> fresh+type MonadInfer m = (MonadThunkId m, MonadVar m, MonadFix m) -    value = JThunk . valueRef+instance MonadInfer m+  => MonadThunk (JThunkT s m) (InferT s m) (Judgment s) where+  thunk = fmap JThunk . thunk+  thunkId (JThunk x) = thunkId x -instance MonadEval (Judgment s) (Infer s) where-    freeVariable var = do-        tv <- fresh-        return $ Judgment (As.singleton var tv) [] tv+  query (JThunk x) b f = query x b f+  queryM (JThunk x) b f = queryM x b f -    -- If we fail to look up an attribute, we just don't know the type.-    attrMissing _ _ = Judgment As.empty [] <$> fresh+  force (JThunk t) f = catch (force t f)+    $ \(_ :: ThunkLoop) ->+-- If we have a thunk loop, we just don't know the type.+                           f =<< Judgment As.empty [] <$> fresh+  forceEff (JThunk t) f = catch (forceEff t f)+    $ \(_ :: ThunkLoop) ->+-- If we have a thunk loop, we just don't know the type.+                           f =<< Judgment As.empty [] <$> fresh -    evaledSym _ = pure+  wrapValue = JThunk . wrapValue+  getValue (JThunk x) = getValue x -    evalCurPos =-        return $ Judgment As.empty [] $ TSet False $ M.fromList-            [ ("file", typePath)-            , ("line", typeInt)-            , ("col",  typeInt) ]+instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where+  freeVariable var = do+    tv <- fresh+    return $ Judgment (As.singleton var tv) [] tv -    evalConstant c  = return $ Judgment As.empty [] (go c)-      where-        go = \case-          NInt _   -> typeInt-          NFloat _ -> typeFloat-          NBool _  -> typeBool-          NNull    -> typeNull+  synHole var = do+    tv <- fresh+    return $ Judgment (As.singleton var tv) [] tv -    evalString      = const $ return $ Judgment As.empty [] typeString-    evalLiteralPath = const $ return $ Judgment As.empty [] typePath-    evalEnvPath     = const $ return $ Judgment As.empty [] typePath+-- If we fail to look up an attribute, we just don't know the type.+  attrMissing _ _ = Judgment As.empty [] <$> fresh -    evalUnary op (Judgment as1 cs1 t1) = do-        tv <- fresh-        return $ Judgment as1 (cs1 ++ unops (t1 :~> tv) op) tv+  evaledSym _ = pure -    evalBinary op (Judgment as1 cs1 t1) e2 = do-        Judgment as2 cs2 t2 <- e2-        tv <- fresh-        return $ Judgment-            (as1 `As.merge` as2)-            (cs1 ++ cs2 ++ binops (t1 :~> t2 :~> tv) op)-            tv+  evalCurPos = return $ Judgment As.empty [] $ TSet False $ M.fromList+    [("file", typePath), ("line", typeInt), ("col", typeInt)] -    evalWith = Eval.evalWithAttrSet+  evalConstant c = return $ Judgment As.empty [] (go c)+   where+    go = \case+      NInt   _ -> typeInt+      NFloat _ -> typeFloat+      NBool  _ -> typeBool+      NNull    -> typeNull -    evalIf (Judgment as1 cs1 t1) t f = do-        Judgment as2 cs2 t2 <- t-        Judgment as3 cs3 t3 <- f-        return $ Judgment-            (as1 `As.merge` as2 `As.merge` as3)-            (cs1 ++ cs2 ++ cs3 ++ [EqConst t1 typeBool, EqConst t2 t3])-            t2+  evalString      = const $ return $ Judgment As.empty [] typeString+  evalLiteralPath = const $ return $ Judgment As.empty [] typePath+  evalEnvPath     = const $ return $ Judgment As.empty [] typePath -    evalAssert (Judgment as1 cs1 t1) body = do-        Judgment as2 cs2 t2 <- body-        return $ Judgment-            (as1 `As.merge` as2)-            (cs1 ++ cs2 ++ [EqConst t1 typeBool])-            t2+  evalUnary op (Judgment as1 cs1 t1) = do+    tv <- fresh+    return $ Judgment as1 (cs1 ++ unops (t1 :~> tv) op) tv -    evalApp (Judgment as1 cs1 t1) e2 = do-        Judgment as2 cs2 t2 <- e2-        tv <- fresh-        return $ Judgment-            (as1 `As.merge` as2)-            (cs1 ++ cs2 ++ [EqConst t1 (t2 :~> tv)])-            tv+  evalBinary op (Judgment as1 cs1 t1) e2 = do+    Judgment as2 cs2 t2 <- e2+    tv                  <- fresh+    return $ Judgment (as1 `As.merge` as2)+                      (cs1 ++ cs2 ++ binops (t1 :~> t2 :~> tv) op)+                      tv -    evalAbs (Param x) k = do-        tv@(TVar a) <- fresh-        ((), Judgment as cs t) <--            extendMSet a (k (pure (Judgment (As.singleton x tv) [] tv))-                            (\_ b -> ((),) <$> b))-        return $ Judgment-            (as `As.remove` x)-            (cs ++ [EqConst t' tv | t' <- As.lookup x as])-            (tv :~> t)+  evalWith = Eval.evalWithAttrSet -    evalAbs (ParamSet ps variadic _mname) k = do-        js <- fmap concat $ forM ps $ \(name, _) -> do-                tv <- fresh-                pure [(name, tv)]+  evalIf (Judgment as1 cs1 t1) t f = do+    Judgment as2 cs2 t2 <- t+    Judgment as3 cs3 t3 <- f+    return $ Judgment+      (as1 `As.merge` as2 `As.merge` as3)+      (cs1 ++ cs2 ++ cs3 ++ [EqConst t1 typeBool, EqConst t2 t3])+      t2 -        let (env, tys) = (\f -> foldl' f (As.empty, M.empty) js)-                $ \(as1, t1) (k, t) ->-                    (as1 `As.merge` As.singleton k t, M.insert k t t1)-            arg   = pure $ Judgment env [] (TSet True tys)-            call  = k arg $ \args b -> (args,) <$> b-            names = map fst js+  evalAssert (Judgment as1 cs1 t1) body = do+    Judgment as2 cs2 t2 <- body+    return+      $ Judgment (as1 `As.merge` as2) (cs1 ++ cs2 ++ [EqConst t1 typeBool]) t2 -        (args, Judgment as cs t) <--            foldr (\(_, TVar a) -> extendMSet a) call js+  evalApp (Judgment as1 cs1 t1) e2 = do+    Judgment as2 cs2 t2 <- e2+    tv                  <- fresh+    return $ Judgment (as1 `As.merge` as2)+                      (cs1 ++ cs2 ++ [EqConst t1 (t2 :~> tv)])+                      tv -        ty <- TSet variadic <$> traverse (inferredType <$>) args+  evalAbs (Param x) k = do+    a <- freshTVar+    let tv = TVar a+    ((), Judgment as cs t) <- extendMSet+      a+      (k (pure (Judgment (As.singleton x tv) [] tv)) (\_ b -> ((), ) <$> b))+    return $ Judgment (as `As.remove` x)+                      (cs ++ [ EqConst t' tv | t' <- As.lookup x as ])+                      (tv :~> t) -        return $ Judgment-            (foldl' As.remove as names)-            (cs ++ [ EqConst t' (tys M.! x)-                   | x  <- names-                   , t' <- As.lookup x as])-            (ty :~> t)+  evalAbs (ParamSet ps variadic _mname) k = do+    js <- fmap concat $ forM ps $ \(name, _) -> do+      tv <- fresh+      pure [(name, tv)] -    evalError = throwError . EvaluationError+    let (env, tys) =+          (\f -> foldl' f (As.empty, M.empty) js) $ \(as1, t1) (k, t) ->+            (as1 `As.merge` As.singleton k t, M.insert k t t1)+        arg   = pure $ Judgment env [] (TSet True tys)+        call  = k arg $ \args b -> (args, ) <$> b+        names = map fst js +    (args, Judgment as cs t) <- foldr (\(_, TVar a) -> extendMSet a) call js++    ty <- TSet variadic <$> traverse (inferredType <$>) args++    return $ Judgment+      (foldl' As.remove as names)+      (cs ++ [ EqConst t' (tys M.! x) | x <- names, t' <- As.lookup x as ])+      (ty :~> t)++  evalError = throwError . EvaluationError+ data Judgment s = Judgment     { assumptions     :: As.Assumption     , typeConstraints :: [Constraint]@@ -443,68 +526,71 @@     }     deriving Show -instance FromValue (Text, DList Text) (Infer s) (Judgment s) where-    fromValueMay _ = return Nothing-    fromValue _ = error "Unused"+instance Monad m => FromValue NixString (InferT s m) (Judgment s) where+  fromValueMay _ = return Nothing+  fromValue _ = error "Unused" -instance FromValue (AttrSet (JThunk s), AttrSet SourcePos) (Infer s) (Judgment s) where-    fromValueMay (Judgment _ _ (TSet _ xs)) = do-        let sing _ = Judgment As.empty []-        pure $ Just (M.mapWithKey (\k v -> value (sing k v)) xs, M.empty)-    fromValueMay _ = pure Nothing-    fromValue = fromValueMay >=> \case-        Just v  -> pure v-        Nothing -> pure (M.empty, M.empty)+instance MonadInfer m+  => FromValue (AttrSet (JThunkT s m), AttrSet SourcePos)+              (InferT s m) (Judgment s) where+  fromValueMay (Judgment _ _ (TSet _ xs)) = do+    let sing _ = Judgment As.empty []+    pure $ Just (M.mapWithKey (\k v -> wrapValue (sing k v)) xs, M.empty)+  fromValueMay _ = pure Nothing+  fromValue = fromValueMay >=> \case+    Just v  -> pure v+    Nothing -> pure (M.empty, M.empty) -instance ToValue (AttrSet (JThunk s), AttrSet SourcePos) (Infer s) (Judgment s) where-    toValue (xs, _) = Judgment-        <$> foldrM go As.empty xs-        <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)-        <*> (TSet True <$> traverse (`force` (pure . inferredType)) xs)-      where-        go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest+instance MonadInfer m+  => ToValue (AttrSet (JThunkT s m), AttrSet SourcePos)+            (InferT s m) (Judgment s) where+  toValue (xs, _) =+    Judgment+      <$> foldrM go As.empty xs+      <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)+      <*> (TSet True <$> traverse (`force` (pure . inferredType)) xs)+    where go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest -instance ToValue [JThunk s] (Infer s) (Judgment s) where-    toValue xs = Judgment-        <$> foldrM go As.empty xs-        <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)-        <*> (TList <$> traverse (`force` (pure . inferredType)) xs)-      where-        go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest+instance MonadInfer m => ToValue [JThunkT s m] (InferT s m) (Judgment s) where+  toValue xs =+    Judgment+      <$> foldrM go As.empty xs+      <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)+      <*> (TList <$> traverse (`force` (pure . inferredType)) xs)+    where go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest -instance ToValue Bool (Infer s) (Judgment s) where-    toValue _ = pure $ Judgment As.empty [] typeBool+instance MonadInfer m => ToValue Bool (InferT s m) (Judgment s) where+  toValue _ = pure $ Judgment As.empty [] typeBool -infer :: NExpr -> Infer s (Judgment s)+infer :: MonadInfer m => NExpr -> InferT s m (Judgment s) infer = cata Eval.eval  inferTop :: Env -> [(Text, NExpr)] -> Either InferError Env-inferTop env [] = Right env-inferTop env ((name, ex):xs) = case inferExpr env ex of-  Left err -> Left err-  Right ty -> inferTop (extend env (name, ty)) xs+inferTop env []                = Right env+inferTop env ((name, ex) : xs) = case inferExpr env ex of+  Left  err -> Left err+  Right ty  -> inferTop (extend env (name, ty)) xs  normalize :: Scheme -> Scheme normalize (Forall _ body) = Forall (map snd ord) (normtype body)-  where-    ord = zip (nub $ fv body) (map TV letters)+ where+  ord = zip (nub $ fv body) (map TV letters) -    fv (TVar a)    = [a]-    fv (a :~> b)   = fv a ++ fv b-    fv (TCon _)    = []-    fv (TSet _ a)  = concatMap fv (M.elems a)-    fv (TList a)   = concatMap fv a-    fv (TMany ts)  = concatMap fv ts+  fv (TVar a  ) = [a]+  fv (a :~> b ) = fv a ++ fv b+  fv (TCon _  ) = []+  fv (TSet _ a) = concatMap fv (M.elems a)+  fv (TList a ) = concatMap fv a+  fv (TMany ts) = concatMap fv ts -    normtype (a :~> b)  = normtype a :~> normtype b-    normtype (TCon a)   = TCon a-    normtype (TSet b a) = TSet b (M.map normtype a)-    normtype (TList a)  = TList (map normtype a)-    normtype (TMany ts) = TMany (map normtype ts)-    normtype (TVar a)   =-      case Prelude.lookup a ord of-        Just x -> TVar x-        Nothing -> error "type variable not in signature"+  normtype (a :~> b ) = normtype a :~> normtype b+  normtype (TCon a  ) = TCon a+  normtype (TSet b a) = TSet b (M.map normtype a)+  normtype (TList a ) = TList (map normtype a)+  normtype (TMany ts) = TMany (map normtype ts)+  normtype (TVar  a ) = case Prelude.lookup a ord of+    Just x  -> TVar x+    Nothing -> error "type variable not in signature"  ------------------------------------------------------------------------------- -- Constraint Solver@@ -515,18 +601,18 @@               MonadLogic, MonadState [TypeError])  instance MonadTrans Solver where-    lift = Solver . lift . lift+  lift = Solver . lift . lift  instance Monad m => MonadError TypeError (Solver m) where-    throwError err = Solver $ lift (modify (err:)) >> mzero-    catchError _ _ = error "This is never used"+  throwError err = Solver $ lift (modify (err :)) >> mzero+  catchError _ _ = error "This is never used"  runSolver :: Monad m => Solver m a -> m (Either [TypeError] [a]) runSolver (Solver s) = do-    res <- runStateT (observeAllT s) []-    pure $ case res of-        (x:xs, _) -> Right (x:xs)-        (_, es)   -> Left (nub es)+  res <- runStateT (observeAllT s) []+  pure $ case res of+    (x : xs, _ ) -> Right (x : xs)+    (_     , es) -> Left (nub es)  -- | The empty substitution emptySubst :: Subst@@ -535,62 +621,62 @@ -- | Compose substitutions compose :: Subst -> Subst -> Subst Subst s1 `compose` Subst s2 =-    Subst $ Map.map (apply (Subst s1)) s2 `Map.union` s1+  Subst $ Map.map (apply (Subst s1)) s2 `Map.union` s1  unifyMany :: Monad m => [Type] -> [Type] -> Solver m Subst-unifyMany [] [] = return emptySubst-unifyMany (t1 : ts1) (t2 : ts2) =-  do su1 <- unifies t1 t2-     su2 <- unifyMany (apply su1 ts1) (apply su1 ts2)-     return (su2 `compose` su1)+unifyMany []         []         = return emptySubst+unifyMany (t1 : ts1) (t2 : ts2) = do+  su1 <- unifies t1 t2+  su2 <- unifyMany (apply su1 ts1) (apply su1 ts2)+  return (su2 `compose` su1) unifyMany t1 t2 = throwError $ UnificationMismatch t1 t2  allSameType :: [Type] -> Bool-allSameType [] = True-allSameType [_] = True-allSameType (x:y:ys) = x == y && allSameType (y:ys)+allSameType []           = True+allSameType [_         ] = True+allSameType (x : y : ys) = x == y && allSameType (y : ys)  unifies :: Monad m => Type -> Type -> Solver m Subst-unifies t1 t2 | t1 == t2 = return emptySubst-unifies (TVar v) t = v `bind` t-unifies t (TVar v) = v `bind` t+unifies t1 t2 | t1 == t2  = return emptySubst+unifies (TVar v) t        = v `bind` t+unifies t        (TVar v) = v `bind` t unifies (TList xs) (TList ys)-    | allSameType xs && allSameType ys = case (xs, ys) of-          (x:_, y:_) -> unifies x y-          _ -> return emptySubst-    | length xs == length ys = unifyMany xs ys+  | allSameType xs && allSameType ys = case (xs, ys) of+    (x : _, y : _) -> unifies x y+    _              -> return emptySubst+  | length xs == length ys = unifyMany xs ys -- We assume that lists of different lengths containing various types cannot -- be unified.-unifies t1@(TList _) t2@(TList _) = throwError $ UnificationFail t1 t2-unifies (TSet True _) (TSet True _) = return emptySubst+unifies t1@(TList _    ) t2@(TList _    ) = throwError $ UnificationFail t1 t2+unifies (   TSet True _) (   TSet True _) = return emptySubst unifies (TSet False b) (TSet True s)-    | M.keys b `intersect` M.keys s == M.keys s = return emptySubst+  | M.keys b `intersect` M.keys s == M.keys s = return emptySubst unifies (TSet True s) (TSet False b)-    | M.keys b `intersect` M.keys s == M.keys b = return emptySubst-unifies (TSet False s) (TSet False b)-    | null (M.keys b \\ M.keys s) = return emptySubst+  | M.keys b `intersect` M.keys s == M.keys b = return emptySubst+unifies (TSet False s) (TSet False b) | null (M.keys b \\ M.keys s) =+  return emptySubst unifies (t1 :~> t2) (t3 :~> t4) = unifyMany [t1, t2] [t3, t4]-unifies (TMany t1s) t2 = considering t1s >>- unifies ?? t2-unifies t1 (TMany t2s) = considering t2s >>- unifies t1-unifies t1 t2 = throwError $ UnificationFail t1 t2+unifies (TMany t1s) t2          = considering t1s >>- unifies ?? t2+unifies t1          (TMany t2s) = considering t2s >>- unifies t1+unifies t1          t2          = throwError $ UnificationFail t1 t2  bind :: Monad m => TVar -> Type -> Solver m Subst bind a t | t == TVar a     = return emptySubst          | occursCheck a t = throwError $ InfiniteType a t          | otherwise       = return (Subst $ Map.singleton a t) -occursCheck ::  FreeTypeVars a => TVar -> a -> Bool+occursCheck :: FreeTypeVars a => TVar -> a -> Bool occursCheck a t = a `Set.member` ftv t  nextSolvable :: [Constraint] -> (Constraint, [Constraint]) nextSolvable xs = fromJust (find solvable (chooseOne xs))-  where-    chooseOne xs = [(x, ys) | x <- xs, let ys = delete x xs]+ where+  chooseOne xs = [ (x, ys) | x <- xs, let ys = delete x xs ] -    solvable (EqConst{}, _)      = True-    solvable (ExpInstConst{}, _) = True-    solvable (ImpInstConst _t1 ms t2, cs) =-        Set.null ((ftv t2 `Set.difference` ms) `Set.intersection` atv cs)+  solvable (EqConst{}     , _) = True+  solvable (ExpInstConst{}, _) = True+  solvable (ImpInstConst _t1 ms t2, cs) =+    Set.null ((ftv t2 `Set.difference` ms) `Set.intersection` atv cs)  considering :: [a] -> Solver m a considering xs = Solver $ LogicT $ \c n -> foldr c n xs@@ -598,15 +684,19 @@ solve :: MonadState InferState m => [Constraint] -> Solver m Subst solve [] = return emptySubst solve cs = solve' (nextSolvable cs)-  where-    solve' (EqConst t1 t2, cs) =-      unifies t1 t2 >>- \su1 ->-      solve (apply su1 cs) >>- \su2 ->-          return (su2 `compose` su1)+ where+  solve' (EqConst t1 t2, cs) = unifies t1 t2+    >>- \su1 -> solve (apply su1 cs) >>- \su2 -> return (su2 `compose` su1) -    solve' (ImpInstConst t1 ms t2, cs) =-      solve (ExpInstConst t1 (generalize ms t2) : cs)+  solve' (ImpInstConst t1 ms t2, cs) =+    solve (ExpInstConst t1 (generalize ms t2) : cs) -    solve' (ExpInstConst t s, cs) = do-      s' <- lift $ instantiate s-      solve (EqConst t s' : cs)+  solve' (ExpInstConst t s, cs) = do+    s' <- lift $ instantiate s+    solve (EqConst t s' : cs)++instance Monad m => Scoped (JThunkT s m) (InferT s m) where+  currentScopes = currentScopesReader+  clearScopes   = clearScopesReader @(InferT s m) @(JThunkT s m)+  pushScopes    = pushScopesReader+  lookupVar     = lookupVarReader
src/Nix/Type/Type.hs view
@@ -1,7 +1,7 @@ module Nix.Type.Type where -import qualified Data.HashMap.Lazy as M-import           Data.Text (Text)+import qualified Data.HashMap.Lazy             as M+import           Data.Text                      ( Text ) import           Nix.Utils  newtype TVar = TV String@@ -32,11 +32,11 @@ typeFun = foldr1 (:~>)  typeInt, typeFloat, typeBool, typeString, typePath, typeNull :: Type-typeInt    = TCon "integer"-typeFloat  = TCon "float"-typeBool   = TCon "boolean"+typeInt = TCon "integer"+typeFloat = TCon "float"+typeBool = TCon "boolean" typeString = TCon "string"-typePath   = TCon "path"-typeNull   = TCon "null"+typePath = TCon "path"+typeNull = TCon "null"  type Name = Text
src/Nix/Utils.hs view
@@ -2,37 +2,54 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-}+ module Nix.Utils (module Nix.Utils, module X) where -import           Control.Arrow ((&&&))+import           Control.Arrow                  ( (&&&) ) import           Control.Monad import           Control.Monad.Fix-import qualified Data.Aeson as A-import qualified Data.Aeson.Encoding as A+import qualified Data.Aeson                    as A+import qualified Data.Aeson.Encoding           as A import           Data.Fix-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M-import           Data.List (sortOn)-import           Data.Monoid (Endo)-import           Data.Text (Text)-import qualified Data.Vector as V-import           Lens.Family2 as X-import           Lens.Family2.Stock (_1, _2)+import           Data.Hashable+import           Data.HashMap.Lazy              ( HashMap )+import qualified Data.HashMap.Lazy             as M+import           Data.List                      ( sortOn )+import           Data.Monoid                    ( Endo+                                                , (<>)+                                                )+import           Data.Text                      ( Text )+import qualified Data.Text                     as Text+import qualified Data.Vector                   as V+import           Lens.Family2                  as X+import           Lens.Family2.Stock             ( _1+                                                , _2+                                                )+import           Lens.Family2.TH  #if ENABLE_TRACING import           Debug.Trace as X #else-import           Prelude as X+import           Prelude                       as X+                                         hiding ( putStr+                                                , putStrLn+                                                , print+                                                ) trace :: String -> a -> a trace = const id traceM :: Monad m => String -> m () traceM = const (return ()) #endif +$(makeLensesBy (\n -> Just ("_" ++ n)) ''Fix)+ type DList a = Endo [a]  type AttrSet = HashMap Text@@ -62,7 +79,7 @@ para f = f . fmap (id &&& para f) . unFix  paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a-paraM f = f <=< traverse (\x -> (x,) <$> paraM f x) . unFix+paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix  cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a cataP f x = f x . fmap (cataP f) . unFix $ x@@ -70,7 +87,7 @@ cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a cataPM f x = f x <=< traverse (cataPM f) . unFix $ x -transport :: Functor g => (forall x. f x -> g x) -> Fix f -> Fix g+transport :: Functor g => (forall x . f x -> g x) -> Fix f -> Fix g transport f (Fix x) = Fix $ fmap (transport f) (f x)  -- | adi is Abstracting Definitional Interpreters:@@ -83,28 +100,67 @@ adi :: Functor f => (f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a adi f g = g (f . fmap (adi f g) . unFix) -adiM :: (Traversable t, Monad m)-     => (t a -> m a) -> ((Fix t -> m a) -> Fix t -> m a) -> Fix t -> m a+adiM+  :: (Traversable t, Monad m)+  => (t a -> m a)+  -> ((Fix t -> m a) -> Fix t -> m a)+  -> Fix t+  -> m a adiM f g = g ((f <=< traverse (adiM f g)) . unFix)  class Has a b where     hasLens :: Lens' a b  instance Has a a where-    hasLens f = f+  hasLens f = f  instance Has (a, b) a where-    hasLens = _1+  hasLens = _1  instance Has (a, b) b where-    hasLens = _2+  hasLens = _2  toEncodingSorted :: A.Value -> A.Encoding toEncodingSorted = \case-    A.Object m ->-        A.pairs . mconcat-                . fmap (\(k, v) -> A.pair k $ toEncodingSorted v)-                . sortOn fst-                $ M.toList m-    A.Array l -> A.list toEncodingSorted $ V.toList l-    v -> A.toEncoding v+  A.Object m ->+    A.pairs+      . mconcat+      . fmap (\(k, v) -> A.pair k $ toEncodingSorted v)+      . sortOn fst+      $ M.toList m+  A.Array l -> A.list toEncodingSorted $ V.toList l+  v         -> A.toEncoding v++data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Show, Eq)++-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon+-- (i.e. @https://...@)+uriAwareSplit :: Text -> [(Text, NixPathEntryType)]+uriAwareSplit = go where+  go str = case Text.break (== ':') str of+    (e1, e2)+      | Text.null e2+      -> [(e1, PathEntryPath)]+      | Text.pack "://" `Text.isPrefixOf` e2+      -> let ((suffix, _) : path) = go (Text.drop 3 e2)+         in  (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path+      | otherwise+      -> (e1, PathEntryPath) : go (Text.drop 1 e2)++alterF+  :: (Eq k, Hashable k, Functor f)+  => (Maybe v -> f (Maybe v))+  -> k+  -> HashMap k v+  -> f (HashMap k v)+alterF f k m = f (M.lookup k m) <&> \case+  Nothing -> M.delete k m+  Just v  -> M.insert k v m++++++++
src/Nix/Value.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}@@ -8,6 +9,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -15,29 +17,29 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}  {-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}  module Nix.Value where +import           Control.Comonad+import           Control.Exception import           Control.Monad-import           Control.Monad.Catch+import           Control.Monad.Free import           Control.Monad.Trans.Class-import           Control.Monad.Trans.Except-import qualified Data.Aeson as A-import           Data.Align-import           Data.Fix-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as M-import           Data.Hashable-import           Data.Monoid (appEndo)-import           Data.Text (Text)-import           Data.These-import           Data.Typeable (Typeable)+import qualified Data.Aeson                    as A+import           Data.Functor.Classes+import           Data.HashMap.Lazy              ( HashMap )+import           Data.Text                      ( Text )+import           Data.Typeable                  ( Typeable ) import           GHC.Generics import           Lens.Family2 import           Lens.Family2.Stock@@ -45,23 +47,22 @@ import           Nix.Atoms import           Nix.Expr.Types import           Nix.Expr.Types.Annotated-import           Nix.Frames-import           Nix.Scope+import           Nix.String import           Nix.Thunk import           Nix.Utils  -- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation is --   completed. 's' is related to the type of errors that might occur during --   construction or use of a value.-data NValueF m r+data NValueF p m r     = NVConstantF NAtom      -- | A string has a value and a context, which can be used to record what a      -- string has been build from-    | NVStrF Text (DList Text)+    | NVStrF NixString     | NVPathF FilePath     | NVListF [r]     | NVSetF (AttrSet r) (AttrSet SourcePos)-    | NVClosureF (Params ()) (m (NValue m) -> m (NValue m))+    | NVClosureF (Params ()) (m p -> m r)       -- ^ A function is a closed set of parameters representing the "call       --   signature", used at application time to check the type of arguments       --   passed to the function. Since it supports default values which may@@ -73,201 +74,349 @@       --   Note that 'm r' is being used here because effectively a function       --   and its set of default arguments is "never fully evaluated". This       --   enforces in the type that it must be re-evaluated for each call.-    | NVBuiltinF String (m (NValue m) -> m (NValue m))+    | NVBuiltinF String (m p -> m r)       -- ^ A builtin function is itself already in normal form. Also, it may       --   or may not choose to evaluate its argument in the production of a       --   result.-    deriving (Generic, Typeable, Functor, Foldable, Traversable)+    deriving (Generic, Typeable, Functor) --- | An 'NValueNF' is a fully evaluated value in normal form. An 'NValue m' is---   a value in head normal form, where only the "top layer" has been---   evaluated. An action of type 'm (NValue m)' is a pending evualation that---   has yet to be performed. An 'NThunk m' is either a pending evaluation, or---   a value in head normal form. A 'NThunkSet' is a set of mappings from keys---   to thunks.+-- | This 'Foldable' instance only folds what the value actually is known to+--   contain at time of fold.+instance Foldable (NValueF p m) where+  foldMap f = \case+    NVConstantF _  -> mempty+    NVStrF      _  -> mempty+    NVPathF     _  -> mempty+    NVListF     l  -> foldMap f l+    NVSetF     s _ -> foldMap f s+    NVClosureF _ _ -> mempty+    NVBuiltinF _ _ -> mempty -type NValueNF m = Fix (NValueF m)      -- normal form-type ValueSet m = AttrSet (NThunk m)+lmapNValueF :: Functor m => (b -> a) -> NValueF a m r -> NValueF b m r+lmapNValueF f = \case+  NVConstantF a  -> NVConstantF a+  NVStrF      s  -> NVStrF s+  NVPathF     p  -> NVPathF p+  NVListF     l  -> NVListF l+  NVSetF     s p -> NVSetF s p+  NVClosureF p g -> NVClosureF p (g . fmap f)+  NVBuiltinF s g -> NVBuiltinF s (g . fmap f) -data Provenance m = Provenance-    { _lexicalScope :: Scopes m (NThunk m)-    , _originExpr   :: NExprLocF (Maybe (NValue m))-      -- ^ When calling the function x: x + 2 with argument x = 3, the-      --   'originExpr' for the resulting value will be 3 + 2, while the-      --   'contextExpr' will be @(x: x + 2) 3@, preserving not only the-      --   result of the call, but what was called and with what arguments.-    }+hoistNValueF+  :: (forall x . n x -> m x)+  -> (forall x . m x -> n x)+  -> NValueF p m a+  -> NValueF p n a+hoistNValueF run lft = \case+  NVConstantF a  -> NVConstantF a+  NVStrF      s  -> NVStrF s+  NVPathF     p  -> NVPathF p+  NVListF     l  -> NVListF l+  NVSetF     s p -> NVSetF s p+  NVClosureF p g -> NVClosureF p (lft . g . run)+  NVBuiltinF s g -> NVBuiltinF s (lft . g . run) -data NThunk m = NThunk-    { _thunkProvenance :: [Provenance m]-    , _baseThunk       :: Thunk m (NValue m)-    }+sequenceNValueF+  :: (Functor n, Monad m, Applicative n)+  => (forall x . n x -> m x)+  -> NValueF p m (n a)+  -> n (NValueF p m a)+sequenceNValueF transform = \case+  NVConstantF a  -> pure $ NVConstantF a+  NVStrF      s  -> pure $ NVStrF s+  NVPathF     p  -> pure $ NVPathF p+  NVListF     l  -> NVListF <$> sequenceA l+  NVSetF     s p -> NVSetF <$> sequenceA s <*> pure p+  NVClosureF p g -> pure $ NVClosureF p (transform <=< g)+  NVBuiltinF s g -> pure $ NVBuiltinF s (transform <=< g) -data NValue m = NValue-    { _valueProvenance :: [Provenance m]-    , _baseValue       :: NValueF m (NThunk m)-    }+bindNValueF+  :: (Monad m, Monad n)+  => (forall x . n x -> m x)+  -> (a -> n b)+  -> NValueF p m a+  -> n (NValueF p m b)+bindNValueF transform f = \case+  NVConstantF a  -> pure $ NVConstantF a+  NVStrF      s  -> pure $ NVStrF s+  NVPathF     p  -> pure $ NVPathF p+  NVListF     l  -> NVListF <$> traverse f l+  NVSetF     s p -> NVSetF <$> traverse f s <*> pure p+  NVClosureF p g -> pure $ NVClosureF p (transform . f <=< g)+  NVBuiltinF s g -> pure $ NVBuiltinF s (transform . f <=< g) -addProvenance :: (NValue m -> Provenance m) -> NValue m -> NValue m-addProvenance f l@(NValue p v) = NValue (f l : p) v+liftNValueF+  :: (MonadTrans u, Monad m)+  => (forall x . u m x -> m x)+  -> NValueF p m a+  -> NValueF p (u m) a+liftNValueF run = hoistNValueF run lift -pattern NVConstant x <- NValue _ (NVConstantF x)+unliftNValueF+  :: (MonadTrans u, Monad m)+  => (forall x . u m x -> m x)+  -> NValueF p (u m) a+  -> NValueF p m a+unliftNValueF run = hoistNValueF lift run -nvConstant x = NValue [] (NVConstantF x)-nvConstantP p x = NValue [p] (NVConstantF x)+type MonadDataContext f (m :: * -> *)+  = (Comonad f, Applicative f, Traversable f, Monad m) -pattern NVStr s d <- NValue _ (NVStrF s d)+-- | At the time of constructor, the expected arguments to closures are values+--   that may contain thunks. The type of such thunks are fixed at that time.+newtype NValue' t f m a = NValue { _nValue :: f (NValueF (NValue t f m) m a) }+    deriving (Generic, Typeable, Functor, Foldable) -nvStr s d = NValue [] (NVStrF s d)-nvStrP p s d = NValue [p] (NVStrF s d)+instance Show r => Show (NValueF p m r) where+  showsPrec = flip go   where+    go (NVConstantF atom  ) = showsCon1 "NVConstant" atom+    go (NVStrF      ns    ) = showsCon1 "NVStr" (hackyStringIgnoreContext ns)+    go (NVListF     lst   ) = showsCon1 "NVList" lst+    go (NVSetF     attrs _) = showsCon1 "NVSet" attrs+    go (NVClosureF p     _) = showsCon1 "NVClosure" p+    go (NVPathF p         ) = showsCon1 "NVPath" p+    go (NVBuiltinF name _ ) = showsCon1 "NVBuiltin" name -pattern NVPath x <- NValue _ (NVPathF x)+    showsCon1 :: Show a => String -> a -> Int -> String -> String+    showsCon1 con a d =+      showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a -nvPath x = NValue [] (NVPathF x)-nvPathP p x = NValue [p] (NVPathF x)+instance (Comonad f, Show a) => Show (NValue' t f m a) where+  show (NValue (extract -> v)) = show v -pattern NVList l <- NValue _ (NVListF l)+instance Comonad f => Show1 (NValue' t f m) where+  liftShowsPrec sp sl p = \case+    NVConstant atom -> showsUnaryWith showsPrec "NVConstantF" p atom+    NVStr ns ->+      showsUnaryWith showsPrec "NVStrF" p (hackyStringIgnoreContext ns)+    NVList lst       -> showsUnaryWith (liftShowsPrec sp sl) "NVListF" p lst+    NVSet attrs _    -> showsUnaryWith (liftShowsPrec sp sl) "NVSetF" p attrs+    NVPath path      -> showsUnaryWith showsPrec "NVPathF" p path+    NVClosure c    _ -> showsUnaryWith showsPrec "NVClosureF" p c+    NVBuiltin name _ -> showsUnaryWith showsPrec "NVBuiltinF" p name+    _                -> error "Pattern synonyms mask coverage" -nvList l = NValue [] (NVListF l)-nvListP p l = NValue [p] (NVListF l)+type NValue t f m = NValue' t f m t -pattern NVSet s x <- NValue _ (NVSetF s x)+sequenceNValue+  :: (Functor n, Traversable f, Monad m, Applicative n)+  => (forall x . n x -> m x)+  -> NValue' t f m (n a)+  -> n (NValue' t f m a)+sequenceNValue transform (NValue v) =+  NValue <$> traverse (sequenceNValueF transform) v -nvSet s x = NValue [] (NVSetF s x)-nvSetP p s x = NValue [p] (NVSetF s x)+bindNValue+  :: (Traversable f, Monad m, Monad n)+  => (forall x . n x -> m x)+  -> (a -> n b)+  -> NValue' t f m a+  -> n (NValue' t f m b)+bindNValue transform f (NValue v) =+  NValue <$> traverse (bindNValueF transform f) v -pattern NVClosure x f <- NValue _ (NVClosureF x f)+hoistNValue+  :: (Functor m, Functor n, Functor f)+  => (forall x . n x -> m x)+  -> (forall x . m x -> n x)+  -> NValue' t f m a+  -> NValue' t f n a+hoistNValue run lft (NValue v) =+  NValue (fmap (lmapNValueF (hoistNValue lft run) . hoistNValueF run lft) v) -nvClosure x f = NValue [] (NVClosureF x f)-nvClosureP p x f = NValue [p] (NVClosureF x f)+liftNValue+  :: (MonadTrans u, Monad m, Functor (u m), Functor f)+  => (forall x . u m x -> m x)+  -> NValue' t f m a+  -> NValue' t f (u m) a+liftNValue run = hoistNValue run lift -pattern NVBuiltin name f <- NValue _ (NVBuiltinF name f)+unliftNValue+  :: (MonadTrans u, Monad m, Functor (u m), Functor f)+  => (forall x . u m x -> m x)+  -> NValue' t f (u m) a+  -> NValue' t f m a+unliftNValue run = hoistNValue lift run -nvBuiltin name f = NValue [] (NVBuiltinF name f)-nvBuiltinP p name f = NValue [p] (NVBuiltinF name f)+-- | An 'NValueNF' is a fully evaluated value in normal form. An 'NValue f t m' is+--   a value in head normal form, where only the "top layer" has been+--   evaluated. An action of type 'm (NValue f t m)' is a pending evualation that+--   has yet to be performed. An 't' is either a pending evaluation, or+--   a value in head normal form. A 'NThunkSet' is a set of mappings from keys+--   to thunks.+--+--   The 'Free' structure is used here to represent the possibility that+--   cycles may appear during normalization. -instance Show (NValueF m (Fix (NValueF m))) where-    showsPrec = flip go where-      go (NVConstantF atom)  = showsCon1 "NVConstant" atom-      go (NVStrF txt ctxt)   = showsCon2 "NVStr"      txt (appEndo ctxt [])-      go (NVListF     lst)   = showsCon1 "NVList"     lst-      go (NVSetF attrs _)    = showsCon1 "NVSet"      attrs-      go (NVClosureF p _)    = showsCon1 "NVClosure"  p-      go (NVPathF p)         = showsCon1 "NVPath"     p-      go (NVBuiltinF name _) = showsCon1 "NVBuiltin"  name+type NValueNF t f m = Free (NValue' t f m) t -      showsCon1 :: Show a => String -> a -> Int -> String -> String-      showsCon1 con a d =-          showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a+iterNValue+  :: forall t f m a r+   . MonadDataContext f m+  => (a -> (NValue' t f m a -> r) -> r)+  -> (NValue' t f m r -> r)+  -> NValue' t f m a+  -> r+iterNValue k f = f . fmap (\a -> k a (iterNValue k f)) -      showsCon2 :: (Show a, Show b)-                => String -> a -> b -> Int -> String -> String-      showsCon2 con a b d =-          showParen (d > 10)-              $ showString (con ++ " ")-              . showsPrec 11 a-              . showString " "-              . showsPrec 11 b+iterNValueM+  :: (MonadDataContext f m, Monad n)+  => (forall x . n x -> m x)+  -> (a -> (NValue' t f m a -> n r) -> n r)+  -> (NValue' t f m r -> n r)+  -> NValue' t f m a+  -> n r+iterNValueM transform k f =+  f <=< bindNValue transform (\a -> k a (iterNValueM transform k f)) -instance Eq (NValue m) where-    NVConstant (NFloat x) == NVConstant (NInt y)   = x == fromInteger y-    NVConstant (NInt x)   == NVConstant (NFloat y) = fromInteger x == y-    NVConstant (NInt x)   == NVConstant (NInt y)   = x == y-    NVConstant (NFloat x) == NVConstant (NFloat y) = x == y-    NVStr x _ == NVStr y _ = x < y-    NVPath x  == NVPath y  = x < y-    _         == _         = False+iterNValueNF+  :: MonadDataContext f m+  => (t -> r)+  -> (NValue' t f m r -> r)+  -> NValueNF t f m+  -> r+iterNValueNF k f = iter f . fmap k -instance Ord (NValue m) where-    NVConstant (NFloat x) <= NVConstant (NInt y)   = x <= fromInteger y-    NVConstant (NInt x)   <= NVConstant (NFloat y) = fromInteger x <= y-    NVConstant (NInt x)   <= NVConstant (NInt y)   = x <= y-    NVConstant (NFloat x) <= NVConstant (NFloat y) = x <= y-    NVStr x _ <= NVStr y _ = x < y-    NVPath x  <= NVPath y  = x < y-    _         <= _         = False+iterNValueNFM+  :: forall f m n t r+   . (MonadDataContext f m, Monad n)+  => (forall x . n x -> m x)+  -> (t -> n r)+  -> (NValue' t f m (n r) -> n r)+  -> NValueNF t f m+  -> n r+iterNValueNFM transform k f v =+  iterM f =<< go (fmap k v)+  where+  go (Pure a ) = Pure <$> a+  go (Free fa) = Free <$> bindNValue transform go fa -checkComparable :: (Framed e m, Typeable m) => NValue m -> NValue m -> m ()-checkComparable x y = case (x, y) of-    (NVConstant (NFloat _), NVConstant (NInt _))   -> pure ()-    (NVConstant (NInt _),   NVConstant (NFloat _)) -> pure ()-    (NVConstant (NInt _),   NVConstant (NInt _))   -> pure ()-    (NVConstant (NFloat _), NVConstant (NFloat _)) -> pure ()-    (NVStr _ _, NVStr _ _) -> pure ()-    (NVPath _, NVPath _)   -> pure ()-    _ -> throwError $ Comparison x y+nValueFromNF+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => NValueNF t f m+  -> NValue t f m+nValueFromNF = iterNValueNF f (fmap wrapValue)+ where+  f t = query t cyc id+  cyc = nvStr (principledMakeNixStringWithoutContext "<CYCLE>") -builtin :: Monad m-        => String -> (m (NValue m) -> m (NValue m)) -> m (NValue m)-builtin name f = return $ nvBuiltin name f+nValueToNF+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => (t -> (NValue t f m -> NValueNF t f m) -> NValueNF t f m)+  -> NValue t f m+  -> NValueNF t f m+nValueToNF k = iterNValue k Free -builtin2 :: Monad m-         => String -> (m (NValue m) -> m (NValue m) -> m (NValue m))-         -> m (NValue m)-builtin2 name f = builtin name (builtin name . f)+nValueToNFM+  :: (MonadDataContext f m, Monad n)+  => (forall x . n x -> m x)+  -> (t -> (NValue t f m -> n (NValueNF t f m)) -> n (NValueNF t f m))+  -> NValue t f m+  -> n (NValueNF t f m)+nValueToNFM transform k = iterNValueM transform k $ pure . Free -builtin3 :: Monad m-         => String-         -> (m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m))-         -> m (NValue m)-builtin3 name f =-    builtin name $ \a -> builtin name $ \b -> builtin name $ \c -> f a b c+pattern NVConstant x <- NValue (extract -> NVConstantF x)+pattern NVConstantNF x <- Free (NValue (extract -> NVConstantF x)) -isClosureNF :: Monad m => NValueNF m -> Bool-isClosureNF (Fix NVClosureF {}) = True-isClosureNF _ = False+nvConstant :: Applicative f => NAtom -> NValue t f m+nvConstant x = NValue (pure (NVConstantF x))+nvConstantNF :: Applicative f => NAtom -> NValueNF t f m+nvConstantNF x = Free (NValue (pure (NVConstantF x))) -thunkEq :: MonadThunk (NValue m) (NThunk m) m-        => NThunk m -> NThunk m -> m Bool-thunkEq lt rt = force lt $ \lv -> force rt $ \rv -> valueEq lv rv+pattern NVStr ns <- NValue (extract -> NVStrF ns)+pattern NVStrNF ns <- Free (NValue (extract -> NVStrF ns)) --- | Checks whether two containers are equal, using the given item equality---   predicate. If there are any item slots that don't match between the two---   containers, the result will be False.-alignEqM-    :: (Align f, Traversable f, Monad m)-    => (a -> b -> m Bool)-    -> f a-    -> f b-    -> m Bool-alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $ do-    pairs <- forM (Data.Align.align fa fb) $ \case-        These a b -> return (a, b)-        _ -> throwE ()-    forM_ pairs $ \(a, b) -> guard =<< lift (eq a b)+nvStr :: Applicative f => NixString -> NValue t f m+nvStr ns = NValue (pure (NVStrF ns))+nvStrNF :: Applicative f => NixString -> NValueNF t f m+nvStrNF ns = Free (NValue (pure (NVStrF ns))) -isDerivation :: MonadThunk (NValue m) (NThunk m) m-             => AttrSet (NThunk m) -> m Bool-isDerivation m = case M.lookup "type" m of-    Nothing -> pure False-    Just t -> force t $ valueEq (nvStr "derivation" mempty)+pattern NVPath x <- NValue (extract -> NVPathF x)+pattern NVPathNF x <- Free (NValue (extract -> NVPathF x)) -valueEq :: MonadThunk (NValue m) (NThunk m) m-        => NValue m -> NValue m -> m Bool-valueEq l r = case (l, r) of-    (NVConstant lc, NVConstant rc) -> pure $ lc == rc-    (NVStr ls _, NVStr rs _) -> pure $ ls == rs-    (NVStr ls _, NVConstant NNull) -> pure $ ls == ""-    (NVConstant NNull, NVStr rs _) -> pure $ "" == rs-    (NVList ls, NVList rs) -> alignEqM thunkEq ls rs-    (NVSet lm _, NVSet rm _) -> do-        let compareAttrs = alignEqM thunkEq lm rm-        isDerivation lm >>= \case-            True -> isDerivation rm >>= \case-                True | Just lp <- M.lookup "outPath" lm-                     , Just rp <- M.lookup "outPath" rm-                       -> thunkEq lp rp-                _ -> compareAttrs-            _ -> compareAttrs-    (NVPath lp, NVPath rp) -> pure $ lp == rp-    _ -> pure False+nvPath :: Applicative f => FilePath -> NValue t f m+nvPath x = NValue (pure (NVPathF x))+nvPathNF :: Applicative f => FilePath -> NValueNF t f m+nvPathNF x = Free (NValue (pure (NVPathF x))) +pattern NVList l <- NValue (extract -> NVListF l)+pattern NVListNF l <- Free (NValue (extract -> NVListF l))++nvList :: Applicative f => [t] -> NValue t f m+nvList l = NValue (pure (NVListF l))+nvListNF :: Applicative f => [NValueNF t f m] -> NValueNF t f m+nvListNF l = Free (NValue (pure (NVListF l)))++pattern NVSet s x <- NValue (extract -> NVSetF s x)+pattern NVSetNF s x <- Free (NValue (extract -> NVSetF s x))++nvSet :: Applicative f+      => HashMap Text t -> HashMap Text SourcePos -> NValue t f m+nvSet s x = NValue (pure (NVSetF s x))+nvSetNF :: Applicative f+        => HashMap Text (NValueNF t f m) -> HashMap Text SourcePos -> NValueNF t f m+nvSetNF s x = Free (NValue (pure (NVSetF s x)))++pattern NVClosure x f <- NValue (extract -> NVClosureF x f)+pattern NVClosureNF x f <- Free (NValue (extract -> NVClosureF x f))++nvClosure :: Applicative f+          => Params () -> (m (NValue t f m) -> m t) -> NValue t f m+nvClosure x f = NValue (pure (NVClosureF x f))+nvClosureNF :: Applicative f+            => Params () -> (m (NValue t f m) -> m (NValueNF t f m)) -> NValueNF t f m+nvClosureNF x f = Free (NValue (pure (NVClosureF x f)))++pattern NVBuiltin name f <- NValue (extract -> NVBuiltinF name f)+pattern NVBuiltinNF name f <- Free (NValue (extract -> NVBuiltinF name f))++nvBuiltin :: Applicative f+          => String -> (m (NValue t f m) -> m t) -> NValue t f m+nvBuiltin name f = NValue (pure (NVBuiltinF name f))+nvBuiltinNF :: Applicative f+            => String -> (m (NValue t f m) -> m (NValueNF t f m)) -> NValueNF t f m+nvBuiltinNF name f = Free (NValue (pure (NVBuiltinF name f)))++builtin+  :: forall m f t+   . (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => String+  -> (m (NValue t f m) -> m (NValue t f m))+  -> m (NValue t f m)+builtin name f = return $ nvBuiltin name $ \a -> thunk $ f a++builtin2+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => String+  -> (m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m))+  -> m (NValue t f m)+builtin2 name f = builtin name $ \a -> builtin name $ \b -> f a b++builtin3+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)+  => String+  -> (  m (NValue t f m)+     -> m (NValue t f m)+     -> m (NValue t f m)+     -> m (NValue t f m)+     )+  -> m (NValue t f m)+builtin3 name f =+  builtin name $ \a -> builtin name $ \b -> builtin name $ \c -> f a b c++isClosureNF :: Comonad f => NValueNF t f m -> Bool+isClosureNF NVClosureNF{} = True+isClosureNF _             = False++data TStringContext = NoContext | HasContext+  deriving Show+ data ValueType     = TInt     | TFloat     | TBool     | TNull-    | TString+    | TString TStringContext     | TList     | TSet     | TClosure@@ -275,72 +424,59 @@     | TBuiltin     deriving Show -valueType :: NValueF m r -> ValueType+valueType :: NValueF a m r -> ValueType valueType = \case-    NVConstantF a -> case a of-        NInt _    -> TInt-        NFloat _  -> TFloat-        NBool _   -> TBool-        NNull     -> TNull-    NVStrF {}     -> TString-    NVListF {}    -> TList-    NVSetF {}     -> TSet-    NVClosureF {} -> TClosure-    NVPathF {}    -> TPath-    NVBuiltinF {} -> TBuiltin+  NVConstantF a -> case a of+    NInt   _ -> TInt+    NFloat _ -> TFloat+    NBool  _ -> TBool+    NNull    -> TNull+  NVStrF ns | stringHasContext ns -> TString HasContext+            | otherwise           -> TString NoContext+  NVListF{}    -> TList+  NVSetF{}     -> TSet+  NVClosureF{} -> TClosure+  NVPathF{}    -> TPath+  NVBuiltinF{} -> TBuiltin  describeValue :: ValueType -> String describeValue = \case-    TInt     -> "an integer"-    TFloat   -> "a float"-    TBool    -> "a boolean"-    TNull    -> "a null"-    TString  -> "a string"-    TList    -> "a list"-    TSet     -> "an attr set"-    TClosure -> "a function"-    TPath    -> "a path"-    TBuiltin -> "a builtin function"--instance Show (NValueF m (NThunk m)) where-    show = show . describeValue . valueType--instance Show (NValue m) where-    show (NValue _ v)  = show v--instance Show (NThunk m) where-    show (NThunk _ (Value v)) = show v-    show (NThunk _ _) = "<thunk>"+  TInt               -> "an integer"+  TFloat             -> "a float"+  TBool              -> "a boolean"+  TNull              -> "a null"+  TString NoContext  -> "a string"+  TString HasContext -> "a string with context"+  TList              -> "a list"+  TSet               -> "an attr set"+  TClosure           -> "a function"+  TPath              -> "a path"+  TBuiltin           -> "a builtin function" -data ValueFrame m+data ValueFrame t f m     = ForcingThunk-    | ConcerningValue (NValue m)-    | Comparison (NValue m) (NValue m)-    | Addition (NValue m) (NValue m)-    | Multiplication (NValue m) (NValue m)-    | Division (NValue m) (NValue m)+    | ConcerningValue (NValue t f m)+    | Comparison (NValue t f m) (NValue t f m)+    | Addition (NValue t f m) (NValue t f m)+    | Multiplication (NValue t f m) (NValue t f m)+    | Division (NValue t f m) (NValue t f m)     | Coercion ValueType ValueType-    | CoercionToJsonNF (NValueNF m)+    | CoercionToJson (NValue t f m)     | CoercionFromJson A.Value-    | ExpectationNF ValueType (NValueNF m)-    | Expectation ValueType (NValue m)+    | ExpectationNF ValueType (NValueNF t f m)+    | Expectation ValueType (NValue t f m)     deriving (Show, Typeable) -instance Typeable m => Exception (ValueFrame m)--$(makeTraversals ''NValueF)-$(makeLenses ''Provenance)-$(makeLenses ''NThunk)-$(makeLenses ''NValue)+type MonadDataErrorContext t f m+  = (Show t, Typeable t, Typeable m, Typeable f, MonadDataContext f m) -alterF :: (Eq k, Hashable k, Functor f)-       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)-alterF f k m = f (M.lookup k m) <&> \case-    Nothing -> M.delete k m-    Just v  -> M.insert k v m+instance MonadDataErrorContext t f m => Exception (ValueFrame t f m) -hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)-hashAt = flip alterF+$(makeTraversals ''NValueF)+$(makeLenses ''NValue') -key :: Applicative f => VarName -> LensLike' f (NValue m) (Maybe (NThunk m))-key k = baseValue._NVSetF._1.hashAt k+key+  :: (Traversable f, Applicative g)+  => VarName+  -> LensLike' g (NValue' t f m a) (Maybe a)+key k = nValue . traverse . _NVSetF . _1 . hashAt k
+ src/Nix/Value/Equal.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}++module Nix.Value.Equal where++import           Control.Comonad+import           Control.Monad+import           Control.Monad.Free+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Except+import           Data.Align+import           Data.Eq.Deriving+import           Data.Functor.Classes+import           Data.Functor.Identity+import qualified Data.HashMap.Lazy             as M+import           Data.These+import           Nix.Atoms+import           Nix.Frames+import           Nix.String+import           Nix.Thunk+import           Nix.Utils+import           Nix.Value++checkComparable+  :: (Framed e m, MonadDataErrorContext t f m)+  => NValue t f m+  -> NValue t f m+  -> m ()+checkComparable x y = case (x, y) of+  (NVConstant (NFloat _), NVConstant (NInt _)) -> pure ()+  (NVConstant (NInt _), NVConstant (NFloat _)) -> pure ()+  (NVConstant (NInt _), NVConstant (NInt _)) -> pure ()+  (NVConstant (NFloat _), NVConstant (NFloat _)) -> pure ()+  (NVStr _, NVStr _) -> pure ()+  (NVPath _, NVPath _) -> pure ()+  _ -> throwError $ Comparison x y++thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool+thunkEqM lt rt = force lt $ \lv -> force rt $ \rv ->+  let unsafePtrEq = case (lt, rt) of+        (thunkId -> lid, thunkId -> rid) | lid == rid -> return True+        _ -> valueEqM lv rv+  in  case (lv, rv) of+        (NVClosure _ _, NVClosure _ _) -> unsafePtrEq+        (NVList _     , NVList _     ) -> unsafePtrEq+        (NVSet _ _    , NVSet _ _    ) -> unsafePtrEq+        _                              -> valueEqM lv rv++-- | Checks whether two containers are equal, using the given item equality+--   predicate. If there are any item slots that don't match between the two+--   containers, the result will be False.+alignEqM+  :: (Align f, Traversable f, Monad m)+  => (a -> b -> m Bool)+  -> f a+  -> f b+  -> m Bool+alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $ do+  pairs <- forM (Data.Align.align fa fb) $ \case+    These a b -> return (a, b)+    _         -> throwE ()+  forM_ pairs $ \(a, b) -> guard =<< lift (eq a b)++alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool+alignEq eq fa fb = runIdentity $ alignEqM (\x y -> Identity (eq x y)) fa fb++isDerivationM :: Monad m => (t -> m (Maybe NixString)) -> AttrSet t -> m Bool+isDerivationM f m = case M.lookup "type" m of+  Nothing -> pure False+  Just t  -> do+    mres <- f t+    case mres of+        -- We should probably really make sure the context is empty here+        -- but the C++ implementation ignores it.+      Just s  -> pure $ principledStringIgnoreContext s == "derivation"+      Nothing -> pure False++isDerivation :: Monad m => (t -> Maybe NixString) -> AttrSet t -> Bool+isDerivation f = runIdentity . isDerivationM (\x -> Identity (f x))++valueFEqM+  :: Monad n+  => (AttrSet a -> AttrSet a -> n Bool)+  -> (a -> a -> n Bool)+  -> NValueF p m a+  -> NValueF p m a+  -> n Bool+valueFEqM attrsEq eq = curry $ \case+  (NVConstantF (NFloat x), NVConstantF (NInt y)  ) -> pure $ x == fromInteger y+  (NVConstantF (NInt   x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y+  (NVConstantF lc        , NVConstantF rc        ) -> pure $ lc == rc+  (NVStrF ls, NVStrF rs) ->+    pure $ principledStringIgnoreContext ls == principledStringIgnoreContext rs+  (NVListF ls , NVListF rs ) -> alignEqM eq ls rs+  (NVSetF lm _, NVSetF rm _) -> attrsEq lm rm+  (NVPathF lp , NVPathF rp ) -> pure $ lp == rp+  _                          -> pure False++valueFEq+  :: (AttrSet a -> AttrSet a -> Bool)+  -> (a -> a -> Bool)+  -> NValueF p m a+  -> NValueF p m a+  -> Bool+valueFEq attrsEq eq x y = runIdentity $ valueFEqM+  (\x' y' -> Identity (attrsEq x' y'))+  (\x' y' -> Identity (eq x' y'))+  x+  y++compareAttrSetsM+  :: Monad m+  => (t -> m (Maybe NixString))+  -> (t -> t -> m Bool)+  -> AttrSet t+  -> AttrSet t+  -> m Bool+compareAttrSetsM f eq lm rm = do+  isDerivationM f lm >>= \case+    True -> isDerivationM f rm >>= \case+      True+        | Just lp <- M.lookup "outPath" lm, Just rp <- M.lookup "outPath" rm -> eq+          lp+          rp+      _ -> compareAttrs+    _ -> compareAttrs+  where compareAttrs = alignEqM eq lm rm++compareAttrSets+  :: (t -> Maybe NixString)+  -> (t -> t -> Bool)+  -> AttrSet t+  -> AttrSet t+  -> Bool+compareAttrSets f eq lm rm = runIdentity+  $ compareAttrSetsM (\t -> Identity (f t)) (\x y -> Identity (eq x y)) lm rm++valueEqM+  :: (MonadThunk t m (NValue t f m), Comonad f)+  => NValue t f m+  -> NValue t f m+  -> m Bool+valueEqM (NValue (extract -> x)) (NValue (extract -> y)) = valueFEqM+  (compareAttrSetsM f thunkEqM)+  thunkEqM+  x+  y+ where+  f t = force t $ \case+    NVStr s -> pure $ Just s+    _       -> pure Nothing++valueNFEq :: Comonad f => NValueNF t f m -> NValueNF t f m -> Bool+valueNFEq (Pure _) (Pure _) = False+valueNFEq (Pure _) (Free _) = False+valueNFEq (Free _) (Pure _) = False+valueNFEq (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =+  valueFEq (compareAttrSets f valueNFEq) valueNFEq x y+ where+  f (Pure _        ) = Nothing+  f (Free (NVStr s)) = Just s+  f _                = Nothing++instance Eq1 (NValueF p m) where+  liftEq _  (NVConstantF x) (NVConstantF y) = x == y+  liftEq _  (NVStrF      x) (NVStrF      y) = x == y+  liftEq eq (NVListF     x) (NVListF     y) = liftEq eq x y+  liftEq eq (NVSetF x _   ) (NVSetF y _   ) = liftEq eq x y+  liftEq _  (NVPathF x    ) (NVPathF y    ) = x == y+  liftEq _  _               _               = False++$(deriveEq1 ''NValue')
+ src/Nix/Var.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module Nix.Var where++import           Control.Monad.Ref+import           Data.GADT.Compare+import           Data.IORef+import           Data.Maybe+import           Data.STRef++import           Unsafe.Coerce++type Var m = Ref m++type MonadVar m = MonadAtomicRef m++eqVar :: forall m a . GEq (Ref m) => Ref m a -> Ref m a -> Bool+eqVar a b = isJust $ geq a b++newVar :: MonadRef m => a -> m (Ref m a)+newVar = newRef++readVar :: MonadRef m => Ref m a -> m a+readVar = readRef++writeVar :: MonadRef m => Ref m a -> a -> m ()+writeVar = writeRef++atomicModifyVar :: MonadAtomicRef m => Ref m a -> (a -> (a, b)) -> m b+atomicModifyVar = atomicModifyRef++--TODO: Upstream GEq instances+instance GEq IORef where+  a `geq` b = if a == unsafeCoerce b then Just $ unsafeCoerce Refl else Nothing++instance GEq (STRef s) where+  a `geq` b = if a == unsafeCoerce b then Just $ unsafeCoerce Refl else Nothing
src/Nix/XML.hs view
@@ -1,54 +1,76 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -module Nix.XML where+module Nix.XML (toXML) where -import           Data.Fix-import qualified Data.HashMap.Lazy as M+import qualified Data.HashMap.Lazy             as M import           Data.List import           Data.Ord-import qualified Data.Text as Text+import qualified Data.Text                     as Text import           Nix.Atoms import           Nix.Expr.Types+import           Nix.String import           Nix.Value import           Text.XML.Light -toXML :: Functor m => NValueNF m -> String-toXML = (.) ((++ "\n") .-             ("<?xml version='1.0' encoding='utf-8'?>\n" ++) .-             ppElement .-             (\e -> Element (unqual "expr") [] [Elem e] Nothing))-        $ cata-        $ \case-    NVConstantF a -> case a of-        NInt n   -> mkElem "int" "value" (show n)-        NFloat f -> mkElem "float" "value" (show f)-        NBool b  -> mkElem "bool" "value" (if b then "true" else "false")-        NNull    -> Element (unqual "null") [] [] Nothing+toXML :: forall t f m . MonadDataContext f m => NValueNF t f m -> NixString+toXML =+  runWithStringContext+    . fmap pp+    . iterNValueNF (const (pure (mkElem "cycle" "value" ""))) phi+ where+  pp =+    ("<?xml version='1.0' encoding='utf-8'?>\n" <>)+      . (<> "\n")+      . Text.pack+      . ppElement+      . (\e -> Element (unqual "expr") [] [Elem e] Nothing) -    NVStrF t _ -> mkElem "string" "value" (Text.unpack t)-    NVListF l  -> Element (unqual "list") [] (Elem <$> l) Nothing+  phi :: NValue' t f m (WithStringContext Element) -> WithStringContext Element+  phi = \case+    NVConstant a -> case a of+      NInt   n -> return $ mkElem "int" "value" (show n)+      NFloat f -> return $ mkElem "float" "value" (show f)+      NBool  b -> return $ mkElem "bool" "value" (if b then "true" else "false")+      NNull    -> return $ Element (unqual "null") [] [] Nothing -    NVSetF s _ -> Element (unqual "attrs") []-        (map (\(k, v) -> Elem (Element (unqual "attr")-                                      [Attr (unqual "name") (Text.unpack k)]-                                      [Elem v] Nothing))-             (sortBy (comparing fst) $ M.toList s)) Nothing+    NVStr  str -> mkElem "string" "value" . Text.unpack <$> extractNixString str+    NVList l   -> sequence l+      >>= \els -> return $ Element (unqual "list") [] (Elem <$> els) Nothing -    NVClosureF p _  -> Element (unqual "function") [] (paramsXML p) Nothing-    NVPathF fp -> mkElem "path" "value" fp-    NVBuiltinF name _ -> mkElem "function" "name" name+    NVSet s _ -> sequence s >>= \kvs -> return $ Element+      (unqual "attrs")+      []+      (map+        (\(k, v) -> Elem+          (Element (unqual "attr")+                   [Attr (unqual "name") (Text.unpack k)]+                   [Elem v]+                   Nothing+          )+        )+        (sortBy (comparing fst) $ M.toList kvs)+      )+      Nothing +    NVClosure p _ ->+      return $ Element (unqual "function") [] (paramsXML p) Nothing+    NVPath fp        -> return $ mkElem "path" "value" fp+    NVBuiltin name _ -> return $ mkElem "function" "name" name+    _                -> error "Pattern synonyms mask coverage"+ mkElem :: String -> String -> String -> Element mkElem n a v = Element (unqual n) [Attr (unqual a) v] [] Nothing  paramsXML :: Params r -> [Content]-paramsXML (Param name) =-    [Elem $ mkElem "varpat" "name" (Text.unpack name)]+paramsXML (Param name) = [Elem $ mkElem "varpat" "name" (Text.unpack name)] paramsXML (ParamSet s b mname) =-    [Elem $ Element (unqual "attrspat") (battr ++ nattr) (paramSetXML s) Nothing]-  where-    battr = [ Attr (unqual "ellipsis") "1" | b ]-    nattr = maybe [] ((:[]) . Attr (unqual "name") . Text.unpack) mname+  [Elem $ Element (unqual "attrspat") (battr <> nattr) (paramSetXML s) Nothing]+ where+  battr = [ Attr (unqual "ellipsis") "1" | b ]+  nattr = maybe [] ((: []) . Attr (unqual "name") . Text.unpack) mname  paramSetXML :: ParamSet r -> [Content]-paramSetXML = map (\(k,_) -> Elem $ mkElem "attr" "name" (Text.unpack k))+paramSetXML = map (\(k, _) -> Elem $ mkElem "attr" "name" (Text.unpack k))
tests/EvalTests.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} @@ -8,15 +9,21 @@  module EvalTests (tests, genEvalCompareTests) where +import           Control.Applicative ((<|>))+import           Control.Monad (when, unless) import           Control.Monad.Catch-import           Control.Monad (when) import           Control.Monad.IO.Class-import qualified Data.HashMap.Lazy as M+-- import qualified Data.HashMap.Lazy as M+import           Data.List ((\\)) import           Data.Maybe (isJust)+import qualified Data.Set as S import           Data.String.Interpolate.IsString import           Data.Text (Text) import           Data.Time import           Nix+import           Nix.TH+import           Nix.Thunk.Standard+import           Nix.Value.Equal import qualified System.Directory as D import           System.Environment import           System.FilePath@@ -37,6 +44,13 @@   assertNixEvalThrows "builtins.div 1 0.0"   assertNixEvalThrows "builtins.div 1.0 0.0" +case_bit_ops = do+    -- mic92 (2018-08-20): change to constantEqualText,+    -- when hnix's nix fork supports bitAnd/bitOr/bitXor+    constantEqualText' "0" "builtins.bitAnd 1 0"+    constantEqualText' "1" "builtins.bitOr 1 1"+    constantEqualText' "3" "builtins.bitXor 1 2"+ case_basic_function =     constantEqualText "2" "(a: a) 2" @@ -92,6 +106,9 @@ case_nested_with =     constantEqualText "2" "with { x = 1; }; with { x = 2; }; x" +case_with_strictness =+    constantEqualText "5" "let x = with x; with { a = 5; }; a; in x"+ case_match_failure_null =     constantEqualText "null" "builtins.match \"ab\" \"abc\"" @@ -119,6 +136,9 @@ case_find_file_failure_invalid_arg_no_path =     assertNixEvalThrows "builtins.findFile [{ prefix=\"\"; }] \"files\"" +case_infinite_recursion =+    assertNixEvalThrows "let foo = a: bar a; bar = a: foo a; in foo 3"+ case_inherit_in_rec_set =     constantEqualText "1" "let x = 1; in (rec { inherit x; }).x" @@ -142,6 +162,34 @@       )).success     |] +-- github/orblivion (2018-08-05): Adding these failing tests so we fix this feature++-- case_overrides =+--     constantEqualText' "2" [i|+--       let+--+--         overrides = { a = 2; };+--+--       in (rec {+--         __overrides = overrides;+--         x = a;+--         a = 1;+--       }.__overrides.a)+--     |]++-- case_inherit_overrides =+--     constantEqualText' "2" [i|+--       let+--+--         __overrides = { a = 2; };+--+--       in (rec {+--         inherit __overrides;+--         x = a;+--         a = 1;+--       }.__overrides.a)+--     |]+ case_unsafegetattrpos1 =     constantEqualText "[ 6 20 ]" [i|       let e = 1;@@ -277,44 +325,110 @@       in fix f     |] +-- case_function_equals1 =+--     constantEqualText "true" "{f = x: x;} == {f = x: x;}"++-- case_function_equals2 =+--     constantEqualText "true" "[(x: x)] == [(x: x)]"++case_function_equals3 =+    constantEqualText "false" "(let a = (x: x); in a == a)"++case_function_equals4 =+    constantEqualText "true" "(let a = {f = x: x;}; in a == a)"++case_function_equals5 =+    constantEqualText "true" "(let a = [(x: x)]; in a == a)"++case_directory_pathexists =+    constantEqualText "false" "builtins.pathExists \"/var/empty/invalid-directory\""+ -- jww (2018-05-02): This constantly changes! -- case_placeholder = --   constantEqualText --       "\"/1rz4g4znpzjwh1xymhjpm42vipw92pr73vdgl6xs1hycac8kf2n9\"" --       "builtins.placeholder \"out\"" +case_rec_path_attr =+    constantEqualText "10"+        "let src = 10; x = rec { passthru.src = src; }; in x.passthru.src"++case_mapattrs_builtin =+    constantEqualText' "{ a = \"afoo\"; b = \"bbar\"; }" [i|+      (builtins.mapAttrs (x: y: x + y) {+        a = "foo";+        b = "bar";+      })+    |]++-- Regression test for #373+case_regression_373 :: Assertion+case_regression_373 = do+  freeVarsEqual "{ inherit a; }" ["a"]+  freeVarsEqual "rec {inherit a; }" ["a"]+  freeVarsEqual "let inherit a; in { }" ["a"]++case_empty_string_equal_null_is_false =+  constantEqualText "false" "\"\" == null"++case_null_equal_empty_string_is_false =+  constantEqualText "false" "null == \"\""++case_empty_string_not_equal_null_is_true =+  constantEqualText "true" "\"\" != null"++case_null_equal_not_empty_string_is_true =+  constantEqualText "true" "null != \"\""++case_list_nested_bottom_diverges =+  assertNixEvalThrows "let nested = [(let x = x; in x)]; in nested == nested"++case_attrset_nested_bottom_diverges =+  assertNixEvalThrows "let nested = { y = (let x = x; in x); }; in nested == nested"++case_list_list_nested_bottom_equal =+  constantEqualText "true" "let nested = [[(let x = x; in x)]]; in nested == nested"++case_list_attrset_nested_bottom_equal =+  constantEqualText "true" "let nested = [{ y = (let x = x; in x); }]; in nested == nested"++case_list_function_nested_bottom_equal =+  constantEqualText "true" "let nested = [(_: let x = x; in x)]; in nested == nested"++case_attrset_list_nested_bottom_equal =+  constantEqualText "true" "let nested = { y = [(let x = x; in x)];}; in nested == nested"++case_attrset_attrset_nested_bottom_equal =+  constantEqualText "true" "let nested = { y = { y = (let x = x; in x); }; }; in nested == nested"++case_attrset_function_nested_bottom_equal =+  constantEqualText "true" "let nested = { y = _: (let x = x; in x); }; in nested == nested"+ -----------------------  tests :: TestTree tests = $testGroupGenerator  genEvalCompareTests = do-    files <- filter ((==".nix") . takeExtension) <$> D.listDirectory testDir-    return $ testGroup "Eval comparison tests" $ map mkTestCase files-  where-    testDir = "tests/eval-compare"-    mkTestCase f = testCase f $ assertEvalFileMatchesNix (testDir </> f)+    td <- D.listDirectory testDir -instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where-    NVConstantF x == NVConstantF y = x == y-    NVStrF x _ == NVStrF y _ = x == y-    NVListF x == NVListF y = and (zipWith (==) x y)-    NVSetF x _ == NVSetF y _ =-        M.keys x == M.keys y &&-        and (zipWith (==) (M.elems x) (M.elems y))-    NVPathF x == NVPathF y = x == y-    x == y = error $ "Need to add comparison for values: "-                 ++ show x ++ " == " ++ show y+    let unmaskedFiles = filter ((==".nix") . takeExtension) td+    let files = unmaskedFiles \\ maskedFiles +    return $ testGroup "Eval comparison tests" $ map (mkTestCase testDir) files+  where+    mkTestCase td f = testCase f $ assertEvalFileMatchesNix (td </> f)+ constantEqual :: NExprLoc -> NExprLoc -> Assertion constantEqual a b = do-    time <- liftIO getCurrentTime+    time <- getCurrentTime     let opts = defaultOptions time     -- putStrLn =<< lint (stripAnnotation a)-    a' <- runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing a-    -- putStrLn =<< lint (stripAnnotation b)-    b' <- runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing b-    assertEqual "" a' b'+    res <- runStandardIO opts $ do+        a' <- normalForm =<< nixEvalExprLoc Nothing a+        b' <- normalForm =<< nixEvalExprLoc Nothing b+        return $ valueNFEq a' b'+    assertBool "" res  constantEqualText' :: Text -> Text -> Assertion constantEqualText' a b = do@@ -325,20 +439,32 @@ constantEqualText :: Text -> Text -> Assertion constantEqualText a b = do   constantEqualText' a b-  mres <- liftIO $ lookupEnv "MATCHING_TESTS"+  mres <- liftIO $ lookupEnv "ALL_TESTS" <|> lookupEnv "MATCHING_TESTS"   when (isJust mres) $       assertEvalMatchesNix b  assertNixEvalThrows :: Text -> Assertion assertNixEvalThrows a = do-    let Success a' = parseNixTextLoc a-    time <- liftIO getCurrentTime-    let opts = defaultOptions time-    errored <- catch ((runLazyM opts $ normalForm =<< nixEvalExprLoc Nothing a') >> pure False) handler-    if errored then-        pure ()-    else-        assertFailure "Did not catch nix exception"-    where-       handler :: NixException -> IO Bool-       handler _ = pure True+  let Success a' = parseNixTextLoc a+  time <- getCurrentTime+  let opts = defaultOptions time+  errored <- catch+      (False <$ runStandardIO opts+         (normalForm =<< nixEvalExprLoc Nothing a'))+      (\(_ :: NixException) -> pure True)+  unless errored $+    assertFailure "Did not catch nix exception"++freeVarsEqual :: Text -> [VarName] -> Assertion+freeVarsEqual a xs = do+  let Success a' = parseNixText a+      xs' = S.fromList xs+      free = freeVars a'+  assertEqual "" xs' free++maskedFiles :: [FilePath]+maskedFiles =+  [ "builtins.fetchurl-01.nix" ]++testDir :: FilePath+testDir = "tests/eval-compare"
tests/Main.hs view
@@ -9,40 +9,32 @@ import qualified Control.Exception as Exc import           Control.Applicative ((<|>)) import           Control.Monad-import           Control.Monad.IO.Class import           Data.Fix-import           Data.List (isInfixOf)+import           Data.List (isSuffixOf) import           Data.Maybe import           Data.String.Interpolate.IsString import           Data.Text (unpack) import           Data.Time import qualified EvalTests import qualified Nix-import           Nix.Exec import           Nix.Expr.Types+import           Nix.String import           Nix.Options import           Nix.Parser+import           Nix.Thunk.Standard import           Nix.Value import qualified NixLanguageTests import qualified ParserTests import qualified PrettyTests import qualified ReduceExprTests--- import qualified PrettyParseTests+import qualified PrettyParseTests import           System.Directory import           System.Environment import           System.FilePath.Glob import           System.Posix.Files-import           System.Process import           Test.Tasty import           Test.Tasty.HUnit -cabalCorrectlyGenerated :: Assertion-cabalCorrectlyGenerated = do-  output <- readCreateProcess (shell "hpack") ""-  when ("modified manually" `isInfixOf` output) $-    errorWithoutStackTrace-      "Edit package.yaml and re-generate hnix.cabal by running \"hpack\""- ensureLangTestsPresent :: Assertion ensureLangTestsPresent = do   exist <- fileExist "data/nix/tests/local.mk"@@ -63,14 +55,26 @@           url    = "https://github.com/NixOS/nixpkgs/archive/#{rev}.tar.gz";           sha256 = "#{sha256}";         }|]) $ \expr -> do-        NVStr dir _ <- do-            time <- liftIO getCurrentTime-            runLazyM (defaultOptions time) $ Nix.nixEvalExprLoc Nothing expr+        NVStr ns <- do+          time <- getCurrentTime+          runStandardIO (defaultOptions time) $+            Nix.nixEvalExprLoc Nothing expr+        let dir = hackyStringIgnoreContext ns+        exists <- fileExist (unpack dir)+        unless exists $+          errorWithoutStackTrace $+            "Directory " ++ show dir ++ " does not exist"         files <- globDir1 (compile "**/*.nix") (unpack dir)-        forM_ files $ \file ->-          -- Parse and deepseq the resulting expression tree, to ensure the-          -- parser is fully executed.-          consider file (parseNixFileLoc file) $ Exc.evaluate . force+        when (length files == 0) $+          errorWithoutStackTrace $+            "Directory " ++ show dir ++ " does not have any files"+        forM_ files $ \file -> do+          unless ("azure-cli/default.nix" `isSuffixOf` file ||+                  "os-specific/linux/udisks/2-default.nix"  `isSuffixOf` file) $ do+            -- Parse and deepseq the resulting expression tree, to ensure the+            -- parser is fully executed.+            _ <- consider file (parseNixFileLoc file) $ Exc.evaluate . force+            return ()     v -> error $ "Unexpected parse from default.nix: " ++ show v  where   getExpr   k m = let Just (Just r) = lookup k m in r@@ -88,24 +92,20 @@   evalComparisonTests <- EvalTests.genEvalCompareTests   let allOrLookup var = lookupEnv "ALL_TESTS" <|> lookupEnv var   nixpkgsTestsEnv     <- allOrLookup "NIXPKGS_TESTS"-  -- prettyTestsEnv      <- lookupEnv "PRETTY_TESTS"-  hpackTestsEnv       <- allOrLookup "HPACK_TESTS"+  prettyTestsEnv      <- lookupEnv "PRETTY_TESTS"    pwd <- getCurrentDirectory   setEnv "NIX_REMOTE" ("local?root=" ++ pwd ++ "/")    defaultMain $ testGroup "hnix" $-    [ testCase "hnix.cabal correctly generated" cabalCorrectlyGenerated-      | isJust hpackTestsEnv ] ++     [ ParserTests.tests     , EvalTests.tests     , PrettyTests.tests     , ReduceExprTests.tests] ++-    -- [ PrettyParseTests.tests-    --     (fromIntegral (read (fromMaybe "0" prettyTestsEnv) :: Int)) ] +++    [ PrettyParseTests.tests+        (fromIntegral (read (fromMaybe "0" prettyTestsEnv) :: Int)) ] ++     [ evalComparisonTests ] ++     [ testCase "Nix language tests present" ensureLangTestsPresent     , nixLanguageTests ] ++     [ testCase "Nixpkgs parses without errors" ensureNixpkgsCanParse       | isJust nixpkgsTestsEnv ]-
tests/NixLanguageTests.hs view
@@ -4,17 +4,21 @@  module NixLanguageTests (genTests) where -import           Control.Arrow ((&&&))+import           Control.Arrow                  ( (&&&) ) import           Control.Exception import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.ST-import           Data.List (delete, sort)-import           Data.List.Split (splitOn)-import           Data.Map (Map)-import qualified Data.Map as Map-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+import           Data.List                      ( delete+                                                , sort+                                                )+import           Data.List.Split                ( splitOn )+import           Data.Map                       ( Map )+import qualified Data.Map                      as Map+import           Data.Set                       ( Set )+import qualified Data.Set                      as Set+import qualified Data.Text                     as Text+import qualified Data.Text.IO                  as Text import           Data.Time import           GHC.Exts import           Nix.Lint@@ -22,12 +26,15 @@ import           Nix.Options.Parser import           Nix.Parser import           Nix.Pretty+import           Nix.String import           Nix.Utils import           Nix.XML-import qualified Options.Applicative as Opts+import qualified Options.Applicative           as Opts import           System.Environment import           System.FilePath-import           System.FilePath.Glob (compile, globDir1)+import           System.FilePath.Glob           ( compile+                                                , globDir1+                                                ) import           Test.Tasty import           Test.Tasty.HUnit import           TestCommon@@ -55,105 +62,137 @@ groupBy :: Ord k => (v -> k) -> [v] -> Map k [v] groupBy key = Map.fromListWith (++) . map (key &&& pure) +-- | New tests, which have never yet passed.  Once any of these is passing,+-- please remove it from this list.  Do not add tests to this list if they have+-- previously passed.+newFailingTests :: Set String+newFailingTests = Set.fromList+  [ "eval-okay-path"+  , "eval-okay-fromTOML"+  , "eval-okay-context-introspection"+  , "eval-okay-concatmap"+  , "eval-okay-builtins-add"+  ]+ genTests :: IO TestTree genTests = do-  testFiles <- sort+  testFiles <-+    sort         -- jww (2018-05-07): Temporarily disable this test until #128 is fixed.-      . filter ((/= "eval-okay-path") . takeBaseName)-      . filter ((/= ".xml") . takeExtension)-      <$> globDir1 (compile "*-*-*.*") "data/nix/tests/lang"+    .   filter ((`Set.notMember` newFailingTests) . takeBaseName)+    .   filter ((/= ".xml") . takeExtension)+    <$> globDir1 (compile "*-*-*.*") "data/nix/tests/lang"   let testsByName = groupBy (takeFileName . dropExtensions) testFiles   let testsByType = groupBy testType (Map.toList testsByName)   let testGroups  = map mkTestGroup (Map.toList testsByType)-  return $ localOption (mkTimeout 2000000)-         $ testGroup "Nix (upstream) language tests" testGroups-  where-    testType (fullpath, _files) =-        take 2 $ splitOn "-" $ takeFileName fullpath-    mkTestGroup (kind, tests) =-        testGroup (unwords kind) $ map (mkTestCase kind) tests-    mkTestCase kind (basename, files) =-        testCase (takeFileName basename) $ do-            time <- liftIO getCurrentTime-            let opts = defaultOptions time-            case kind of-                ["parse", "okay"] -> assertParse opts $ the files-                ["parse", "fail"] -> assertParseFail opts $ the files-                ["eval", "okay"]  -> assertEval opts files-                ["eval", "fail"]  -> assertEvalFail $ the files-                _ -> error $ "Unexpected: " ++ show kind+  return $ localOption (mkTimeout 2000000) $ testGroup+    "Nix (upstream) language tests"+    testGroups+ where+  testType (fullpath, _files) = take 2 $ splitOn "-" $ takeFileName fullpath+  mkTestGroup (kind, tests) =+    testGroup (unwords kind) $ map (mkTestCase kind) tests+  mkTestCase kind (basename, files) = testCase (takeFileName basename) $ do+    time <- liftIO getCurrentTime+    let opts = defaultOptions time+    case kind of+      ["parse", "okay"] -> assertParse opts $ the files+      ["parse", "fail"] -> assertParseFail opts $ the files+      ["eval" , "okay"] -> assertEval opts files+      ["eval" , "fail"] -> assertEvalFail $ the files+      _                 -> error $ "Unexpected: " ++ show kind  assertParse :: Options -> FilePath -> Assertion assertParse _opts file = parseNixFileLoc file >>= \case   Success _expr -> return () -- pure $! runST $ void $ lint opts expr-  Failure err  ->-      assertFailure $ "Failed to parse " ++ file ++ ":\n" ++ show err+  Failure err ->+    assertFailure $ "Failed to parse " ++ file ++ ":\n" ++ show err  assertParseFail :: Options -> FilePath -> Assertion assertParseFail opts file = do-    eres <- parseNixFileLoc file-    catch (case eres of-               Success expr -> do-                   _ <- pure $! runST $ void $ lint opts expr-                   assertFailure $ "Unexpected success parsing `"-                       ++ file ++ ":\nParsed value: " ++ show expr-               Failure _ -> return ()) $ \(_ :: SomeException) ->-        return ()+  eres <- parseNixFileLoc file+  catch+      (case eres of+        Success expr -> do+          _ <- pure $! runST $ void $ lint opts expr+          assertFailure+            $  "Unexpected success parsing `"+            ++ file+            ++ ":\nParsed value: "+            ++ show expr+        Failure _ -> return ()+      )+    $ \(_ :: SomeException) -> return ()  assertLangOk :: Options -> FilePath -> Assertion assertLangOk opts file = do-  actual <- printNix <$> hnixEvalFile opts (file ++ ".nix")+  actual   <- printNix <$> hnixEvalFile opts (file ++ ".nix")   expected <- Text.readFile $ file ++ ".exp"   assertEqual "" expected $ Text.pack (actual ++ "\n")  assertLangOkXml :: Options -> FilePath -> Assertion assertLangOkXml opts file = do-  actual <- toXML <$> hnixEvalFile opts (file ++ ".nix")+  actual <- principledStringIgnoreContext . toXML <$> hnixEvalFile+    opts+    (file ++ ".nix")   expected <- Text.readFile $ file ++ ".exp.xml"-  assertEqual "" expected $ Text.pack actual+  assertEqual "" expected actual  assertEval :: Options -> [FilePath] -> Assertion assertEval _opts files = do-    time <- liftIO getCurrentTime-    let opts = defaultOptions time-    case delete ".nix" $ sort $ map takeExtensions files of-        [] -> () <$ hnixEvalFile opts (name ++ ".nix")-        [".exp"] -> assertLangOk opts name-        [".exp.xml"] -> assertLangOkXml opts name-        [".exp.disabled"] -> return ()-        [".exp-disabled"] -> return ()-        [".exp", ".flags"] -> do-            liftIO $ unsetEnv "NIX_PATH"-            flags <- Text.readFile (name ++ ".flags")-            let flags' | Text.last flags == '\n' = Text.init flags-                       | otherwise = flags-            case Opts.execParserPure Opts.defaultPrefs (nixOptionsInfo time)-                     (fixup (map Text.unpack (Text.splitOn " " flags'))) of-                Opts.Failure err -> errorWithoutStackTrace $-                    "Error parsing flags from " ++ name ++ ".flags: "-                        ++ show err-                Opts.Success opts' ->-                    assertLangOk-                        (opts' { include = include opts' ++-                                   [ "nix=../../../../data/nix/corepkgs"-                                   , "lang/dir4"-                                   , "lang/dir5" ] })-                        name-                Opts.CompletionInvoked _ -> error "unused"-        _ -> assertFailure $ "Unknown test type " ++ show files-  where-    name = "data/nix/tests/lang/"-        ++ the (map (takeFileName . dropExtensions) files)+  time <- liftIO getCurrentTime+  let opts = defaultOptions time+  case delete ".nix" $ sort $ map takeExtensions files of+    []                 -> () <$ hnixEvalFile opts (name ++ ".nix")+    [".exp"         ]  -> assertLangOk opts name+    [".exp.xml"     ]  -> assertLangOkXml opts name+    [".exp.disabled"]  -> return ()+    [".exp-disabled"]  -> return ()+    [".exp", ".flags"] -> do+      liftIO $ unsetEnv "NIX_PATH"+      flags <- Text.readFile (name ++ ".flags")+      let flags' | Text.last flags == '\n' = Text.init flags+                 | otherwise               = flags+      case+          Opts.execParserPure+            Opts.defaultPrefs+            (nixOptionsInfo time)+            (fixup (map Text.unpack (Text.splitOn " " flags')))+        of+          Opts.Failure err ->+            errorWithoutStackTrace+              $  "Error parsing flags from "+              ++ name+              ++ ".flags: "+              ++ show err+          Opts.Success opts' -> assertLangOk+            (opts'+              { include = include opts'+                            ++ [ "nix=../../../../data/nix/corepkgs"+                               , "lang/dir4"+                               , "lang/dir5"+                               ]+              }+            )+            name+          Opts.CompletionInvoked _ -> error "unused"+    _ -> assertFailure $ "Unknown test type " ++ show files+ where+  name =+    "data/nix/tests/lang/" ++ the (map (takeFileName . dropExtensions) files) -    fixup ("--arg":x:y:rest) = "--arg":(x ++ "=" ++ y):fixup rest-    fixup ("--argstr":x:y:rest) = "--argstr":(x ++ "=" ++ y):fixup rest-    fixup (x:rest) = x:fixup rest-    fixup [] = []+  fixup ("--arg"    : x : y : rest) = "--arg" : (x ++ "=" ++ y) : fixup rest+  fixup ("--argstr" : x : y : rest) = "--argstr" : (x ++ "=" ++ y) : fixup rest+  fixup (x                  : rest) = x : fixup rest+  fixup []                          = []  assertEvalFail :: FilePath -> Assertion assertEvalFail file = catch ?? (\(_ :: SomeException) -> return ()) $ do-  time <- liftIO getCurrentTime+  time       <- liftIO getCurrentTime   evalResult <- printNix <$> hnixEvalFile (defaultOptions time) file-  evalResult `seq` assertFailure $-      file ++ " should not evaluate.\nThe evaluation result was `"-           ++ evalResult ++ "`."+  evalResult+    `seq` assertFailure+    $     file+    ++    " should not evaluate.\nThe evaluation result was `"+    ++    evalResult+    ++    "`."
tests/ParserTests.hs view
@@ -10,9 +10,10 @@  import Data.Fix import Data.List.NonEmpty (NonEmpty(..))-import Data.Semigroup import Data.String.Interpolate.IsString-import Data.Text (Text, unpack, pack)+import Data.Text (Text, unpack)+import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Text import Nix.Atoms import Nix.Expr import Nix.Parser@@ -20,7 +21,6 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.TH-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))  case_constant_int = assertParseText "234" $ mkInt 234 @@ -275,6 +275,9 @@     (mkPath False "./def")  where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing +case_select_keyword = do+  assertParseText "{ false = \"foo\"; }" $ Fix $ NSet [NamedVar (mkSelector "false") (mkStr "foo") nullPos]+ case_fun_app = do   assertParseText "f a b" $ Fix $ NBinary NApp (Fix $ NBinary NApp (mkSym "f") (mkSym "a")) (mkSym "b")   assertParseText "f a.x or null" $ Fix $ NBinary NApp (mkSym "f") $ Fix $@@ -391,9 +394,9 @@ assertParsePrint :: Text -> Text -> Assertion assertParsePrint src expect =   let Success expr = parseNixTextLoc src-      result = displayS-             . renderPretty 0.4 80+      result = renderStrict+             . layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)              . prettyNix              . stripAnnotation              $ expr-  in assertEqual "" expect (pack (result ""))+  in assertEqual "" expect result
tests/PrettyParseTests.hs view
@@ -9,27 +9,31 @@  {-# OPTIONS -Wno-orphans#-} -module PrettyParseTests  where+module PrettyParseTests where  import           Data.Algorithm.Diff import           Data.Algorithm.DiffOutput import           Data.Char import           Data.Fix-import qualified Data.List.NonEmpty as NE-import           Data.Text (Text, pack)+import qualified Data.List.NonEmpty            as NE+import           Data.Text                      ( Text+                                                , pack+                                                )+import           Data.Text.Prettyprint.Doc import           Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range+import qualified Hedgehog.Gen                  as Gen+import qualified Hedgehog.Range                as Range import           Nix.Atoms import           Nix.Expr import           Nix.Parser import           Nix.Pretty import           Test.Tasty import           Test.Tasty.Hedgehog-import           Text.Megaparsec (Pos, SourcePos, mkPos)-import           Text.PrettyPrint.ANSI.Leijen ((</>), text)-import qualified Text.PrettyPrint.ANSI.Leijen as P-import qualified Text.Show.Pretty as PS+import           Text.Megaparsec                ( Pos+                                                , SourcePos+                                                , mkPos+                                                )+import qualified Text.Show.Pretty              as PS  asciiString :: MonadGen m => m String asciiString = Gen.list (Range.linear 1 15) Gen.lower@@ -45,95 +49,90 @@ genSourcePos = SourcePos <$> asciiString <*> genPos <*> genPos  genKeyName :: Gen (NKeyName NExpr)-genKeyName = Gen.choice [ DynamicKey <$> genAntiquoted genString-                        , StaticKey <$> asciiText ]+genKeyName =+  Gen.choice [DynamicKey <$> genAntiquoted genString, StaticKey <$> asciiText]  genAntiquoted :: Gen a -> Gen (Antiquoted a NExpr)-genAntiquoted gen = Gen.choice-  [ Plain <$> gen-  , pure EscapedNewline-  , Antiquoted <$> genExpr-  ]+genAntiquoted gen =+  Gen.choice [Plain <$> gen, pure EscapedNewline, Antiquoted <$> genExpr]  genBinding :: Gen (Binding NExpr) genBinding = Gen.choice   [ NamedVar <$> genAttrPath <*> genExpr <*> genSourcePos-  , Inherit <$> Gen.maybe genExpr-            <*> Gen.list (Range.linear 0 5) genKeyName-            <*> genSourcePos+  , Inherit+  <$> Gen.maybe genExpr+  <*> Gen.list (Range.linear 0 5) genKeyName+  <*> genSourcePos   ]  genString :: Gen (NString NExpr) genString = Gen.choice   [ DoubleQuoted <$> Gen.list (Range.linear 0 5) (genAntiquoted asciiText)-  , Indented <$> Gen.int (Range.linear 0 10)-             <*> Gen.list (Range.linear 0 5) (genAntiquoted asciiText)+  , Indented <$> Gen.int (Range.linear 0 10) <*> Gen.list+    (Range.linear 0 5)+    (genAntiquoted asciiText)   ]  genAttrPath :: Gen (NAttrPath NExpr)-genAttrPath = (NE.:|) <$> genKeyName-                      <*> Gen.list (Range.linear 0 4) genKeyName+genAttrPath = (NE.:|) <$> genKeyName <*> Gen.list (Range.linear 0 4) genKeyName  genParams :: Gen (Params NExpr) genParams = Gen.choice-  [ Param    <$> asciiText-  , ParamSet <$> Gen.list (Range.linear 0 10) ((,) <$> asciiText-                                                   <*> Gen.maybe genExpr)-             <*> Gen.bool-             <*> Gen.choice [pure Nothing, Just <$> asciiText]+  [ Param <$> asciiText+  , ParamSet+  <$> Gen.list (Range.linear 0 10) ((,) <$> asciiText <*> Gen.maybe genExpr)+  <*> Gen.bool+  <*> Gen.choice [pure Nothing, Just <$> asciiText]   ]  genAtom :: Gen NAtom genAtom = Gen.choice-  [ NInt   <$> Gen.integral (Range.linear 0 1000)+  [ NInt <$> Gen.integral (Range.linear 0 1000)   , NFloat <$> Gen.float (Range.linearFrac 0.0 1000.0)-  , NBool  <$> Gen.bool-  , pure NNull ]+  , NBool <$> Gen.bool+  , pure NNull+  ]  -- This is written by hand so we can use `fairList` rather than the normal -- list Arbitrary instance which makes the generator terminate. The -- distribution is not scientifically chosen. genExpr :: Gen NExpr-genExpr = Gen.sized $ \(Size n) ->-  Fix <$>-      if n < 2-      then Gen.choice-        [genConstant, genStr, genSym, genLiteralPath, genEnvPath ]-      else-        Gen.frequency-          [ ( 1, genConstant)-          , ( 1, genSym)-          , ( 4, Gen.resize (Size (n `div` 3)) genIf)-          , (10, genRecSet )-          , (20, genSet )-          , ( 5, genList )-          , ( 2, genUnary )-          , ( 2, Gen.resize (Size (n `div` 3)) genBinary )-          , ( 3, Gen.resize (Size (n `div` 3)) genSelect )-          , (20, Gen.resize (Size (n `div` 2)) genAbs )-          , ( 2, Gen.resize (Size (n `div` 2)) genHasAttr )-          , (10, Gen.resize (Size (n `div` 2)) genLet )-          , (10, Gen.resize (Size (n `div` 2)) genWith )-          , ( 1, Gen.resize (Size (n `div` 2)) genAssert)-          ]+genExpr = Gen.sized $ \(Size n) -> Fix <$> if n < 2+  then Gen.choice [genConstant, genStr, genSym, genLiteralPath, genEnvPath]+  else Gen.frequency+    [ (1 , genConstant)+    , (1 , genSym)+    , (4 , Gen.resize (Size (n `div` 3)) genIf)+    , (10, genRecSet)+    , (20, genSet)+    , (5 , genList)+    , (2 , genUnary)+    , (2, Gen.resize (Size (n `div` 3)) genBinary)+    , (3, Gen.resize (Size (n `div` 3)) genSelect)+    , (20, Gen.resize (Size (n `div` 2)) genAbs)+    , (2, Gen.resize (Size (n `div` 2)) genHasAttr)+    , (10, Gen.resize (Size (n `div` 2)) genLet)+    , (10, Gen.resize (Size (n `div` 2)) genWith)+    , (1, Gen.resize (Size (n `div` 2)) genAssert)+    ]  where-  genConstant    = NConstant    <$> genAtom-  genStr         = NStr         <$> genString-  genSym         = NSym         <$> asciiText-  genList        = NList        <$> fairList genExpr-  genSet         = NSet         <$> fairList genBinding-  genRecSet      = NRecSet      <$> fairList genBinding+  genConstant    = NConstant <$> genAtom+  genStr         = NStr <$> genString+  genSym         = NSym <$> asciiText+  genList        = NList <$> fairList genExpr+  genSet         = NSet <$> fairList genBinding+  genRecSet      = NRecSet <$> fairList genBinding   genLiteralPath = NLiteralPath . ("./" ++) <$> asciiString-  genEnvPath     = NEnvPath     <$> asciiString-  genUnary       = NUnary       <$> Gen.enumBounded <*> genExpr-  genBinary      = NBinary      <$> Gen.enumBounded <*> genExpr <*> genExpr-  genSelect      = NSelect      <$> genExpr <*> genAttrPath <*> Gen.maybe genExpr-  genHasAttr     = NHasAttr     <$> genExpr <*> genAttrPath-  genAbs         = NAbs         <$> genParams <*> genExpr-  genLet         = NLet         <$> fairList genBinding <*> genExpr-  genIf          = NIf          <$> genExpr <*> genExpr <*> genExpr-  genWith        = NWith        <$> genExpr <*> genExpr-  genAssert      = NAssert      <$> genExpr <*> genExpr+  genEnvPath     = NEnvPath <$> asciiString+  genUnary       = NUnary <$> Gen.enumBounded <*> genExpr+  genBinary      = NBinary <$> Gen.enumBounded <*> genExpr <*> genExpr+  genSelect      = NSelect <$> genExpr <*> genAttrPath <*> Gen.maybe genExpr+  genHasAttr     = NHasAttr <$> genExpr <*> genAttrPath+  genAbs         = NAbs <$> genParams <*> genExpr+  genLet         = NLet <$> fairList genBinding <*> genExpr+  genIf          = NIf <$> genExpr <*> genExpr <*> genExpr+  genWith        = NWith <$> genExpr <*> genExpr+  genAssert      = NAssert <$> genExpr <*> genExpr  -- | Useful when there are recursive positions at each element of the list as --   it divides the size by the length of the generated list.@@ -148,86 +147,87 @@  normalize :: NExpr -> NExpr normalize = cata $ \case-  NConstant (NInt n)   | n < 0 -> Fix (NUnary NNeg (Fix (NConstant (NInt (negate n)))))-  NConstant (NFloat n) | n < 0 -> Fix (NUnary NNeg (Fix (NConstant (NFloat (negate n)))))+  NConstant (NInt n) | n < 0 ->+    Fix (NUnary NNeg (Fix (NConstant (NInt (negate n)))))+  NConstant (NFloat n) | n < 0 ->+    Fix (NUnary NNeg (Fix (NConstant (NFloat (negate n))))) -  NSet binds      -> Fix (NSet (map normBinding binds))-  NRecSet binds   -> Fix (NRecSet (map normBinding binds))-  NLet binds r    -> Fix (NLet (map normBinding binds) r)+  NSet    binds -> Fix (NSet (map normBinding binds))+  NRecSet binds -> Fix (NRecSet (map normBinding binds))+  NLet binds  r -> Fix (NLet (map normBinding binds) r) -  NAbs params r   -> Fix (NAbs (normParams params) r)+  NAbs params r -> Fix (NAbs (normParams params) r) -  r               -> Fix r+  r             -> Fix r   where-  normBinding (NamedVar path r pos) = NamedVar (NE.map normKey path) r pos-  normBinding (Inherit mr names pos) = Inherit mr (map normKey names) pos+  normBinding (NamedVar path r     pos) = NamedVar (NE.map normKey path) r pos+  normBinding (Inherit  mr   names pos) = Inherit mr (map normKey names) pos    normKey (DynamicKey quoted) = DynamicKey (normAntiquotedString quoted)-  normKey (StaticKey name) = StaticKey name+  normKey (StaticKey  name  ) = StaticKey name -  normAntiquotedString :: Antiquoted (NString NExpr) NExpr-                       -> Antiquoted (NString NExpr) NExpr-  normAntiquotedString (Plain (DoubleQuoted [EscapedNewline])) =-      EscapedNewline+  normAntiquotedString+    :: Antiquoted (NString NExpr) NExpr -> Antiquoted (NString NExpr) NExpr+  normAntiquotedString (Plain (DoubleQuoted [EscapedNewline])) = EscapedNewline   normAntiquotedString (Plain (DoubleQuoted strs)) =-      let strs' = map normAntiquotedText strs-      in if strs == strs'-         then Plain (DoubleQuoted strs)-         else normAntiquotedString (Plain (DoubleQuoted strs'))+    let strs' = map normAntiquotedText strs+    in  if strs == strs'+          then Plain (DoubleQuoted strs)+          else normAntiquotedString (Plain (DoubleQuoted strs'))   normAntiquotedString r = r    normAntiquotedText :: Antiquoted Text NExpr -> Antiquoted Text NExpr-  normAntiquotedText (Plain "\n")   = EscapedNewline+  normAntiquotedText (Plain "\n"  ) = EscapedNewline   normAntiquotedText (Plain "''\n") = EscapedNewline-  normAntiquotedText r = r+  normAntiquotedText r              = r    normParams (ParamSet binds var (Just "")) = ParamSet binds var Nothing-  normParams r = r+  normParams r                              = r  -- | Test that parse . pretty == id up to attribute position information. prop_prettyparse :: Monad m => NExpr -> PropertyT m () prop_prettyparse p = do-  let prog = show (pretty p)+  let prog = show (prettyNix p)   case parse (pack prog) of     Failure s -> do-        footnote $ show $-            text "Parse failed:" </> text (show s)-              P.<$> P.indent 2 (pretty p)-        discard+      footnote $ show $ vsep+        [fillSep ["Parse failed:", pretty (show s)], indent 2 (prettyNix p)]+      discard     Success v-        | equivUpToNormalization p v -> success-        | otherwise -> do-          let pp = normalise prog-              pv = normalise (show (pretty v))-          footnote $ show $-                  text "----------------------------------------"-            P.<$> text "Expr before:" P.<$> P.indent 2 (text (PS.ppShow p))-            P.<$> text "----------------------------------------"-            P.<$> text "Expr after:"  P.<$> P.indent 2 (text (PS.ppShow v))-            P.<$> text "----------------------------------------"-            P.<$> text "Pretty before:" P.<$> P.indent 2 (text prog)-            P.<$> text "----------------------------------------"-            P.<$> text "Pretty after:"  P.<$> P.indent 2 (pretty v)-            P.<$> text "----------------------------------------"-            P.<$> text "Normalised before:" P.<$> P.indent 2 (text pp)-            P.<$> text "----------------------------------------"-            P.<$> text "Normalised after:"  P.<$> P.indent 2 (text pv)-            P.<$> text "========================================"-            P.<$> text "Normalised diff:"-            P.<$> text (ppDiff (diff pp pv))-            P.<$> text "========================================"-          assert (pp == pv)-  where-    pretty = prettyNix-    parse  = parseNixText+      | equivUpToNormalization p v -> success+      | otherwise -> do+        let pp = normalise prog+            pv = normalise (show (prettyNix v))+        footnote+          $ show+          $ vsep+          $ [ "----------------------------------------"+            , vsep ["Expr before:", indent 2 (pretty (PS.ppShow p))]+            , "----------------------------------------"+            , vsep ["Expr after:", indent 2 (pretty (PS.ppShow v))]+            , "----------------------------------------"+            , vsep ["Pretty before:", indent 2 (pretty prog)]+            , "----------------------------------------"+            , vsep ["Pretty after:", indent 2 (prettyNix v)]+            , "----------------------------------------"+            , vsep ["Normalised before:", indent 2 (pretty pp)]+            , "----------------------------------------"+            , vsep ["Normalised after:", indent 2 (pretty pv)]+            , "========================================"+            , vsep ["Normalised diff:", pretty (ppDiff (diff pp pv))]+            , "========================================"+            ]+        assert (pp == pv)+ where+  parse     = parseNixText -    normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines+  normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines -    diff :: String -> String -> [Diff [String]]-    diff s1 s2 = getDiff (map (:[]) (lines s1)) (map (:[]) (lines s2))+  diff :: String -> String -> [Diff [String]]+  diff s1 s2 = getDiff (map (: []) (lines s1)) (map (: []) (lines s2))  tests :: TestLimit -> TestTree tests n = testProperty "Pretty/Parse Property" $ withTests n $ property $ do-    x <- forAll genExpr-    prop_prettyparse x+  x <- forAll genExpr+  prop_prettyparse x
tests/PrettyTests.hs view
@@ -2,36 +2,37 @@ {-# LANGUAGE OverloadedStrings #-} module PrettyTests (tests) where -import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.TH+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.TH -import Nix.Expr-import Nix.Pretty+import           Nix.Expr+import           Nix.Pretty  case_indented_antiquotation :: Assertion case_indented_antiquotation = do-    assertPretty (mkIndentedStr 0 "echo $foo") "''echo $foo''"-    assertPretty (mkIndentedStr 0 "echo ${foo}") "''echo ''${foo}''"+  assertPretty (mkIndentedStr 0 "echo $foo")   "''echo $foo''"+  assertPretty (mkIndentedStr 0 "echo ${foo}") "''echo ''${foo}''"  case_string_antiquotation :: Assertion case_string_antiquotation = do-    assertPretty (mkStr "echo $foo") "\"echo \\$foo\""-    assertPretty (mkStr "echo ${foo}") "\"echo \\${foo}\""+  assertPretty (mkStr "echo $foo")   "\"echo \\$foo\""+  assertPretty (mkStr "echo ${foo}") "\"echo \\${foo}\""  case_function_params :: Assertion case_function_params =-    assertPretty (mkFunction (mkParamset [] True) (mkInt 3)) "{ ... }:\n  3"+  assertPretty (mkFunction (mkParamset [] True) (mkInt 3)) "{ ... }:\n  3"  case_paths :: Assertion case_paths = do-    assertPretty (mkPath False "~/test.nix") "~/test.nix"-    assertPretty (mkPath False "/test.nix") "/test.nix"-    assertPretty (mkPath False "./test.nix") "./test.nix"+  assertPretty (mkPath False "~/test.nix") "~/test.nix"+  assertPretty (mkPath False "/test.nix")  "/test.nix"+  assertPretty (mkPath False "./test.nix") "./test.nix"  tests :: TestTree tests = $testGroupGenerator  -------------------------------------------------------------------------------- assertPretty :: NExpr -> String -> Assertion-assertPretty e s = assertEqual ("When pretty-printing " ++ show e) s . show $ prettyNix e+assertPretty e s =+  assertEqual ("When pretty-printing " ++ show e) s . show $ prettyNix e
tests/ReduceExprTests.hs view
@@ -1,44 +1,45 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} module ReduceExprTests (tests) where-import Data.Fix-import Test.Tasty-import Test.Tasty.HUnit+import           Data.Fix+import           Test.Tasty+import           Test.Tasty.HUnit -import Nix.Atoms-import Nix.Expr.Types-import Nix.Expr.Types.Annotated-import Nix.Parser-import Nix.Reduce (reduceExpr)+import           Nix.Atoms+import           Nix.Expr.Types+import           Nix.Expr.Types.Annotated+import           Nix.Parser+import           Nix.Reduce                     ( reduceExpr )   tests :: TestTree-tests = testGroup "Expr Reductions"-    [ testCase "Non nested NSelect on set should be reduced" $ -        cmpReduceResult selectBasic selectBasicExpect,-      testCase "Nested NSelect on set should be reduced" $ -        cmpReduceResult selectNested selectNestedExpect,-      testCase "Non nested NSelect with incorrect attrpath shouldn't be reduced" $ -        shouldntReduce selectIncorrectAttrPath,-      testCase "Nested NSelect with incorrect attrpath shouldn't be reduced" $ -        shouldntReduce selectNestedIncorrectAttrPath -    ]+tests = testGroup+  "Expr Reductions"+  [ testCase "Non nested NSelect on set should be reduced"+    $ cmpReduceResult selectBasic selectBasicExpect+  , testCase "Nested NSelect on set should be reduced"+    $ cmpReduceResult selectNested selectNestedExpect+  , testCase "Non nested NSelect with incorrect attrpath shouldn't be reduced"+    $ shouldntReduce selectIncorrectAttrPath+  , testCase "Nested NSelect with incorrect attrpath shouldn't be reduced"+    $ shouldntReduce selectNestedIncorrectAttrPath+  ]  assertSucc :: Result a -> IO a assertSucc (Success a) = pure a assertSucc (Failure d) = assertFailure $ show d -cmpReduceResult :: Result NExprLoc -> NExpr -> Assertion +cmpReduceResult :: Result NExprLoc -> NExpr -> Assertion cmpReduceResult r e = do-    r <- assertSucc r-    r <- stripAnnotation <$> reduceExpr Nothing r-    r @?= e+  r <- assertSucc r+  r <- stripAnnotation <$> reduceExpr Nothing r+  r @?= e  shouldntReduce :: Result NExprLoc -> Assertion shouldntReduce r = do-    r <- assertSucc r-    rReduced <- reduceExpr Nothing r-    r @?= rReduced+  r        <- assertSucc r+  rReduced <- reduceExpr Nothing r+  r @?= rReduced  selectBasic :: Result NExprLoc selectBasic = parseNixTextLoc "{b=2;a=42;}.a"
tests/TestCommon.hs view
@@ -1,46 +1,54 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}  module TestCommon where -import Control.Monad.Catch-import Control.Monad.IO.Class-import Data.Text (Text, unpack)-import Data.Time-import Nix-import System.Environment-import System.IO-import System.Posix.Files-import System.Posix.Temp-import System.Process-import Test.Tasty.HUnit+import           Control.Monad.Catch+import           Control.Monad.IO.Class+import           Data.Text                      ( Text+                                                , unpack+                                                )+import           Data.Time+import           Nix+import           Nix.Exec                       ( )+import           Nix.Thunk.Standard+import           System.Environment+import           System.IO+import           System.Posix.Files+import           System.Posix.Temp+import           System.Process+import           Test.Tasty.HUnit -hnixEvalFile :: Options -> FilePath -> IO (NValueNF (Lazy IO))+hnixEvalFile :: Options -> FilePath -> IO (StandardValueNF IO) hnixEvalFile opts file = do   parseResult <- parseNixFileLoc file   case parseResult of-    Failure err        ->-        error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err+    Failure err ->+      error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err     Success expr -> do-        setEnv "TEST_VAR" "foo"-        runLazyM opts $-            catch (evaluateExpression (Just file) nixEvalExprLoc-                                      normalForm expr) $ \case-                NixException frames ->-                    errorWithoutStackTrace . show-                        =<< renderFrames @(NThunk (Lazy IO)) frames+      setEnv "TEST_VAR" "foo"+      runStandardIO opts+        $ catch (evaluateExpression (Just file) nixEvalExprLoc normalForm expr)+        $ \case+            NixException frames ->+              errorWithoutStackTrace+                .   show+                =<< renderFrames @(StandardValue IO) @(StandardThunk IO) frames -hnixEvalText :: Options -> Text -> IO (NValueNF (Lazy IO))+hnixEvalText :: Options -> Text -> IO (StandardValueNF IO) hnixEvalText opts src = case parseNixText src of-    Failure err        ->-        error $ "Parsing failed for expressien `"-            ++ unpack src ++ "`.\n" ++ show err-    Success expr ->-        runLazyM opts $ normalForm =<< nixEvalExpr Nothing expr+  Failure err ->+    error+      $  "Parsing failed for expressien `"+      ++ unpack src+      ++ "`.\n"+      ++ show err+  Success expr -> runStandardIO opts $ normalForm =<< nixEvalExpr Nothing expr  nixEvalString :: String -> IO String nixEvalString expr = do-  (fp,h) <- mkstemp "nix-test-eval"+  (fp, h) <- mkstemp "nix-test-eval"   hPutStr h expr   hClose h   res <- nixEvalFile fp@@ -52,16 +60,15 @@  assertEvalFileMatchesNix :: FilePath -> Assertion assertEvalFileMatchesNix fp = do-  time <- liftIO getCurrentTime-  hnixVal <- (++"\n") . printNix <$> hnixEvalFile (defaultOptions time) fp-  nixVal <- nixEvalFile fp+  time    <- liftIO getCurrentTime+  hnixVal <- (++ "\n") . printNix <$> hnixEvalFile (defaultOptions time) fp+  nixVal  <- nixEvalFile fp   assertEqual fp nixVal hnixVal  assertEvalMatchesNix :: Text -> Assertion assertEvalMatchesNix expr = do-  time <- liftIO getCurrentTime-  hnixVal <- (++"\n") . printNix <$> hnixEvalText (defaultOptions time) expr-  nixVal <- nixEvalString expr'+  time    <- liftIO getCurrentTime+  hnixVal <- (++ "\n") . printNix <$> hnixEvalText (defaultOptions time) expr+  nixVal  <- nixEvalString expr'   assertEqual expr' nixVal hnixVal- where-  expr' = unpack expr+  where expr' = unpack expr
+ tests/eval-compare/builtins.string.store.nix view
@@ -0,0 +1,1 @@+"${builtins.storeDir}"