treewide: Expr.Types: NExprF: NSelect: move optional default as first arg

This allows to reuse `Nothing` & `Just` logic between uses. This also leads to
more streamlined code.

Author: Anton-Latukha

src/Nix/Eval.hs

@@ -129,7 +129,7 @@ eval (NBinary op   larg rarg) =
     lav <- larg
     evalBinary op lav rarg
 
-eval (NSelect aset attr alt ) =
+eval (NSelect alt aset attr) =
   do
     let useAltOrReportMissing (s, ks) = fromMaybe (attrMissing ks $ pure s) alt
 

src/Nix/Expr/Shorthands.hs

@@ -175,8 +175,8 @@ mkFunction :: Params NExpr -> NExpr -> NExpr
 mkFunction params = Fix . NAbs params
 
 -- | General dot-reference with optional alternative if the jey does not exist.
-getRefOrDefault :: NExpr -> Text -> Maybe NExpr -> NExpr
-getRefOrDefault obj name alt = Fix $ NSelect obj (mkSelector name) alt
+getRefOrDefault :: Maybe NExpr -> NExpr -> Text -> NExpr
+getRefOrDefault alt obj name = Fix $ NSelect alt obj (mkSelector name)
 
 -- ** Base functor builders for basic expressions builders *sic
 
@@ -294,14 +294,14 @@ recAttrsE pairs = mkRecSet $ uncurry ($=) <$> pairs
 
 -- | Dot-reference into an attribute set: @attrSet.k@
 (@.) :: NExpr -> Text -> NExpr
-(@.) obj name = getRefOrDefault obj name Nothing
+(@.) = getRefOrDefault Nothing
 infix 9 @.
 
 -- | Dot-reference into an attribute set with alternative if the key does not exist.
 --
 -- > s.x or y
 (@.<|>) :: NExpr -> Text -> NExpr -> NExpr
-(@.<|>) obj name alt = getRefOrDefault obj name $ pure alt
+(@.<|>) obj name alt = getRefOrDefault (pure alt ) obj name
 infix 9 @.<|>
 
 -- | Function application (@' '@ in @f x@)

src/Nix/Expr/Types.hs

@@ -530,14 +530,14 @@ data NExprF r
   --
   -- > NBinary NPlus x y                           ~  x + y
   -- > NBinary NApp  f x                           ~  f x
-  | NSelect !r !(NAttrPath r) !(Maybe r)
+  | NSelect !(Maybe r) !r !(NAttrPath r)
   --  2021-05-15: NOTE: Default value should be first argument to leverage partial application.
   -- Cascading change diff is not that big.
   -- ^ Dot-reference into an attribute set, optionally providing an
   -- alternative if the key doesn't exist.
   --
-  -- > NSelect s (x :| []) Nothing                 ~  s.x
-  -- > NSelect s (x :| []) (pure y)                ~  s.x or y
+  -- > NSelect Nothing  s (x :| [])                ~  s.x
+  -- > NSelect (pure y) s (x :| [])                ~  s.x or y
   | NHasAttr !r !(NAttrPath r)
   -- ^ Ask if a set contains a given attribute path.
   --

src/Nix/Expr/Types/Annotated.hs

@@ -158,16 +158,9 @@ nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =
   AnnE (s1 <> s2 <> s3) $ NBinary b e1 e2
 
 nSelectLoc
-  :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc
-nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) =
-  --  2021-05-16: NOTE: This could been rewritten into function application of @(s3, pure e2)@
-  -- if @SrcSpan@ was Monoid, which requires @SorcePos@ to be a Monoid, and upstream code prevents it.
-  -- Question upstream: https://github.com/mrkkrp/megaparsec/issues/450
-  maybe
-    (                    AnnE  s1s2        $ NSelect e1 ats   Nothing)
-    (\ e2@(AnnE s3 _) -> AnnE (s1s2 <> s3) $ NSelect e1 ats $ pure e2)
- where
-  s1s2 = s1 <> s2
+  :: Maybe NExprLoc -> NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
+nSelectLoc Nothing e1@(AnnE s2 _) (Ann s1 ats) = AnnE (s2 <> s1) $ NSelect Nothing e1 ats
+nSelectLoc (Just e2@(AnnE s3 _)) e1@(AnnE s2 _) (Ann s1 ats) = AnnE (s3 <> s2 <> s1) $ NSelect (pure e2) e1 ats
 
 nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
 nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) $ NHasAttr e1 ats
@@ -222,8 +215,8 @@ pattern NUnary_ ann op x = AnnFP ann (NUnary op x)
 pattern NBinary_ :: SrcSpan -> NBinaryOp -> r -> r -> NExprLocF r
 pattern NBinary_ ann op x y = AnnFP ann (NBinary op x y)
 
-pattern NSelect_ :: SrcSpan -> r -> NAttrPath r -> Maybe r -> NExprLocF r
-pattern NSelect_ ann x p v = AnnFP ann (NSelect x p v)
+pattern NSelect_ :: SrcSpan ->  Maybe r -> r -> NAttrPath r -> NExprLocF r
+pattern NSelect_ ann v x p = AnnFP ann (NSelect v x p)
 
 pattern NHasAttr_ :: SrcSpan -> r -> NAttrPath r -> NExprLocF r
 pattern NHasAttr_ ann x p = AnnFP ann (NHasAttr x p)

