hnix 0.15.0 → 0.16.0

raw patch · 79 files changed

+2292/−2052 lines, 79 filesdep ~basedep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, hashable

API changes (from Hackage documentation)

Files

• ChangeLog.md +31/−0
• benchmarks/Main.hs +1/−0
• benchmarks/ParserBench.hs +1/−0
• data/nix/corepkgs/buildenv.nix +0/−25
• data/nix/corepkgs/derivation.nix +0/−27
• data/nix/corepkgs/fetchurl.nix +0/−41
• data/nix/corepkgs/imported-drv-to-derivation.nix +0/−21
• data/nix/corepkgs/unpack-channel.nix +0/−39
• data/nix/tests/lang/eval-fail-antiquoted-path.nix +0/−4
• data/nix/tests/lang/eval-okay-ind-string.exp +1/−1
• data/nix/tests/lang/eval-okay-search-path.nix +2/−3
• data/nix/tests/lang/eval-okay-sort.exp +1/−1
• data/nix/tests/lang/eval-okay-sort.nix +13/−1
• data/nix/tests/lang/eval-okay-tojson.exp +1/−1
• data/nix/tests/lang/eval-okay-tojson.nix +1/−0
• data/nix/tests/lang/parse-okay-url.nix +1/−0
• data/nix/tests/local.mk +47/−12
• hnix.cabal +12/−32
• main/Main.hs +105/−104
• main/Repl.hs +81/−79
• src/Nix.hs +12/−13
• src/Nix/Atoms.hs +4/−3
• src/Nix/Builtins.hs +360/−271
• src/Nix/Cache.hs +1/−0
• src/Nix/Cited.hs +10/−8
• src/Nix/Cited/Basic.hs +12/−9
• src/Nix/Context.hs +12/−11
• src/Nix/Convert.hs +34/−26
• src/Nix/Effects.hs +5/−2
• src/Nix/Effects/Basic.hs +4/−4
• src/Nix/Effects/Derivation.hs +16/−15
• src/Nix/Eval.hs +34/−34
• src/Nix/Exec.hs +255/−233
• src/Nix/Expr/Shorthands.hs +4/−4
• src/Nix/Expr/Strings.hs +16/−7
• src/Nix/Expr/Types.hs +101/−21
• src/Nix/Expr/Types/Annotated.hs +3/−2
• src/Nix/Frames.hs +15/−8
• src/Nix/Fresh.hs +3/−3
• src/Nix/Fresh/Basic.hs +30/−12
• src/Nix/Json.hs +8/−7
• src/Nix/Lint.hs +17/−14
• src/Nix/Normal.hs +6/−3
• src/Nix/Options.hs +68/−60
• src/Nix/Options/Parser.hs +1/−0
• src/Nix/Parser.hs +80/−65
• src/Nix/Prelude.hs +20/−0
• src/Nix/Pretty.hs +144/−113
• src/Nix/Reduce.hs +28/−24
• src/Nix/Render.hs +3/−2
• src/Nix/Render/Frame.hs +34/−32
• src/Nix/Scope.hs +9/−6
• src/Nix/Standard.hs +13/−10
• src/Nix/String.hs +43/−50
• src/Nix/String/Coerce.hs +77/−56
• src/Nix/TH.hs +6/−85
• src/Nix/Thunk.hs +1/−0
• src/Nix/Thunk/Basic.hs +18/−21
• src/Nix/Type/Assumption.hs +4/−2
• src/Nix/Type/Env.hs +2/−1
• src/Nix/Type/Infer.hs +29/−55
• src/Nix/Type/Type.hs +1/−1
• src/Nix/Unused.hs +1/−0
• src/Nix/Utils.hs +204/−155
• src/Nix/Utils/Fix1.hs +3/−1
• src/Nix/Value.hs +96/−89
• src/Nix/Value/Equal.hs +12/−13
• src/Nix/Value/Monad.hs +0/−1
• src/Nix/Var.hs +1/−0
• src/Nix/XML.hs +1/−1
• src/Prelude.hs +0/−20
• tests/EvalTests.hs +25/−10
• tests/Main.hs +2/−1
• tests/NixLanguageTests.hs +16/−11
• tests/ParserTests.hs +40/−28
• tests/PrettyParseTests.hs +1/−0
• tests/PrettyTests.hs +4/−2
• tests/ReduceExprTests.hs +3/−0
• tests/TestCommon.hs +42/−36

@@ -1,6 +1,37 @@  # ChangeLog +## [(diff)](https://github.com/haskell-nix/hnix/compare/0.15.0...0.16.0#files_bucket) 0.16.0++On update problems, please reach out to us. For support refere to: https://github.com/haskell-nix/hnix/issues/984++Partial log (for now):++* Breaking:+  * Where `coerce` should work, removed `newtype` accessors.+  * [(link)](https://github.com/haskell-nix/hnix/pull/1006/files), [(link)](https://github.com/haskell-nix/hnix/pull/1009/files) Incomprehensible record accessors zoo like: `arg`, `options`, `unStore`, `scFlavor`, `nsContext` `_provenance` - was organized, now all record accessors start with `get*`, and their names tend to have according unique sematic meaning of data action they do.+  * Builder names got unified. Now they all start with `mk*`. So a lof of `nvSet` became `mkNVSet`.+  * `Nix.String` builders/destructors instead of `make` use `mk`, & where mentioning of `string` is superflous - dropped it from the name, so `stringIgnoreContext`, became `ignoreContext`.+  * Type system:+    * Things that are paths are now `newtype Path = Path String`.+    * Things that are indentifier names are now `newtype VarName = VarName Text`.+    * Function signatures changed accordingly.++* Additional:+  * [(link)](https://github.com/haskell-nix/hnix/pull/1019) Matched expression escaping & its representation to breaking changes in Nix `2.4`.+  * `Builtins` (`builtins` function set) gained functions:+    * [(link)](https://github.com/haskell-nix/hnix/pull/1032) `path`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1020) `isPathNix`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1032) `unsafeDiscardOutputDependency`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1031) `ceil`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1031) `floor`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1021) `hashFile`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1033) `groupBy`+  * [(link)](https://github.com/haskell-nix/hnix/pull/1029) `data/nix` submodule (& its tests) updated to 2022-01-17.++* Other notes:+  * `Shorthands` was kept untouched.+ ## [(diff)](https://github.com/haskell-nix/hnix/compare/0.14.0...0.15.0#files_bucket) 0.15.0  For support refere to: https://github.com/haskell-nix/hnix/issues/984

@@ -1,5 +1,6 @@ module Main where +import           Nix.Prelude import           Criterion.Main  import qualified ParserBench

@@ -1,5 +1,6 @@ module ParserBench (benchmarks) where +import           Nix.Prelude import           Nix.Parser  import           Criterion

