Add principled 'fetchurl' + tests

Tests are masked until store work is done

src/Nix/Builtins.hs

@@ -91,6 +91,7 @@ import           Nix.Value
 import           Nix.XML
 import           System.FilePath
 import           System.Posix.Files (isRegularFile, isDirectory, isSymbolicLink)
+import           Text.Read
 import           Text.Regex.TDFA
 
 -- | Evaluate a nix expression in the default context
@@ -457,7 +458,7 @@ splitVersion s = case Text.uncons s of
       | h `elem` versionComponentSeparators -> splitVersion t
       | isDigit h ->
           let (digits, rest) = Text.span isDigit s
-          in VersionComponent_Number (read $ Text.unpack digits) : splitVersion rest
+          in VersionComponent_Number (fromMaybe (error $ "splitVersion: couldn't parse " <> show digits) $ readMaybe $ Text.unpack digits) : splitVersion rest
       | otherwise ->
           let (chars, rest) = Text.span (\c -> not $ isDigit c || c `elem` versionComponentSeparators) s
               thisComponent = case chars of
@@ -1092,11 +1093,16 @@ fetchurl v = v >>= \case
  where
     go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
     go _msha = \case
-        NVStr ns -> getURL (hackyStringIgnoreContext ns) >>= \case -- msha
+        NVStr ns -> noContextAttrs ns >>= getURL >>= \case -- msha
             Left e -> throwError e
             Right p -> toValue p
         v -> throwError $ ErrorCall $
-                 "builtins.fetchurl: Expected URI or string, got " ++ show v
+          "builtins.fetchurl: Expected URI or string, got " ++ show v
+
+    noContextAttrs ns = case principledGetStringNoContext ns of
+      Nothing -> throwError $ ErrorCall $
+        "builtins.fetchurl: unsupported arguments to url"
+      Just t -> pure t
 
 partition_ :: forall e m. MonadNix e m
            => m (NValue m) -> m (NValue m) -> m (NValue m)

src/Nix/Eval.hs

@@ -341,26 +341,25 @@ buildArgument params arg = do
                         Nothing -> id
                         Just n -> M.insert n $ const $
                             thunk (withScopes scope arg)
