From 5304ea0dec0135d83f28055e398b3744b7aa1b46 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Tue, 18 Jan 2022 01:46:10 +0200
Subject: [PATCH] Builtins: add path

Courtesy of `layus`, ported from implementation in
https://github.com/haskell-nix/hnix/pull/755.
---
 src/Nix/Builtins.hs       | 46 ++++++++++++++++++++++++++++++++++++++-
 tests/NixLanguageTests.hs |  5 ++---
 2 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs
index 7a707ef1b..845222333 100644
--- a/src/Nix/Builtins.hs
+++ b/src/Nix/Builtins.hs
@@ -885,6 +885,50 @@ builtinsBuiltinNix
   => m (NValue t f m)
 builtinsBuiltinNix = throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred"
 
+attrGetOr'
+  :: forall e t f m v a
+   . (MonadNix e t f m, FromValue v m (NValue t f m))
+  => AttrSet (NValue t f m)
+  -> VarName
+  -> m a
+  -> (v -> m a)
+  -> m a
+attrGetOr' attrs n d f =
+  maybe
+    d
+    (f <=< fromValue)
+    (M.lookup n attrs)
+
+attrGetOr
+  :: forall e t f m v a
+   . (MonadNix e t f m, FromValue v m (NValue t f m))
+  => AttrSet (NValue t f m)
+  -> VarName
+  -> a
+  -> (v -> m a)
+  -> m a
+attrGetOr attrs name fallback = attrGetOr' attrs name (pure fallback)
+
+--  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`
+path :: forall e t f m. MonadNix e t f m => NValue t f m -> m (NValue t f m)
+path 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 attrs "name"      (takeFileName path) (fmap (coerce . toString) . fromStringNoContext)
+    recursive <- attrGetOr attrs "recursive" True          pure
+
+    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
@@ -1899,7 +1943,7 @@ builtinsList =
     , add0 Normal   "null"             (pure nvNull)
     , add  Normal   "parseDrvName"     parseDrvNameNix
     , add2 Normal   "partition"        partitionNix
-    --, add  Normal   "path"             path
+    , add  Normal   "path"             path
     , add  Normal   "pathExists"       pathExistsNix
     , add  Normal   "readDir"          readDirNix
     , add  Normal   "readFile"         readFileNix
diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs
index 6890dc3ed..6295317e3 100644
--- a/tests/NixLanguageTests.hs
+++ b/tests/NixLanguageTests.hs
@@ -56,8 +56,7 @@ groupBy key = Map.fromListWith (<>) . fmap (key &&& pure)
 -- previously passed.
 newFailingTests :: Set String
 newFailingTests = Set.fromList
-  [ "eval-okay-path"  -- #128
-  , "eval-okay-fromTOML"
+  [ "eval-okay-fromTOML"
   , "eval-okay-zipAttrsWith"
   , "eval-okay-tojson"
   , "eval-okay-search-path"
@@ -75,7 +74,7 @@ deprecatedRareNixQuirkTests :: Set String
 deprecatedRareNixQuirkTests = Set.fromList
   [ -- A rare quirk of Nix that is proper to fix&enforce then to support (see git commit history)
     "eval-okay-strings-as-attrs-names"
-    -- Nix upstream removed this test alltogather
+    -- Nix upstream removed this test altogether
   , "eval-okay-hash"
   ]