Expr: Types: Binding(Inherit): NKeyName -> VarName

Thread: #377 (comment) `inherit x y` in y` position always takes a variable name. Nix allows `inherit x "y"`, but there is no use (in the wild real life use) for it, it seems a misfeature and would be considered a quirk of the original type system/implementation, until the use case of it would be clear (which is hard, since there is a single use of it in Nixpkgs, which is mentioned in the thread).
haskell-nix · Jul 21, 2021 · 194cd19 · 194cd19
1 parent f81830b
commit 194cd19
Show file tree

Hide file tree

Showing 10 changed files with 45 additions and 52 deletions.
diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs
@@ -369,36 +369,27 @@ evalBinds recursive binds =
         =<< evalSetterKeyName h
 
   applyBindToAdt scopes (Inherit ms names pos) =
-    catMaybes <$>
-      traverse
-        processScope
-        names
+    pure $ processScope <$> names
    where
     processScope
-      :: NKeyName (m v)
-      -> m (Maybe ([VarName], SourcePos, m v))
-    processScope nkeyname =
-      (\ mkey ->
-        do
-          key <- mkey
-          pure
-            ([key]
-            , pos
-            , maybe
-                (attrMissing (key :| mempty) Nothing)
-                demand
-                =<< maybe
-                    (withScopes scopes $ lookupVar key)
-                    (\ s ->
-                      do
-                        (coerce -> scope, _) <- fromValue @(AttrSet v, PositionSet) =<< s
-
-                        clearScopes @v $ pushScope scope $ lookupVar key
-                    )
-                    ms
-            )
-      ) <$>
-        evalSetterKeyName nkeyname
+      :: VarName
+      -> ([VarName], SourcePos, m v)
+    processScope var =
+      ([var]
+      , pos
+      , maybe
+          (attrMissing (var :| mempty) Nothing)
+          demand
+          =<< maybe
+              (withScopes scopes $ lookupVar var)
+              (\ s ->
+                do
+                  (coerce -> scope, _) <- fromValue @(AttrSet v, PositionSet) =<< s
+
+                  clearScopes @v $ pushScope scope $ lookupVar var
+              )
+              ms
+      )
 
   moveOverridesLast = uncurry (<>) . partition
     (\case

diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
@@ -267,7 +267,7 @@ mkSynHoleF = NSynHole . coerce
 -- | @inheritFrom x [a, b]@ | @inherit (x) a b;@ | @a = x.a;@ |
 -- |                        |                    | @b = x.b;@ |
 -- +------------------------+--------------------+------------+
-inheritFrom :: e -> [NKeyName e] -> Binding e
+inheritFrom :: e -> [VarName] -> Binding e
 inheritFrom expr ks = Inherit (pure expr) ks nullPos
 
 -- | An `inherit` clause without an expression to pull from.
@@ -278,7 +278,7 @@ inheritFrom expr ks = Inherit (pure expr) ks nullPos
 -- | @inheritFrom [a, b]@ | @inherit a b;@ | @a = outside.a;@ |
 -- |                      |                | @b = outside.b;@ |
 -- +----------------------+----------------+------------------+
-inherit :: [NKeyName e] -> Binding e
+inherit :: [VarName] -> Binding e
 inherit ks = Inherit Nothing ks nullPos
 
 -- | Nix @=@ (bind operator).

diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs
@@ -393,7 +393,7 @@ data Binding r
   -- ^ An explicit naming.
   --
   -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z SourcePos{}  ~  x.y = z;
-  | Inherit !(Maybe r) ![NKeyName r] !SourcePos
+  | Inherit !(Maybe r) ![VarName] !SourcePos
   -- ^ Inheriting an attribute (binding) into the attribute set from the other scope (attribute set). No denoted scope means to inherit from the closest outside scope.
   --
   -- +---------------------------------------------------------------+--------------------+-----------------------+

diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs
@@ -450,7 +450,7 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
       p <- getSourcePos
       x <- whiteSpace *> optional scope
       liftA2 (Inherit x)
-        (many keyName)
+        (many identifier)
         (pure p)
         <?> "inherited binding"
   namedVar =

diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs
@@ -164,7 +164,7 @@ prettyBind :: Binding (NixDoc ann) -> Doc ann
 prettyBind (NamedVar n v _p) =
   prettySelector n <> " = " <> withoutParens v <> ";"
 prettyBind (Inherit s ns _p) =
-  "inherit " <> scope <> align (fillSep $ prettyKeyName <$> ns) <> ";"
+  "inherit " <> scope <> align (fillSep $ prettyVarName <$> ns) <> ";"
   where
     scope =
       maybe

diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
@@ -453,7 +453,7 @@ pruneTree opts =
   pruneBinding (NamedVar xs                (Just x) pos) = pure $ NamedVar (pruneKeyName <$> xs) x pos
   pruneBinding (Inherit  _                 []       _  ) = Nothing
   pruneBinding (Inherit  (join -> Nothing) _        _  ) = Nothing
-  pruneBinding (Inherit  (join -> m)       xs       pos) = pure $ Inherit m (pruneKeyName <$> xs) pos
+  pruneBinding (Inherit  (join -> m)       xs       pos) = pure $ Inherit m xs pos
 
 reducingEvalExpr
   :: (Framed e m, Has e Options, Exception r, MonadCatch m, MonadIO m)

diff --git a/src/Nix/TH.hs b/src/Nix/TH.hs
@@ -104,22 +104,18 @@ freeVars e = case unFix e of
    where
     bind1Def :: Binding r -> Set VarName
     bind1Def (Inherit   Nothing                  _    _) = mempty
-    bind1Def (Inherit  (Just _                 ) keys _) = Set.fromList $ mapMaybe staticKey keys
+    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 $ mapMaybe staticKey keys
+    bind1Free (Inherit  Nothing     keys _) = Set.fromList keys
     bind1Free (Inherit (Just scope) _    _) = freeVars scope
     bind1Free (NamedVar path        expr _) = pathFree path <> freeVars expr
 
-  staticKey :: NKeyName r -> Maybe VarName
-  staticKey (StaticKey  varname) = pure varname
-  staticKey (DynamicKey _      ) = Nothing
-
   pathFree :: NAttrPath NExpr -> Set VarName
   pathFree = foldMap mapFreeVars
 

diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs
@@ -66,12 +66,19 @@ newFailingTests = Set.fromList
   , "eval-okay-fromTOML"
   ]
 