-                loebM (inject $ alignWithKey (assemble scope isVariadic)
+                loebM (inject $ M.mapMaybe id $ alignWithKey (assemble scope isVariadic)
                                              args (M.fromList s))
   where
     assemble :: Scopes m t
              -> Bool
              -> Text
              -> These t (Maybe (m v))
-             -> AttrSet t
-             -> m t
+             -> Maybe (AttrSet t -> m t)
     assemble scope isVariadic k = \case
-        That Nothing  ->
+        That Nothing  -> Just $
             const $ evalError @v $ ErrorCall $
                 "Missing value for parameter: " ++ show k
-        That (Just f) -> \args ->
+        That (Just f) -> Just $ \args ->
             thunk $ withScopes scope $ pushScope args f
-        This x | isVariadic -> const (pure x)
-               | otherwise  ->
+        This _ | isVariadic -> Nothing
+               | otherwise  -> Just $
                  const $ evalError @v $ ErrorCall $
                      "Unexpected parameter: " ++ show k
-        These x _ -> const (pure x)
+        These x _ -> Just (const (pure x))
 
 addSourcePositions :: (MonadReader e m, Has e SrcSpan)
                    => Transform NExprLocF (m a)

src/Nix/Exec.hs

@@ -591,19 +591,20 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
         mapMaybeM op = foldr f (return [])
           where f x xs = op x >>= (<$> xs) . (++) . maybeToList
 
-        --handleEntry :: Bool -> (Text, NThunk (Lazy m)) -> Lazy m (Maybe (Text, NThunk (Lazy m)))
+        handleEntry :: Bool -> (Text, NThunk (Lazy m)) -> Lazy m (Maybe (Text, NThunk (Lazy m)))
         handleEntry ignoreNulls (k, v) = fmap (k,) <$> case k of
             -- The `args' attribute is special: it supplies the command-line
             -- arguments to the builder.
             -- TODO This use of coerceToString is probably not right and may
             -- not have the right arguments.
-            "args"          -> force v (\v2 -> Just <$> coerceNix v2)
+            "args"          -> force v $ fmap Just . coerceNixList
             "__ignoreNulls" -> pure Nothing
             _ -> force v $ \case
                 NVConstant NNull | ignoreNulls -> pure Nothing
                 v' -> Just <$> coerceNix v'
           where
             coerceNix = toNix <=< coerceToString CopyToStore CoerceAny
+            coerceNixList = toNix <=< traverse (\x -> force x coerceNix) <=< fromValue @[NThunk (Lazy m)]
 
     traceEffect = putStrLn
 

src/Nix/Json.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Nix.Json where
@@ -7,6 +8,7 @@ import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Encoding as A
+import qualified Data.HashMap.Lazy as HM
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TL
@@ -34,8 +36,9 @@ nvalueToJSON = \case
   NVStr ns  -> A.toJSON <$> extractNixString ns
   NVList l  ->
     A.Array . V.fromList <$> traverse (join . lift . flip force (return . nvalueToJSON)) l
-  NVSet m _ ->
-    A.Object <$> traverse (join . lift . flip force (return . nvalueToJSON)) m
+  NVSet m _ -> case HM.lookup "outPath" m of
+    Nothing -> A.Object <$> traverse (join . lift . flip force (return . nvalueToJSON)) m
+    Just outPath -> join $ lift $ force outPath (return . nvalueToJSON)
   NVPath p  -> do
     fp <- lift $ unStorePath <$> addPath p
     addSingletonStringContext $ StringContext (Text.pack fp) DirectPath

src/Nix/Thunk.hs

@@ -32,7 +32,6 @@ import Data.Typeable
 import Unsafe.Coerce
 
 #if ENABLE_TRACING
-import Data.IORef
 import System.IO.Unsafe
 import Nix.Utils
 

tests/EvalTests.hs

@@ -13,6 +13,7 @@ import           Control.Monad.Catch
 import           Control.Monad (when)
 import           Control.Monad.IO.Class
 import qualified Data.HashMap.Lazy as M
+import           Data.List ((\\))
 import           Data.Maybe (isJust)
 import           Data.String.Interpolate.IsString
 import qualified Data.Set as S
@@ -41,7 +42,7 @@ case_zero_div = do
   assertNixEvalThrows "builtins.div 1.0 0.0"
 
 case_bit_ops = do
-    -- mic92 (2018-08-20): change to constantEqualText, 
+    -- mic92 (2018-08-20): change to constantEqualText,
     -- when hnix's nix fork supports bitAnd/bitOr/bitXor
     constantEqualText' "0" "builtins.bitAnd 1 0"
     constantEqualText' "1" "builtins.bitOr 1 1"
@@ -379,11 +380,15 @@ tests :: TestTree
 tests = $testGroupGenerator
 
 genEvalCompareTests = do
-    files <- filter ((==".nix") . takeExtension) <$> D.listDirectory testDir
-    return $ testGroup "Eval comparison tests" $ map mkTestCase files
+    td <- D.listDirectory testDir
+
+    let unmaskedFiles = filter ((==".nix") . takeExtension) td
+    let files = unmaskedFiles \\ maskedFiles
+
+    return $ testGroup "Eval comparison tests" $ map (mkTestCase testDir) files
   where
-    testDir = "tests/eval-compare"
-    mkTestCase f = testCase f $ assertEvalFileMatchesNix (testDir </> f)
+    mkTestCase td f = testCase f $ assertEvalFileMatchesNix (td </> f)
+
 
 instance (Show r, Show (NValueF m r), Eq r) => Eq (NValueF m r) where
     NVConstantF x == NVConstantF y = x == y
@@ -439,3 +444,10 @@ freeVarsEqual a xs = do
       xs' = S.fromList xs
       free = freeVars a'
   assertEqual "" xs' free
+
+maskedFiles :: [FilePath]
+maskedFiles =
+  [ "builtins.fetchurl-01.nix" ]
+
+testDir :: FilePath
+testDir = "tests/eval-compare"

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

@@ -0,0 +1,5 @@
+with builtins;
+
+let a = fetchurl "https://haskell.org";
+
+in [ a (hasContext a) ]

tests/eval-compare/ellipsis.nix

@@ -0,0 +1,3 @@
+let x = 1;
+    f = { ... }: x;
+in f { x = 2; }