Merge branch 'master' into vs-context-primops

.gitignore

@@ -10,4 +10,5 @@ TAGS
 cabal.project*
 ctags
 dist-newstyle
-result
+result*
+.ghc.environment.*

.travis.yml

@@ -16,7 +16,6 @@ env:
 
   matrix:
     - GHCVERSION=ghc863 STRICT=false TRACING=false
-    - GHCVERSION=ghc863 STRICT=false TRACING=true
 #     - GHCVERSION=ghcjs
 # 
 # matrix:

default.nix

@@ -39,8 +39,8 @@ let
   hnix-store-src = pkgs.fetchFromGitHub {
     owner = "haskell-nix";
     repo = "hnix-store";
-    rev = "0fe7ff5e8492ce6141d0eb400685516b4d07594b";
-    sha256 = "1izqp4ma6bkvdjcxhkasjcv1p11l72hdnm4dqmnnpkbmw70xrp36";
+    rev = "8cc6595803872b7effc4cbf97aec0b8723068212";
+    sha256 = "1scm72bxn4wx9r00m0l4h4kanlgq9fw5z1nfzi11d973b5pf1nf3";
   };
 
   overlay = pkgs.lib.foldr pkgs.lib.composeExtensions (_: _: {}) [

release.nix

@@ -1,7 +1,10 @@
 {}:
 let matrix = [
-      { compiler = "ghc843"; doStrict = false; doTracing = false; }
-      { compiler = "ghc843"; doStrict = false; doTracing = true;  }
+      { compiler = "ghc863"; doStrict = false; doTracing = false; }
+      { compiler = "ghc863"; doStrict = false; doTracing = true;  }
+
+      { compiler = "ghc844"; doStrict = false; doTracing = false; }
+      { compiler = "ghc844"; doStrict = false; doTracing = true;  }
 
       # Broken
       # { compiler = "ghc802"; doStrict = false; doTracing = false; }

src/Nix/Builtins.hs

@@ -599,7 +599,7 @@ mapAttrs_ fun xs = fun >>= \f ->
         values <- for pairs $ \(key, value) ->
             thunk $
             withFrame Debug (ErrorCall "While applying f in mapAttrs:\n") $
-            callFunc ?? force' value =<< callFunc f (pure (nvStr (hackyMakeNixStringWithoutContext key)))
+            callFunc ?? force' value =<< callFunc f (pure (nvStr (principledMakeNixStringWithoutContext key)))
         toNix . M.fromList . zip (map fst pairs) $ values
 
 filter_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
@@ -897,7 +897,7 @@ lessThan ta tb = ta >>= \va -> tb >>= \vb -> do
             (NInt   a, NFloat b) -> pure $ fromInteger a < b
             (NFloat a, NFloat b) -> pure $ a < b
             _ -> badType
-        (NVStr a, NVStr b) -> pure $ hackyStringIgnoreContext a < hackyStringIgnoreContext b
+        (NVStr a, NVStr b) -> pure $ principledStringIgnoreContext a < principledStringIgnoreContext b
         _ -> badType
 
 concatLists :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)

src/Nix/Render.hs

@@ -21,7 +21,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Data.Text.Prettyprint.Doc
 import           Data.Void
-import           Debug.Trace
 import           Nix.Expr.Types.Annotated
 import qualified System.Directory as S
 import qualified System.Posix.Files as S
@@ -95,17 +94,22 @@ errorContext path bl bc _el _ec =
     pretty path <> ":" <> pretty (unPos bl) <> ":" <> pretty (unPos bc)
 
 sourceContext :: MonadFile m => FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
-sourceContext path (unPos -> begLine) (unPos -> begCol)
-                   (unPos -> endLine) (unPos -> endCol) msg = do
-    traceM $ "Taking lines from " ++ path
-    traceM $ "begLine = " ++ show begLine
-    traceM $ "begCol  = " ++ show begCol
-    traceM $ "endLine = " ++ show endLine
-    traceM $ "endCol  = " ++ show endCol
-    traceM $ "msg     = " ++ show msg
-    ls <- take (endLine - begLine)
-        . drop (pred begLine)
+sourceContext path (unPos -> begLine) (unPos -> _begCol)
+                   (unPos -> endLine) (unPos -> _endCol) msg = do
+    let beg' = min begLine (begLine - 3)
+        end' = max endLine (endLine + 3)
+    ls <- map pretty
+        . take (end' - beg')
+        . drop (pred beg')
         . T.lines
         . T.decodeUtf8
         <$> readFile path
-    pure $ vsep $ map pretty ls
+    let nums    = map (show . fst) $ zip [beg'..] ls
+        longest = maximum (map length nums)
+        nums'   = flip map nums $ \n ->
+            replicate (longest - length n) ' ' ++ n
+        pad n | read n == begLine = "==> " ++ n
+              | otherwise = "    " ++ n
+        ls' = zipWith (<+>) (map (pretty . pad) nums')
+                  (zipWith (<+>) (repeat "| ") ls)
+    pure $ vsep $ ls' ++ [msg]

tests/EvalTests.hs

@@ -335,7 +335,7 @@ case_function_equals5 =
     constantEqualText "true" "(let a = [(x: x)]; in a == a)"
 
 case_directory_pathexists =
-    constantEqualText "false" "builtins.pathExists \"/bin/sh/invalid-directory\""
+    constantEqualText "false" "builtins.pathExists \"/var/empty/invalid-directory\""
 
 -- jww (2018-05-02): This constantly changes!
 -- case_placeholder =

tests/eval-compare/builtins.lessThan-01.nix

@@ -0,0 +1,44 @@
+with builtins;
+
+let numTestPrecisionA = 4.000000000000000000001;
+    numTestPrecisionB = 4;
+    numTest3 = -4.1;
+    numTest4 = -4;
+    numTestZeroA = 0;
+    numTestZeroB = -0;
+    numTestMaxBoundA = 999999999999999999;
+    numTestMaxBoundB = 999999999999999998;
+    numTestMinBoundA = -999999999999999999;
+    numTestMinBoundB = -999999999999999998;
+    stringTest1 = "abcd";
+    stringTest2 = "abce";
+    stringTestBase1 = "foo" + "/" + stringTest1;
+    stringTestBase2 = "foo" + "/" + stringTest2;
+    stringTestJSONA = toJSON stringTest1;
+    stringTestJSONB = toJSON stringTest2;
+    stringTestToFileA = toFile "stringTest1" stringTest1;
+    stringTestToFileB = toFile "stringTest2" stringTest2;
+in [(lessThan numTestPrecisionA numTestPrecisionB)
+    (lessThan numTestPrecisionB numTestPrecisionA)
+    (lessThan numTest3 numTest4)
+    (lessThan numTest4 numTest3)
+    (lessThan numTestZeroA numTestZeroB)
+    (lessThan numTestZeroB numTestZeroA)
+    (lessThan numTestMaxBoundA numTestMaxBoundB)
+    (lessThan numTestMaxBoundB numTestMaxBoundA)
+    (lessThan numTestMinBoundA numTestMinBoundB)
+    (lessThan numTestMinBoundB numTestMinBoundA)
+    (lessThan stringTest1 stringTest2)
+    (lessThan stringTest2 stringTest1)
+    (lessThan stringTestJSONA stringTestJSONB)
+    (lessThan stringTestJSONB stringTestJSONA)
+    (lessThan stringTest1 stringTestJSONB)
+    (lessThan stringTestJSONB stringTest1)
+    (lessThan stringTest2 stringTestJSONA)
+    (lessThan stringTestJSONA stringTest2)
+    (lessThan stringTest1 stringTestToFileB)
+    (lessThan stringTestToFileB stringTest1)
+    (lessThan stringTestToFileA stringTest2)
+    (lessThan stringTest1 (baseNameOf stringTestBase1))
+    (lessThan stringTest2 (baseNameOf stringTestBase2))
+  ]

tests/eval-compare/builtins.mapAttrs-01.nix

@@ -0,0 +1,20 @@
+with builtins;
+
+let fooset = { foo = 123; bar = 456; };
+    lolset = { "foo/bar" = "lol"; "bar/baz" = "wat";};
+    emptyset = {};
+in [ (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key) fooset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key) lolset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key) emptyset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toString value) fooset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toString value) lolset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toString value) emptyset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON value) fooset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON value) lolset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON value) emptyset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON (toString value)) fooset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON (toString value)) lolset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + toJSON (toString value)) emptyset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + value) lolset)))
+     (all (x: hasContext(x)) (attrValues (mapAttrs (key: value: key + value) emptyset)))
+  ]

tests/eval-compare/builtins.pathExists.nix

@@ -0,0 +1 @@
+builtins.pathExists "/var/empty/invalid-directory"