+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"
+  ]
+
 genTests :: IO TestTree
 genTests = do
   testFiles <-
     sort
     -- Disabling the not yet done tests cases.
-    . filter ((`Set.notMember` newFailingTests) . takeBaseName)
+    . filter ((`Set.notMember` (newFailingTests `Set.union` deprecatedRareNixQuirkTests)) . takeBaseName)
     . filter ((/= ".xml") . takeExtension)
     <$> globDir1 (compile "*-*-*.*") "data/nix/tests/lang"
   let

diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs
@@ -185,7 +185,7 @@ case_set_inherit =
   checks
     ( mkNonRecSet
         [ "e" $= mkInt 3
-        , inherit (StaticKey <$> ["a", "b"])
+        , inherit ["a", "b"]
         ]
     , "{ e = 3; inherit a b; }"
     )
@@ -197,7 +197,7 @@ case_set_scoped_inherit =
   checks
     ( mkNonRecSet $
         (\ x -> [x, "e" $= mkInt 4, x]) $
-          inheritFrom (var "a") (StaticKey <$> ["b", "c"])
+          inheritFrom (var "a") ["b", "c"]
     , "{ inherit (a) b c; e = 4; inherit(a)b c; }"
     )
 
@@ -207,15 +207,14 @@ case_set_inherit_direct =
     , "{ inherit ({a = 3;}); }"
     )
 
-case_inherit_selector =
-  checks
-    ( mkNonRecSet [inherit [DynamicKey (Plain (DoubleQuoted [Plain "a"]))]]
-    , "{ inherit \"a\"; }"
-    )
-
 case_inherit_selector_syntax_mistakes =
   mistakes
     "{ inherit a.x; }"
+    ( -- A rare quirk of Nix that is proper to fix then to support (see git commit history)
+      -- (old parser test result was):
+      -- mkNonRecSet [inherit [DynamicKey (Plain (DoubleQuoted [Plain "a"]))]],
+      "{ inherit \"a\"; }"
+    )
 
 
 -- ** Lists
@@ -356,7 +355,7 @@ case_let_scoped_inherit =
   checks
     ( mkLets
         [ "a" $= mkNull
-        , inheritFrom (var "b") [StaticKey "c"]
+        , inheritFrom (var "b") $ one "c"
         ]
         $ var "c"
     , "let a = null; inherit (b) c; in c"

diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs
@@ -58,7 +58,7 @@ genBinding = Gen.choice
       genSourcePos
   , liftA3 Inherit
       (Gen.maybe genExpr)
-      (Gen.list (Range.linear 0 5) genKeyName)
+      (Gen.list (Range.linear 0 5) (coerce <$> asciiText))
       genSourcePos
   ]
 
@@ -170,7 +170,7 @@ normalize = foldFix $ \case
 
  where
   normBinding (NamedVar path r     pos) = NamedVar (normKey <$> path) r pos
-  normBinding (Inherit  mr   names pos) = Inherit mr (normKey <$> names) pos
+  normBinding (Inherit  mr   names pos) = Inherit mr names pos
 
   normKey (DynamicKey quoted) = DynamicKey (normAntiquotedString quoted)
   normKey (StaticKey  name  ) = StaticKey name