WIP

M src/Nix/Expr/Shorthands.hs M tests/ParserTests.hs
haskell-nix · Jul 10, 2021 · 2437414 · 2437414
1 parent adc62c9
commit 2437414
Show file tree

Hide file tree

Showing 2 changed files with 56 additions and 75 deletions.
diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs
@@ -299,16 +299,16 @@ recAttrsE pairs = mkRecSet $ uncurry ($=) <$> pairs
 --  2021-07-10: NOTE: Probably the presedence of some operators is still needs to be tweaked.
 
 -- | Dot-reference into an attribute set: @attrSet.k@
-(@.) :: NExpr -> Text -> NExpr
-(@.) obj name = getRefOrDefault obj name Nothing
-infix 9 @.
+($.) :: NExpr -> Text -> NExpr
+($.) obj name = getRefOrDefault obj name Nothing
+infix 9 $.
 
 -- | Dot-reference into an attribute set with alternative if the key does not exist.
 --
 -- > s.x or y
-(@./) :: NExpr -> VarName -> NExpr -> NExpr
-(@./) obj name alt = getRefOrDefault obj name $ pure alt
-infix 9 @./
+($./) :: NExpr -> VarName -> NExpr -> NExpr
+($./) obj name alt = getRefOrDefault obj name $ pure alt
+infix 9 $./
 
 -- | Function application (@' '@ in @f x@)
 (@@) = mkOp2 NApp

diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs
@@ -25,6 +25,13 @@ import Test.Tasty.TH
 
 var = mkSym
 
+static = staticFor var
+
+staticFor :: (Text -> NExpr) -> Text -> Assertion
+staticFor f v =
+  (<=>) v $
+    f v
+
 -- * Tests
 
 case_constant_int =
@@ -38,47 +45,36 @@ case_constant_bool = do
     mkBool False
 
 case_constant_bool_respects_attributes = do
-  (<=>) "true-foo"  $
-    var "true-foo"
-  (<=>) "false-bar" $
-    var "false-bar"
+  static "true-foo"
+  static "false-bar"
 
 case_constant_path = do
-  (<=>) "./." $
-    mkRelPath "./."
-  (<=>) "./+-_/cdef/09ad+-" $
-    mkRelPath "./+-_/cdef/09ad+-"
-  (<=>) "/abc" $
-    mkRelPath "/abc"
-  (<=>) "../abc" $
-    mkRelPath "../abc"
+  staticFor (mkRelPath . toString) "./."
+  staticFor (mkRelPath . toString) "./+-_/cdef/09ad+-"
+  staticFor (mkRelPath . toString) "/abc"
+  staticFor (mkRelPath . toString) "../abc"
+  staticFor (mkRelPath . toString) "~/a"
+  staticFor (mkRelPath . toString) "~/a/b"
+  staticFor (mkRelPath . toString) "a/b"
+  staticFor (mkRelPath . toString) "4/2"
+  staticFor (mkRelPath . toString) "rec+def/cdef"
+  (<=>) "a'b/c" $
+    var "a'b" @@ mkRelPath "/c"
+  (<=>) "a/b//c/def//<g> < def/d" $
+    mkRelPath "a/b" $// mkRelPath "c/def" $// mkEnvPath "g" $<  mkRelPath "def/d"
   (<=>) "<abc>" $
     mkEnvPath "abc"
   (<=>) "<../cdef>" $
     mkEnvPath "../cdef"
   (<=>) "a//b" $
     var "a" $// var "b"
-  (<=>) "rec+def/cdef" $
-    mkRelPath "rec+def/cdef"
-  (<=>) "a/b//c/def//<g> < def/d" $
-    mkRelPath "a/b" $// mkRelPath "c/def" $// mkEnvPath "g" $<  mkRelPath "def/d"
-  (<=>) "a'b/c" $
-    var "a'b" @@ mkRelPath "/c"
-  (<=>) "a/b" $
-    mkRelPath "a/b"
-  (<=>) "4/2" $
-    mkRelPath "4/2"
   assertParseFail "."
   assertParseFail ".."
   assertParseFail "/"
   assertParseFail "a/"
   assertParseFail "a/def/"
   assertParseFail "~"
   assertParseFail "~/"
-  (<=>) "~/a" $
-    mkRelPath "~/a"
-  (<=>) "~/a/b" $
-    mkRelPath "~/a/b"
 
 case_constant_uri = do
   (<=>) "a:a" $
@@ -116,11 +112,9 @@ case_set_inherit = do
 
 case_set_scoped_inherit =
   (<=>) "{ inherit (a) b c; e = 4; inherit(a)b c; }" $
-    mkNonRecSet
-      [ inheritFrom (var "a") (StaticKey <$> ["b", "c"])
-      , "e" $= mkInt 4
-      , inheritFrom (var "a") (StaticKey <$> ["b", "c"])
-      ]
+    mkNonRecSet $
+      (\ x -> [x, "e" $= mkInt 4, x]) $
+        inheritFrom (var "a") (StaticKey <$> ["b", "c"])
 
 case_set_rec =
   (<=>) "rec { a = 3; b = a; }" $
@@ -151,7 +145,9 @@ case_set_complex_keynames = do
 case_set_inherit_direct =
   (<=>) "{ inherit ({a = 3;}); }" $
     mkNonRecSet