@@ -1,25 +0,0 @@-{ derivations, manifest }:--derivation {-  name = "user-environment";-  system = "builtin";-  builder = "builtin:buildenv";--  inherit manifest;--  # !!! grmbl, need structured data for passing this in a clean way.-  derivations =-    map (d:-      [ (d.meta.active or "true")-        (d.meta.priority or 5)-        (builtins.length d.outputs)-      ] ++ map (output: builtins.getAttr output d) d.outputs)-      derivations;--  # Building user environments remotely just causes huge amounts of-  # network traffic, so don't do that.-  preferLocalBuild = true;--  # Also don't bother substituting.-  allowSubstitutes = false;-}

@@ -1,27 +0,0 @@-/* 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

@@ -1,41 +0,0 @@-{ system ? "" # obsolete-, url-, hash ? "" # an SRI ash--# Legacy hash specification-, md5 ? "", sha1 ? "", sha256 ? "", sha512 ? ""-, outputHash ?-    if hash != "" then hash else if sha512 != "" then sha512 else if sha1 != "" then sha1 else if md5 != "" then md5 else sha256-, outputHashAlgo ?-    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)-}:--derivation {-  builder = "builtin:fetchurl";--  # New-style output content requirements.-  inherit outputHashAlgo outputHash;-  outputHashMode = if unpack || executable then "recursive" else "flat";--  inherit name url executable unpack;--  system = "builtin";--  # No need to double the amount of network traffic-  preferLocalBuild = true;--  impureEnvVars = [-    # We borrow these environment variables from the caller to allow-    # easy proxy configuration.  This is impure, but a fixed-output-    # derivation like fetchurl is allowed to do so since its result is-    # by definition pure.-    "http_proxy" "https_proxy" "ftp_proxy" "all_proxy" "no_proxy"-  ];--  # To make "nix-prefetch-url" work.-  urls = [ url ];-}

@@ -1,21 +0,0 @@-attrs @ { drvPath, outputs, name, ... }:--let--  commonAttrs = (builtins.listToAttrs outputsList) //-    { all = map (x: x.value) outputsList;-      inherit drvPath name;-      type = "derivation";-    };--  outputToAttrListElement = outputName:-    { name = outputName;-      value = commonAttrs // {-        outPath = builtins.getAttr outputName attrs;-        inherit outputName;-      };-    };-    -  outputsList = map outputToAttrListElement outputs;-    -in (builtins.head outputsList).value

@@ -1,39 +0,0 @@-with import <nix/config.nix>;--let--  builder = builtins.toFile "unpack-channel.sh"-    ''-      mkdir $out-      cd $out-      xzpat="\.xz\$"-      gzpat="\.gz\$"-      if [[ "$src" =~ $xzpat ]]; then-        ${xz} -d < $src | ${tar} xf - ${tarFlags}-      elif [[ "$src" =~ $gzpat ]]; then-        ${gzip} -d < $src | ${tar} xf - ${tarFlags}-      else-        ${bzip2} -d < $src | ${tar} xf - ${tarFlags}-      fi-      if [ * != $channelName ]; then-        mv * $out/$channelName-      fi-    '';--in--{ name, channelName, src }:--derivation {-  system = builtins.currentSystem;-  builder = shell;-  args = [ "-e" builder ];-  inherit name channelName src;--  PATH = "${nixBinDir}:${coreutils}";--  # No point in doing this remotely.-  preferLocalBuild = true;--  inherit chrootDeps;-}

@@ -1,4 +0,0 @@-# This must fail to evaluate, since ./fnord doesn't exist.  If it did-# exist, it would produce "/nix/store/<hash>-fnord/xyzzy" (with an-# appropriate context).-"${./fnord}/xyzzy"

@@ -1,1 +1,1 @@-"This is an indented multi-line string\nliteral.  An amount of whitespace at\nthe start of each line matching the minimum\nindentation of all lines in the string\nliteral together will be removed.  Thus,\nin this case four spaces will be\nstripped from each line, even though\n  THIS LINE is indented six spaces.\n\nAlso, empty lines don't count in the\ndetermination of the indentation level (the\nprevious empty line has indentation 0, but\nit doesn't matter).\nIf the string starts with whitespace\n  followed by a newline, it's stripped, but\n  that's not the case here. Two spaces are\n  stripped because of the \"  \" at the start. \nThis line is indented\na bit further.\nAnti-quotations, like so, are\nalso allowed.\n  The \\ is not special here.\n' can be followed by any character except another ', e.g. 'x'.\nLikewise for $, e.g. $$ or $varName.\nBut ' followed by ' is special, as is $ followed by {.\nIf you want them, use anti-quotations: '', ${.\n   Tabs are not interpreted as whitespace (since we can't guess\n   what tab settings are intended), so don't use them.\n\tThis line starts with a space and a tab, so only one\n   space will be stripped from each line.\nAlso note that if the last line (just before the closing ' ')\nconsists only of whitespace, it's ignored.  But here there is\nsome non-whitespace stuff, so the line isn't removed. \nThis shows a hacky way to preserve an empty line after the start.\nBut there's no reason to do so: you could just repeat the empty\nline.\n  Similarly you can force an indentation level,\n  in this case to 2 spaces.  This works because the anti-quote\n  is significant (not whitespace).\nstart on network-interfaces\n\nstart script\n\n  rm -f /var/run/opengl-driver\n  ln -sf 123 /var/run/opengl-driver\n\n  rm -f /var/log/slim.log\n   \nend script\n\nenv SLIM_CFGFILE=abc\nenv SLIM_THEMESDIR=def\nenv FONTCONFIG_FILE=/etc/fonts/fonts.conf  \t\t\t\t# !!! cleanup\nenv XKB_BINDIR=foo/bin         \t\t\t\t# Needed for the Xkb extension.\nenv LD_LIBRARY_PATH=libX11/lib:libXext/lib:/usr/lib/          # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz)\n\nenv XORG_DRI_DRIVER_PATH=nvidiaDrivers/X11R6/lib/modules/drivers/ \n\nexec slim/bin/slim\nEscaping of ' followed by ': ''\nEscaping of $ followed by {: ${\nAnd finally to interpret \\n etc. as in a string: \n, \r, \t.\nfoo\n'bla'\nbar\ncut -d $'\\t' -f 1\nending dollar $$\n"+"This is an indented multi-line string\nliteral.  An amount of whitespace at\nthe start of each line matching the minimum\nindentation of all lines in the string\nliteral together will be removed.  Thus,\nin this case four spaces will be\nstripped from each line, even though\n  THIS LINE is indented six spaces.\n\nAlso, empty lines don't count in the\ndetermination of the indentation level (the\nprevious empty line has indentation 0, but\nit doesn't matter).\nIf the string starts with whitespace\n  followed by a newline, it's stripped, but\n  that's not the case here. Two spaces are\n  stripped because of the \"  \" at the start. \nThis line is indented\na bit further.\nAnti-quotations, like so, are\nalso allowed.\n  The \\ is not special here.\n' can be followed by any character except another ', e.g. 'x'.\nLikewise for $, e.g. $$ or $varName.\nBut ' followed by ' is special, as is $ followed by {.\nIf you want them, use anti-quotations: '', \${.\n   Tabs are not interpreted as whitespace (since we can't guess\n   what tab settings are intended), so don't use them.\n\tThis line starts with a space and a tab, so only one\n   space will be stripped from each line.\nAlso note that if the last line (just before the closing ' ')\nconsists only of whitespace, it's ignored.  But here there is\nsome non-whitespace stuff, so the line isn't removed. \nThis shows a hacky way to preserve an empty line after the start.\nBut there's no reason to do so: you could just repeat the empty\nline.\n  Similarly you can force an indentation level,\n  in this case to 2 spaces.  This works because the anti-quote\n  is significant (not whitespace).\nstart on network-interfaces\n\nstart script\n\n  rm -f /var/run/opengl-driver\n  ln -sf 123 /var/run/opengl-driver\n\n  rm -f /var/log/slim.log\n   \nend script\n\nenv SLIM_CFGFILE=abc\nenv SLIM_THEMESDIR=def\nenv FONTCONFIG_FILE=/etc/fonts/fonts.conf  \t\t\t\t# !!! cleanup\nenv XKB_BINDIR=foo/bin         \t\t\t\t# Needed for the Xkb extension.\nenv LD_LIBRARY_PATH=libX11/lib:libXext/lib:/usr/lib/          # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz)\n\nenv XORG_DRI_DRIVER_PATH=nvidiaDrivers/X11R6/lib/modules/drivers/ \n\nexec slim/bin/slim\nEscaping of ' followed by ': ''\nEscaping of $ followed by {: \${\nAnd finally to interpret \\n etc. as in a string: \n, \r, \t.\nfoo\n'bla'\nbar\ncut -d $'\\t' -f 1\nending dollar $$\n"

@@ -1,10 +1,9 @@ with import ./lib.nix; with builtins; -assert pathExists <nix/buildenv.nix>;+assert isFunction (import <nix/fetchurl.nix>); -assert length __nixPath == 6;-assert length (filter (x: x.prefix == "nix") __nixPath) == 1;+assert length __nixPath == 5; assert length (filter (x: baseNameOf x.path == "dir4") __nixPath) == 1;  import <a.nix> + import <b.nix> + import <c.nix> + import <dir5/c.nix>

@@ -1,1 +1,1 @@-[ [ 42 77 147 249 483 526 ] [ 526 483 249 147 77 42 ] [ "bar" "fnord" "foo" "xyzzy" ] [ { key = 1; value = "foo"; } { key = 1; value = "fnord"; } { key = 2; value = "bar"; } ] ]+[ [ 42 77 147 249 483 526 ] [ 526 483 249 147 77 42 ] [ "bar" "fnord" "foo" "xyzzy" ] [ { key = 1; value = "foo"; } { key = 1; value = "fnord"; } { key = 2; value = "bar"; } ] [ [ ] [ ] [ 1 ] [ 1 4 ] [ 1 5 ] [ 1 6 ] [ 2 ] [ 2 3 ] [ 3 ] [ 3 ] ] ]

@@ -4,5 +4,17 @@   (sort (x: y: y < x) [ 483 249 526 147 42 77 ])   (sort lessThan [ "foo" "bar" "xyzzy" "fnord" ])   (sort (x: y: x.key < y.key)-    [ { key = 1; value = "foo"; } { key = 2; value = "bar"; } { key = 1; value = "fnord"; } ]) +    [ { key = 1; value = "foo"; } { key = 2; value = "bar"; } { key = 1; value = "fnord"; } ])+  (sort lessThan [+    [ 1 6 ]+    [ ]+    [ 2 3 ]+    [ 3 ]+    [ 1 5 ]+    [ 2 ]+    [ 1 ]+    [ ]+    [ 1 4 ]+    [ 3 ]+  ]) ]

@@ -1,1 +1,1 @@-"{\"a\":123,\"b\":-456,\"c\":\"foo\",\"d\":\"foo\\n\\\"bar\\\"\",\"e\":true,\"f\":false,\"g\":[1,2,3],\"h\":[\"a\",[\"b\",{\"foo\\nbar\":{}}]],\"i\":3,\"j\":1.44}"+"{\"a\":123,\"b\":-456,\"c\":\"foo\",\"d\":\"foo\\n\\\"bar\\\"\",\"e\":true,\"f\":false,\"g\":[1,2,3],\"h\":[\"a\",[\"b\",{\"foo\\nbar\":{}}]],\"i\":3,\"j\":1.44,\"k\":\"foo\"}"

@@ -9,4 +9,5 @@     h = [ "a" [ "b" { "foo\nbar" = {}; } ] ];     i = 1 + 2;     j = 1.44;+    k = { __toString = self: self.a; a = "foo"; };   }

@@ -3,5 +3,6 @@   http://www2.mplayerhq.hu/MPlayer/releases/fonts/font-arial-iso-8859-1.tar.bz2   http://losser.st-lab.cs.uu.nl/~armijn/.nix/gcc-3.3.4-static-nix.tar.gz   http://fpdownload.macromedia.com/get/shockwave/flash/english/linux/7.0r25/install_flash_player_7_linux.tar.gz+  https://ftp5.gwdg.de/pub/linux/archlinux/extra/os/x86_64/unzip-6.0-14-x86_64.pkg.tar.zst   ftp://ftp.gtk.org/pub/gtk/v1.2/gtk+-1.2.10.tar.gz ]

@@ -1,42 +1,77 @@-check:-	@echo "Warning: Nix has no 'make check'. Please install Nix and run 'make installcheck' instead."- nix_tests = \-  init.sh hash.sh lang.sh add.sh simple.sh dependencies.sh \+  hash.sh lang.sh add.sh simple.sh dependencies.sh \+  config.sh \   gc.sh \+  ca/gc.sh \   gc-concurrent.sh \+  gc-non-blocking.sh \   gc-auto.sh \   referrers.sh user-envs.sh logging.sh nix-build.sh misc.sh fixed.sh \   gc-runtime.sh check-refs.sh filter-source.sh \-  remote-store.sh export.sh export-graph.sh \+  local-store.sh remote-store.sh export.sh export-graph.sh \+  db-migration.sh \   timeout.sh secure-drv-outputs.sh nix-channel.sh \-  multiple-outputs.sh import-derivation.sh fetchurl.sh optimise-store.sh \-  binary-cache.sh nix-profile.sh repair.sh dump-db.sh case-hack.sh \+  multiple-outputs.sh import-derivation.sh ca/import-derivation.sh fetchurl.sh optimise-store.sh \+  binary-cache.sh \+  substitute-with-invalid-ca.sh \+  binary-cache-build-remote.sh \+  nix-profile.sh repair.sh dump-db.sh case-hack.sh \   check-reqs.sh pass-as-file.sh tarball.sh restricted.sh \   placeholders.sh nix-shell.sh \   linux-sandbox.sh \   build-dry.sh \-  build-remote.sh \+  build-remote-input-addressed.sh \+  build-remote-content-addressed-fixed.sh \+  build-remote-content-addressed-floating.sh \+  ssh-relay.sh \   nar-access.sh \   structured-attrs.sh \   fetchGit.sh \+  fetchGitRefs.sh \+  fetchGitSubmodules.sh \   fetchMercurial.sh \   signing.sh \-  run.sh \+  shell.sh \   brotli.sh \+  zstd.sh \+  compression-levels.sh \   pure-eval.sh \   check.sh \   plugins.sh \   search.sh \   nix-copy-ssh.sh \   post-hook.sh \-  function-trace.sh+  ca/post-hook.sh \+  function-trace.sh \+  recursive.sh \+  describe-stores.sh \+  flakes.sh \+  flake-local-settings.sh \+  flake-searching.sh \+  build.sh \+  repl.sh ca/repl.sh \+  ca/build.sh \+  ca/build-with-garbage-path.sh \+  ca/duplicate-realisation-in-closure.sh \+  ca/substitute.sh \+  ca/signatures.sh \+  ca/nix-shell.sh \+  ca/nix-run.sh \+  ca/recursive.sh \+  ca/concurrent-builds.sh \+  ca/nix-copy.sh \+  eval-store.sh \+  readfile-context.sh   # parallel.sh +ifeq ($(HAVE_LIBCPUID), 1)+	nix_tests += compute-levels.sh+endif+ install-tests += $(foreach x, $(nix_tests), tests/$(x))  tests-environment = NIX_REMOTE= $(bash) -e -clean-files += $(d)/common.sh+clean-files += $(d)/common.sh $(d)/config.nix $(d)/ca/config.nix -installcheck: $(d)/common.sh $(d)/plugins/libplugintest.$(SO_EXT)+test-deps += tests/common.sh tests/config.nix tests/ca/config.nix tests/plugins/libplugintest.$(SO_EXT)

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hnix-version:        0.15.0+version:        0.16.0 synopsis:       Haskell implementation of the Nix language description:    Haskell implementation of the Nix language. category:       System, Data, Nix@@ -12,21 +12,10 @@ license-file:   License build-type:     Simple data-dir:       data/-data-files:-  nix/corepkgs/buildenv.nix-  nix/corepkgs/unpack-channel.nix-  nix/corepkgs/derivation.nix-  nix/corepkgs/fetchurl.nix-  nix/corepkgs/imported-drv-to-derivation.nix extra-source-files:   ChangeLog.md   ReadMe.md   License-  data/nix/corepkgs/buildenv.nix-  data/nix/corepkgs/unpack-channel.nix-  data/nix/corepkgs/derivation.nix-  data/nix/corepkgs/fetchurl.nix-  data/nix/corepkgs/imported-drv-to-derivation.nix   data/nix/tests/lang/binary-data   data/nix/tests/lang/data   data/nix/tests/lang/dir1/a.nix@@ -38,7 +27,6 @@   data/nix/tests/lang/dir4/a.nix   data/nix/tests/lang/dir4/c.nix   data/nix/tests/lang/eval-fail-abort.nix-  data/nix/tests/lang/eval-fail-antiquoted-path.nix   data/nix/tests/lang/eval-fail-assert.nix   data/nix/tests/lang/eval-fail-bad-antiquote-1.nix   data/nix/tests/lang/eval-fail-bad-antiquote-2.nix@@ -341,8 +329,8 @@  library   exposed-modules:-    Prelude     Nix+    Nix.Prelude     Nix.Utils     Nix.Atoms     Nix.Builtins@@ -398,16 +386,13 @@     Paths_hnix   hs-source-dirs:     src-  mixins:-      base hiding (Prelude)-    , relude   ghc-options:     -Wall     -fprint-potential-instances   build-depends:       aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.1     , array >= 0.4 && < 0.6-    , base >= 4.12 && < 5+    , base >= 4.12 && < 4.16     , base16-bytestring >= 0.1.1 && < 1.1     , binary >= 0.8.5 && < 0.9     , bytestring >= 0.10.8 && < 0.12@@ -422,7 +407,7 @@     , filepath >= 1.4.2 && < 1.5     , free >= 5.1 && < 5.2     , gitrev >= 1.1.0 && < 1.4-    , hashable >= 1.2.5 && < 1.4+    , hashable >= 1.2.5 && < 1.5     , hashing >= 0.1.0 && < 0.2     , hnix-store-core >= 0.5.0 && < 0.6     , hnix-store-remote >= 0.5.0 && < 0.6@@ -469,7 +454,8 @@     , vector >= 0.12.0 && < 0.13     , xml >= 1.3.14 && < 1.4   default-extensions:-      OverloadedStrings+      NoImplicitPrelude+    , OverloadedStrings     , DeriveGeneric     , DeriveDataTypeable     , DeriveFunctor@@ -532,11 +518,9 @@     , serialise     , template-haskell     , time-  mixins:-      base hiding (Prelude)-    , relude   default-extensions:-      OverloadedStrings+      NoImplicitPrelude+    , OverloadedStrings     , DeriveGeneric     , DeriveDataTypeable     , DeriveFunctor@@ -579,9 +563,6 @@     PrettyTests     ReduceExprTests     TestCommon-  mixins:-      base hiding (Prelude)-    , relude   hs-source-dirs:     tests   ghc-options:@@ -615,7 +596,8 @@     , time     , unix-compat   default-extensions:-      OverloadedStrings+      NoImplicitPrelude+    , OverloadedStrings     , DeriveGeneric     , DeriveDataTypeable     , DeriveFunctor@@ -650,9 +632,6 @@     ParserBench   hs-source-dirs:     benchmarks-  mixins:-      base hiding (Prelude)-    , relude   ghc-options:     -Wall   build-depends:@@ -668,7 +647,8 @@     , template-haskell     , time   default-extensions:-      OverloadedStrings+      NoImplicitPrelude+    , OverloadedStrings     , DeriveGeneric     , DeriveDataTypeable     , DeriveFunctor

@@ -4,6 +4,7 @@  module Main ( main ) where +import           Nix.Prelude import           Relude                        as Prelude ( force ) import           Control.Comonad                ( extract ) import qualified Control.Exception             as Exception@@ -19,7 +20,6 @@ import           Text.Show.Pretty               ( ppShow ) import           Nix                     hiding ( force ) import           Nix.Convert-import           Nix.Fresh.Basic import           Nix.Json import           Nix.Options.Parser import           Nix.Standard@@ -37,8 +37,8 @@ main :: IO () main =   do-    time <- getCurrentTime-    opts <- execParser $ nixOptionsInfo time+    currentTime <- getCurrentTime+    opts <- execParser $ nixOptionsInfo currentTime      main' opts @@ -47,18 +47,18 @@  where   --  2021-07-15: NOTE: This logic should be weaved stronger through CLI options logic (OptParse-Applicative code)   -- As this logic is not stated in the CLI documentation, for example. So user has no knowledge of these.-  execContentsFilesOrRepl :: StandardT (StdIdT IO) ()+  execContentsFilesOrRepl :: StdIO   execContentsFilesOrRepl =     fromMaybe       loadFromCliFilePathList-      ( loadBinaryCacheFile <|>+      $ loadBinaryCacheFile <|>         loadLiteralExpression <|>         loadExpressionFromFile-      )    where     -- | The base case: read expressions from the last CLI directive (@[FILE]@) listed on the command line.+    loadFromCliFilePathList :: StdIO     loadFromCliFilePathList =-      case filePaths of+      case getFilePaths of         []     -> runRepl         ["-"]  -> readExpressionFromStdin         _paths -> processSeveralFiles (coerce _paths)@@ -67,27 +67,28 @@       runRepl = withEmptyNixContext Repl.main        readExpressionFromStdin =-        do-          expr <- liftIO Text.getContents-          processExpr expr+        processExpr =<< liftIO Text.getContents -    processSeveralFiles :: [Path] -> StandardT (StdIdT IO) ()+    processSeveralFiles :: [Path] -> StdIO     processSeveralFiles = traverse_ processFile      where       processFile path = handleResult (pure path) =<< parseNixFileLoc path      -- |  The `--read` option: load expression from a serialized file.+    loadBinaryCacheFile :: Maybe StdIO     loadBinaryCacheFile =       (\ (binaryCacheFile :: Path) ->         do           let file = replaceExtension binaryCacheFile "nixc"-          processCLIOptions (Just file) =<< liftIO (readCache binaryCacheFile)-      ) <$> readFrom+          processCLIOptions (pure file) =<< liftIO (readCache binaryCacheFile)+      ) <$> getReadFrom      -- | The `--expr` option: read expression from the argument string-    loadLiteralExpression = processExpr <$> expression+    loadLiteralExpression :: Maybe StdIO+    loadLiteralExpression = processExpr <$> getExpression      -- | The `--file` argument: read expressions from the files listed in the argument file+    loadExpressionFromFile :: Maybe StdIO     loadExpressionFromFile =       -- We can start use Text as in the base case, requires changing Path -> Text       -- But that is a gradual process:@@ -96,9 +97,10 @@         (\case           "-" -> Text.getContents           _fp -> readFile _fp-        ) <$> fromFile+        ) <$> getFromFile -  processExpr text = handleResult Nothing     $   parseNixTextLoc text+  processExpr :: Text -> StdIO+  processExpr = handleResult mempty . parseNixTextLoc    withEmptyNixContext = withNixContext mempty @@ -109,21 +111,21 @@         bool           errorWithoutStackTrace           (liftIO . hPutStrLn stderr)-          ignoreErrors+          isIgnoreErrors           $ "Parse failed: " <> show err       )        (\ expr ->         do-          when check $+          when isCheck $             do               expr' <- liftIO $ reduceExpr mpath expr               either                 (\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)-                (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <>-                  ppShow (maybeToMonoid $ Map.lookup @VarName @[Scheme] "it" $ coerce ty)+                (liftIO . putStrLn . (<>) "Type of expression: " .+                  ppShow . maybeToMonoid . Map.lookup @VarName @[Scheme] "it" . coerce                 )-                (HM.inferTop mempty (one ("it", stripAnnotation expr')))+                $ HM.inferTop mempty $ curry one "it" $ stripAnnotation expr'                  -- liftIO $ putStrLn $ runST $                 --     runLintM opts . renderSymbolic =<< lint opts expr@@ -133,36 +135,33 @@               NixException frames ->                 errorWithoutStackTrace . show =<<                   renderFrames-                    @(StdValue (StandardT (StdIdT IO)))-                    @(StdThunk (StandardT (StdIdT IO)))+                    @StdVal+                    @StdThun                     frames -          when repl $+          when isRepl $             withEmptyNixContext $               bool                 Repl.main-                (do-                  val <- nixEvalExprLoc (coerce mpath) expr-                  Repl.main' $ pure val-                )-                evaluate+                ((Repl.main' . pure) =<< nixEvalExprLoc (coerce mpath) expr)+                isEvaluate       )    --  2021-07-15: NOTE: Logic of CLI Option processing is scattered over several functions, needs to be consolicated.-  processCLIOptions :: Maybe Path -> NExprLoc -> StandardT (StdIdT IO) ()+  processCLIOptions :: Maybe Path -> NExprLoc -> StdIO   processCLIOptions mpath expr-    | evaluate =+    | isEvaluate =       if-        | tracing                       -> evaluateExprWithEvaluator nixTracingEvalExprLoc expr-        | Just path <- reduce           -> evaluateExprWithEvaluator (reduction path . coerce) expr-        | null arg || null argstr       -> evaluateExprWithEvaluator nixEvalExprLoc expr+        | isTrace                       -> evaluateExprWith nixTracingEvalExprLoc expr+        | Just path <- getReduce        -> evaluateExprWith (reduction path . coerce) expr+        | null getArg || null getArgstr -> evaluateExprWith nixEvalExprLoc expr         | otherwise                     -> processResult printer <=< nixEvalExprLoc (coerce mpath) $ expr-    | xml                        = fail "Rendering expression trees to XML is not yet implemented"-    | json                       = fail "Rendering expression trees to JSON is not implemented"-    | verbose >= DebugInfo       =  liftIO . putStr . ppShow . stripAnnotation $ expr-    | cache , Just path <- mpath =  liftIO . writeCache (replaceExtension path "nixc") $ expr-    | parseOnly                  =  void . liftIO . Exception.evaluate . force $ expr-    | otherwise                  =+    | isXml                        = fail "Rendering expression trees to XML is not yet implemented"+    | isJson                       = fail "Rendering expression trees to JSON is not implemented"+    | getVerbosity >= DebugInfo    = liftIO . putStr . ppShow . stripAnnotation $ expr+    | isCache , Just path <- mpath = liftIO . writeCache (replaceExtension path "nixc") $ expr+    | isParseOnly                  = void . liftIO . Exception.evaluate . force $ expr+    | otherwise                    =       liftIO .         renderIO           stdout@@ -171,40 +170,60 @@           . stripAnnotation           $ expr    where-    evaluateExprWithEvaluator evaluator = evaluateExpression (coerce mpath) evaluator printer+    evaluateExprWith evaluator = evaluateExpression (coerce mpath) evaluator printer      printer-      | finder    = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))+      :: StdVal+      -> StdIO+    printer+      | isFinder    = findAttrs <=< fromValue @(AttrSet StdVal)       | otherwise = printer'      where+      -- 2021-05-27: NOTE: With naive fix of the #941+      -- This is overall a naive printer implementation, as options should interact/respect one another.+      -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which+      -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),+      -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.       printer'-        | xml       = go (stringIgnoreContext . toXML)                     normalForm-        -- 2021-05-27: NOTE: With naive fix of the #941-        -- This is overall a naive printer implementation, as options should interact/respect one another.-        -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which-        -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),-        -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.-        | json      = go (stringIgnoreContext . mempty . nvalueToJSONNixString) normalForm-        | strict    = go (show . prettyNValue)                             normalForm-        | values    = go (show . prettyNValueProv)                         removeEffects-        | otherwise = go (show . prettyNValue)                             removeEffects+        | isXml     = out (ignoreContext . toXML)                    normalForm+        | isJson    = out (ignoreContext . mempty . toJSONNixString) normalForm+        | isStrict  = out (show . prettyNValue)                      normalForm+        | isValues  = out (show . prettyNValueProv)                  removeEffects+        | otherwise = out (show . prettyNValue)                      removeEffects        where-        go+        out           :: (b -> Text)-          -> (a -> StandardT (StdIdT IO) b)+          -> (a -> StandardIO b)           -> a-          -> StandardT (StdIdT IO) ()-        go g f = liftIO . Text.putStrLn . g <=< f+          -> StdIO+        out transform val = liftIO . Text.putStrLn . transform <=< val        findAttrs-        :: AttrSet (StdValue (StandardT (StdIdT IO)))-        -> StandardT (StdIdT IO) ()+        :: AttrSet StdVal+        -> StdIO       findAttrs = go mempty        where+        go :: Text -> AttrSet StdVal -> StdIO         go prefix s =-          do-            xs <--              traverse+          traverse_+            (\ (k, mv) ->+              do+                let+                  path              = prefix <> k+                  (report, descend) = filterEntry path k+                when report $+                  do+                    liftIO $ Text.putStrLn path+                    when descend $+                      maybe+                        stub+                        (\case+                          NVSet _ s' -> go (path <> ".") s'+                          _          -> stub+                        )+                        mv+            )+            =<< traverse                 (\ (k, nv) ->                   (k, ) <$>                   free@@ -214,40 +233,21 @@                           path         = prefix <> k                           (_, descend) = filterEntry path k -                        val <- readRef @(StandardT (StdIdT IO)) ref+                        val <- readRef @StandardIO ref                         bool                           (pure Nothing)                           (forceEntry path nv)                           (descend &&-                           deferred-                            (const False)-                            (const True)-                            val+                            deferred+                              (const False)+                              (const True)+                              val                           )                     )                     (pure . pure . Free)                     nv                 )                 (sortWith fst $ M.toList $ M.mapKeys coerce s)-            traverse_-              (\ (k, mv) ->-                do-                  let-                    path              = prefix <> k-                    (report, descend) = filterEntry path k-                  when report $-                    do-                      liftIO $ Text.putStrLn path-                      when descend $-                        maybe-                          stub-                          (\case-                            NVSet _ s' -> go (path <> ".") s'-                            _          -> stub-                          )-                          mv-              )-              xs          where           filterEntry path k = case (path, k) of             ("stdenv", "stdenv"          ) -> (True , True )@@ -267,36 +267,37 @@             _                              -> (True , True )            forceEntry-            :: MonadValue a (StandardT (StdIdT IO))+            :: MonadValue a StandardIO             => Text             -> a-            -> StandardT (StdIdT IO) (Maybe a)+            -> StandardIO (Maybe a)           forceEntry k v =             catch               (pure <$> demand v)-              (\ (NixException frames) ->-                do-                  liftIO-                    . Text.putStrLn-                    . (("Exception forcing " <> k <> ": ") <>)-                    . show =<<-                      renderFrames-                        @(StdValue (StandardT (StdIdT IO)))-                        @(StdThunk (StandardT (StdIdT IO)))-                        frames-                  pure Nothing-              )+              fun+           where+            fun :: NixException -> StandardIO (Maybe a)+            fun (coerce -> frames) =+              do+                liftIO+                  . Text.putStrLn+                  . (("Exception forcing " <> k <> ": ") <>)+                  . show =<<+                    renderFrames+                      @StdVal+                      @StdThun+                      frames+                pure Nothing    reduction path mpathToContext annExpr =     do       eres <-         withNixContext           mpathToContext-          (reducingEvalExpr-            evalContent-            mpathToContext-            annExpr-          )+          $ reducingEvalExpr+              evalContent+              mpathToContext+              annExpr       handleReduced path eres    handleReduced

@@ -14,16 +14,16 @@   , main'   ) where -import           Prelude                 hiding ( state )+import           Nix.Prelude             hiding ( state ) import           Nix                     hiding ( exec ) import           Nix.Scope import           Nix.Value.Monad                ( demand ) -import qualified Data.HashMap.Lazy           as M+import qualified Data.HashMap.Lazy             as M import           Data.Char                      ( isSpace ) import           Data.List                      ( dropWhileEnd )-import qualified Data.Text                   as Text-import qualified Data.Text.IO                as Text+import qualified Data.Text                     as Text+import qualified Data.Text.IO                  as Text import           Data.Version                   ( showVersion ) import           Paths_hnix                     ( version ) @@ -33,7 +33,7 @@                                                 , space                                                 ) import qualified Prettyprinter-import qualified Prettyprinter.Render.Text    as Prettyprinter+import qualified Prettyprinter.Render.Text     as Prettyprinter  import           System.Console.Haskeline.Completion                                                 ( Completion(isFinished)@@ -49,9 +49,9 @@                                                 , HaskelineT                                                 , evalRepl                                                 )-import qualified System.Console.Repline      as Console-import qualified System.Exit                 as Exit-import qualified System.IO.Error             as Error+import qualified System.Console.Repline        as Console+import qualified System.Exit                   as Exit+import qualified System.IO.Error               as Error  -- | Repl entry point main :: (MonadNix e t f m, MonadIO m, MonadMask m) =>  m ()@@ -111,7 +111,7 @@         (words <$> lines f)    handleMissing e-    | Error.isDoesNotExistError e = pure mempty+    | Error.isDoesNotExistError e = stub     | otherwise = throwM e    -- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline`@@ -161,15 +161,15 @@       M.fromList $       ("builtins", builtins) : fmap ("input",) (maybeToList mIni) -  opts :: Nix.Options <- asks $ view hasLens+  opts <- askOptions    pure $     IState       Nothing       scope       defReplConfig-        { cfgStrict = strict opts-        , cfgValues = values opts+        { cfgStrict = isStrict opts+        , cfgValues = isValues opts         }   where     evalText :: (MonadNix e t f m) => Text -> m (NValue t f m)@@ -190,65 +190,71 @@   => Bool   -> Text   -> Repl e t f m (Maybe (NValue t f m))-exec update source = do-  -- Get the current interpreter state-  state <- get+exec update source =+  do+    -- Get the current interpreter state+    state <- get -  when (cfgDebug $ replCfg state) $ liftIO $ print state+    when (cfgDebug $ replCfg state) $ liftIO $ print state -  -- Parser ( returns AST as `NExprLoc` )-  case parseExprOrBinding source of-    (Left err, _) -> do-      liftIO $ print err-      pure Nothing-    (Right expr, isBinding) -> do+    -- Parser ( returns AST as `NExprLoc` )+    case parseExprOrBinding source of+      (Left err, _) ->+        do+          liftIO $ print err+          pure Nothing+      (Right expr, isBinding) ->+        do -      -- Type Inference ( returns Typing Environment )-      ---      -- import qualified Nix.Type.Env                  as Env-      -- import           Nix.Type.Infer-      ---      -- let tyctx' = inferTop mempty [("repl", stripAnnotation expr)]-      -- liftIO $ print tyctx'+          -- Type Inference ( returns Typing Environment )+          --+          -- import qualified Nix.Type.Env                  as Env+          -- import           Nix.Type.Infer+          --+          -- let tyctx' = inferTop mempty [("repl", stripAnnotation expr)]+          -- liftIO $ print tyctx' -      mVal <- lift $ lift $ try $ pushScope (replCtx state) (evalExprLoc expr)+          mVal <- lift $ lift $ try $ pushScope (replCtx state) (evalExprLoc expr) -      either-        (\ (NixException frames) -> do-          lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames-          pure Nothing)-        (\ val -> do-          -- Update the interpreter state-          when (update && isBinding) $ do-            -- Set `replIt` to last entered expression-            put state { replIt = pure expr }+          either+            (\ (NixException frames) ->+              do+                lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames+                pure Nothing+            )+            (\ val ->+              do+                -- Update the interpreter state+                when (update && isBinding) $ do+                  -- Set `replIt` to last entered expression+                  put state { replIt = pure expr } -            -- If the result value is a set, update our context with it-            case val of-              NVSet _ (coerce -> scope) -> put state { replCtx = scope <> replCtx state }-              _          -> stub+                  -- If the result value is a set, update our context with it+                  case val of+                    NVSet _ (coerce -> scope) -> put state { replCtx = scope <> replCtx state }+                    _          -> stub -          pure $ pure val-        )-        mVal-  where-    -- If parsing fails, turn the input into singleton attribute set-    -- and try again.-    ---    -- This allows us to handle assignments like @a = 42@-    -- which get turned into @{ a = 42; }@-    parseExprOrBinding i =-      either-        (\ e    ->-          either-            (const (Left e, False)) -- return the first parsing failure-            (\ e' -> (pure e', True))-            (parseNixTextLoc $ toAttrSet i))-        (\ expr -> (pure expr, False))-        (parseNixTextLoc i)+                pure $ pure val+            )+            mVal+ where+  -- If parsing fails, turn the input into singleton attribute set+  -- and try again.+  --+  -- This allows us to handle assignments like @a = 42@+  -- which get turned into @{ a = 42; }@+  parseExprOrBinding i =+    either+      (\ e    ->+        either+          (const (Left e, False)) -- return the first parsing failure+          (\ e' -> (pure e', True))+          (parseNixTextLoc $ toAttrSet i))+      (\ expr -> (pure expr, False))+      (parseNixTextLoc i) -    toAttrSet i =-      "{" <> i <> whenFalse ";" (Text.isSuffixOf ";" i) <> "}"+  toAttrSet i =+    "{" <> i <> whenFalse ";" (Text.isSuffixOf ";" i) <> "}"  cmd   :: (MonadNix e t f m, MonadIO m)@@ -299,7 +305,6 @@ -- | @:load@ command load   :: (MonadNix e t f m, MonadIO m)-  -- This one does I String -> O String pretty fast, it is ugly to double marshall here.   => Path   -> Repl e t f m () load path =@@ -316,22 +321,18 @@   :: (MonadNix e t f m, MonadIO m)   => Text   -> Repl e t f m ()-typeof args = do+typeof src = do   state <- get   mVal <-     maybe-      (exec False line)+      (exec False src)       (pure . pure)-      (M.lookup (coerce line) (coerce $ replCtx state))+      (M.lookup (coerce src) (coerce $ replCtx state))    traverse_ printValueType mVal   where-  line = args-  printValueType val =-    do-      s <- lift . lift . showValueType $ val-      liftIO $ Text.putStrLn s+  printValueType = liftIO . Text.putStrLn <=< lift . lift . showValueType   -- | @:quit@ command@@ -361,12 +362,13 @@ completion   :: (MonadNix e t f m, MonadIO m)   => CompleterStyle (StateT (IState t f m) m)-completion = System.Console.Repline.Prefix-  (completeWordWithPrev (pure '\\') separators completeFunc)-  defaultMatcher-  where-    separators :: String-    separators = " \t[(,=+*&|}#?>:"+completion =+  System.Console.Repline.Prefix+    (completeWordWithPrev (pure '\\') separators completeFunc)+    defaultMatcher+ where+  separators :: String+  separators = " \t[(,=+*&|}#?>:"  -- | Main completion function --@@ -587,4 +589,4 @@ options   :: (MonadNix e t f m, MonadIO m)   => Console.Options (Repl e t f m)-options = (\h -> (toString $ helpOptionName h, helpOptionFunction h)) <$> helpOptions+options = (\ h -> (toString $ helpOptionName h, helpOptionFunction h)) <$> helpOptions

@@ -1,4 +1,3 @@- module Nix   ( module Nix.Cache   , module Nix.Exec@@ -25,6 +24,7 @@   ) where +import           Nix.Prelude import           Relude.Unsafe                  ( (!!) ) import           GHC.Err                        ( errorWithoutStackTrace ) import           Data.Fix                       ( Fix )@@ -104,17 +104,17 @@   -> m a evaluateExpression mpath evaluator handler expr =   do-    opts :: Options <- asks $ view hasLens+    opts <- askOptions     (coerce -> args) <-       (traverse . traverse)         eval'-        $  (second parseArg <$> arg    opts)-        <> (second mkStr    <$> argstr opts)+        $  (second parseArg <$> getArg    opts)+        <> (second mkStr    <$> getArgstr opts)     f <- evaluator mpath expr     f' <- demand f     val <-       case f' of-        NVClosure _ g -> g $ argmap args+        NVClosure _ g -> g $ mkNVSet mempty $ M.fromList args         _             -> pure f     processResult handler val  where@@ -126,20 +126,19 @@    eval' = normalForm <=< nixEvalExpr mpath -  argmap args = nvSet mempty $ M.fromList args- 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-  maybe-    (h val)-    (\ (coerce . Text.splitOn "." -> keys) -> processKeys keys val)-    (attr opts)+processResult h val =+  do+    opts <- askOptions+    maybe+      (h val)+      (\ (coerce . Text.splitOn "." -> keys) -> processKeys keys val)+      (getAttr opts)  where   processKeys :: [VarName] -> NValue t f m -> m a   processKeys kys v =

@@ -1,8 +1,9 @@-{-# language CPP            #-}-{-# language DeriveAnyClass #-}+{-# language CPP               #-}+{-# language DeriveAnyClass    #-}  module Nix.Atoms where +import           Nix.Prelude import           Codec.Serialise                ( Serialise )  import           Data.Data                      ( Data)@@ -11,7 +12,7 @@ import           Data.Aeson.Types               ( FromJSON                                                 , ToJSON                                                 )---  2021-08-01: NOTE: Check the order efficience of NAtom constructors.+--  2021-08-01: NOTE: Check the order effectiveness of NAtom constructors.  -- | Atoms are values that evaluate to themselves. -- In other words - this is a constructors that are literals in Nix.

@@ -13,6 +13,7 @@  {-# options_ghc -fno-warn-name-shadowing #-} + -- | Code that implements Nix builtins. Lists the functions that are built into the Nix expression evaluator. Some built-ins (aka `derivation`), are always in the scope, so they can be accessed by the name. To keap the namespace clean, most built-ins are inside the `builtins` scope - a set that contains all what is a built-in. module Nix.Builtins   ( withNixContext@@ -20,7 +21,7 @@   ) where -+import           Nix.Prelude import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Control.Comonad                ( Comonad ) import           Control.Monad                  ( foldM )@@ -45,6 +46,7 @@ import           Data.Foldable                  ( foldrM ) import           Data.Fix                       ( foldFix ) import           Data.List                      ( partition )+import qualified Data.HashSet                  as HS import qualified Data.HashMap.Lazy             as M import           Data.Scientific import qualified Data.Set                      as S@@ -87,7 +89,6 @@                                                 , matchAllText                                                 ) - -- This is a big module. There is recursive reuse: -- @builtins -> builtinsList -> scopedImport -> withNixContext -> builtins@, -- since @builtins@ is self-recursive: aka we ship @builtins.builtins.builtins...@.@@ -125,7 +126,7 @@   )   => ToBuiltin t f m (a -> b) where   toBuiltin name f =-    pure $ nvBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper+    pure $ mkNVBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper  -- *** @WValue@ closure wrapper to have @Ord@ @@ -141,7 +142,7 @@   WValue (NVConstant (NFloat x)) == WValue (NVConstant (NFloat y)) = x == y   WValue (NVPath     x         ) == WValue (NVPath     y         ) = x == y   WValue (NVStr x) == WValue (NVStr y) =-    stringIgnoreContext x == stringIgnoreContext y+    ignoreContext x == ignoreContext y   _ == _ = False  instance Comonad f => Ord (WValue t f m) where@@ -153,21 +154,16 @@   WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NFloat y)) = x <= y   WValue (NVPath     x         ) <= WValue (NVPath     y         ) = x <= y   WValue (NVStr x) <= WValue (NVStr y) =-    stringIgnoreContext x <= stringIgnoreContext y+    ignoreContext x <= ignoreContext y   _ <= _ = False  -- ** Helpers -nvNull-  :: MonadNix e t f m-  => NValue t f m-nvNull = nvConstant NNull- mkNVBool   :: MonadNix e t f m   => Bool   -> NValue t f m-mkNVBool = nvConstant . NBool+mkNVBool = mkNVConstant . NBool  data NixPathEntryType   = PathEntryPath@@ -209,9 +205,9 @@         mDataDir      foldrM-      go+      fun       z-      $ (fromInclude . stringIgnoreContext <$> dirs)+      $ (fromInclude . ignoreContext <$> dirs)         <> uriAwareSplit `whenJust` mPath         <> one (fromInclude $ "nix=" <> fromString (coerce dataDir) <> "/nix/corepkgs")  where@@ -224,8 +220,8 @@         PathEntryURI         ("://" `Text.isInfixOf` x) -  go :: (Text, NixPathEntryType) -> r -> m r-  go (x, ty) rest =+  fun :: (Text, NixPathEntryType) -> r -> m r+  fun (x, ty) rest =     case Text.splitOn "=" x of       [p] -> f (coerce $ toString p) mempty ty rest       [n, p] -> f (coerce $ toString p) (pure n) ty rest@@ -253,22 +249,20 @@  splitVersion :: Text -> [VersionComponent] splitVersion s =- whenJust-   (\ (x, xs) -> if-      | isRight eDigitsPart ->-          either-            (\ e -> error $ "splitVersion: did hit impossible: '" <> toText e <> "' while parsing '" <> s <> "'.")-            (\ res ->-              one (VersionComponentNumber $ fst res)-              <> splitVersion (snd res)-            )-            eDigitsPart+  (\ (x, xs) -> if+    | isRight eDigitsPart ->+        either+          (\ e -> error $ "splitVersion: did hit impossible: '" <> fromString e <> "' while parsing '" <> s <> "'.")+          (\ res ->+            one (VersionComponentNumber $ fst res)+            <> splitVersion (snd res)+          )+          eDigitsPart -      | x `elem` separators -> splitVersion xs+    | x `elem` separators -> splitVersion xs -      | otherwise -> one charsPart <> splitVersion rest2-  )-  (Text.uncons s)+    | otherwise -> one charsPart <> splitVersion rest2+  ) `whenJust` Text.uncons s  where   -- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44   separators :: String@@ -337,7 +331,7 @@   relStart       = max 0 start - numDropped   (before, rest) = B.splitAt relStart haystack   caps :: NValue t f m-  caps           = nvList (f <$> captures)+  caps           = mkNVList (f <$> captures)   f :: (ByteString, (Int, b)) -> NValue t f m   f (a, (s, _))  =     bool@@ -346,7 +340,7 @@       (s >= 0)  thunkStr :: Applicative f => ByteString -> NValue t f m-thunkStr s = nvStrWithoutContext $ decodeUtf8 s+thunkStr s = mkNVStrWithoutContext $ decodeUtf8 s  hasKind   :: forall a e t f m@@ -364,7 +358,7 @@     NVStr ns ->       do         let-          path = coerce . toString $ stringIgnoreContext ns+          path = coerce . toString $ ignoreContext ns          unless (isAbsolute path) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path"         pure path@@ -428,26 +422,26 @@ nixPathNix :: forall e t f m . MonadNix e t f m => m (NValue t f m) nixPathNix =   fmap-    nvList+    mkNVList     $ foldNixPath mempty $         \p mn ty rest ->           pure $             pure-              (nvSet+              (mkNVSet                 mempty                 (M.fromList                   [case ty of-                    PathEntryPath -> ("path", nvPath  p)-                    PathEntryURI  -> ( "uri", nvStrWithoutContext $ fromString $ coerce p)+                    PathEntryPath -> ("path", mkNVPath  p)+                    PathEntryURI  -> ( "uri", mkNVStrWithoutContext $ fromString $ coerce p) -                  , ( "prefix", nvStrWithoutContext $ maybeToMonoid mn)+                  , ( "prefix", mkNVStrWithoutContext $ maybeToMonoid mn)                   ]                 )               )             <> rest  toStringNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toStringNix = toValue <=< coerceToString callFunc DontCopyToStore CoerceAny+toStringNix = toValue <=< coerceAnyToNixString callFunc DontCopyToStore  hasAttrNix   :: forall e t f m@@ -463,7 +457,7 @@     toValue $ M.member key aset  hasContextNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-hasContextNix = inHask stringHasContext+hasContextNix = inHask hasContext  getAttrNix   :: forall e t f m@@ -478,6 +472,20 @@      attrsetGet key aset +unsafeDiscardOutputDependencyNix+  :: forall e t f m+   . MonadNix e t f m+  => NValue t f m+  -> m (NValue t f m)+unsafeDiscardOutputDependencyNix nv =+  do+    (nc, ns) <- (getStringContext &&& ignoreContext) <$> fromValue nv+    toValue $ mkNixString (HS.map discard nc) ns+ where+  discard :: StringContext -> StringContext+  discard (StringContext AllOutputs a) = StringContext DirectPath a+  discard x                            = x+ unsafeGetAttrPosNix   :: forall e t f m    . MonadNix e t f m@@ -494,7 +502,7 @@         maybe           (pure nvNull)           toValue-          (M.lookup @VarName (coerce $ stringIgnoreContext ns) apos)+          (M.lookup @VarName (coerce $ ignoreContext ns) apos)       _xy -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPosNix: " <> show _xy  -- This function is a bit special in that it doesn't care about the contents@@ -605,7 +613,7 @@ tailNix =   maybe     (throwError $ ErrorCall "builtins.tail: empty list")-    (pure . nvList)+    (pure . mkNVList)   . viaNonEmpty tail <=< fromValue @[NValue t f m]  splitVersionNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -613,8 +621,8 @@   do     version <- fromStringNoContext =<< fromValue v     pure $-      nvList $-        nvStrWithoutContext . show <$>+      mkNVList $+        mkNVStrWithoutContext . show <$>           splitVersion version  compareVersionsNix@@ -634,7 +642,7 @@           EQ -> 0           GT -> 1 -    pure $ nvConstant $ NInt cmpVers+    pure $ mkNVConstant $ NInt cmpVers   where   mkText = fromStringNoContext <=< fromValue@@ -659,7 +667,7 @@         ]   where-  mkNVStr = nvStrWithoutContext+  mkNVStr = mkNVStrWithoutContext  matchNix   :: forall e t f m@@ -677,11 +685,11 @@     -- going to preserve the behavior here until it is fixed upstream.     -- Relevant issue: https://github.com/NixOS/nix/issues/2547     let-      s  = stringIgnoreContext ns+      s  = ignoreContext ns       re = makeRegex p :: Regex       mkMatch t =         bool-          (toValue ()) -- Shorthand for Null+          (pure nvNull)           (toValue $ mkNixStringWithoutContext t)           (not $ Text.null t) @@ -689,7 +697,7 @@       Just ("", sarr, "") ->         do           let submatches = fst <$> elems sarr-          nvList <$>+          mkNVList <$>             traverse               mkMatch               (case submatches of@@ -714,11 +722,11 @@         -- going to preserve the behavior here until it is fixed upstream.         -- Relevant issue: https://github.com/NixOS/nix/issues/2547     let-      s = stringIgnoreContext ns+      s = ignoreContext ns       regex       = makeRegex p :: Regex       haystack = encodeUtf8 s -    pure $ nvList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack+    pure $ mkNVList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack  substringNix :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString substringNix start len str =@@ -783,7 +791,7 @@        applyFunToKeyVal (key, val) =         do-          runFunForKey <- callFunc f $ nvStrWithoutContext (coerce key)+          runFunForKey <- callFunc f $ mkNVStrWithoutContext (coerce key)           callFunc runFunForKey val      newVals <-@@ -817,7 +825,7 @@     n <- fromStringNoContext =<< fromValue attrName     l <- fromValue @[NValue t f m] xs -    nvList . catMaybes <$>+    mkNVList . catMaybes <$>       traverse         (fmap (M.lookup @VarName $ coerce n) . fromValue <=< demand)         l@@ -825,9 +833,9 @@ baseNameOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) baseNameOfNix x =   do-    ns <- coerceToString callFunc DontCopyToStore CoerceStringy x+    ns <- coerceStringlikeToNixString DontCopyToStore x     pure $-      nvStr $+      mkNVStr $         modifyNixContents           (fromString . coerce takeFileName . toString)           ns@@ -877,21 +885,57 @@   => m (NValue t f m) builtinsBuiltinNix = throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred" +-- a safer version of `attrsetGet`+attrGetOr+  :: forall e t f m v a+   . (MonadNix e t f m, FromValue v m (NValue t f m))+  => a+  -> (v -> m a)+  -> VarName+  -> AttrSet (NValue t f m)+  -> m a+attrGetOr fallback fun name attrs =+  maybe+    (pure fallback)+    (fun <=< fromValue)+    (M.lookup name attrs)+++--  NOTE: It is a part of the implementation taken from:+--  https://github.com/haskell-nix/hnix/pull/755+--  look there for `sha256` and/or `filterSource`+pathNix :: forall e t f m. MonadNix e t f m => NValue t f m -> m (NValue t f m)+pathNix arg =+  do+    attrs <- fromValue @(AttrSet (NValue t f m)) arg+    path      <- fmap (coerce . toString) $ fromStringNoContext =<< coerceToPath =<< attrsetGet "path" attrs++    -- TODO: Fail on extra args+    -- XXX: This is a very common pattern, we could factor it out+    name      <- toText <$> attrGetOr (takeFileName path) (fmap (coerce . toString) . fromStringNoContext) "name" attrs+    recursive <- attrGetOr True pure "recursive" attrs++    Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name path recursive False+    -- TODO: Ensure that s matches sha256 when not empty+    pure $ mkNVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s+ where+  coerceToPath = coerceToString callFunc DontCopyToStore CoerceAny+ dirOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) dirOfNix nvdir =   do     dir <- demand nvdir      case dir of-      NVStr ns -> pure $ nvStr $ modifyNixContents (fromString . coerce takeDirectory . toString) ns-      NVPath path -> pure $ nvPath $ takeDirectory path+      NVStr ns -> pure $ mkNVStr $ modifyNixContents (fromString . coerce takeDirectory . toString) ns+      NVPath path -> pure $ mkNVPath $ 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? unsafeDiscardStringContextNix   :: MonadNix e t f m => NValue t f m -> m (NValue t f m) unsafeDiscardStringContextNix =-  inHask (mkNixStringWithoutContext . stringIgnoreContext)+  inHask (mkNixStringWithoutContext . ignoreContext)  -- | Evaluate `a` to WHNF to collect its topmost effect. seqNix@@ -1038,7 +1082,7 @@          where           formMatchReplaceTailInfo (m, r) = (m, r, Text.drop (Text.length m) input) -          fromKeysToValsMap = zip (stringIgnoreContext <$> fromKeys) toVals+          fromKeysToValsMap = zip (ignoreContext <$> fromKeys) toVals          -- Not passing args => It is constant that gets embedded into `go` => It is simple `go` tail recursion         passOneChar =@@ -1049,7 +1093,7 @@          --  2021-02-18: NOTE: rly?: toStrict . toLazyText         --  Maybe `text-builder`, `text-show`?-        finish ctx output = mkNixString (toStrict $ Builder.toLazyText output) ctx+        finish ctx output = mkNixString ctx (toStrict $ Builder.toLazyText output)          replace (key, replacementNS, unprocessedInput) = replaceWithNixBug unprocessedInput updatedOutput @@ -1073,8 +1117,8 @@           updatedOutput  = output <> replacement           updatedCtx     = ctx <> replacementCtx -          replacement    = Builder.fromText $ stringIgnoreContext replacementNS-          replacementCtx = getContext replacementNS+          replacement    = Builder.fromText $ ignoreContext replacementNS+          replacementCtx = getStringContext replacementNS            -- The bug modifies the content => bug demands `pass` to be a real function =>           -- `go` calls `pass` function && `pass` calls `go` function@@ -1085,7 +1129,7 @@               (\(c, i) -> go updatedCtx i $ output <> Builder.singleton c) -- If there are chars - pass one char & continue               (Text.uncons input)  -- chip first char -    toValue $ go (getContext string) (stringIgnoreContext string) mempty+    toValue $ go (getStringContext string) (ignoreContext string) mempty  removeAttrsNix   :: forall e t f m@@ -1098,10 +1142,10 @@     (m, p) <- fromValue @(AttrSet (NValue t f m), PositionSet) set     (nsToRemove :: [NixString]) <- fromValue $ Deeper v     (coerce -> toRemove) <- traverse fromStringNoContext nsToRemove-    toValue (go m toRemove, go p toRemove)+    toValue (fun m toRemove, fun p toRemove)  where-  go :: forall k v . (Eq k, Hashable k) => HashMap k v -> [k] -> HashMap k v-  go = foldl' (flip M.delete)+  fun :: forall k v . (Eq k, Hashable k) => HashMap k v -> [k] -> HashMap k v+  fun = foldl' (flip M.delete)  intersectAttrsNix   :: forall e t f m@@ -1114,7 +1158,7 @@     (s1, p1) <- fromValue @(AttrSet (NValue t f m), PositionSet) set1     (s2, p2) <- fromValue @(AttrSet (NValue t f m), PositionSet) set2 -    pure $ nvSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)+    pure $ mkNVSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)  functionArgsNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -1141,13 +1185,13 @@     mres  <-       toFile_         (coerce $ toString name')-        (stringIgnoreContext s')+        (ignoreContext s')      let       storepath  = coerce (fromString @Text) mres-      sc = StringContext storepath DirectPath+      sc = StringContext DirectPath storepath -    toValue $ mkNixStringWithSingletonContext storepath sc+    toValue $ mkNixStringWithSingletonContext sc storepath  toPathNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) toPathNix = inHask @Path id@@ -1159,9 +1203,13 @@     toValue =<<       case path of         NVPath p  -> doesPathExist p-        NVStr  ns -> doesPathExist $ coerce $ toString $ stringIgnoreContext ns+        NVStr  ns -> doesPathExist $ coerce $ toString $ ignoreContext ns         _v -> throwError $ ErrorCall $ "builtins.pathExists: expected path, got " <> show _v +isPathNix+  :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)+isPathNix = hasKind @Path+ isAttrsNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) isAttrsNix = hasKind @(AttrSet (NValue t f m))@@ -1208,11 +1256,9 @@         _           -> False  throwNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-throwNix mnv =-  do-    ns <- coerceToString callFunc CopyToStore CoerceStringy mnv--    throwError . ErrorCall . toString $ stringIgnoreContext ns+throwNix =+  throwError . ErrorCall . toString . ignoreContext+    <=< coerceStringlikeToNixString CopyToStore  -- | Implementation of Nix @import@ clause. --@@ -1226,7 +1272,7 @@ -- importNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)-importNix = scopedImportNix $ nvSet mempty mempty+importNix = scopedImportNix $ mkNVSet mempty mempty  -- | @scopedImport scope path@ -- An undocumented secret powerful function.@@ -1346,7 +1392,7 @@             (NFloat a, NInt   b) -> pure $             a < fromInteger b             (NFloat a, NFloat b) -> pure $             a < b             _                    -> badType-        (NVStr a, NVStr b) -> pure $ stringIgnoreContext a < stringIgnoreContext b+        (NVStr a, NVStr b) -> pure $ ignoreContext a < ignoreContext b         _ -> badType  -- | Helper function, generalization of @concat@ operations.@@ -1387,7 +1433,7 @@   do     l <- fromValue @[NValue t f m] lst     fmap-      (nvSet mempty . M.fromList . reverse)+      (mkNVSet mempty . M.fromList . reverse)       (traverse         (\ nvattrset ->           do@@ -1428,6 +1474,49 @@         mkHash s = hash $ encodeUtf8 s  +-- | hashFileNix+-- use hashStringNix to hash file content+hashFileNix+  :: forall e t f m . MonadNix e t f m => NixString -> Path -> Prim m NixString+hashFileNix nsAlgo nvfilepath = Prim $ hash =<< fileContent+ where+  hash = outPrim . hashStringNix nsAlgo+  outPrim (Prim x) = x+  fileContent :: m NixString+  fileContent = mkNixStringWithoutContext <$> Nix.Render.readFile nvfilepath+++-- | groupByNix+-- Groups elements of list together by the string returned from the function f called on +-- each element. It returns an attribute set where each attribute value contains the +-- elements of list that are mapped to the same corresponding attribute name returned by f.+groupByNix+  :: forall e t f m+   . MonadNix e t f m+  => NValue t f m+  -> NValue t f m+  -> m (NValue t f m)+groupByNix nvfun nvlist = do+  list   <- demand nvlist+  fun    <- demand nvfun+  (f, l) <- extractP (fun, list)+  mkNVSet mempty+    .   fmap (mkNVList . reverse)+    .   M.fromListWith (<>)+    <$> traverse (app f) l+ where+  app f x = do+    name <- fromValue @Text =<< f x+    pure (VarName name, one x)+  extractP (NVBuiltin _ f, NVList l) = pure (f, l)+  extractP (NVClosure _ f, NVList l) = pure (f, l)+  extractP _v =+    throwError+      $  ErrorCall+      $  "builtins.groupBy: expected function and list, got "+      <> show _v++ placeHolderNix :: forall t f m e . MonadNix e t f m => NValue t f m -> m (NValue t f m) placeHolderNix p =   do@@ -1455,7 +1544,7 @@       bytes :: NixString -> ByteString       bytes = encodeUtf8 . body -      body = stringIgnoreContext+      body = ignoreContext  readFileNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) readFileNix = toValue <=< Nix.Render.readFile <=< absolutePathFromValue <=< demand@@ -1474,9 +1563,9 @@     case (aset, filePath) of       (NVList x, NVStr ns) ->         do-          mres <- findPath @t @f @m x $ coerce $ toString $ stringIgnoreContext ns+          mres <- findPath @t @f @m x $ coerce $ toString $ ignoreContext ns -          pure $ nvPath mres+          pure $ mkNVPath mres        (NVList _, _y     ) -> throwError $ ErrorCall $ "expected a string, got " <> show _y       (_x      , NVStr _) -> throwError $ ErrorCall $ "expected a list, got " <> show _x@@ -1490,6 +1579,7 @@     items          <- listDirectory path      let+      -- | Function indeed binds filepaths as keys ('VarNames') in Nix attrset.       detectFileTypes :: Path -> m (VarName, FileType)       detectFileTypes item =         do@@ -1502,7 +1592,7 @@                 | isSymbolicLink s -> FileTypeSymlink                 | otherwise        -> FileTypeUnknown -          pure (coerce @Text @VarName $ toText item, t) -- function indeed binds filepaths as keys (VarNames) in Nix attrset.+          pure (coerce @(String -> Text) fromString item, t)      itemsWithTypes <-       traverse@@ -1530,17 +1620,17 @@     \case       A.Object m ->         traverseToNValue-          (nvSet mempty)+          (mkNVSet mempty) #if MIN_VERSION_aeson(2,0,0)           (M.mapKeys (coerce . AKM.toText)  $ AKM.toHashMap m) #else           (M.mapKeys coerce m) #endif-      A.Array  l -> traverseToNValue nvList (V.toList l)-      A.String s -> pure $ nvStrWithoutContext s+      A.Array  l -> traverseToNValue mkNVList (V.toList l)+      A.String s -> pure $ mkNVStrWithoutContext s       A.Number n ->         pure $-          nvConstant $+          mkNVConstant $             either               NFloat               NInt@@ -1552,10 +1642,10 @@     traverseToNValue f v = f <$> traverse jsonToNValue v  toJSONNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toJSONNix = (fmap nvStr . nvalueToJSONNixString) <=< demand+toJSONNix = (fmap mkNVStr . toJSONNixString) <=< demand  toXMLNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toXMLNix = (fmap (nvStr . toXML) . normalForm) <=< demand+toXMLNix = (fmap (mkNVStr . toXML) . normalForm) <=< demand  typeOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) typeOfNix nvv =@@ -1587,7 +1677,7 @@   (onSuccess <$> demand e)  where   onSuccess v =-    nvSet+    mkNVSet       mempty       $ M.fromList         [ ("success", mkNVBool True)@@ -1596,7 +1686,7 @@    onError :: SomeException -> NValue t f m   onError _ =-    nvSet+    mkNVSet       mempty       $ M.fromList         $ (, mkNVBool False) <$>@@ -1612,7 +1702,7 @@   -> m (NValue t f m) traceNix msg action =   do-    traceEffect @t @f @m . toString . stringIgnoreContext =<< fromValue msg+    traceEffect @t @f @m . toString . ignoreContext =<< fromValue msg     pure action  -- Please, can function remember fail context@@ -1628,12 +1718,11 @@   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) execNix xs =   do-    ls <- fromValue @[NValue t f m] xs-    xs <- traverse (coerceToString callFunc DontCopyToStore CoerceStringy) ls+    xs' <- traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs     -- 2018-11-19: NOTE: 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 $ stringIgnoreContext <$> xs+    exec $ ignoreContext <$> xs'  fetchurlNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -1677,7 +1766,7 @@      let       (right, wrong) = partition fst selection-      makeSide       = nvList . fmap snd+      makeSide       = mkNVList . fmap snd      toValue @(AttrSet (NValue t f m))       $ M.fromList@@ -1691,31 +1780,28 @@     os   <- getCurrentSystemOS     arch <- getCurrentSystemArch -    pure $ nvStrWithoutContext $ arch <> "-" <> os+    pure $ mkNVStrWithoutContext $ arch <> "-" <> os  currentTimeNix :: MonadNix e t f m => m (NValue t f m) currentTimeNix =   do-    opts :: Options <- asks $ view hasLens-    toValue @Integer $ round $ Time.utcTimeToPOSIXSeconds $ currentTime opts+    opts <- askOptions+    toValue @Integer $ round $ Time.utcTimeToPOSIXSeconds $ getTime opts  derivationStrictNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) derivationStrictNix = derivationStrict  getRecursiveSizeNix :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m)-getRecursiveSizeNix = fmap (nvConstant . NInt . fromIntegral) . recursiveSize+getRecursiveSizeNix = fmap (mkNVConstant . NInt . fromIntegral) . recursiveSize  getContextNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)-getContextNix v =-  do-    v' <- demand v-    case v' of-      (NVStr ns) -> do-        let context = getNixLikeContext $ toNixLikeContext $ getContext ns-        valued :: AttrSet (NValue t f m) <- traverseToValue context-        pure $ nvSet mempty valued-      x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x+getContextNix =+  \case+    (NVStr ns) ->+      mkNVSet mempty <$> traverseToValue (getNixLikeContext $ toNixLikeContext $ getStringContext ns)+    x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x+  <=< demand  appendContextNix   :: forall e t f m@@ -1731,63 +1817,64 @@     case (x, y) of       (NVStr ns, NVSet _ attrs) ->         do-          newContextValues <- traverse getPathNOuts attrs+          let+            getPathNOuts :: NValue t f m -> m NixLikeContextValue+            getPathNOuts tx =+              do+                x <- demand tx -          toValue $ addContext ns newContextValues+                case x of+                  NVSet _ atts ->+                    do+                      -- TODO: Fail for unexpected keys. -      _xy -> throwError $ ErrorCall $ "Invalid types for builtins.appendContext: " <> show _xy+                      let+                        getK :: VarName -> m Bool+                        getK k =+                          maybe+                            (pure False)+                            (fromValue <=< demand)+                            $ M.lookup k atts - where-  getPathNOuts tx =-    do-      x <- demand tx+                        getOutputs :: m [Text]+                        getOutputs =+                          maybe+                            stub+                            (\ touts ->+                              do+                                outs <- demand touts -      case x of-        NVSet _ attrs->-          do-            -- TODO: Fail for unexpected keys.+                                case outs of+                                  NVList vs -> traverse (fmap ignoreContext . fromValue) vs+                                  _x -> throwError $ ErrorCall $ "Invalid types for context value outputs in builtins.appendContext: " <> show _x+                            )+                            (M.lookup "outputs" atts) -            let-              getK k =-                maybe-                  (pure False)-                  (fromValue <=< demand)-                  (M.lookup k attrs)+                      path <- getK "path"+                      allOutputs <- getK "allOutputs" -              getOutputs =-                maybe-                  stub-                  (\ touts ->-                    do-                      outs <- demand touts+                      NixLikeContextValue path allOutputs <$> getOutputs -                      case outs of-                        NVList vs -> traverse (fmap stringIgnoreContext . fromValue) vs-                        _x -> throwError $ ErrorCall $ "Invalid types for context value outputs in builtins.appendContext: " <> show _x-                  )-                  (M.lookup "outputs" attrs)+                  _x -> throwError $ ErrorCall $ "Invalid types for context value in builtins.appendContext: " <> show _x+            addContext :: HashMap VarName NixLikeContextValue -> NixString+            addContext newContextValues =+              mkNixString+                (fromNixLikeContext $+                  NixLikeContext $+                    M.unionWith+                      (<>)+                      newContextValues+                      $ getNixLikeContext $+                          toNixLikeContext $+                            getStringContext ns+                )+                $ ignoreContext ns -            path <- getK "path"-            allOutputs <- getK "allOutputs"+          toValue . addContext =<< traverse getPathNOuts attrs -            NixLikeContextValue path allOutputs <$> getOutputs+      _xy -> throwError $ ErrorCall $ "Invalid types for builtins.appendContext: " <> show _xy -        _x -> throwError $ ErrorCall $ "Invalid types for context value in builtins.appendContext: " <> show _x -  addContext ns newContextValues =-    mkNixString-      (stringIgnoreContext ns)-      (fromNixLikeContext $-        NixLikeContext $-          M.unionWith-            (<>)-            newContextValues-            (getNixLikeContext $-              toNixLikeContext $-                getContext ns-            )-      )- nixVersionNix :: MonadNix e t f m => m (NValue t f m) nixVersionNix = toValue $ mkNixStringWithoutContext "2.3" @@ -1797,112 +1884,118 @@ -- ** @builtinsList@  builtinsList :: forall e t f m . MonadNix e t f m => m [Builtin (NValue t f m)]-builtinsList = sequenceA-  [ add0 Normal   "nixVersion"       nixVersionNix-  , add0 Normal   "langVersion"      langVersionNix-  , add  TopLevel "abort"            throwNix -- for now-  , add2 Normal   "add"              addNix-  , add2 Normal   "addErrorContext"  addErrorContextNix-  , add2 Normal   "all"              allNix-  , add2 Normal   "any"              anyNix-  , add2 Normal   "appendContext"    appendContextNix-  , add  Normal   "attrNames"        attrNamesNix-  , add  Normal   "attrValues"       attrValuesNix-  , add  TopLevel "baseNameOf"       baseNameOfNix-  , add2 Normal   "bitAnd"           bitAndNix-  , add2 Normal   "bitOr"            bitOrNix-  , add2 Normal   "bitXor"           bitXorNix-  , add0 Normal   "builtins"         builtinsBuiltinNix-  , add2 Normal   "catAttrs"         catAttrsNix-  , add2 Normal   "compareVersions"  compareVersionsNix-  , add  Normal   "concatLists"      concatListsNix-  , add2 Normal   "concatMap"        concatMapNix-  , add' Normal   "concatStringsSep" (arity2 intercalateNixString)-  , add0 Normal   "currentSystem"    currentSystemNix-  , add0 Normal   "currentTime"      currentTimeNix-  , add2 Normal   "deepSeq"          deepSeqNix-  , add0 TopLevel "derivation"       derivationNix-  , add  TopLevel "derivationStrict" derivationStrictNix-  , add  TopLevel "dirOf"            dirOfNix-  , add2 Normal   "div"              divNix-  , add2 Normal   "elem"             elemNix-  , add2 Normal   "elemAt"           elemAtNix-  , add  Normal   "exec"             execNix-  , add0 Normal   "false"            (pure $ mkNVBool False)-  --, add  Normal   "fetchGit"         fetchGit-  --, add  Normal   "fetchMercurial"   fetchMercurial-  , add  Normal   "fetchTarball"     fetchTarball-  , add  Normal   "fetchurl"         fetchurlNix-  , add2 Normal   "filter"           filterNix-  --, add  Normal   "filterSource"     filterSource-  , add2 Normal   "findFile"         findFileNix-  , add3 Normal   "foldl'"           foldl'Nix-  , add  Normal   "fromJSON"         fromJSONNix-  --, add  Normal   "fromTOML"         fromTOML-  , add  Normal   "functionArgs"     functionArgsNix-  , add  Normal   "genericClosure"   genericClosureNix-  , add2 Normal   "genList"          genListNix-  , add2 Normal   "getAttr"          getAttrNix-  , add  Normal   "getContext"       getContextNix-  , add  Normal   "getEnv"           getEnvNix-  , add2 Normal   "hasAttr"          hasAttrNix-  , add  Normal   "hasContext"       hasContextNix-  , add' Normal   "hashString"       (hashStringNix @e @t @f @m)-  , add  Normal   "head"             headNix-  , add  TopLevel "import"           importNix-  , add2 Normal   "intersectAttrs"   intersectAttrsNix-  , add  Normal   "isAttrs"          isAttrsNix-  , add  Normal   "isBool"           isBoolNix-  , add  Normal   "isFloat"          isFloatNix-  , add  Normal   "isFunction"       isFunctionNix-  , add  Normal   "isInt"            isIntNix-  , add  Normal   "isList"           isListNix-  , add  TopLevel "isNull"           isNullNix-  , add  Normal   "isString"         isStringNix-  , add  Normal   "length"           lengthNix-  , add2 Normal   "lessThan"         lessThanNix-  , add  Normal   "listToAttrs"      listToAttrsNix-  , add2 TopLevel "map"              mapNix-  , add2 TopLevel "mapAttrs"         mapAttrsNix-  , add2 Normal   "match"            matchNix-  , add2 Normal   "mul"              mulNix-  , add0 Normal   "nixPath"          nixPathNix-  , add0 Normal   "null"             (pure nvNull)-  , add  Normal   "parseDrvName"     parseDrvNameNix-  , add2 Normal   "partition"        partitionNix-  --, add  Normal   "path"             path-  , add  Normal   "pathExists"       pathExistsNix-  , add  TopLevel "placeholder"      placeHolderNix-  , add  Normal   "readDir"          readDirNix-  , add  Normal   "readFile"         readFileNix-  , add2 TopLevel "removeAttrs"      removeAttrsNix-  , add3 Normal   "replaceStrings"   replaceStringsNix-  , add2 TopLevel "scopedImport"     scopedImportNix-  , add2 Normal   "seq"              seqNix-  , add2 Normal   "sort"             sortNix-  , add2 Normal   "split"            splitNix-  , add  Normal   "splitVersion"     splitVersionNix-  , add0 Normal   "storeDir"         (pure $ nvStrWithoutContext "/nix/store")-  --, add  Normal   "storePath"        storePath-  , add' Normal   "stringLength"     (arity1 $ Text.length . stringIgnoreContext)-  , add' Normal   "sub"              (arity2 ((-) @Integer))-  , add' Normal   "substring"        substringNix-  , add  Normal   "tail"             tailNix-  , add  TopLevel "throw"            throwNix-  , add2 Normal   "toFile"           toFileNix-  , add  Normal   "toJSON"           toJSONNix-  , add  Normal   "toPath"           toPathNix-  , add  TopLevel "toString"         toStringNix-  , add  Normal   "toXML"            toXMLNix-  , add2 TopLevel "trace"            traceNix-  , add0 Normal   "true"             (pure $ mkNVBool True)-  , add  Normal   "tryEval"          tryEvalNix-  , add  Normal   "typeOf"           typeOfNix-  --, add0 Normal   "unsafeDiscardOutputDependency" unsafeDiscardOutputDependency-  , add  Normal   "unsafeDiscardStringContext"    unsafeDiscardStringContextNix-  , add2 Normal   "unsafeGetAttrPos"              unsafeGetAttrPosNix-  , add  Normal   "valueSize"        getRecursiveSizeNix-  ]+builtinsList =+  sequenceA+    [ add  TopLevel "abort"            throwNix -- for now+    , add  TopLevel "baseNameOf"       baseNameOfNix+    , add0 TopLevel "derivation"       derivationNix+    , add  TopLevel "derivationStrict" derivationStrictNix+    , add  TopLevel "dirOf"            dirOfNix+    , add  TopLevel "import"           importNix+    , add  TopLevel "isNull"           isNullNix+    , add2 TopLevel "map"              mapNix+    , add2 TopLevel "mapAttrs"         mapAttrsNix+    , add  TopLevel "placeholder"      placeHolderNix+    , add2 TopLevel "removeAttrs"      removeAttrsNix+    , add2 TopLevel "scopedImport"     scopedImportNix+    , add  TopLevel "throw"            throwNix+    , add  TopLevel "toString"         toStringNix+    , add2 TopLevel "trace"            traceNix+    , add0 Normal   "nixVersion"       nixVersionNix+    , add0 Normal   "langVersion"      langVersionNix+    , add2 Normal   "add"              addNix+    , add2 Normal   "addErrorContext"  addErrorContextNix+    , add2 Normal   "all"              allNix+    , add2 Normal   "any"              anyNix+    , add2 Normal   "appendContext"    appendContextNix+    , add  Normal   "attrNames"        attrNamesNix+    , add  Normal   "attrValues"       attrValuesNix+    , add2 Normal   "bitAnd"           bitAndNix+    , add2 Normal   "bitOr"            bitOrNix+    , add2 Normal   "bitXor"           bitXorNix+    , add0 Normal   "builtins"         builtinsBuiltinNix+    , add2 Normal   "catAttrs"         catAttrsNix+    , add' Normal   "ceil"             (arity1 (ceiling @Float @Integer))+    , add2 Normal   "compareVersions"  compareVersionsNix+    , add  Normal   "concatLists"      concatListsNix+    , add2 Normal   "concatMap"        concatMapNix+    , add' Normal   "concatStringsSep" (arity2 intercalateNixString)+    , add0 Normal   "currentSystem"    currentSystemNix+    , add0 Normal   "currentTime"      currentTimeNix+    , add2 Normal   "deepSeq"          deepSeqNix+    , add2 Normal   "div"              divNix+    , add2 Normal   "elem"             elemNix+    , add2 Normal   "elemAt"           elemAtNix+    , add  Normal   "exec"             execNix+    , add0 Normal   "false"            (pure $ mkNVBool False)+    --, add  Normal   "fetchGit"         fetchGit+    --, add  Normal   "fetchMercurial"   fetchMercurial+    , add  Normal   "fetchTarball"     fetchTarball+    , add  Normal   "fetchurl"         fetchurlNix+    , add2 Normal   "filter"           filterNix+    --, add  Normal   "filterSource"     filterSource+    , add2 Normal   "findFile"         findFileNix+    , add' Normal   "floor"            (arity1 (floor @Float @Integer))+    , add3 Normal   "foldl'"           foldl'Nix+    , add  Normal   "fromJSON"         fromJSONNix+    --, add  Normal   "fromTOML"         fromTOML+    , add  Normal   "functionArgs"     functionArgsNix+    , add  Normal   "genericClosure"   genericClosureNix+    , add2 Normal   "genList"          genListNix+    , add2 Normal   "getAttr"          getAttrNix+    , add  Normal   "getContext"       getContextNix+    , add  Normal   "getEnv"           getEnvNix+    , add2 Normal   "groupBy"          groupByNix+    , add2 Normal   "hasAttr"          hasAttrNix+    , add  Normal   "hasContext"       hasContextNix+    , add' Normal   "hashString"       (hashStringNix @e @t @f @m)+    , add' Normal   "hashFile"         hashFileNix+    , add  Normal   "head"             headNix+    , add2 Normal   "intersectAttrs"   intersectAttrsNix+    , add  Normal   "isAttrs"          isAttrsNix+    , add  Normal   "isBool"           isBoolNix+    , add  Normal   "isFloat"          isFloatNix+    , add  Normal   "isFunction"       isFunctionNix+    , add  Normal   "isInt"            isIntNix+    , add  Normal   "isList"           isListNix+    , add  Normal   "isString"         isStringNix+    , add  Normal   "isPath"           isPathNix+    , add  Normal   "length"           lengthNix+    , add2 Normal   "lessThan"         lessThanNix+    , add  Normal   "listToAttrs"      listToAttrsNix+    , add2 Normal   "match"            matchNix+    , add2 Normal   "mul"              mulNix+    , add0 Normal   "nixPath"          nixPathNix+    , add0 Normal   "null"             (pure nvNull)+    , add  Normal   "parseDrvName"     parseDrvNameNix+    , add2 Normal   "partition"        partitionNix+    , add  Normal   "path"             pathNix+    , add  Normal   "pathExists"       pathExistsNix+    , add  Normal   "readDir"          readDirNix+    , add  Normal   "readFile"         readFileNix+    , add3 Normal   "replaceStrings"   replaceStringsNix+    , add2 Normal   "seq"              seqNix+    , add2 Normal   "sort"             sortNix+    , add2 Normal   "split"            splitNix+    , add  Normal   "splitVersion"     splitVersionNix+    , add0 Normal   "storeDir"         (pure $ mkNVStrWithoutContext "/nix/store")+    --, add  Normal   "storePath"        storePath+    , add' Normal   "stringLength"     (arity1 $ Text.length . ignoreContext)+    , add' Normal   "sub"              (arity2 ((-) @Integer))+    , add' Normal   "substring"        substringNix+    , add  Normal   "tail"             tailNix+    , add2 Normal   "toFile"           toFileNix+    , add  Normal   "toJSON"           toJSONNix+    , add  Normal   "toPath"           toPathNix+    , add  Normal   "toXML"            toXMLNix+    , add0 Normal   "true"             (pure $ mkNVBool True)+    , add  Normal   "tryEval"          tryEvalNix+    , add  Normal   "typeOf"           typeOfNix+    , add  Normal   "unsafeDiscardOutputDependency" unsafeDiscardOutputDependencyNix+    , add  Normal   "unsafeDiscardStringContext"    unsafeDiscardStringContextNix+    , add2 Normal   "unsafeGetAttrPos"              unsafeGetAttrPosNix+    , add  Normal   "valueSize"        getRecursiveSizeNix+    ]  where    arity0 :: a -> Prim m a@@ -1991,13 +2084,11 @@   -> m r withNixContext mpath action =   do-    base            <- builtins-    opts :: Options <- asks $ view hasLens-    let-      i = nvList $ nvStrWithoutContext . toText <$> include opts+    base <- builtins+    opts <- askOptions      pushScope-      (coerce $ M.fromList $ one ("__includes", i))+      (one ("__includes", mkNVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts))       (pushScopes         base $         maybe@@ -2005,8 +2096,7 @@           (\ path act ->             do               traceM $ "Setting __cur_file = " <> show path-              let ref = nvPath path-              pushScope (coerce $ M.fromList $ one ("__cur_file", ref)) act+              pushScope (one ("__cur_file", mkNVPath path)) act           )           mpath           action@@ -2020,9 +2110,8 @@   => m (Scopes m (NValue t f m)) builtins =   do-    ref <- defer $ nvSet mempty <$> buildMap-    lst <- (one ("builtins", ref) <>) <$> topLevelBuiltins-    pushScope (coerce (M.fromList lst)) currentScopes+    ref <- defer $ mkNVSet mempty <$> buildMap+    (`pushScope` askScopes) . coerce . M.fromList . (one ("builtins", ref) <>) =<< topLevelBuiltins  where   buildMap :: m (HashMap VarName (NValue t f m))   buildMap         =  M.fromList . (mapping <$>) <$> builtinsList@@ -2036,5 +2125,5 @@     nameBuiltins :: Builtin v -> Builtin v     nameBuiltins b@(Builtin TopLevel _) = b     nameBuiltins (Builtin Normal nB) =-      Builtin TopLevel $ first (coerce @Text . ("__" <>) . coerce @VarName) nB+      Builtin TopLevel $ first (coerce @(Text -> Text) ("__" <>)) nB 

@@ -3,6 +3,7 @@ -- | Reading and writing Nix cache files module Nix.Cache where +import           Nix.Prelude import qualified Data.ByteString.Lazy          as BSL import           Nix.Expr.Types.Annotated 

@@ -5,6 +5,7 @@  module Nix.Cited where +import           Nix.Prelude import           Control.Comonad import           Control.Comonad.Env import           Lens.Family2.TH@@ -16,8 +17,9 @@  data Provenance m v =   Provenance-    { _lexicalScope :: Scopes m v-    , _originExpr   :: NExprLocF (Maybe v)+    { getLexicalScope :: Scopes m v+      --  2021-11-09: NOTE: Better name?+    , getOriginExpr   :: 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@@ -27,8 +29,8 @@  data NCited m v a =   NCited-    { _provenance :: [Provenance m v]-    , _cited      :: a+    { getProvenance :: [Provenance m v]+    , getCited      :: a     }     deriving (Generic, Typeable, Functor, Foldable, Traversable, Show) @@ -37,11 +39,11 @@   (<*>) (NCited xs f) (NCited ys x) = NCited (xs <> ys) (f x)  instance Comonad (NCited m v) where-  duplicate p = NCited (_provenance p) p-  extract = _cited+  duplicate p = NCited (getProvenance p) p+  extract = getCited  instance ComonadEnv [Provenance m v] (NCited m v) where-  ask = _provenance+  ask = getProvenance  $(makeLenses ''Provenance) $(makeLenses ''NCited)@@ -55,7 +57,7 @@   addProvenance :: Provenance m v -> a -> a  instance HasCitations m v (NCited m v a) where-  citations = _provenance+  citations = getProvenance   addProvenance x (NCited p v) = NCited (x : p) v  instance HasCitations1 m v f

@@ -4,6 +4,7 @@  module Nix.Cited.Basic where +import           Nix.Prelude import           Control.Comonad                ( Comonad ) import           Control.Comonad.Env            ( ComonadEnv ) import           Control.Monad.Catch     hiding ( catchJust )@@ -79,26 +80,28 @@   thunk :: m v -> m (Cited u f m t)   thunk mv =     do-      opts :: Options <- asks $ view hasLens+      opts <- askOptions        bool         (cite mempty)-        (\ t ->+        (\ mt ->           do-            frames :: Frames <- asks $ view hasLens+            frames <- askFrames              -- Gather the current evaluation context at the time of thunk             -- creation, and record it along with the thunk.             let-              go :: SomeException -> [Provenance m (NValue u f m)]-              go (fromException -> Just (EvaluatingExpr scope (Ann s e))) =+              fun :: SomeException -> [Provenance m (NValue u f m)]+              fun (fromException -> Just (EvaluatingExpr scope (Ann s e))) =                 one $ Provenance scope $ AnnF s (Nothing <$ e)-              go _ = mempty-              ps = foldMap (go . frame) frames+              fun _ = mempty -            cite ps t+              ps :: [Provenance m (NValue u f m)]+              ps = foldMap (fun . frame) frames++            cite ps mt         )-        (thunks opts)+        (isThunks opts)         (thunk mv)    thunkId :: Cited u f m t -> ThunkId m

@@ -1,6 +1,6 @@- module Nix.Context where +import           Nix.Prelude import           Nix.Options                    ( Options ) import           Nix.Scope                      ( Scopes ) import           Nix.Frames                     ( Frames )@@ -9,24 +9,25 @@                                                 )  --  2021-07-18: NOTE: It should be Options -> Scopes -> Frames -> Source(span)-data Context m t = Context-    { scopes  :: Scopes m t-    , source  :: SrcSpan-    , frames  :: Frames-    , options :: Options+data Context m t =+  Context+    { getOptions :: Options+    , getScopes  :: Scopes m t+    , getSource  :: SrcSpan+    , getFrames  :: Frames     }  instance Has (Context m t) (Scopes m t) where-  hasLens f a = (\x -> a { scopes = x }) <$> f (scopes a)+  hasLens f a = (\x -> a { getScopes = x }) <$> f (getScopes a)  instance Has (Context m t) SrcSpan where-  hasLens f a = (\x -> a { source = x }) <$> f (source a)+  hasLens f a = (\x -> a { getSource = x }) <$> f (getSource a)  instance Has (Context m t) Frames where-  hasLens f a = (\x -> a { frames = x }) <$> f (frames a)+  hasLens f a = (\x -> a { getFrames = x }) <$> f (getFrames a)  instance Has (Context m t) Options where-  hasLens f a = (\x -> a { options = x }) <$> f (options a)+  hasLens f a = (\x -> a { getOptions = x }) <$> f (getOptions a)  newContext :: Options -> Context m t-newContext = Context mempty nullSpan mempty+newContext o = Context o mempty nullSpan mempty

@@ -15,6 +15,7 @@  module Nix.Convert where +import           Nix.Prelude import           Control.Monad.Free import qualified Data.HashMap.Lazy             as M import           Nix.Atoms@@ -68,16 +69,22 @@   fromValue    :: v -> m a   fromValueMay :: v -> m (Maybe a) -traverseFromM+traverseFromValue   :: ( Applicative m      , Traversable t      , FromValue b m a      )   => t a   -> m (Maybe (t b))-traverseFromM = traverseM fromValueMay+traverseFromValue = traverse2 fromValueMay -traverseToValue :: ((Traversable t, Applicative f, ToValue a f b) => t a -> f (t b))+traverseToValue+  :: ( Traversable t+     , Applicative f+     , ToValue a f b+     )+  => t a+  -> f (t b) traverseToValue = traverse toValue  -- Please, hide these helper function from export, to be sure they get optimized away.@@ -133,9 +140,10 @@          )   => FromValue a m (Deeper (NValue t f m)) where +  fromValueMay :: Deeper (NValue t f m) -> m (Maybe a)   fromValueMay (Deeper v) =     free-      ((fromValueMay . Deeper) <=< force)+      ((fromValueMay . Deeper) <=< force)  -- these places are complex in types       (fromValueMay . Deeper)       =<< demand v @@ -211,7 +219,7 @@     \case       NVStr' ns -> pure $ pure ns       NVPath' p ->-        (\path -> pure $ mkNixStringWithSingletonContext path (StringContext path DirectPath)) . fromString . coerce <$>+        (\path -> pure $ mkNixStringWithSingletonContext (StringContext DirectPath path) path) . fromString . coerce <$>           addPath p       NVSet' _ s ->         maybe@@ -281,7 +289,7 @@   => FromValue [a] m (Deeper (NValue' t f m (NValue t f m))) where   fromValueMay =     \case-      Deeper (NVList' l) -> traverseFromM l+      Deeper (NVList' l) -> traverseFromValue l       _                  -> stub  @@ -305,7 +313,7 @@    fromValueMay =     \case-      Deeper (NVSet' _ s) -> traverseFromM s+      Deeper (NVSet' _ s) -> traverseFromValue s       _                   -> stub    fromValue = fromMayToDeeperValue TSet@@ -330,7 +338,7 @@    fromValueMay =     \case-      Deeper (NVSet' p s) -> (, p) <<$>> traverseFromM s+      Deeper (NVSet' p s) -> (, p) <<$>> traverseFromValue s       _                   -> stub    fromValue = fromMayToDeeperValue TSet@@ -363,39 +371,39 @@  instance Convertible e t f m   => ToValue () m (NValue' t f m (NValue t f m)) where-  toValue _ = pure . nvConstant' $ NNull+  toValue = const $ pure nvNull'  instance Convertible e t f m   => ToValue Bool m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvConstant' . NBool+  toValue = pure . mkNVConstant' . NBool  instance Convertible e t f m   => ToValue Int m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvConstant' . NInt . toInteger+  toValue = pure . mkNVConstant' . NInt . toInteger  instance Convertible e t f m   => ToValue Integer m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvConstant' . NInt+  toValue = pure . mkNVConstant' . NInt  instance Convertible e t f m   => ToValue Float m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvConstant' . NFloat+  toValue = pure . mkNVConstant' . NFloat  instance Convertible e t f m   => ToValue NixString m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvStr'+  toValue = pure . mkNVStr'  instance Convertible e t f m   => ToValue ByteString m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvStr' . mkNixStringWithoutContext . decodeUtf8+  toValue = pure . mkNVStr' . mkNixStringWithoutContext . decodeUtf8  instance Convertible e t f m   => ToValue Text m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvStr' . mkNixStringWithoutContext+  toValue = pure . mkNVStr' . mkNixStringWithoutContext  instance Convertible e t f m   => ToValue Path m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvPath' . coerce+  toValue = pure . mkNVPath' . coerce  instance Convertible e t f m   => ToValue StorePath m (NValue' t f m (NValue t f m)) where@@ -408,40 +416,40 @@     l' <- toValue $ unPos l     c' <- toValue $ unPos c     let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')]-    pure $ nvSet' mempty pos+    pure $ mkNVSet' mempty pos  -- | With 'ToValue', we can always act recursively instance Convertible e t f m   => ToValue [NValue t f m] m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvList'+  toValue = pure . mkNVList'  instance (Convertible e t f m   , ToValue a m (NValue t f m)   )   => ToValue [a] m (Deeper (NValue' t f m (NValue t f m))) where-  toValue l = Deeper . nvList' <$> traverseToValue l+  toValue l = Deeper . mkNVList' <$> traverseToValue l  instance Convertible e t f m   => ToValue (AttrSet (NValue t f m)) m (NValue' t f m (NValue t f m)) where-  toValue s = pure $ nvSet' mempty s+  toValue s = pure $ mkNVSet' mempty s  instance (Convertible e t f m, ToValue a m (NValue t f m))   => ToValue (AttrSet a) m (Deeper (NValue' t f m (NValue t f m))) where   toValue s =-    liftA2 (\ v s -> Deeper $ nvSet' s v)+    liftA2 (\ v s -> Deeper $ mkNVSet' s v)       (traverseToValue s)       stub  instance Convertible e t f m   => ToValue (AttrSet (NValue t f m), PositionSet) m             (NValue' t f m (NValue t f m)) where-  toValue (s, p) = pure $ nvSet' p s+  toValue (s, p) = pure $ mkNVSet' p s  instance (Convertible e t f m, ToValue a m (NValue t f m))   => ToValue (AttrSet a, PositionSet) m             (Deeper (NValue' t f m (NValue t f m))) where   toValue (s, p) =-    liftA2 (\ v s -> Deeper $ nvSet' s v)+    liftA2 (\ v s -> Deeper $ mkNVSet' s v)       (traverseToValue s)       (pure p) @@ -465,14 +473,14 @@         (pure Nothing)         (fmap pure . toValue)         ts-    pure $ nvSet' mempty $ M.fromList $ catMaybes+    pure $ mkNVSet' mempty $ M.fromList $ catMaybes       [ ("path"      ,) <$> path       , ("allOutputs",) <$> allOutputs       , ("outputs"   ,) <$> outputs       ]  instance Convertible e t f m => ToValue () m (NExprF (NValue t f m)) where-  toValue _ = pure . NConstant $ NNull+  toValue = const . pure . NConstant $ NNull  instance Convertible e t f m => ToValue Bool m (NExprF (NValue t f m)) where   toValue = pure . NConstant . NBool

@@ -12,9 +12,10 @@  module Nix.Effects where -import           Prelude                 hiding ( putStrLn+import           Nix.Prelude             hiding ( putStrLn                                                 , print                                                 )+import qualified Nix.Prelude                   as Prelude import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import qualified Data.HashSet                  as HS import qualified Data.Text                     as Text@@ -432,6 +433,8 @@     pure     =<< addTextToStore' a b c d +--  2021-10-30: NOTE: Misleading name, please rename.+-- | Add @Path@ into the Nix Store addPath :: (Framed e m, MonadStore m) => Path -> m StorePath addPath p =   either@@ -440,4 +443,4 @@     =<< addToStore (fromString $ coerce takeFileName p) p True False  toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath-toFile_ p contents = addTextToStore (toText p) contents mempty False+toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty False

@@ -2,7 +2,7 @@  module Nix.Effects.Basic where -import           Prelude                 hiding ( head+import           Nix.Prelude             hiding ( head                                                 ) import           Relude.Unsafe                  ( head ) import           GHC.Exception                  ( ErrorCall(ErrorCall) )@@ -144,7 +144,7 @@                 tryPath path $                   whenJust                     (\ nsPfx ->-                      let pfx = stringIgnoreContext nsPfx in+                      let pfx = ignoreContext nsPfx in                       pure $ coerce $ toString pfx `whenFalse` Text.null pfx                     )                     mns@@ -191,7 +191,7 @@     -> m (NValue t f m)   fetchFromString msha =     \case-      NVStr ns -> fetch (stringIgnoreContext ns) msha+      NVStr ns -> fetch (ignoreContext 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@@ -216,7 +216,7 @@         do           nsSha <- fromValue =<< demand v -          let sha = stringIgnoreContext nsSha+          let sha = ignoreContext nsSha            nixInstantiateExpr $             "builtins.fetchTarball { " <> "url    = \"" <> uri <> "\"; " <> "sha256 = \"" <> sha <> "\"; }"

@@ -5,7 +5,7 @@  module Nix.Effects.Derivation ( defaultDerivationStrict ) where -import           Prelude                 hiding ( readFile )+import           Nix.Prelude             hiding ( readFile ) import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Data.Char                      ( isAscii                                                 , isAlphaNum@@ -31,7 +31,7 @@                                                 , callFunc                                                 ) import           Nix.Frames-import           Nix.Json                       ( nvalueToJSONNixString )+import           Nix.Json                       ( toJSONNixString ) import           Nix.Render import           Nix.String import           Nix.String.Coerce@@ -289,13 +289,13 @@     let       outputsWithContext =         Map.mapWithKey-          (\out (coerce -> path) -> mkNixStringWithSingletonContext path $ StringContext drvPath $ DerivationOutput out)+          (\out (coerce -> path) -> mkNixStringWithSingletonContext (StringContext (DerivationOutput out) drvPath) path)           (outputs drv')-      drvPathWithContext = mkNixStringWithSingletonContext drvPath $ StringContext drvPath AllOutputs-      attrSet = nvStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext)+      drvPathWithContext = mkNixStringWithSingletonContext (StringContext AllOutputs drvPath) drvPath+      attrSet = mkNVStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext)     -- TODO: Add location information for all the entries.     --              here --v-    pure $ nvSet mempty (M.mapKeys coerce attrSet)+    pure $ mkNVSet mempty $ M.mapKeys coerce attrSet    where @@ -309,13 +309,14 @@     toStorePaths = foldl (flip addToInputs) mempty      addToInputs :: Bifunctor p => StringContext -> p (Set Text) (Map Text [Text])  -> p (Set Text) (Map Text [Text])-    addToInputs (StringContext path kind) = case kind of-      DirectPath -> first (Set.insert (coerce path))-      DerivationOutput o -> second (Map.insertWith (<>) (coerce path) $ one o)-      AllOutputs ->-        -- TODO: recursive lookup. See prim_derivationStrict-        -- XXX: When is this really used ?-        error "Not implemented: derivations depending on a .drv file are not yet supported."+    addToInputs (StringContext kind (coerce -> path)) =+      case kind of+        DirectPath -> first $ Set.insert path+        DerivationOutput o -> second $ Map.insertWith (<>) path $ one o+        AllOutputs ->+          -- TODO: recursive lookup. See prim_derivationStrict+          -- XXX: When is this really used ?+          error "Not implemented: derivations depending on a .drv file are not yet supported."   -- | Build a derivation in a context collecting string contexts.@@ -367,12 +368,12 @@        env <- if useJson         then do-          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet mempty $ M.mapKeys coerce $+          jsonString :: NixString <- lift $ toJSONNixString $ mkNVSet mempty $ M.mapKeys coerce $             deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs           rawString :: Text <- extractNixString jsonString           pure $ one ("__json", rawString)         else-          traverse (extractNixString <=< lift . coerceToString callFunc CopyToStore CoerceAny) $+          traverse (extractNixString <=< lift . coerceAnyToNixString callFunc CopyToStore) $             Map.fromList $ M.toList $ deleteKeys [ "args", "__ignoreNulls" ] attrs        pure $ Derivation { platform, builder, args, env,  hashMode, useJson

@@ -3,9 +3,9 @@ {-# language RankNTypes #-}  - module Nix.Eval where +import           Nix.Prelude import           Relude.Extra                   ( set ) import           Control.Monad                  ( foldM ) import           Control.Monad.Fix              ( MonadFix )@@ -84,7 +84,7 @@ data EvalFrame m v   = EvaluatingExpr (Scopes m v) NExprLoc   | ForcingExpr (Scopes m v) NExprLoc-  | Calling Text SrcSpan+  | Calling VarName SrcSpan   | SynHole (SynHoleInfo m v)   deriving (Show, Typeable) @@ -122,7 +122,7 @@ eval (NBinary NApp fun arg) =   do     f <- fun-    scope <- currentScopes :: m (Scopes m v)+    scope <- askScopes     evalApp f $ withScopes scope arg  eval (NBinary op   larg rarg) =@@ -144,7 +144,7 @@  eval (NList l           ) =   do-    scope <- currentScopes+    scope <- askScopes     toValue =<< traverse (defer @v @m . withScopes @v scope) l  eval (NSet r binds) =@@ -174,7 +174,7 @@   -- 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.-  curScope <- currentScopes+  curScope <- askScopes   let     withCurScope = withScopes curScope @@ -199,7 +199,7 @@ --   this implementation may be used as an implementation for 'evalWith'. evalWithAttrSet :: forall v m . MonadNixEval v m => m v -> m v -> m v evalWithAttrSet aset body = do-  scopes <- currentScopes :: m (Scopes m v)+  scopes <- askScopes   -- The scope is deliberately wrapped in a thunk here, since it is demanded   -- 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@@ -259,39 +259,40 @@           , AttrSet (m v)           )     recurse p'' m'' =-      fmap-        (insertVal . (=<<) (toValue @(AttrSet v, PositionSet)) . fmap (,mempty) . sequenceA . snd)-        (go p'' m'' ks)+      insertVal . ((toValue @(AttrSet v, PositionSet)) <=< ((,mempty) <$>) . sequenceA . snd) <$> go p'' m'' ks  desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]-desugarBinds embed binds = evalState (traverse (findBinding <=< collect) binds) mempty+desugarBinds embed = (`evalState` mempty) . traverse (findBinding <=< collect)  where   collect     :: Binding r     -> State-         (HashMap VarName (SourcePos, [Binding r]))+         (AttrSet (SourcePos, [Binding r]))          (Either VarName (Binding r))-  collect (NamedVar (StaticKey x :| y : ys) val p) =+  collect (NamedVar (StaticKey x :| y : ys) val oldPosition) =     do-      m <- get-      put $-        join-          (M.insert-            x-            . maybe-              (p, one $ bindValAt p)-              (\ (sp, bnd) -> (sp, one (bindValAt sp) <> bnd))-              . M.lookup x-          )-          m+      modify updateBindingInformation       pure $ Left x    where-    bindValAt = NamedVar (y :| ys) val+    updateBindingInformation+      :: AttrSet (SourcePos, [Binding r])+      -> AttrSet (SourcePos, [Binding r])+    updateBindingInformation =+      M.insert x+        =<< maybe+            (mkBindingSingleton oldPosition)+            (\ (foundPosition, newBindings) -> second (<> newBindings) $ mkBindingSingleton foundPosition)+            . M.lookup x+    mkBindingSingleton :: SourcePos -> (SourcePos, [Binding r])+    mkBindingSingleton np = (np , one $ bindValAt np)+     where+      bindValAt :: SourcePos -> Binding r+      bindValAt = NamedVar (y :| ys) val   collect x = pure $ pure x    findBinding     :: Either VarName (Binding r)-    -> State (HashMap VarName (SourcePos, [Binding r])) (Binding r)+    -> State (AttrSet (SourcePos, [Binding r])) (Binding r)   findBinding =     either       (\ x ->@@ -312,7 +313,7 @@   -> m (AttrSet v, PositionSet) evalBinds isRecursive binds =   do-    scope <- currentScopes :: m (Scopes m v)+    scope <- askScopes      buildResult scope . fold =<< (`traverse` moveOverridesLast binds) (applyBindToAdt scope) @@ -466,8 +467,7 @@   \case     StaticKey k -> pure $ pure k     DynamicKey k ->-      (coerce . stringIgnoreContext) <<$>>-        runAntiquoted "\n" assembleString (fromValueMay =<<) k+      coerce . ignoreContext <<$>> runAntiquoted "\n" assembleString (fromValueMay =<<) k  assembleString   :: forall v m@@ -477,7 +477,7 @@ assembleString = fromParts . stringParts  where   fromParts :: [Antiquoted Text (m v)] -> m (Maybe NixString)-  fromParts xs = fold <<$>> traverseM fun xs+  fromParts xs = fold <<$>> traverse2 fun xs    fun :: Antiquoted Text (m v) -> m (Maybe NixString)   fun =@@ -490,7 +490,7 @@   :: forall v m . MonadNixEval v m => Params (m v) -> m v -> m (AttrSet v) buildArgument params arg =   do-    scope <- currentScopes :: m (Scopes m v)+    scope <- askScopes     let       argThunk = defer $ withScopes scope arg     case params of@@ -548,7 +548,7 @@   => TransformF NExprLoc (m a) addStackFrames f v =   do-    scopes <- currentScopes :: m (Scopes m v)+    scopes <- askScopes      -- sectioning gives GHC optimization     -- If opimization question would arrive again, check the @(`withFrameInfo` f v) $ EvaluatingExpr scopes v@@@ -557,15 +557,15 @@  where   withFrameInfo = withFrame Info -framedEvalExprLoc+evalWithMetaInfo   :: forall e v m   . (MonadNixEval v m, Framed e m, Has e SrcSpan, Typeable m, Typeable v)   => NExprLoc   -> m v-framedEvalExprLoc =+evalWithMetaInfo =   adi addMetaInfo evalContent --- | Add source postionss & frame context system.+-- | Add source positions & frame context system. addMetaInfo   :: forall v m e a   . (Framed e m, Scoped v m, Has e SrcSpan, Typeable m, Typeable v)

@@ -12,7 +12,7 @@  module Nix.Exec where -import           Prelude                 hiding ( putStr+import           Nix.Prelude             hiding ( putStr                                                 , putStrLn                                                 , print                                                 )@@ -44,7 +44,7 @@ import           Prettyprinter import qualified Text.Show.Pretty              as PS -#ifdef MIN_VERSION_ghc_datasize+#ifdef MIN_VERSION_ghc_datasize  import           GHC.DataSize #endif @@ -54,57 +54,66 @@   , MonadDataContext f m   ) -nvConstantP+mkNVConstantWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)+  => Scopes m (NValue t f m)+  -> SrcSpan   -> NAtom   -> NValue t f m-nvConstantP p x = addProvenance p $ nvConstant x+mkNVConstantWithProvenance scopes span x =+  addProvenance (Provenance scopes . NConstantAnnF span $ x) $ mkNVConstant x -nvStrP+mkNVStrWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)+  => Scopes m (NValue t f m)+  -> SrcSpan   -> NixString   -> NValue t f m-nvStrP p ns = addProvenance p $ nvStr ns+mkNVStrWithProvenance scopes span x =+  addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ mkNVStr x -nvPathP+mkNVPathWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)+  => Scopes m (NValue t f m)+  -> SrcSpan   -> Path+  -> Path   -> NValue t f m-nvPathP p x = addProvenance p $ nvPath x+mkNVPathWithProvenance scope span lit real =+  addProvenance (Provenance scope . NLiteralPathAnnF span $ lit) $ mkNVPath real -nvListP+mkNVClosureWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)-  -> [NValue t f m]+  => Scopes m (NValue t f m)+  -> SrcSpan+  -> Params ()+  -> (NValue t f m -> m (NValue t f m))   -> NValue t f m-nvListP p l = addProvenance p $ nvList l+mkNVClosureWithProvenance scopes span x f =+  addProvenance (Provenance scopes $ NAbsAnnF span (Nothing <$ x) Nothing) $ mkNVClosure x f -nvSetP+mkNVUnaryOpWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)-  -> PositionSet-  -> AttrSet (NValue t f m)+  => Scopes m (NValue t f m)+  -> SrcSpan+  -> NUnaryOp+  -> Maybe (NValue t f m)   -> NValue t f m-nvSetP p x s = addProvenance p $ nvSet x s--nvClosureP-  :: MonadCited t f m-  => Provenance m (NValue t f m)-  -> Params ()-  -> (NValue t f m -> m (NValue t f m))   -> NValue t f m-nvClosureP p x f = addProvenance p $ nvClosure x f+mkNVUnaryOpWithProvenance scope span op val =+  addProvenance (Provenance scope $ NUnaryAnnF span op val) -nvBuiltinP+mkNVBinaryOpWithProvenance   :: MonadCited t f m-  => Provenance m (NValue t f m)-  -> VarName-  -> (NValue t f m -> m (NValue t f m))+  => Scopes m (NValue t f m)+  -> SrcSpan+  -> NBinaryOp+  -> Maybe (NValue t f m)+  -> Maybe (NValue t f m)   -> NValue t f m-nvBuiltinP p name f = addProvenance p $ nvBuiltin name f+  -> NValue t f m+mkNVBinaryOpWithProvenance scope span op lval rval =+  addProvenance (Provenance scope $ NBinaryAnnF span op lval rval)  type MonadCitedThunks t f m =   ( MonadThunk t m (NValue t f m)@@ -135,8 +144,8 @@ 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+askSpan :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan+askSpan = askLocal  wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc wrapExprLoc span x = Fix $ NSymAnn span "<?>" <$ x@@ -148,147 +157,141 @@   freeVariable var =     nverr @e @t @f $ ErrorCall $ toString @Text $ "Undefined variable '" <> coerce var <> "'" -  synHole name = do-    span  <- currentPos-    scope <- currentScopes-    evalError @(NValue t f m) $ SynHole $-      SynHoleInfo-        { _synHoleInfo_expr  = NSynHoleAnn span name-        , _synHoleInfo_scope = scope-        }+  synHole name =+    do+      span  <- askSpan+      scope <- askScopes+      evalError @(NValue t f m) $ SynHole $+        SynHoleInfo+          { _synHoleInfo_expr  = NSynHoleAnn span name+          , _synHoleInfo_scope = scope+          }     attrMissing ks ms =     evalError @(NValue t f m) $ ErrorCall $ toString $       maybe         ("Inheriting unknown attribute: " <> attr)-        (\ s ->-          "Could not look up attribute " <> attr <> " in " <> show (prettyNValue s)-        )+        (\ s -> "Could not look up attribute " <> attr <> " in " <> show (prettyNValue s))         ms        where         attr = Text.intercalate "." $ NE.toList $ coerce ks -  evalCurPos = do-    scope                  <- currentScopes-    span@(SrcSpan delta _) <- currentPos-    addProvenance @_ @_ @(NValue t f m)-      (Provenance scope $ NSymAnnF span (coerce @Text "__curPos")) <$>-        toValue delta--  evaledSym name val = do-    scope <- currentScopes-    span  <- currentPos-    pure $+  evalCurPos =+    do+      scope                  <- askScopes+      span@(SrcSpan delta _) <- askSpan       addProvenance @_ @_ @(NValue t f m)-        (Provenance scope $ NSymAnnF span name)-        val+        (Provenance scope . NSymAnnF span $ coerce @Text "__curPos") <$>+          toValue delta -  evalConstant c = do-    scope <- currentScopes-    span  <- currentPos-    pure $ join (nvConstantP . Provenance scope . NConstantAnnF span) c+  evaledSym name val =+    do+      scope <- askScopes+      span  <- askSpan+      pure $+        addProvenance @_ @_ @(NValue t f m)+          (Provenance scope $ NSymAnnF span name)+          val +  evalConstant c =+    do+      scope <- askScopes+      span  <- askSpan+      pure $ mkNVConstantWithProvenance scope span c+   evalString =     maybe       (nverr $ ErrorCall "Failed to assemble string")       (\ ns ->         do-          scope <- currentScopes-          span  <- currentPos-          pure $-            join-              (nvStrP-                . Provenance-                  scope-                  . NStrAnnF span . DoubleQuoted . one . Plain . stringIgnoreContext-              )-              ns+          scope <- askScopes+          span  <- askSpan+          pure $ mkNVStrWithProvenance scope span ns       )       <=< assembleString -  evalLiteralPath p = do-    scope <- currentScopes-    span  <- currentPos-    let-      evalPath :: Path -> m (NValue t f m)-      evalPath p1 =-        fmap-          (g p1)-          (f p1)-       where-        g :: Path -> Path -> NValue t f m-        g = nvPathP . Provenance scope . NLiteralPathAnnF span-        f :: Path -> m Path-        f = toAbsolutePath @t @f @m-    evalPath p+  evalLiteralPath p =+    do+      scope <- askScopes+      span  <- askSpan+      mkNVPathWithProvenance scope span p <$> toAbsolutePath @t @f @m p -  evalEnvPath p = do-    scope <- currentScopes-    span  <- currentPos-    nvPathP (Provenance scope $ NEnvPathAnnF span p) <$>-      findEnvPath @t @f @m (coerce p)+  evalEnvPath p =+    do+      scope <- askScopes+      span  <- askSpan+      mkNVPathWithProvenance scope span p <$> findEnvPath @t @f @m (coerce p) -  evalUnary op arg = do-    scope <- currentScopes-    span  <- currentPos-    execUnaryOp scope span op arg+  evalUnary op arg =+    do+      scope <- askScopes+      span  <- askSpan+      execUnaryOp scope span op arg -  evalBinary op larg rarg = do-    scope <- currentScopes-    span  <- currentPos-    execBinaryOp scope span op larg rarg+  evalBinary op larg rarg =+    do+      scope <- askScopes+      span  <- askSpan+      execBinaryOp scope span op larg rarg -  evalWith c b = do-    scope <- currentScopes-    span  <- currentPos-    let f = join $ addProvenance . Provenance scope . NWithAnnF span Nothing . pure-    f <$> evalWithAttrSet c b+  evalWith c b =+    do+      scope <- askScopes+      span  <- askSpan+      let f = join $ addProvenance . Provenance scope . NWithAnnF span Nothing . pure+      f <$> evalWithAttrSet c b -  evalIf c tVal fVal = do-    scope <- currentScopes-    span  <- currentPos-    bl <- fromValue c+  evalIf c tVal fVal =+    do+      scope <- askScopes+      span  <- askSpan+      bl <- fromValue c -    let-      fun x y = addProvenance (Provenance scope $ NIfAnnF span (pure c) x y)-      -- Note: join acts as \ f x -> f x x-      falseVal = join (fun Nothing . pure) <$> fVal-      trueVal = join (flip fun Nothing . pure) <$> tVal+      let+        fun x y = addProvenance (Provenance scope $ NIfAnnF span (pure c) x y)+        falseVal = (fun Nothing =<< pure) <$> fVal+        trueVal = (flip fun Nothing =<< pure) <$> tVal -    bool-      falseVal-      trueVal-      bl+      bool+        falseVal+        trueVal+        bl    evalAssert c body =     do-      span <- currentPos+      span <- askSpan       b <- fromValue c       bool         (nverr $ Assertion span c)         (do-          scope <- currentScopes+          scope <- askScopes           join (addProvenance . Provenance scope . NAssertAnnF span (pure c) . pure) <$> body         )         b -  evalApp f x = do-    scope <- currentScopes-    span  <- currentPos-    addProvenance (Provenance scope $ NBinaryAnnF span NApp (pure f) Nothing) <$>-      (callFunc f =<< defer x)+  evalApp f x =+    do+      scope <- askScopes+      span  <- askSpan+      mkNVBinaryOpWithProvenance scope span NApp (pure f) Nothing <$> (callFunc f =<< defer x) -  evalAbs p k = do-    let-      fk = flip k-    scope <- currentScopes-    span  <- currentPos-    pure $-      nvClosureP-        (Provenance scope $ NAbsAnnF span (Nothing <$ p) Nothing)-        (void p)-        $ fmap snd . fk (const $ fmap ((), )) . pure+  evalAbs+    :: Params (m (NValue t f m))+    -> ( forall a+      . m (NValue t f m)+      -> ( AttrSet (m (NValue t f m))+        -> m (NValue t f m)+        -> m (a, NValue t f m)+        )+      -> m (a, NValue t f m)+      )+    -> m (NValue t f m)+  evalAbs p k =+    do+      scope <- askScopes+      span  <- askSpan+      pure $ mkNVClosureWithProvenance scope span (void p) (fmap snd . flip (k @()) (const (fmap (mempty ,))) . pure)    evalError = throwError @@ -301,7 +304,7 @@   -> m (NValue t f m) callFunc fun arg =   do-    frames :: Frames <- asks $ view hasLens+    frames <- askFrames     when (length frames > 2000) $ throwError $ ErrorCall "Function call stack exhausted"      fun' <- demand fun@@ -309,14 +312,15 @@       NVClosure _params f -> f arg       NVBuiltin name f    ->         do-          span <- currentPos-          withFrame Info ((Calling @m @(NValue t f m)) (coerce name) span) $ f arg -- Is this cool?+          span <- askSpan+          withFrame Info ((Calling @m @(NValue t f m)) name span) $ f arg -- Is this cool?       (NVSet _ m) | Just f <- M.lookup "__functor" m ->-        (`callFunc` arg) =<< (`callFunc` fun') =<< demand f+        (`callFunc` arg) =<< (`callFunc` fun') f       _x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show _x  execUnaryOp-  :: (Framed e m, MonadCited t f m, Show t)+  :: forall e t f m+   . (Framed e m, MonadCited t f m, Show t)   => Scopes m (NValue t f m)   -> SrcSpan   -> NUnaryOp@@ -326,15 +330,16 @@   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)+        (NNeg, NInt   i) -> mkUnaryOp NInt negate i+        (NNeg, NFloat f) -> mkUnaryOp NFloat negate f+        (NNot, NBool  b) -> mkUnaryOp NBool not b         _seq ->           throwError $ ErrorCall $ "unsupported argument type for unary operator " <> show _seq     _x ->       throwError $ ErrorCall $ "argument to unary operator must evaluate to an atomic type: " <> show _x  where-  unaryOp = pure . nvConstantP (Provenance scope $ NUnaryAnnF span op $ pure arg)+  mkUnaryOp :: (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)+  mkUnaryOp c b a = pure . mkNVUnaryOpWithProvenance scope span op (pure arg) . mkNVConstant $ c (b a)  execBinaryOp   :: forall e t f m@@ -385,10 +390,7 @@    toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)   toBoolOp r b =-    pure $-      nvConstantP-        (Provenance scope $ NBinaryAnnF span op (pure lval) r)-        (NBool b)+    pure $ mkNVBinaryOpWithProvenance scope span op (pure lval) r $ mkNVConstant $ NBool b  execBinaryOpForced   :: forall e t f m@@ -400,92 +402,105 @@   -> NValue t f m   -> m (NValue t f m) -execBinaryOpForced scope span op lval rval = case op of-  NLt    -> compare (<)-  NLte   -> compare (<=)-  NGt    -> compare (>)-  NGte   -> compare (>=)-  NMinus -> numBinOp (-)-  NMult  -> numBinOp (*)-  NDiv   -> numBinOp' div (/)-  NConcat ->-    case (lval, rval) of-      (NVList ls, NVList rs) -> pure $ nvListP prov $ ls <> rs-      _ -> unsupportedTypes--  NUpdate ->-    case (lval, rval) of-      (NVSet lp ls, NVSet rp rs) -> pure $ nvSetP prov (rp <> lp) (rs <> ls)-      (NVSet lp ls, NVConstant NNull) -> pure $ nvSetP prov lp ls-      (NVConstant NNull, NVSet rp rs) -> pure $ nvSetP prov rp rs-      _ -> unsupportedTypes+execBinaryOpForced scope span op lval rval =+  case op of+    NLt    -> mkCmpOp (<)+    NLte   -> mkCmpOp (<=)+    NGt    -> mkCmpOp (>)+    NGte   -> mkCmpOp (>=)+    NMinus -> mkBinNumOp (-)+    NMult  -> mkBinNumOp (*)+    NDiv   -> mkBinNumOp' div (/)+    NConcat ->+      case (lval, rval) of+        (NVList ls, NVList rs) -> pure $ mkListP $ ls <> rs+        _ -> unsupportedTypes -  NPlus ->-    case (lval, rval) of-      (NVConstant _, NVConstant _) -> numBinOp (+)+    NUpdate ->+      case (lval, rval) of+        (NVSet lp ls, NVSet rp rs) -> pure $ mkSetP (rp <> lp) (rs <> ls)+        (NVSet lp ls, NVConstant NNull) -> pure $ mkSetP lp ls+        (NVConstant NNull, NVSet rp rs) -> pure $ mkSetP rp rs+        _ -> unsupportedTypes -      (NVStr ls, NVStr rs) -> pure $ nvStrP prov (ls <> rs)-      (NVStr ls, rs@NVPath{}) ->-        (\rs2 -> nvStrP prov (ls <> rs2)) <$>-          coerceToString callFunc CopyToStore CoerceStringy rs-      (NVPath ls, NVStr rs) ->-        maybe-          (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412-          (\ rs2 ->-            nvPathP prov <$>-              toAbsolutePath @t @f (ls <> coerce (toString rs2))-          )-          (getStringNoContext rs)-      (NVPath ls, NVPath rs) -> nvPathP prov <$> toAbsolutePath @t @f (ls <> rs)+    NPlus ->+      case (lval, rval) of+        (NVConstant _, NVConstant _) -> mkBinNumOp (+)+        (NVStr ls, NVStr rs) -> pure $ mkStrP (ls <> rs)+        (NVStr ls, NVPath p) ->+          mkStrP . (ls <>) <$>+            coercePathToNixString CopyToStore p+        (NVPath ls, NVStr rs) ->+          maybe+            (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412+            (\ rs2 -> mkPathP <$> toAbsolutePath @t @f (ls <> coerce (toString rs2)))+            (getStringNoContext rs)+        (NVPath ls, NVPath rs) -> mkPathP <$> toAbsolutePath @t @f (ls <> rs) -      (ls@NVSet{}, NVStr rs) ->-        (\ls2 -> nvStrP prov (ls2 <> rs)) <$>-          coerceToString callFunc DontCopyToStore CoerceStringy ls-      (NVStr ls, rs@NVSet{}) ->-        (\rs2 -> nvStrP prov (ls <> rs2)) <$>-          coerceToString callFunc DontCopyToStore CoerceStringy rs-      _ -> unsupportedTypes+        (ls@NVSet{}, NVStr rs) ->+          mkStrP . (<> rs) <$>+            coerceAnyToNixString callFunc DontCopyToStore ls+        (NVStr ls, rs@NVSet{}) ->+          mkStrP . (ls <>) <$>+            coerceAnyToNixString callFunc DontCopyToStore rs+        _ -> unsupportedTypes -  NEq   -> alreadyHandled-  NNEq  -> alreadyHandled-  NAnd  -> alreadyHandled-  NOr   -> alreadyHandled-  NImpl -> alreadyHandled-  NApp  -> throwError $ ErrorCall "NApp should be handled by evalApp"+    NApp  -> throwError $ ErrorCall "NApp should be handled by evalApp"+    _other   -> shouldBeAlreadyHandled   where-  prov :: Provenance m (NValue t f m)-  prov = Provenance scope $ NBinaryAnnF span op (pure lval) (pure rval)+  addProv :: NValue t f m -> NValue t f m+  addProv =+    mkNVBinaryOpWithProvenance scope span op (pure lval) (pure rval) -  toBool = pure . nvConstantP prov . NBool-  compare :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)-  compare op = case (lval, rval) of-    (NVConstant l, NVConstant r) -> toBool $ l `op` r-    (NVStr l, NVStr r) -> toBool $ l `op` r-    _ -> unsupportedTypes+  mkBoolP :: Bool -> m (NValue t f m)+  mkBoolP = pure . addProv . mkNVConstant . NBool -  nvInt = pure . nvConstantP prov . NInt-  nvFloat = pure . nvConstantP prov . NFloat+  mkIntP :: Integer -> m (NValue t f m)+  mkIntP = pure . addProv . mkNVConstant . NInt -  numBinOp :: (forall a. Num a => a -> a -> a) -> m (NValue t f m)-  numBinOp op = numBinOp' op op+  mkFloatP :: Float -> m (NValue t f m)+  mkFloatP = pure . addProv . mkNVConstant . NFloat -  numBinOp'+  mkListP :: [NValue t f m] -> NValue t f m+  mkListP = addProv . mkNVList++  mkStrP :: NixString -> NValue t f m+  mkStrP = addProv . mkNVStr++  mkPathP :: Path -> NValue t f m+  mkPathP = addProv . mkNVPath++  mkSetP :: (PositionSet -> AttrSet (NValue t f m) -> NValue t f m)+  mkSetP x s = addProv $ mkNVSet x s++  mkCmpOp :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)+  mkCmpOp op = case (lval, rval) of+    (NVConstant l, NVConstant r) -> mkBoolP $ l `op` r+    (NVStr l, NVStr r) -> mkBoolP $ l `op` r+    _ -> unsupportedTypes++  mkBinNumOp :: (forall a. Num a => a -> a -> a) -> m (NValue t f m)+  mkBinNumOp op = mkBinNumOp' op op++  mkBinNumOp'     :: (Integer -> Integer -> Integer)     -> (Float -> Float -> Float)     -> m (NValue t f m)-  numBinOp' intOp floatOp = case (lval, rval) of-    (NVConstant l, NVConstant r) -> case (l, r) of-      (NInt   li, NInt   ri) -> nvInt $ li `intOp` ri-      (NInt   li, NFloat rf) -> nvFloat $ fromInteger li `floatOp` rf-      (NFloat lf, NInt   ri) -> nvFloat $ lf `floatOp` fromInteger ri-      (NFloat lf, NFloat rf) -> nvFloat $ lf `floatOp` rf+  mkBinNumOp' intOp floatOp =+    case (lval, rval) of+      (NVConstant l, NVConstant r) ->+        case (l, r) of+          (NInt   li, NInt   ri) -> mkIntP $ li `intOp` ri+          (NInt   li, NFloat rf) -> mkFloatP $ fromInteger li `floatOp` rf+          (NFloat lf, NInt   ri) -> mkFloatP $ lf `floatOp` fromInteger ri+          (NFloat lf, NFloat rf) -> mkFloatP $ lf `floatOp` rf+          _ -> unsupportedTypes       _ -> unsupportedTypes-    _ -> unsupportedTypes    unsupportedTypes = throwError $ ErrorCall $ "Unsupported argument types for binary operator " <> show op <> ": " <> show lval <> ", " <> show rval -  alreadyHandled = throwError $ ErrorCall $ "This cannot happen: operator " <> show op <> " should have been handled in execBinaryOp."+  shouldBeAlreadyHandled = throwError $ ErrorCall $ "This cannot happen: operator " <> show op <> " should have been handled in execBinaryOp."   -- This function is here, rather than in 'Nix.String', because of the need to@@ -515,14 +530,13 @@   local succ $ do     v'@(AnnF span x) <- sequenceA v     pure $ do-      opts :: Options <- asks $ view hasLens+      opts <- askOptions       let         rendered =-          if verbose opts >= Chatty-            then-              pretty $-                PS.ppShow $ void x-            else prettyNix $ Fix $ Fix (NSym "?") <$ x+          bool+            (prettyNix $ Fix $ Fix (NSym "?") <$ x)+            (pretty $ PS.ppShow $ void x)+            (getVerbosity opts >= Chatty)         msg x = pretty ("eval: " <> replicate depth ' ') <> x       loc <- renderLocation span $ msg rendered <> " ...\n"       putStr $ show loc@@ -530,27 +544,35 @@       print $ msg rendered <> " ...done"       pure res +evalWithTracingAndMetaInfo+  :: forall e t f m+  . MonadNix e t f m+  => NExprLoc+  -> ReaderT Int m (m (NValue t f m))+evalWithTracingAndMetaInfo =+  adi+    addMetaInfo+    (addTracing Eval.evalContent)+  where+  addMetaInfo :: (NExprLoc -> ReaderT r m a) -> NExprLoc -> ReaderT r m a+  addMetaInfo = (ReaderT .) . flip . (Eval.addMetaInfo .) . flip . (runReaderT .)+ 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+    opts <- askOptions     let       pTracedAdi =         bool-          Eval.framedEvalExprLoc-          (join . (`runReaderT` (0 :: Int)) .-            adi-              (raise Eval.addMetaInfo)-              (addTracing Eval.evalContent)-          )-          (tracing opts)+          Eval.evalWithMetaInfo+          (join . (`runReaderT` (0 :: Int)) . evalWithTracingAndMetaInfo)+          (isTrace opts)     pTracedAdi expr- where-  raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x  exec :: (MonadNix e t f m, MonadInstantiate m) => [Text] -> m (NValue t f m) exec args = either throwError evalExprLoc =<< exec' args +-- Please, delete `nix` from the name nixInstantiateExpr   :: (MonadNix e t f m, MonadInstantiate m) => Text -> m (NValue t f m) nixInstantiateExpr s = either throwError evalExprLoc =<< instantiateExpr s

@@ -1,10 +1,10 @@---- | A bunch of shorthands for making nix expressions.+-- | Shorthands for making Nix expressions. -- -- Functions with an @F@ suffix return a more general type (base functor @F a@) without the outer -- 'Fix' wrapper that creates @a@. module Nix.Expr.Shorthands where +import           Nix.Prelude import           Data.Fix import           Nix.Atoms import           Nix.Expr.Types@@ -424,13 +424,13 @@ -- | __@Deprecated@__: Please, use `mkOp` -- Put an unary operator. mkOper :: NUnaryOp -> NExpr -> NExpr-mkOper op = Fix . NUnary op+mkOper = mkOp  -- NOTE: Remove after 2023-07 -- | __@Deprecated@__: Please, use `mkOp2` -- | Put a binary operator. mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr-mkOper2 op a = Fix . NBinary op a+mkOper2 = mkOp2  -- NOTE: Remove after 2023-07 -- | __@Deprecated@__: Please, use `mkOp2`

@@ -1,7 +1,7 @@- -- | Functions for manipulating nix strings. module Nix.Expr.Strings where +import           Nix.Prelude import           Relude.Unsafe                 as Unsafe -- Please, switch things to NonEmpty import           Data.List                      ( dropWhileEnd@@ -39,14 +39,16 @@ runAntiquoted _  _ k (Antiquoted r) = k r  -- | 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+splitLines :: forall r . [Antiquoted Text r] -> [[Antiquoted Text r]]+splitLines = uncurry (flip (:)) . go+ where+  go :: [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])+  go (Plain t : xs) = (one (Plain l) <>) <$> foldr f (go xs) ls    where     (l : ls) = T.split (== '\n') t     f prefix (finished, current) = ((Plain prefix : current) : finished, mempty)-  go (Antiquoted a   : xs) = (Antiquoted a :) <$> go xs-  go (EscapedNewline : xs) = (EscapedNewline :) <$> go xs+  go (Antiquoted a   : xs) = (one (Antiquoted a) <>) <$> go xs+  go (EscapedNewline : xs) = (one EscapedNewline <>) <$> go xs   go []                    = mempty  -- | Join a stream of strings containing antiquotes again. This is the inverse@@ -108,10 +110,17 @@  escapeCodes :: [(Char, Char)] escapeCodes =-  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('\\', '\\'), ('$', '$'), ('"', '"')]+  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('"', '"'), ('$', '$'), ('\\', '\\')]  fromEscapeCode :: Char -> Maybe Char fromEscapeCode = (`lookup` (swap <$> escapeCodes))  toEscapeCode :: Char -> Maybe Char toEscapeCode = (`lookup` escapeCodes)++escapeMap :: [(Text, Text)]+escapeMap =+  [("\n", "\\n"), ("\r", "\\r"), ("\t", "\\t"), ("\"", "\\\""), ("${", "\\${"), ("\\", "\\\\")]++escapeString :: Text -> Text+escapeString = applyAll (fmap (uncurry T.replace) escapeMap)

@@ -7,6 +7,7 @@ {-# language TypeFamilies #-}  {-# options_ghc -Wno-orphans #-}+{-# options_ghc -Wno-name-shadowing #-} {-# options_ghc -Wno-missing-signatures #-}  -- | The Nix expression type and supporting types.@@ -19,17 +20,19 @@ -- (additiona info for dev): Big use of TemplateHaskell in the module requires proper (top-down) organization of declarations. module Nix.Expr.Types where -import qualified Codec.Serialise                as Serialise+import           Nix.Prelude+import qualified Codec.Serialise               as Serialise import           Codec.Serialise                ( Serialise ) import           Control.DeepSeq                ( NFData1(..) ) import           Data.Aeson import qualified Data.Binary                   as Binary import           Data.Binary                    ( Binary ) import           Data.Data-import           Data.Fix                       ( Fix(Fix) )+import           Data.Fix                       ( Fix(..) ) import           Data.Functor.Classes import           Data.Hashable.Lifted import qualified Data.HashMap.Lazy             as MapL+import qualified Data.Set                      as Set import qualified Data.List.NonEmpty            as NE import qualified Text.Show import           Data.Traversable               ( fmapDefault, foldMapDefault )@@ -57,14 +60,14 @@  -- * utils --- | Holds file positionng information for abstrations.--- A type synonym for @HashMap VarName SourcePos@.-type PositionSet = HashMap VarName SourcePos- --  2021-07-16: NOTE: Should replace @ParamSet@ List -- | > Hashmap VarName -- type synonym type AttrSet = HashMap VarName +-- | Holds file positionng information for abstrations.+-- A type synonym for @HashMap VarName SourcePos@.+type PositionSet = AttrSet SourcePos+ -- ** orphan instances  -- Placed here because TH inference depends on declaration sequence.@@ -174,7 +177,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Hashable, Hashable1+    , Show, Hashable     )  instance IsString (Params r) where@@ -185,6 +188,8 @@ $(deriveEq1   ''Params) $(deriveOrd1  ''Params) +deriving instance Hashable1 Params+ -- *** lens traversals  $(makeTraversals ''Params)@@ -210,14 +215,9 @@     , Typeable, Data, NFData, NFData1, Serialise, Binary     , ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Read, Hashable, Hashable1+    , Show, Read, Hashable     ) -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- $(deriveShow1 ''Antiquoted) $(deriveShow2 ''Antiquoted) $(deriveRead1 ''Antiquoted)@@ -228,7 +228,13 @@ $(deriveOrd2  ''Antiquoted) $(deriveJSON2 defaultOptions ''Antiquoted) +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 +deriving instance (Hashable v) => Hashable1 (Antiquoted (v :: Type))+ -- *** lens traversals  $(makeTraversals ''Antiquoted)@@ -261,19 +267,21 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Read, Hashable, Hashable1+    , Show, Read, Hashable     )  -- | For the the 'IsString' instance, we use a plain doublequoted string. instance IsString (NString r) where   fromString ""     = DoubleQuoted mempty-  fromString string = DoubleQuoted [Plain $ fromString string]+  fromString string = DoubleQuoted $ one $ Plain $ fromString string  $(deriveShow1 ''NString) $(deriveRead1 ''NString) $(deriveEq1   ''NString) $(deriveOrd1  ''NString) +deriving instance Hashable1 NString+ -- *** lens traversals  $(makeTraversals ''NString)@@ -316,9 +324,9 @@     )  instance NFData1 NKeyName where-  liftRnf _ (StaticKey  !_            ) = ()-  liftRnf _ (DynamicKey (Plain !_)    ) = ()-  liftRnf _ (DynamicKey EscapedNewline) = ()+  liftRnf _ (StaticKey  !_            ) = mempty+  liftRnf _ (DynamicKey (Plain !_)    ) = mempty+  liftRnf _ (DynamicKey EscapedNewline) = mempty   liftRnf k (DynamicKey (Antiquoted r)) = k r  -- | Most key names are just static text, so this instance is convenient.@@ -421,7 +429,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, FromJSON     , Functor, Foldable, Traversable-    , Show, Hashable, Hashable1+    , Show, Hashable     )  $(deriveShow1 ''Binding)@@ -429,6 +437,8 @@ $(deriveOrd1  ''Binding) --x $(deriveJSON1 defaultOptions ''Binding) +deriving instance Hashable1 Binding+ -- *** lens traversals  $(makeTraversals ''Binding)@@ -506,7 +516,7 @@  -- * data NExprF - Nix expressions, base functor --- | The main Nix expression type. As it is polimophic, has a functor,+-- | The main Nix expression type. As it is polimorphic, has a functor, -- which allows to traverse expressions and map functions over them. -- The actual 'NExpr' type is a fixed point of this functor, defined -- below.@@ -594,7 +604,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, FromJSON     , Functor, Foldable, Traversable-    , Show, Hashable, Hashable1+    , Show, Hashable     )  @@ -603,6 +613,8 @@ $(deriveOrd1  ''NExprF) --x $(deriveJSON1 defaultOptions ''NExprF) +deriving instance Hashable1 NExprF+ -- ** lens traversals  $(makeTraversals ''NExprF)@@ -739,3 +751,71 @@           )         <$> f Nothing ekey _ _ f e = fromMaybe e <$> f Nothing+++getFreeVars :: NExpr -> Set VarName+getFreeVars e =+  case unFix e of+    (NConstant    _               ) -> mempty+    (NStr         string          ) -> mapFreeVars string+    (NSym         var             ) -> one var+    (NList        list            ) -> mapFreeVars list+    (NSet   NonRecursive  bindings) -> bindFreeVars bindings+    (NSet   Recursive     bindings) -> diffBetween bindFreeVars bindDefs bindings+    (NLiteralPath _               ) -> mempty+    (NEnvPath     _               ) -> mempty+    (NUnary       _    expr       ) -> getFreeVars expr+    (NBinary      _    left right ) -> collectFreeVars left right+    (NSelect      orExpr expr path) ->+      Set.unions+        [ getFreeVars expr+        , pathFree path+        , getFreeVars `whenJust` orExpr+        ]+    (NHasAttr expr            path) -> getFreeVars expr <> pathFree path+    (NAbs     (Param varname) expr) -> Set.delete varname (getFreeVars expr)+    (NAbs (ParamSet varname _ pset) expr) ->+      Set.difference+        -- Include all free variables from the expression and the default arguments+        (getFreeVars expr <> Set.unions (getFreeVars <$> mapMaybe snd pset))+        -- But remove the argument name if existing, and all arguments in the parameter set+        ((one `whenJust` varname) <> Set.fromList (fst <$> pset))+    (NLet         bindings expr   ) ->+      Set.difference+        (getFreeVars expr <> bindFreeVars bindings)+        (bindDefs bindings)+    (NIf          cond th   el    ) -> Set.unions $ getFreeVars <$> [cond, th, 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       ) -> collectFreeVars set expr+    (NAssert      assertion expr  ) -> collectFreeVars assertion expr+    (NSynHole     _               ) -> mempty+ where+  diffBetween :: (a -> Set VarName) -> (a -> Set VarName) -> a -> Set VarName+  diffBetween g f b = Set.difference (g b) (f b)++  collectFreeVars :: NExpr -> NExpr -> Set VarName+  collectFreeVars = (<>) `on` getFreeVars++  bindDefs :: Foldable t => t (Binding NExpr) -> Set VarName+  bindDefs = foldMap bind1Def+   where+    bind1Def :: Binding r -> Set VarName+    bind1Def (Inherit   Nothing                  _    _) = mempty+    bind1Def (Inherit  (Just _                 ) keys _) = Set.fromList keys+    bind1Def (NamedVar (StaticKey  varname :| _) _    _) = one varname+    bind1Def (NamedVar (DynamicKey _       :| _) _    _) = mempty++  bindFreeVars :: Foldable t => t (Binding NExpr) -> Set VarName+  bindFreeVars = foldMap bind1Free+   where+    bind1Free :: Binding NExpr -> Set VarName+    bind1Free (Inherit  Nothing     keys _) = Set.fromList keys+    bind1Free (Inherit (Just scope) _    _) = getFreeVars scope+    bind1Free (NamedVar path        expr _) = pathFree path <> getFreeVars expr++  pathFree :: NAttrPath NExpr -> Set VarName+  pathFree = foldMap mapFreeVars++  mapFreeVars :: Foldable t => t NExpr -> Set VarName+  mapFreeVars = foldMap getFreeVars

@@ -16,6 +16,7 @@   ) where +import           Nix.Prelude import           Codec.Serialise import           Control.DeepSeq import           Data.Aeson                     ( ToJSON(..)@@ -111,8 +112,6 @@  -- ** Instances -instance Hashable ann => Hashable1 (AnnUnit ann)- instance NFData ann => NFData1 (AnnUnit ann)  instance (Binary ann, Binary a) => Binary (AnnUnit ann a)@@ -127,6 +126,8 @@ $(deriveShow2 ''AnnUnit) $(deriveJSON1 defaultOptions ''AnnUnit) $(deriveJSON2 defaultOptions ''AnnUnit)++instance Hashable ann => Hashable1 (AnnUnit ann)  instance (Serialise ann, Serialise a) => Serialise (AnnUnit ann a) 

@@ -5,6 +5,7 @@ module Nix.Frames   ( NixLevel(..)   , Frames+  , askFrames   , Framed   , NixFrame(..)   , NixException(..)@@ -14,6 +15,7 @@   ) where +import           Nix.Prelude import           Data.Typeable           hiding ( typeOf ) import           Control.Monad.Catch            ( MonadThrow(..) ) import qualified Text.Show@@ -21,10 +23,11 @@ data NixLevel = Fatal | Error | Warning | Info | Debug   deriving (Ord, Eq, Bounded, Enum, Show) -data NixFrame = NixFrame-  { frameLevel :: NixLevel-  , frame      :: SomeException-  }+data NixFrame =+  NixFrame+    { frameLevel :: NixLevel+    , frame      :: SomeException+    }  instance Show NixFrame where   show (NixFrame level f) =@@ -32,6 +35,9 @@  type Frames = [NixFrame] +askFrames :: forall e m . (MonadReader e m, Has e Frames) => m Frames+askFrames = askLocal+ type Framed e m = (MonadReader e m, Has e Frames, MonadThrow m)  newtype NixException = NixException Frames@@ -45,7 +51,8 @@  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 fail..."-  throwM $ NixException $ NixFrame Error (toException err) : context+throwError err =+  do+    context <- askLocal+    traceM "Throwing fail..."+    throwM $ NixException $ NixFrame Error (toException err) : context

@@ -8,6 +8,7 @@  module Nix.Fresh where +import           Nix.Prelude import           Control.Monad.Base   ( MonadBase(..) ) import           Control.Monad.Catch  ( MonadCatch                                       , MonadMask@@ -20,7 +21,6 @@  import           Nix.Thunk ---  2021-06-02: NOTE: Remove singleton newtype accessor in favour of free coerce newtype FreshIdT i m a = FreshIdT (ReaderT (Ref m i) m a)   deriving     ( Functor@@ -59,5 +59,5 @@     v <- ask     atomicModifyRef v (\i -> (succ i, i)) -runFreshIdT :: Functor m => Ref m i -> FreshIdT i m a -> m a-runFreshIdT i m = runReaderT (coerce m) i+runFreshIdT :: Functor m => FreshIdT i m a -> Ref m i -> m a+runFreshIdT = runReaderT . coerce

@@ -8,6 +8,7 @@ #if !MIN_VERSION_base(4,13,0) import           Control.Monad.Fail ( MonadFail ) #endif+import           Nix.Prelude import           Nix.Effects import           Nix.Render import           Nix.Fresh@@ -28,19 +29,36 @@  instance (MonadEffects t f m, MonadDataContext f m)   => MonadEffects t f (StdIdT m) where++  toAbsolutePath :: Path -> StdIdT m Path   toAbsolutePath = lift . toAbsolutePath @t @f @m++  findEnvPath :: String -> StdIdT m Path   findEnvPath      = lift . findEnvPath @t @f @m-  findPath vs path = do-    i <- FreshIdT ask-    let vs' = unliftNValue (runFreshIdT i) <$> vs-    lift $ findPath @t @f @m vs' path-  importPath path = do-    i <- FreshIdT ask-    p <- lift $ importPath @t @f @m path-    pure $ liftNValue (runFreshIdT i) p++  findPath :: [NValue t f (StdIdT m)] -> Path -> StdIdT m Path+  findPath vs path =+    do+      i <- FreshIdT ask+      lift $ findPath @t @f @m (unliftNValue (`runFreshIdT` i) <$> vs) path++  importPath :: Path -> StdIdT m (NValue t f (StdIdT m))+  importPath path =+    do+      i <- FreshIdT ask+      lift $ liftNValue (`runFreshIdT` i) <$> (importPath @t @f @m $ path)++  pathToDefaultNix :: Path -> StdIdT m Path   pathToDefaultNix = lift . pathToDefaultNix @t @f @m-  derivationStrict v = do-    i <- FreshIdT ask-    p <- lift $ derivationStrict @t @f @m $ unliftNValue (runFreshIdT i) v-    pure $ liftNValue (runFreshIdT i) p++  derivationStrict :: NValue t f (StdIdT m) -> StdIdT m (NValue t f (StdIdT m))+  derivationStrict v =+    do+      i <- FreshIdT ask+      let+        fresh :: FreshIdT Int m a -> m a+        fresh = (`runFreshIdT` i)+      lift $ liftNValue fresh <$> (derivationStrict @t @f @m . unliftNValue fresh $ v)++  traceEffect :: String -> StdIdT m ()   traceEffect = lift . traceEffect @t @f @m

@@ -2,6 +2,7 @@  module Nix.Json where +import           Nix.Prelude import qualified Data.Aeson                    as A import qualified Data.Aeson.Encoding           as A import qualified Data.Vector                   as V@@ -36,8 +37,8 @@   A.Array l -> A.list toEncodingSorted $ V.toList l   v         -> A.toEncoding v -nvalueToJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString-nvalueToJSONNixString =+toJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString+toJSONNixString =   runWithStringContextT .     fmap       ( decodeUtf8@@ -46,10 +47,10 @@       . toEncodingSorted       ) -      . nvalueToJSON+      . toJSON -nvalueToJSON :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value-nvalueToJSON = \case+toJSON :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value+toJSON = \case   NVConstant (NInt   n) -> pure $ A.toJSON n   NVConstant (NFloat n) -> pure $ A.toJSON n   NVConstant (NBool  b) -> pure $ A.toJSON b@@ -72,10 +73,10 @@   NVPath p ->     do       fp <- lift $ coerce <$> addPath p-      addSingletonStringContext $ StringContext (fromString fp) DirectPath+      addSingletonStringContext $ StringContext DirectPath $ fromString fp       pure $ A.toJSON fp   v -> lift $ throwError $ CoercionToJson v   where   intoJson :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value-  intoJson nv = join $ lift $ nvalueToJSON <$> demand nv+  intoJson nv = join $ lift $ toJSON <$> demand nv

@@ -11,6 +11,7 @@  module Nix.Lint where +import           Nix.Prelude import           Relude.Unsafe                 as Unsafe ( head ) import           Control.Exception              ( throw ) import           GHC.Exception                  ( ErrorCall(ErrorCall) )@@ -214,7 +215,7 @@         (pure <$> r)       bool         id-        ((TSet (pure m) :) <$>)+        ((one (TSet $ pure m) <>) <$>)         (not $ M.null m)         rest @@ -270,9 +271,11 @@       m <- merge context xs ys       bool         (do-          writeRef x   (NMany m)-          writeRef y   (NMany m)-          packSymbolic (NMany m)+          let+           nm = NMany m+          writeRef x   nm+          writeRef y   nm+          packSymbolic nm         )         (               -- x' <- renderSymbolic (Symbolic x)@@ -304,16 +307,16 @@   defer = fmap ST . thunk    demand :: Symbolic m -> m (Symbolic m)-  demand (ST v)= demand =<< force v-  demand (SV v)= pure (SV v)+  demand (ST v) = demand =<< force v+  demand (SV v) = pure (SV v)   instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)   => MonadValueF (Symbolic m) m where    demandF :: (Symbolic m -> m r) -> Symbolic m -> m r-  demandF f (ST v)= demandF f =<< force v-  demandF f (SV v)= f (SV v)+  demandF f (ST v) = demandF f =<< force v+  demandF f (SV v) = f (SV v)   instance MonadLint e m => MonadEval (Symbolic m) m where@@ -349,7 +352,7 @@   evalEnvPath     = const $ mkSymbolic $ one TPath    evalUnary op arg =-    unify (void (NUnary op arg)) arg =<< mkSymbolic (one (TConstant [TInt, TBool]))+    unify (void $ NUnary op arg) arg =<< mkSymbolic (one $ TConstant [TInt, TBool])    evalBinary = lintBinaryOp @@ -385,7 +388,7 @@       _ <- unify (void e) cond =<< mkSymbolic (one $ TConstant $ one TBool)       pure body' -  evalApp = (fmap snd .) . lintApp (NBinary NApp () ())+  evalApp = (fmap snd .) . lintApp (join (NBinary NApp) mempty)   evalAbs params _ = mkSymbolic (one $ TClosure $ void params)    evalError = throwError@@ -491,15 +494,15 @@     )  instance MonadThrow (Lint s) where+  throwM :: forall e a . Exception e => e -> Lint s a   throwM e = Lint $ ReaderT $ const (throw e)  instance MonadCatch (Lint s) where   catch _m _h = Lint $ ReaderT $ const (fail "Cannot catch in 'Lint s'")  runLintM :: Options -> Lint s a -> ST s a-runLintM opts action = do-  i <- newRef (1 :: Int)-  runFreshIdT i $ (`runReaderT` newContext opts) $ runLint action+runLintM opts action =+  runFreshIdT ((`runReaderT` newContext opts) $ runLint action) =<< newRef (1 :: Int)  symbolicBaseEnv   :: Monad m@@ -522,7 +525,7 @@  instance   Scoped (Symbolic (Lint s)) (Lint s) where-  currentScopes = currentScopesReader+  askScopes = askScopesReader   clearScopes   = clearScopesReader @(Lint s) @(Symbolic (Lint s))   pushScopes    = pushScopesReader   lookupVar     = lookupVarReader

@@ -10,6 +10,7 @@ -- And so do not converge into a normal form. module Nix.Normal where +import           Nix.Prelude import           Control.Monad.Free        ( Free(..) ) import           Data.Set                  ( member                                            , insert@@ -100,7 +101,9 @@       (do         i <- ask         when (i > 2000) $ fail "Exceeded maximum normalization depth of 2000 levels"-        lifted (lifted $ f t) $ local succ . k+        (lifted . lifted)+          (f t)+          (local succ . k)       )       (pure $ pure t)       b@@ -139,7 +142,7 @@ normalForm_ t = void $ normalizeValue t  opaqueVal :: Applicative f => NValue t f m-opaqueVal = nvStrWithoutContext "<cycle>"+opaqueVal = mkNVStrWithoutContext "<cycle>"  -- | Detect cycles & stub them. stubCycles@@ -165,7 +168,7 @@   Free (NValue' cyc) = opaqueVal  thunkStubVal :: Applicative f => NValue t f m-thunkStubVal = nvStrWithoutContext thunkStubText+thunkStubVal = mkNVStrWithoutContext thunkStubText  -- | Check if thunk @t@ is computed, -- then bind it into first arg.

@@ -3,74 +3,79 @@ -- | Definitions & defaults for the CLI options module Nix.Options where +import           Nix.Prelude import           Data.Time  --  2021-07-15: NOTE: What these are? They need to be documented. -- Also need better names. Foe example, Maybes & lists names need to show their type in the name.-data Options = Options-    { verbose      :: Verbosity-    , tracing      :: Bool-    , thunks       :: Bool-    , values       :: Bool-    , showScopes   :: Bool-    , reduce       :: Maybe Path-    , reduceSets   :: Bool-    , reduceLists  :: Bool-    , parse        :: Bool-    , parseOnly    :: Bool-    , finder       :: Bool-    , findFile     :: Maybe Path-    , strict       :: Bool-    , evaluate     :: Bool-    , json         :: Bool-    , xml          :: Bool-    , attr         :: Maybe Text-    , include      :: [Path]-    , check        :: Bool-    , readFrom     :: Maybe Path-    , cache        :: Bool-    , repl         :: Bool-    , ignoreErrors :: Bool-    , expression   :: Maybe Text-    , arg          :: [(Text, Text)]-    , argstr       :: [(Text, Text)]-    , fromFile     :: Maybe Path-    , currentTime  :: UTCTime-    , filePaths    :: [Path]+data Options =+  Options+    { getVerbosity   :: Verbosity+    , isTrace        :: Bool+    , isThunks       :: Bool+    , isValues       :: Bool+    , isShowScopes   :: Bool+    , getReduce      :: Maybe Path+    , isReduceSets   :: Bool+    , isReduceLists  :: Bool+    , isParse        :: Bool+    , isParseOnly    :: Bool+    , isFinder       :: Bool+    , getFindFile    :: Maybe Path+    , isStrict       :: Bool+    , isEvaluate     :: Bool+    , isJson         :: Bool+    , isXml          :: Bool+    , getAttr        :: Maybe Text+    , getInclude     :: [Path]+    , isCheck        :: Bool+    , getReadFrom    :: Maybe Path+    , isCache        :: Bool+    , isRepl         :: Bool+    , isIgnoreErrors :: Bool+    , getExpression  :: Maybe Text+    , getArg         :: [(Text, Text)]+    , getArgstr      :: [(Text, Text)]+    , getFromFile    :: Maybe Path+    , getTime        :: UTCTime+    -- ^ The time can be set to reproduce time-dependent states.+    , getFilePaths   :: [Path]     }     deriving Show  defaultOptions :: UTCTime -> Options-defaultOptions current = Options { verbose      = ErrorsOnly-                                 , tracing      = False-                                 , thunks       = False-                                 , values       = False-                                 , showScopes   = False-                                 , reduce       = mempty-                                 , reduceSets   = False-                                 , reduceLists  = False-                                 , parse        = False-                                 , parseOnly    = False-                                 , finder       = False-                                 , findFile     = mempty-                                 , strict       = False-                                 , evaluate     = False-                                 , json         = False-                                 , xml          = False-                                 , attr         = mempty-                                 , include      = mempty-                                 , check        = False-                                 , readFrom     = mempty-                                 , cache        = False-                                 , repl         = False-                                 , ignoreErrors = False-                                 , expression   = mempty-                                 , arg          = mempty-                                 , argstr       = mempty-                                 , fromFile     = mempty-                                 , currentTime  = current-                                 , filePaths    = mempty-                                 }+defaultOptions currentTime =+  Options+    { getVerbosity   = ErrorsOnly+    , isTrace        = False+    , isThunks       = False+    , isValues       = False+    , isShowScopes   = False+    , getReduce      = mempty+    , isReduceSets   = False+    , isReduceLists  = False+    , isParse        = False+    , isParseOnly    = False+    , isFinder       = False+    , getFindFile    = mempty+    , isStrict       = False+    , isEvaluate     = False+    , isJson         = False+    , isXml          = False+    , getAttr        = mempty+    , getInclude     = mempty+    , isCheck        = False+    , getReadFrom    = mempty+    , isCache        = False+    , isRepl         = False+    , isIgnoreErrors = False+    , getExpression  = mempty+    , getArg         = mempty+    , getArgstr      = mempty+    , getFromFile    = mempty+    , getTime        = currentTime+    , getFilePaths   = mempty+    }  data Verbosity     = ErrorsOnly@@ -80,3 +85,6 @@     | DebugInfo     | Vomit     deriving (Eq, Ord, Enum, Bounded, Show)++askOptions :: forall e m . (MonadReader e m, Has e Options) => m Options+askOptions = askLocal

@@ -3,6 +3,7 @@ -- | Code that configures presentation parser for the CLI options module Nix.Options.Parser where +import           Nix.Prelude import           Relude.Unsafe                  ( read ) import           GHC.Err                        ( errorWithoutStackTrace ) import           Data.Char                      ( isDigit )

@@ -9,6 +9,7 @@   , parseNixFileLoc   , parseNixText   , parseNixTextLoc+  , parseExpr   , parseFromFileEx   , Parser   , parseFromText@@ -39,7 +40,7 @@   ) where -import           Prelude                 hiding ( (<|>)+import           Nix.Prelude             hiding ( (<|>)                                                 , some                                                 , many                                                 )@@ -270,74 +271,79 @@     antiquotedLexeme     <|> Plain <$> p -nixString' :: Parser (NString NExprLoc)-nixString' = label "string" $ lexeme $ doubleQuoted <|> indented- where-  doubleQuoted :: Parser (NString NExprLoc)-  doubleQuoted =-    label "double quoted string" $-      DoubleQuoted . removeEmptyPlains . mergePlain <$>-        inQuotationMarks (many $ stringChar quotationMark (void $ char '\\') doubleEscape)-   where-    inQuotationMarks :: Parser a -> Parser a-    inQuotationMarks expr = quotationMark *> expr <* quotationMark+escapeCode :: Parser Char+escapeCode =+  msum+    [ c <$ char e | (c, e) <- escapeCodes ]+  <|> anySingle -    quotationMark :: Parser ()-    quotationMark = void $ char '"'+stringChar+  :: Parser ()+  -> Parser ()+  -> Parser (Antiquoted Text NExprLoc)+  -> Parser (Antiquoted Text NExprLoc)+stringChar end escStart esc =+  antiquoted+  <|> Plain . one <$> char '$'+  <|> esc+  <|> Plain . fromString <$> some plainChar+  where+  plainChar :: Parser Char+  plainChar =+    notFollowedBy (end <|> void (char '$') <|> escStart) *> anySingle -    doubleEscape :: Parser (Antiquoted Text r)-    doubleEscape = Plain . one <$> (char '\\' *> escapeCode)+doubleQuoted :: Parser (NString NExprLoc)+doubleQuoted =+  label "double quoted string" $+    DoubleQuoted . removeEmptyPlains . mergePlain <$>+      inQuotationMarks (many $ stringChar quotationMark (void $ char '\\') doubleEscape)+  where+  inQuotationMarks :: Parser a -> Parser a+  inQuotationMarks expr = quotationMark *> expr <* quotationMark -  indented :: Parser (NString NExprLoc)-  indented =-    label "indented string" $-      stripIndent <$>-        inIndentedQuotation (many $ join stringChar indentedQuotationMark indentedEscape)-   where-    indentedEscape :: Parser (Antiquoted Text r)-    indentedEscape =-      try $-        do-          indentedQuotationMark-          (Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$'))-            <|>-              do-                _ <- char '\\'-                c <- escapeCode+  quotationMark :: Parser ()+  quotationMark = void $ char '"' -                pure $-                  bool-                    EscapedNewline-                    (Plain $ one c)-                    (c /= '\n')+  doubleEscape :: Parser (Antiquoted Text r)+  doubleEscape = Plain . one <$> (char '\\' *> escapeCode) -    inIndentedQuotation :: Parser a -> Parser a-    inIndentedQuotation expr = indentedQuotationMark *> expr <* indentedQuotationMark -    indentedQuotationMark :: Parser ()-    indentedQuotationMark = label "\"''\"" . void $ chunk "''"+indented :: Parser (NString NExprLoc)+indented =+  label "indented string" $+    stripIndent <$>+      inIndentedQuotation (many $ join stringChar indentedQuotationMark indentedEscape)+ where+  -- | Read escaping inside of the "'' <expr> ''"+  indentedEscape :: Parser (Antiquoted Text r)+  indentedEscape =+    try $+      do+        indentedQuotationMark+        (Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$'))+          <|>+            do+              _ <- char '\\'+              c <- escapeCode -  stringChar-    :: Parser ()-    -> Parser ()-    -> Parser (Antiquoted Text NExprLoc)-    -> Parser (Antiquoted Text NExprLoc)-  stringChar end escStart esc =-    antiquoted-    <|> Plain . one <$> char '$'-    <|> esc-    <|> Plain . fromString <$> some plainChar-   where-    plainChar :: Parser Char-    plainChar =-      notFollowedBy (end <|> void (char '$') <|> escStart) *> anySingle+              pure $+                bool+                  EscapedNewline+                  (Plain $ one c)+                  (c /= '\n') -  escapeCode :: Parser Char-  escapeCode =-    msum-      [ c <$ char e | (c, e) <- escapeCodes ]-    <|> anySingle+  -- | Enclosed into indented quatation "'' <expr> ''"+  inIndentedQuotation :: Parser a -> Parser a+  inIndentedQuotation expr = indentedQuotationMark *> expr <* indentedQuotationMark +  -- | Symbol "''"+  indentedQuotationMark :: Parser ()+  indentedQuotationMark = label "\"''\"" . void $ chunk "''"+++nixString' :: Parser (NString NExprLoc)+nixString' = label "string" $ lexeme $ doubleQuoted <|> indented+ nixString :: Parser NExprLoc nixString = annNStr <$> annotateLocation1 nixString' @@ -586,6 +592,7 @@     one $ binaryR NImpl "->"   ] +--  2021-11-09: NOTE: rename OperatorInfo accessors to `get*` --  2021-08-10: NOTE: --  All this is a sidecar: --  * This type@@ -595,11 +602,13 @@ --  * getSpecialOperation --  can reduced in favour of adding precedence field into @NOperatorDef@. -- details: https://github.com/haskell-nix/hnix/issues/982-data OperatorInfo = OperatorInfo-  { precedence    :: Int-  , associativity :: NAssoc-  , operatorName  :: Text-  } deriving (Eq, Ord, Generic, Typeable, Data, Show)+data OperatorInfo =+  OperatorInfo+    { precedence    :: Int+    , associativity :: NAssoc+    , operatorName  :: Text+    }+ deriving (Eq, Ord, Generic, Typeable, Data, Show)  detectPrecedence   :: Ord a@@ -918,3 +927,9 @@ parseNixTextLoc =   parseNixText' id +parseExpr :: (MonadFail m) => Text -> m NExpr+parseExpr =+  either+    (fail . show)+    pure+    . parseNixText

@@ -0,0 +1,20 @@+-- | This is a @Prelude@, but, please, do not put things in here,+-- put them into "Nix.Utils". This module is a pass-through-multiplexer,+-- between our custom code ("Nix.Utils") that shadows over the outside prelude that is in use ("Relude")+-- "Prelude" module has a problem of being imported & used by other projects.+-- "Nix.Utils" as a module with a regular name does not have that problem.+module Nix.Prelude+    ( module Nix.Utils+    , module Relude+    ) where++import           Nix.Utils+import           Relude                  hiding ( pass+                                                , force+                                                , readFile+                                                , whenJust+                                                , whenNothing+                                                , trace+                                                , traceM+                                                )+

@@ -3,10 +3,9 @@  {-# options_ghc -fno-warn-name-shadowing #-} - module Nix.Pretty where -import           Prelude                  hiding ( toList, group )+import           Nix.Prelude             hiding ( toList, group ) import           Control.Monad.Free             ( Free(Free) ) import           Data.Fix                       ( Fix(..)                                                 , foldFix )@@ -33,8 +32,8 @@ -- | This type represents a pretty printed nix expression -- together with some information about the expression. data NixDoc ann = NixDoc-  { -- | The rendered expression, without any parentheses.-    withoutParens    :: Doc ann+  { -- | Rendered expression. Without surrounding parenthesis.+    getDoc :: 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@@ -45,8 +44,16 @@                     -- we can add brackets appropriately   } +-- | Represent Nix antiquotes.+--+-- >+-- > ${ expr }+-- >+antiquote :: NixDoc ann -> Doc ann+antiquote x = "${" <> getDoc x <> "}"+ mkNixDoc :: OperatorInfo -> Doc ann -> NixDoc ann-mkNixDoc o d = NixDoc { withoutParens = d, rootOp = o, wasPath = False }+mkNixDoc o d = NixDoc { getDoc = 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@@ -64,13 +71,13 @@ --   binding). leastPrecedence :: Doc ann -> NixDoc ann leastPrecedence =-  mkNixDoc (OperatorInfo maxBound NAssocNone "least precedence")+  mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"  appOp :: OperatorInfo appOp = getBinaryOperator NApp  appOpNonAssoc :: OperatorInfo-appOpNonAssoc = (getBinaryOperator NApp) { associativity = NAssocNone }+appOpNonAssoc = appOp { associativity = NAssocNone }  selectOp :: OperatorInfo selectOp = getSpecialOperator NSelectOp@@ -78,57 +85,68 @@ hasAttrOp :: OperatorInfo hasAttrOp = getSpecialOperator NHasAttrOp -wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann-wrapParens op sub =-  bool-    (\ a -> "(" <> a <> ")")-    id-    (   precedence (rootOp sub)   <  precedence op-    || (precedence (rootOp sub)   == precedence op-        && associativity (rootOp sub) == associativity op-        && associativity op /= NAssocNone)-    )-    (withoutParens sub)+-- | Determine if to return doc wraped into parens,+-- according the given operator.+precedenceWrap :: OperatorInfo -> NixDoc ann -> Doc ann+precedenceWrap op subExpr =+  maybeWrap $ getDoc subExpr+ where+  maybeWrap :: Doc ann -> Doc ann+  maybeWrap =+    bool+      parens+      id+      needsParens+   where+    needsParens :: Bool+    needsParens =+      precedence root < precedence op+      || (  precedence    root == precedence    op+         && associativity root == associativity op+         && associativity op   /= NAssocNone+         ) +    root = rootOp subExpr++ -- Used in the selector case to print a path in a selector as -- "${./abc}" wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann wrapPath op sub =   bool-    (wrapParens op sub)-    ("\"${" <> withoutParens sub <> "}\"")+    (precedenceWrap op sub)+    (dquotes $ antiquote sub)     (wasPath sub) +-- | Handle Output representation of the string escape codes. prettyString :: NString (NixDoc ann) -> Doc ann-prettyString (DoubleQuoted parts) = "\"" <> foldMap prettyPart parts <> "\""+prettyString (DoubleQuoted parts) =+  dquotes $ foldMap prettyPart parts  where-  -- It serializes Text -> String, because the helper code is done for String,-  -- please, can someone break that code.-  prettyPart (Plain t)      = pretty . foldMap escape . toString $ t+  prettyPart (Plain t)      = pretty $ escapeString t   prettyPart EscapedNewline = "''\\n"-  prettyPart (Antiquoted r) = "${" <> withoutParens r <> "}"-  escape '"' = "\\\""-  escape x   =-    maybe-      (one x)-      (('\\' :) . one)-      (toEscapeCode x)-prettyString (Indented _ parts) = group $ nest 2 $ vcat-  ["''", content, "''"]+  prettyPart (Antiquoted r) = antiquote r+prettyString (Indented _ parts) =+  group $ nest 2 $ vcat ["''", content, "''"]  where   content = vsep . fmap prettyLine . stripLastIfEmpty . splitLines $ parts   stripLastIfEmpty :: [[Antiquoted Text r]] -> [[Antiquoted Text r]]-  stripLastIfEmpty = filter flt+  stripLastIfEmpty =+    filter flt    where     flt :: [Antiquoted Text r] -> Bool     flt [Plain t] | Text.null (strip t) = False     flt _ = True -  prettyLine = hcat . fmap prettyPart-  prettyPart (Plain t) =-    pretty . replace "${" "''${" . replace "''" "'''" $ t-  prettyPart EscapedNewline = "\\n"-  prettyPart (Antiquoted r) = "${" <> withoutParens r <> "}"+  prettyLine :: [Antiquoted Text (NixDoc ann)] -> Doc ann+  prettyLine =+    hcat . fmap prettyPart+   where+    prettyPart :: Antiquoted Text (NixDoc ann) -> Doc ann+    prettyPart (Plain t) =+      pretty . replace "${" "''${" . replace "''" "'''" $ t+    prettyPart EscapedNewline = "\\n"+    prettyPart (Antiquoted r) = antiquote r  prettyVarName :: VarName -> Doc ann prettyVarName = pretty @Text . coerce@@ -137,55 +155,49 @@ prettyParams (Param n           ) = prettyVarName n prettyParams (ParamSet mname variadic pset) =   prettyParamSet variadic pset <>-     toDoc `whenJust` mname+    toDoc `whenJust` mname  where   toDoc :: VarName -> Doc ann   toDoc (coerce -> name) =     ("@" <> pretty name) `whenFalse` Text.null name -prettyParamSet :: Variadic -> ParamSet (NixDoc ann) -> Doc ann+prettyParamSet :: forall ann . Variadic -> ParamSet (NixDoc ann) -> Doc ann prettyParamSet variadic args =   encloseSep     "{ "     (align " }")-    sep+    (align ", ")     (fmap prettySetArg args <> one "..." `whenTrue` (variadic == Variadic))  where+  prettySetArg :: (VarName, Maybe (NixDoc ann)) -> Doc ann   prettySetArg (n, maybeDef) =-    maybe-      varName-      (\x -> varName <> " ? " <> withoutParens x)-      maybeDef-   where-    varName = prettyVarName n-  sep            = align ", "+    (prettyVarName n <>) $ ((" ? " <>) . getDoc) `whenJust` maybeDef  prettyBind :: Binding (NixDoc ann) -> Doc ann prettyBind (NamedVar n v _p) =-  prettySelector n <> " = " <> withoutParens v <> ";"+  prettySelector n <> " = " <> getDoc v <> ";" prettyBind (Inherit s ns _p) =   "inherit " <> scope <> align (fillSep $ prettyVarName <$> ns) <> ";"-  where-    scope =-      ((<> " ") . parens . withoutParens) `whenJust` s+ where+  scope =+    ((<> " ") . parens . getDoc) `whenJust` s  prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann prettyKeyName (StaticKey key) =   bool     "\"\""     (bool-      varName-      ("\"" <> varName <> "\"")+      id+      dquotes       (HashSet.member key reservedNames)+      (prettyVarName key)     )     (not $ Text.null $ coerce key)- where-  varName = prettyVarName key prettyKeyName (DynamicKey key) =   runAntiquoted     (DoubleQuoted $ one $ Plain "\n")     prettyString-    (\ x -> "${" <> withoutParens x <> "}")+    antiquote     key  prettySelector :: NAttrPath (NixDoc ann) -> Doc ann@@ -195,32 +207,43 @@ prettyAtom = simpleExpr . pretty . atomText  prettyNix :: NExpr -> Doc ann-prettyNix = withoutParens . foldFix exprFNixDoc+prettyNix = getDoc . foldFix exprFNixDoc  prettyOriginExpr   :: forall t f m ann    . HasCitations1 m (NValue t f m) f   => NExprLocF (Maybe (NValue t f m))   -> Doc ann-prettyOriginExpr = withoutParens . go+prettyOriginExpr = getDoc . go  where+  go :: NExprLocF (Maybe (NValue t f m)) -> NixDoc ann   go = exprFNixDoc . stripAnnF . fmap render    where     render :: Maybe (NValue t f m) -> NixDoc ann     render Nothing = simpleExpr "_"-    render (Just (Free (reverse . citations @m -> p:_))) = go (_originExpr p)+    render (Just (Free (reverse . citations @m -> p:_))) = go (getOriginExpr p)     render _       = simpleExpr "?"       -- render (Just (NValue (citations -> ps))) =-          -- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . withoutParens+          -- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . getDoc           --                           . go . originExpr)           --     mempty (reverse ps) -exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann+-- | Takes original expression from inside provenance information.+-- Prettifies that expression.+prettyExtractFromProvenance+  :: forall t f m ann+   . HasCitations1 m (NValue t f m) f+  => [Provenance m (NValue t f m)] -> Doc ann+prettyExtractFromProvenance =+  sep .+    fmap (prettyOriginExpr . getOriginExpr)++exprFNixDoc :: forall ann . NExprF (NixDoc ann) -> NixDoc ann exprFNixDoc = \case   NConstant atom -> prettyAtom atom   NStr      str  -> simpleExpr $ prettyString str   NList xs ->-    prettyContainer "[" (wrapParens appOpNonAssoc) "]" xs+    prettyContainer "[" (precedenceWrap appOpNonAssoc) "]" xs   NSet NonRecursive xs ->     prettyContainer "{" prettyBind "}" xs   NSet Recursive xs ->@@ -230,10 +253,10 @@       nest 2 $         vsep           [ prettyParams args <> ":"-          , withoutParens body+          , getDoc body           ]   NBinary NApp fun arg ->-    mkNixDoc appOp (wrapParens appOp fun <> " " <> wrapParens appOpNonAssoc arg)+    mkNixDoc appOp (precedenceWrap appOp fun <> " " <> precedenceWrap appOpNonAssoc arg)   NBinary op r1 r2 ->     mkNixDoc       opInfo $@@ -244,9 +267,9 @@         ]    where     opInfo = getBinaryOperator op-    f :: NAssoc -> NixDoc ann1 -> Doc ann1+    f :: NAssoc -> NixDoc ann -> Doc ann     f x =-      wrapParens+      precedenceWrap         $ bool             opInfo             (opInfo { associativity = NAssocNone })@@ -254,7 +277,7 @@   NUnary op r1 ->     mkNixDoc       opInfo $-      pretty (operatorName opInfo) <> wrapParens opInfo r1+      pretty (operatorName opInfo) <> precedenceWrap opInfo r1    where     opInfo = getUnaryOperator op   NSelect o r' attr ->@@ -262,13 +285,10 @@       (mkNixDoc selectOp)       (const leastPrecedence)       o-      $ wrapPath selectOp r <> "." <> prettySelector attr <> ordoc-   where-    r     = mkNixDoc selectOp (wrapParens appOpNonAssoc r')-    ordoc =-      ((" or " <>) . wrapParens appOpNonAssoc) `whenJust` o+      $ wrapPath selectOp (mkNixDoc selectOp (precedenceWrap appOpNonAssoc r')) <> "." <> prettySelector attr <>+        ((" or " <>) . precedenceWrap appOpNonAssoc) `whenJust` o   NHasAttr r attr ->-    mkNixDoc hasAttrOp (wrapParens hasAttrOp r <> " ? " <> prettySelector attr)+    mkNixDoc hasAttrOp (precedenceWrap hasAttrOp r <> " ? " <> prettySelector attr)   NEnvPath     p -> simpleExpr $ pretty @String $ "<" <> coerce p <> ">"   NLiteralPath p ->     pathExpr $@@ -277,29 +297,33 @@           "./"  -> "./."           "../" -> "../."           ".."  -> "../."-          _txt  ->+          path  ->             bool-              ("./" <> _txt)-              _txt-              (any (`isPrefixOf` coerce _txt) ["/", "~/", "./", "../"])+              ("./" <> path)+              path+              (any (`isPrefixOf` coerce path) ["/", "~/", "./", "../"])   NSym name -> simpleExpr $ prettyVarName name   NLet binds body ->     leastPrecedence $       group $         vsep           [ "let"-          , indent 2 (vsep (fmap prettyBind binds))-          , "in " <> withoutParens body+          , indent 2 (vsep $ fmap prettyBind binds)+          , "in " <> getDoc body           ]   NIf cond trueBody falseBody ->     leastPrecedence $       group $         nest 2 $-          sep-            [ "if " <> withoutParens cond-            , align ("then " <> withoutParens trueBody)-            , align ("else " <> withoutParens falseBody)-            ]+          ifThenElse getDoc+   where+    ifThenElse :: (NixDoc ann -> Doc ann) -> Doc ann+    ifThenElse wp =+      sep+        [ "if " <> wp cond+        , align ("then " <> wp trueBody)+        , align ("else " <> wp falseBody)+        ]   NWith scope body ->     prettyAddScope "with " scope body   NAssert cond body ->@@ -315,7 +339,7 @@   prettyAddScope h c b =     leastPrecedence $       vsep-        [h <> withoutParens c <> ";", align $ withoutParens b]+        [h <> getDoc c <> ";", align $ getDoc b]   valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr@@ -325,7 +349,7 @@    phi :: NValue' t f m NExpr -> NExprF NExpr   phi (NVConstant' a     ) = NConstant a-  phi (NVStr'      ns    ) = NStr $ DoubleQuoted $ one $ Plain $ stringIgnoreContext ns+  phi (NVStr'      ns    ) = NStr $ DoubleQuoted $ one $ Plain $ ignoreContext ns   phi (NVList'     l     ) = NList l   phi (NVSet'      p    s) = NSet mempty     [ NamedVar (one $ StaticKey k) v (fromMaybe nullPos $ (`M.lookup` p) k)@@ -339,29 +363,47 @@   :: forall t f m ann . MonadDataContext f m => NValue t f m -> Doc ann prettyNValue = prettyNix . valueToExpr -prettyNValueProv+-- | During the output, which can print only representation of value,+-- lazy thunks need to looked into & so - be evaluated (*sic)+-- This type is a simple manual witness "is the thunk gets shown".+data ValueOrigin = WasThunk | Value+ deriving Eq++prettyProv   :: forall t f m ann    . ( HasCitations m (NValue t f m) t      , HasCitations1 m (NValue t f m) f      , MonadThunk t m (NValue t f m)      , MonadDataContext f m      )-  => NValue t f m+  => ValueOrigin  -- ^ Was thunk?+  -> NValue t f m   -> Doc ann-prettyNValueProv v =+prettyProv wasThunk v =   list-    prettyNVal-    (\ ps ->+    id+    (\ ps pv ->       fillSep-        [ prettyNVal+        [ pv         , indent 2 $-          "(" <> fold (one "from: " <> (prettyOriginExpr . _originExpr <$> ps)) <> ")"+          "(" <> ("thunk " `whenTrue` (wasThunk == WasThunk) <> "from: " <> prettyExtractFromProvenance ps) <> ")"         ]     )     (citations @m @(NValue t f m) v)- where-  prettyNVal = prettyNValue v+    (prettyNValue v) +prettyNValueProv+  :: forall t f m ann+   . ( HasCitations m (NValue t f m) t+     , HasCitations1 m (NValue t f m) f+     , MonadThunk t m (NValue t f m)+     , MonadDataContext f m+     )+  => NValue t f m+  -> Doc ann+prettyNValueProv =+  prettyProv Value+ prettyNThunk   :: forall t f m ann    . ( HasCitations m (NValue t f m) t@@ -372,25 +414,16 @@   => t   -> m (Doc ann) prettyNThunk t =-  do-    let ps = citations @m @(NValue t f m) @t t-    v' <- prettyNValue <$> dethunk t-    pure $-      fillSep-        [ v'-        , indent 2 $-          "(" <> fold (one "thunk from: " <> (prettyOriginExpr . _originExpr <$> ps)) <> ")"-        ]+  prettyProv WasThunk <$> dethunk t  -- | This function is used only by the testing code. printNix :: forall t f m . MonadDataContext f m => NValue t f m -> Text-printNix = iterNValueByDiscardWith thk phi+printNix =+  iterNValueByDiscardWith thunkStubText phi  where-  thk = thunkStubText-   phi :: NValue' t f m Text -> Text   phi (NVConstant' a ) = atomText a-  phi (NVStr'      ns) = show $ stringIgnoreContext ns+  phi (NVStr'      ns) = "\"" <> escapeString (ignoreContext ns) <> "\""   phi (NVList'     l ) = "[ " <> unwords l <> " ]"   phi (NVSet' _ s) =     "{ " <>@@ -405,10 +438,8 @@         v         (tryRead @Int <|> tryRead @Float)      where-      surround s = "\"" <> s <> "\""-       tryRead :: forall a . (Read a, Show a) => Maybe Text-      tryRead = fmap (surround . show) (readMaybe (toString v) :: Maybe a)+      tryRead = fmap ((\ s -> "\"" <> s <> "\"") . show) $ readMaybe @a $ toString v   phi NVClosure'{}        = "<<lambda>>"   phi (NVPath' fp       ) = fromString $ coerce fp   phi (NVBuiltin' name _) = "<<builtin " <> coerce name <> ">>"

@@ -20,6 +20,7 @@   , reducingEvalExpr   ) where +import           Nix.Prelude import           Control.Monad.Catch            ( MonadCatch(catch) ) #if !MIN_VERSION_base(4,13,0) import           Prelude                 hiding ( fail )@@ -44,8 +45,9 @@ import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.Options                    ( Options-                                                , reduceSets-                                                , reduceLists+                                                , isReduceSets+                                                , isReduceLists+                                                , askOptions                                                 ) import           Nix.Parser import           Nix.Scope@@ -169,22 +171,24 @@ -- --     * Reduce a lambda function by adding its name to the local --       scope and recursively reducing its body.-reduce (NBinaryAnnF bann NApp fun arg) = fun >>= \case-  f@(NSymAnn _ "import") ->-    (\case-        -- NEnvPathAnn     pann origPath -> staticImport pann origPath-      NLiteralPathAnn pann origPath -> staticImport pann origPath-      v -> pure $ NBinaryAnn bann NApp f v-    ) =<< arg+reduce (NBinaryAnnF bann NApp fun arg) =+  (\case+    f@(NSymAnn _ "import") ->+      (\case+          -- NEnvPathAnn     pann origPath -> staticImport pann origPath+        NLiteralPathAnn pann origPath -> staticImport pann origPath+        v -> pure $ NBinaryAnn bann NApp f v+      ) =<< arg -  NAbsAnn _ (Param name) body ->-    do-      x <- arg-      pushScope-        (coerce $ HM.singleton name x)-        (foldFix reduce body)+    NAbsAnn _ (Param name) body ->+      do+        x <- arg+        pushScope+          (coerce $ HM.singleton name x)+          (foldFix reduce body) -  f -> NBinaryAnn bann NApp f <$> arg+    f -> NBinaryAnn bann NApp f <$> arg+  ) =<< fun  -- | Reduce an integer addition to its result. reduce (NBinaryAnnF bann op larg rarg) =@@ -368,13 +372,13 @@       bool         (fromMaybe annNNull <$>)         catMaybes-        (reduceLists opts)  -- Reduce list members that aren't used; breaks if elemAt is used+        (isReduceLists opts)  -- Reduce list members that aren't used; breaks if elemAt is used         l     NSet recur binds -> pure $ NSet recur $       bool         (fromMaybe annNNull <<$>>)         (mapMaybe sequenceA)-        (reduceSets opts)  -- Reduce set members that aren't used; breaks if hasAttr is used+        (isReduceSets opts)  -- Reduce set members that aren't used; breaks if hasAttr is used         binds      NLet binds (Just body@(Ann _ x)) ->@@ -450,7 +454,7 @@         bool           fmap           ((pure .) . maybe annNNull)-          (reduceSets opts)  -- Reduce set members that aren't used; breaks if hasAttr is used+          (isReduceSets opts)  -- Reduce set members that aren't used; breaks if hasAttr is used           (fromMaybe annNNull)    pruneBinding :: Binding (Maybe NExprLoc) -> Maybe (Binding NExprLoc)@@ -471,14 +475,14 @@     expr'           <- flagExprLoc =<< liftIO (reduceExpr mpath expr)     eres <- (`catch` pure . Left) $       pure <$> foldFix (addEvalFlags eval) expr'-    opts :: Options <- asks $ view hasLens+    opts <- askOptions     expr''          <- pruneTree opts expr'     pure (fromMaybe annNNull 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+  askScopes   = askScopesReader+  clearScopes = clearScopesReader @(Reducer m) @NExprLoc+  pushScopes  = pushScopesReader+  lookupVar   = lookupVarReader

@@ -9,6 +9,7 @@  module Nix.Render where +import           Nix.Prelude import qualified Data.Set                      as Set import           Nix.Utils.Fix1                 ( Fix1T                                                 , MonadFix1T@@ -24,7 +25,7 @@ class (MonadFail m, MonadIO m) => MonadFile m where     readFile :: Path -> m Text     default readFile :: (MonadTrans t, MonadIO m', MonadFile m', m ~ t m') => Path -> m Text-    readFile = liftIO . Prelude.readFile+    readFile = liftIO . Nix.Prelude.readFile     listDirectory :: Path -> m [Path]     default listDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m [Path]     listDirectory = lift . listDirectory@@ -51,7 +52,7 @@     getSymbolicLinkStatus = lift . getSymbolicLinkStatus  instance MonadFile IO where-  readFile              = Prelude.readFile+  readFile              = Nix.Prelude.readFile   listDirectory         = coerce S.listDirectory   getCurrentDirectory   = coerce S.getCurrentDirectory   canonicalizePath      = coerce S.canonicalizePath

@@ -9,7 +9,7 @@ -- | Code for rendering/representation of the messages packaged with their context (Frames). module Nix.Render.Frame where -import           Prelude             hiding ( Comparison )+import           Nix.Prelude         hiding ( Comparison ) import           GHC.Exception              ( ErrorCall ) import           Data.Fix                   ( Fix(..) ) import           Nix.Eval            hiding ( addMetaInfo )@@ -41,10 +41,10 @@ renderFrames []       = stub renderFrames xss@(x : xs) =   do-    opts :: Options <- asks $ view hasLens+    opts <- askOptions     let       verbosity :: Verbosity-      verbosity = verbose opts+      verbosity = getVerbosity opts     renderedFrames <- if         | verbosity <= ErrorsOnly -> render1 x       --  2021-10-22: NOTE: List reverse is completely conterproductive. `reverse` of list famously neest to traverse the whole list to take the last element@@ -104,7 +104,7 @@   -> m [Doc ann] renderEvalFrame level f =   do-    opts :: Options <- asks (view hasLens)+    opts <- askOptions     let       addMetaInfo :: ([Doc ann] -> [Doc ann]) -> SrcSpan -> Doc ann -> m [Doc ann]       addMetaInfo trans loc = fmap (trans . one) . renderLocation loc@@ -118,9 +118,9 @@          where           scopeInfo :: [Doc ann]           scopeInfo =-            one (pretty $ Text.show scope) `whenTrue` showScopes opts+            one (pretty $ Text.show scope) `whenTrue` isShowScopes opts -      ForcingExpr _scope e@(Ann loc _) | thunks opts ->+      ForcingExpr _scope e@(Ann loc _) | isThunks opts ->         addMetaInfo           id           loc@@ -130,7 +130,7 @@         addMetaInfo           id           loc-          $ "While calling builtins." <> pretty name+          $ "While calling `builtins." <> prettyVarName name <> "`"        SynHole synfo ->         sequenceA@@ -151,28 +151,29 @@   -> Text   -> NExprLoc   -> m (Doc ann)-renderExpr _level longLabel shortLabel e@(Ann _ x) = do-  opts :: Options <- asks (view hasLens)-  let-    lvl :: Verbosity-    lvl = verbose opts+renderExpr _level longLabel shortLabel e@(Ann _ x) =+  do+    opts <- askOptions+    let+      verbosity :: Verbosity+      verbosity = getVerbosity opts -    expr :: NExpr-    expr = stripAnnotation e+      expr :: NExpr+      expr = stripAnnotation e -    concise = prettyNix $ Fix $ Fix (NSym "<?>") <$ x+      concise = prettyNix $ Fix $ Fix (NSym "<?>") <$ x -    chatty =-      bool-        (pretty $ PS.ppShow expr)-        (prettyNix expr)-        (lvl == Chatty)+      chatty =+        bool+          (pretty $ PS.ppShow expr)+          (prettyNix expr)+          (verbosity == Chatty) -  pure $-    bool-      (pretty shortLabel <> fillSep [": ", concise])-      (vsep [pretty (longLabel <> ":\n>>>>>>>>"), indent 2 chatty, "<<<<<<<<"])-      (lvl >= Chatty)+    pure $+      bool+        (pretty shortLabel <> fillSep [": ", concise])+        (vsep [pretty (longLabel <> ":\n>>>>>>>>"), indent 2 chatty, "<<<<<<<<"])+        (verbosity >= Chatty)  renderValueFrame   :: forall e t f m ann@@ -214,13 +215,14 @@   -> Text   -> NValue t f m   -> m (Doc ann)-renderValue _level _longLabel _shortLabel v = do-  opts :: Options <- asks $ view hasLens-  bool-    prettyNValue-    prettyNValueProv-    (values opts)-    <$> removeEffects v+renderValue _level _longLabel _shortLabel v =+  do+    opts <- askOptions+    bool+      prettyNValue+      prettyNValueProv+      (isValues opts)+      <$> removeEffects v  dumbRenderValue   :: forall e t f m ann

@@ -1,3 +1,4 @@+{-# language UndecidableInstances #-} {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language FunctionalDependencies #-}@@ -5,6 +6,7 @@  module Nix.Scope where +import           Nix.Prelude import qualified Data.HashMap.Lazy             as M import qualified Text.Show import           Lens.Family2@@ -18,19 +20,20 @@     , Read, Hashable     , Semigroup, Monoid     , Functor, Foldable, Traversable+    , One     )  instance Show (Scope a) where   show (Scope m) = show $ M.keys m  scopeLookup :: VarName -> [Scope a] -> Maybe a-scopeLookup key = foldr go Nothing+scopeLookup key = foldr fun Nothing  where-  go+  fun     :: Scope a     -> Maybe a     -> Maybe a-  go (Scope m) rest = M.lookup key m <|> rest+  fun (Scope m) rest = M.lookup key m <|> rest  data Scopes m a =   Scopes@@ -52,18 +55,18 @@ emptyScopes = Scopes mempty mempty  class Scoped a m | m -> a where-  currentScopes :: m (Scopes m a)+  askScopes :: m (Scopes m a)   clearScopes   :: m r -> m r   pushScopes    :: Scopes m a -> m r -> m r   lookupVar     :: VarName -> m (Maybe a) -currentScopesReader+askScopesReader   :: forall m a e   . ( MonadReader e m     , Has e (Scopes m a)     )   => m (Scopes m a)-currentScopesReader = asks $ view hasLens+askScopesReader = askLocal  clearScopesReader   :: forall m a e r

@@ -8,6 +8,7 @@  module Nix.Standard where +import           Nix.Prelude import           Control.Comonad                ( Comonad ) import           Control.Comonad.Env            ( ComonadEnv ) import           Control.Monad.Catch            ( MonadThrow@@ -59,9 +60,12 @@ newtype StdThunk m =   StdThunk     (StdCited m (NThunkF m (StdValue m)))- type StdValue' m = NValue' (StdThunk m) (StdCited m) m (StdValue m) type StdValue m = NValue (StdThunk m) (StdCited m) m+type StandardIO = StandardT (StdIdT IO)+type StdVal = StdValue StandardIO+type StdThun = StdThunk StandardIO+type StdIO = StandardIO ()  -- | Type alias: --@@ -80,10 +84,10 @@   addProvenance x (StdThunk c) = StdThunk $ addProvenance1 x c  instance MonadReader (Context m (StdValue m)) m => Scoped (StdValue m) m where-  currentScopes = currentScopesReader-  clearScopes   = clearScopesReader @m @(StdValue m)-  pushScopes    = pushScopesReader-  lookupVar     = lookupVarReader+  askScopes   = askScopesReader+  clearScopes = clearScopesReader @m @(StdValue m)+  pushScopes  = pushScopesReader+  lookupVar   = lookupVarReader  instance   ( MonadFix m@@ -365,11 +369,10 @@   -> StandardT (StdIdT m) a   -> m a runWithBasicEffects opts =-  go . (`evalStateT` mempty) . (`runReaderT` newContext opts) . runStandardT+  fun . (`evalStateT` mempty) . (`runReaderT` newContext opts) . runStandardT  where-  go action = do-    i <- newRef (1 :: Int)-    runFreshIdT i action+  fun action =+    runFreshIdT action =<< newRef (1 :: Int) -runWithBasicEffectsIO :: Options -> StandardT (StdIdT IO) a -> IO a+runWithBasicEffectsIO :: Options -> StandardIO a -> IO a runWithBasicEffectsIO = runWithBasicEffects

@@ -2,7 +2,7 @@  module Nix.String   ( NixString-  , getContext+  , getStringContext   , mkNixString   , StringContext(..)   , ContextFlavor(..)@@ -10,10 +10,10 @@   , NixLikeContextValue(..)   , toNixLikeContext   , fromNixLikeContext-  , stringHasContext+  , hasContext   , intercalateNixString   , getStringNoContext-  , stringIgnoreContext+  , ignoreContext   , mkNixStringWithoutContext   , mkNixStringWithSingletonContext   , modifyNixContents@@ -32,6 +32,7 @@   +import           Nix.Prelude             hiding ( Type, TVar ) import           Control.Monad.Writer           ( WriterT(..), MonadWriter(tell)) import qualified Data.HashMap.Lazy             as M import qualified Data.HashSet                  as S@@ -45,12 +46,11 @@  -- ** Context ---  2021-07-18: NOTE: it should be ContextFlavor -> Varname. -- | A Nix 'StringContext' ... data StringContext =   StringContext-    { scPath :: !VarName-    , scFlavor :: !ContextFlavor+    { getStringContextFlavor :: !ContextFlavor+    , getStringContextPath   :: !VarName     }   deriving (Eq, Ord, Show, Generic) @@ -104,11 +104,10 @@  -- ** NixString ---  2021-07-18: NOTE: It should be Context -> Contents. data NixString =   NixString-    { nsContents :: !Text-    , nsContext :: !(S.HashSet StringContext)+    { getStringContext :: !(S.HashSet StringContext)+    , getStringContent :: !Text     }   deriving (Eq, Ord, Show, Generic) @@ -127,47 +126,45 @@  -- | Constructs NixString without a context mkNixStringWithoutContext :: Text -> NixString-mkNixStringWithoutContext = (`NixString` mempty)+mkNixStringWithoutContext = NixString mempty  -- | Create NixString using a singleton context mkNixStringWithSingletonContext-  :: VarName -> StringContext -> NixString-mkNixStringWithSingletonContext s c = NixString (coerce @VarName @Text s) $ one c+  :: StringContext -> VarName -> NixString+mkNixStringWithSingletonContext c s = NixString (one c) (coerce @VarName @Text s)  -- | Create NixString from a Text and context-mkNixString :: Text -> S.HashSet StringContext -> NixString+mkNixString+  :: S.HashSet StringContext -> Text -> NixString mkNixString = NixString   -- ** Checkers  -- | Returns True if the NixString has an associated context-stringHasContext :: NixString -> Bool-stringHasContext (NixString _ c) = not $ null c+hasContext :: NixString -> Bool+hasContext (NixString c _) = not $ null c   -- ** Getters -getContext :: NixString -> S.HashSet StringContext-getContext = nsContext- fromNixLikeContext :: NixLikeContext -> S.HashSet StringContext fromNixLikeContext =-  S.fromList . (toStringContexts <=< (M.toList . getNixLikeContext))+  S.fromList . (uncurry toStringContexts <=< M.toList . getNixLikeContext)  -- | Extract the string contents from a NixString that has no context getStringNoContext :: NixString -> Maybe Text-getStringNoContext (NixString s c)+getStringNoContext (NixString c s)   | null c    = pure s   | otherwise = mempty  -- | Extract the string contents from a NixString even if the NixString has an associated context-stringIgnoreContext :: NixString -> Text-stringIgnoreContext (NixString s _) = s+ignoreContext :: NixString -> Text+ignoreContext (NixString _ s) = s  -- | 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) =+extractNixString (NixString c s) =   WithStringContextT $     s <$ tell c @@ -176,11 +173,10 @@  -- this really should be 2 args, then with @toStringContexts path@ laziness it would tail recurse. -- for now tuple dissected internaly with laziness preservation.-toStringContexts :: (VarName, NixLikeContextValue) -> [StringContext]-toStringContexts ~(path, nlcv) =-  go nlcv+toStringContexts :: VarName -> NixLikeContextValue -> [StringContext]+toStringContexts path = go  where-+  go :: NixLikeContextValue -> [StringContext]   go cv =     case cv of       NixLikeContextValue True _    _ ->@@ -191,29 +187,32 @@         mkCtxFor . DerivationOutput <$> ls       _ -> mempty    where-    mkCtxFor = StringContext path-    mkLstCtxFor t c = mkCtxFor t : go c+    mkCtxFor :: ContextFlavor -> StringContext+    mkCtxFor context = StringContext context path+    mkLstCtxFor :: ContextFlavor -> NixLikeContextValue -> [StringContext]+    mkLstCtxFor t c = one (mkCtxFor t) <> go c -toNixLikeContextValue :: StringContext -> (VarName, NixLikeContextValue)++toNixLikeContextValue :: StringContext -> (NixLikeContextValue, VarName) toNixLikeContextValue sc =-  ( scPath sc-  , case scFlavor sc of+  ( case getStringContextFlavor sc of       DirectPath         -> NixLikeContextValue True False mempty       AllOutputs         -> NixLikeContextValue False True mempty       DerivationOutput t -> NixLikeContextValue False False $ one t+  , getStringContextPath sc   )  toNixLikeContext :: S.HashSet StringContext -> NixLikeContext toNixLikeContext stringContext =   NixLikeContext $     S.foldr-      go+      fun       mempty       stringContext  where-  go sc hm =-    let (t, nlcv) = toNixLikeContextValue sc in-    M.insertWith (<>) t nlcv hm+  fun :: (StringContext -> AttrSet NixLikeContextValue -> AttrSet NixLikeContextValue)+  fun sc hm =+    uncurry (M.insertWith (<>)) (swap $ toNixLikeContextValue sc) hm  -- | Add 'StringContext's into the resulting set. addStringContext@@ -227,7 +226,7 @@ -- | 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+  uncurry (flip NixString) <$> runWriterT m  -- | Run an action producing a string with a context and put those into a 'NixString'. runWithStringContext :: WithStringContextT Identity Text -> NixString@@ -238,7 +237,7 @@  -- | Modify the string part of the NixString, leaving the context unchanged modifyNixContents :: (Text -> Text) -> NixString -> NixString-modifyNixContents f (NixString s c) = NixString (f s) c+modifyNixContents f (NixString c s) = NixString c (f s)  -- | Run an action that manipulates nix strings, and collect the contexts encountered. -- Warning: this may be unsafe, depending on how you handle the resulting context list.@@ -255,15 +254,9 @@ intercalateNixString _   []   = mempty intercalateNixString _   [ns] = ns intercalateNixString sep nss  =-  uncurry NixString $ mapPair intertwine unpackNss- where--  intertwine =-    ( Text.intercalate (nsContents sep)-    , S.unions . (:)   (nsContext  sep)-    )--  unpackNss = (fnss nsContents, fnss nsContext)-   where-    fnss = (`fmap` nss) -- do once-+  uncurry NixString $+    mapPair+      (S.unions . (one (getStringContext  sep) <>) . (getStringContext <$>)+      , Text.intercalate (getStringContent sep) . (getStringContent <$>)+      )+      $ dup nss