src/Nix/Parser.hs

@@ -144,10 +144,9 @@ nixSelect term =
     -> NExprLoc
   build t mexpr =
     maybe
-      id
-      (\ expr t -> (uncurry $ nSelectLoc t) expr)
-      mexpr
       t
+      (\ (a, m) -> (`nSelectLoc` t) m a)
+      mexpr
 
 nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
 nixSelector =
@@ -265,7 +264,7 @@ nixLet = annotateLocation1
       (reserved "in" *> nixToplevelForm)
   -- Let expressions `let {..., body = ...}' are just desugared
   -- into `(rec {..., body = ...}).body'.
-  letBody    = (\x -> NSelect x (StaticKey "body" :| mempty) Nothing) <$> aset
+  letBody    = (\x -> NSelect Nothing x (StaticKey "body" :| mempty)) <$> aset
   aset       = annotateLocation1 $ NSet Recursive <$> braces nixBinders
 
 nixIf :: Parser NExprLoc

src/Nix/Pretty.hs

@@ -248,7 +248,7 @@ exprFNixDoc = \case
       opInfo
       (pretty (operatorName opInfo) <> wrapParens opInfo r1)
     where opInfo = getUnaryOperator op
-  NSelect r' attr o ->
+  NSelect o r' attr ->
     maybe
       (mkNixDoc selectOp)
       (const leastPrecedence)

src/Nix/Reduce.hs

@@ -203,9 +203,9 @@ reduce (NBinary_ bann op larg rarg) =
 --   1. The selected expr is indeed a set.
 --   2. The selection AttrPath is a list of StaticKeys.
 --   3. The selected AttrPath exists in the set.
-reduce base@(NSelect_ _ _ attrs _)
+reduce base@(NSelect_ _ _ _ attrs)
   | sAttrPath $ NE.toList attrs = do
-    (NSelect_ _ aset attrs _) <- sequence base
+    (NSelect_ _ _ aset attrs) <- sequence base
     inspectSet (unFix aset) attrs
   | otherwise = sId
  where
@@ -378,8 +378,8 @@ pruneTree opts =
           (`NLet` body)
           (mapMaybe pruneBinding binds)
 
-    NSelect (Just aset) attr alt ->
-      pure $ NSelect aset (pruneKeyName <$> attr) $ join alt
+    NSelect alt (Just aset) attr ->
+      pure $ NSelect (join alt) aset $ pruneKeyName <$> attr
 
     -- These are the only short-circuiting binary operators
     NBinary NAnd (Just (AnnE _ larg)) _ -> pure larg

src/Nix/TH.hs

@@ -62,7 +62,7 @@ freeVars e = case unFix e of
   (NEnvPath     _               ) -> mempty
   (NUnary       _    expr       ) -> freeVars expr
   (NBinary      _    left right ) -> collectFreeVars left right
-  (NSelect      expr path orExpr) ->
+  (NSelect      orExpr expr path) ->
     Set.unions
       [ freeVars expr
       , pathFree path

tests/ParserTests.hs

@@ -493,18 +493,15 @@ case_indented_string_escape =
 
 case_select =
   checks
-    ( Fix $ NSelect (var "a")
-        (StaticKey "e" :| [StaticKey "di", StaticKey "f"])
-        Nothing
+    ( Fix $ NSelect Nothing (var "a") (StaticKey "e" :| [StaticKey "di", StaticKey "f"])
     , "a .  e .di. f"
     )
-    ( Fix $ NSelect (var "a")
+    ( Fix $ NSelect (pure mkNull) (var "a")
         (StaticKey "e" :| [StaticKey "d"])
-        (pure mkNull)
     , "a.e . d    or null"
     )
-    ( Fix $ NSelect emptySet
-        (DynamicKey (Plain (DoubleQuoted mempty)) :| mempty) (pure mkNull)
+    ( Fix $ NSelect (pure mkNull) emptySet
+        (DynamicKey (Plain (DoubleQuoted mempty)) :| mempty)
     , "{}.\"\"or null"
     )
     ( Fix $ NBinary NConcat
@@ -534,7 +531,7 @@ case_select_path =
     ( emptySet @@ mkRelPath "./def"
     , "{}./def"
     )
-    ( Fix (NSelect emptySet (DynamicKey (Plain $ DoubleQuoted mempty) :| mempty) Nothing) @@ mkRelPath "./def"
+    ( Fix (NSelect Nothing emptySet (DynamicKey (Plain $ DoubleQuoted mempty) :| mempty)) @@ mkRelPath "./def"
     , "{}.\"\"./def"
     )
 

tests/PrettyParseTests.hs

@@ -132,7 +132,7 @@ genExpr =
   genEnvPath     = NEnvPath                 <$> asciiString
   genUnary       = liftA2 NUnary   Gen.enumBounded       genExpr
   genBinary      = liftA3 NBinary  Gen.enumBounded       genExpr     genExpr
-  genSelect      = liftA3 NSelect  genExpr               genAttrPath (Gen.maybe genExpr)
+  genSelect      = liftA3 NSelect  (Gen.maybe genExpr)   genExpr     genAttrPath
   genHasAttr     = liftA2 NHasAttr genExpr               genAttrPath
   genAbs         = liftA2 NAbs     genParams             genExpr
   genLet         = liftA2 NLet     (fairList genBinding) genExpr