-      [ inheritFrom (mkNonRecSet ["a" $= mkInt 3]) mempty
+      [ inheritFrom (mkNonRecSet ["a" $= mkIn  staticFor (mkRelPath . toString) "~/a"
+  staticFor (mkRelPath . toString) "~/a/b"
+t 3]) mempty
       ]
 
 case_inherit_selector = do
@@ -161,8 +157,7 @@ case_inherit_selector = do
 
 case_int_list =
   (<=>) "[1 2 3]" $
-    mkList
-      [ mkInt i | i <- [1,2,3] ]
+    mkList $ mkInt <$> [ i | i <- [1,2,3] ]
 
 case_int_null_list =
   (<=>) "[1 2 3 null 4]" $
@@ -171,13 +166,13 @@ case_int_null_list =
 case_mixed_list = do
   (<=>) "[{a = 3;}.a (if true then null else false) null false 4 [] c.d or null]" $
     mkList
-    [ mkNonRecSet ["a" $= mkInt 3] @. "a"
+    [ mkNonRecSet ["a" $= mkInt 3] $. "a"
     , mkIf (mkBool True) mkNull (mkBool False)
     , mkNull
     , mkBool False
     , mkInt 4
     , emptyList
-    , (@./) (var "c") "d" mkNull
+    , ($./) (var "c") "d" mkNull
     ]
   assertParseFail "[if true then null else null]"
   assertParseFail "[a ? b]"
@@ -192,9 +187,9 @@ case_lambda_or_uri = do
   (<=>) "a :b" $
     mkFunction (Param "a") (var "b")
   (<=>) "a c:def" $
-    (@@) (var "a") (mkStr "c:def")
+    var "a" @@ mkStr "c:def"
   (<=>) "c:def: c" $
-    (@@) (mkStr "c:def:") (var "c")
+    mkStr "c:def:" @@ var "c"
   (<=>) "a:{}" $
     mkFunction (Param "a") emptySet
   (<=>) "a:[a]" $
@@ -241,7 +236,7 @@ case_simple_let = do
 
 case_let_body =
   (<=>) "let { body = 1; }" $
-   mkRecSet ["body" $= mkInt 1] @. "body"
+   mkRecSet ["body" $= mkInt 1] $. "body"
 
 case_nested_let = do
   (<=>) "let a = 4; in let b = 5; in a" $
@@ -268,34 +263,22 @@ case_if = do
   assertParseFail "1 + 2 then"
 
 case_identifier_special_chars = do
-  (<=>) "_a" $
-    var "_a"
-  (<=>) "a_b" $
-    var "a_b"
-  (<=>) "a'b" $
-    var "a'b"
-  (<=>) "a''b" $
-    var "a''b"
-  (<=>) "a-b" $
-    var "a-b"
-  (<=>) "a--b" $
-    var "a--b"
-  (<=>) "a12a" $
-    var "a12a"
+  static "_a"
+  static "a_b"
+  static "a'b"
+  static "a''b"
+  static "a-b"
+  static "a--b"
+  static "a12a"
   assertParseFail ".a"
   assertParseFail "'a"
 
 case_identifier_keyword_prefix = do
-  (<=>) "true-name" $
-    var "true-name"
-  (<=>) "trueName" $
-    var "trueName"
-  (<=>) "null-name" $
-    var "null-name"
-  (<=>) "nullName" $
-    var "nullName"
-  (<=>) "[ null-name ]" $
-    mkList [ var "null-name" ]
+  static "true-name"
+  static "trueName"
+  static "null-name"
+  static "nullName"
+  (<=>) "[ null-name ]" $ mkList [ var "null-name" ]
 
 makeTextParseTest str =
   (<=>) ("\"" <> str <> "\"") $
@@ -338,7 +321,7 @@ case_select = do
       (DynamicKey (Plain (DoubleQuoted mempty)) :| mempty) (pure mkNull)
   (<=>) "{ a = [1]; }.a or [2] ++ [3]" $
     Fix $ NBinary NConcat
-      ((@./)
+      (($./)
         (mkNonRecSet
           [NamedVar
             (mkSelector "a")
@@ -360,7 +343,7 @@ case_select_path = do
     emptySet @@ mkRelPath "./def"
   (<=>) "{}.\"\"./def" $
     Fix (NSelect emptySet (DynamicKey (Plain $ DoubleQuoted mempty) :| mempty) Nothing) @@ mkRelPath "./def"
- where select = var "f" @. "b"
+ where select = var "f" $. "b"
 
 case_select_keyword = do
   (<=>) "{ false = \"foo\"; }" $
@@ -370,8 +353,7 @@ case_fun_app = do
   (<=>) "f a b" $
     var "f" @@ var "a" @@ var "b"
   (<=>) "f a.x or null" $
-    var "f" @@
-      (@./) (var "a") "x" mkNull
+    var "f" @@ ($./) (var "a") "x" mkNull
   assertParseFail "f if true then null else null"
 
 case_indented_string = do
@@ -400,8 +382,7 @@ case_operator_fun_app = do
   (<=>) "a ++ b" $
     var "a" $++ var "b"
   (<=>) "a ++ f b" $
-    ($++) (var "a") $
-      var "f" @@ var "b"
+    var "a" $++ var "f" @@ var "b"
 
 case_operators = do
   (<=>) "1 + 2 - 3" $