Merge #1009: Unify accessor naming

Author: Anton-Latukha

main/Main.hs

@@ -152,15 +152,15 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
     | isEvaluate =
       if
         | isTrace                       -> evaluateExprWith nixTracingEvalExprLoc expr
-        | Just path <- getReduce           -> evaluateExprWith (reduction path . coerce) expr
-        | null getArg || null getArgstr       -> evaluateExprWith nixEvalExprLoc expr
+        | Just path <- getReduce        -> evaluateExprWith (reduction path . coerce) expr
+        | null getArg || null getArgstr -> evaluateExprWith nixEvalExprLoc expr
         | otherwise                     -> processResult printer <=< nixEvalExprLoc (coerce mpath) $ expr
     | isXml                        = fail "Rendering expression trees to XML is not yet implemented"
     | isJson                       = fail "Rendering expression trees to JSON is not implemented"
-    | getVerbosity >= DebugInfo       =  liftIO . putStr . ppShow . stripAnnotation $ expr
-    | isCache , Just path <- mpath =  liftIO . writeCache (replaceExtension path "nixc") $ expr
-    | isParseOnly                  =  void . liftIO . Exception.evaluate . force $ expr
-    | otherwise                  =
+    | getVerbosity >= DebugInfo    = liftIO . putStr . ppShow . stripAnnotation $ expr
+    | isCache , Just path <- mpath = liftIO . writeCache (replaceExtension path "nixc") $ expr
+    | isParseOnly                  = void . liftIO . Exception.evaluate . force $ expr
+    | otherwise                    =
       liftIO .
         renderIO
           stdout
@@ -178,24 +178,24 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
       | isFinder    = findAttrs <=< fromValue @(AttrSet StdVal)
       | otherwise = printer'
      where
+      -- 2021-05-27: NOTE: With naive fix of the #941
+      -- This is overall a naive printer implementation, as options should interact/respect one another.
+      -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
+      -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
+      -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
       printer'
-        | isXml       = fun (ignoreContext . toXML)                     normalForm
-        -- 2021-05-27: NOTE: With naive fix of the #941
-        -- This is overall a naive printer implementation, as options should interact/respect one another.
-        -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
-        -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
-        -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
-        | isJson      = fun (ignoreContext . mempty . toJSONNixString) normalForm
-        | isStrict    = fun (show . prettyNValue)                       normalForm
-        | isValues    = fun (show . prettyNValueProv)                   removeEffects
-        | otherwise = fun (show . prettyNValue)                       removeEffects
+        | isXml     = out (ignoreContext . toXML)                    normalForm
+        | isJson    = out (ignoreContext . mempty . toJSONNixString) normalForm
+        | isStrict  = out (show . prettyNValue)                      normalForm
+        | isValues  = out (show . prettyNValueProv)                  removeEffects
+        | otherwise = out (show . prettyNValue)                      removeEffects
        where
-        fun
+        out
           :: (b -> Text)
           -> (a -> StandardIO b)
           -> a
           -> StdIO
-        fun g f = liftIO . Text.putStrLn . g <=< f
+        out transform val = liftIO . Text.putStrLn . transform <=< val
 
       findAttrs
         :: AttrSet StdVal
@@ -238,9 +238,9 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
                           (forceEntry path nv)
                           (descend &&
                             deferred
-                            (const False)
-                            (const True)
-                            val
+                              (const False)
+                              (const True)
+                              val
                           )
                     )
                     (pure . pure . Free)

src/Nix/Builtins.hs

@@ -247,22 +247,20 @@ instance Show VersionComponent where
 
 splitVersion :: Text -> [VersionComponent]
 splitVersion s =
- whenJust
-   (\ (x, xs) -> if
-      | isRight eDigitsPart ->
-          either
-            (\ e -> error $ "splitVersion: did hit impossible: '" <> fromString e <> "' while parsing '" <> s <> "'.")
-            (\ res ->
-              one (VersionComponentNumber $ fst res)
-              <> splitVersion (snd res)
-            )
-            eDigitsPart
-
-      | x `elem` separators -> splitVersion xs
-
-      | otherwise -> one charsPart <> splitVersion rest2
-  )
-  (Text.uncons s)
+  (\ (x, xs) -> if
+    | isRight eDigitsPart ->
+        either
+          (\ e -> error $ "splitVersion: did hit impossible: '" <> fromString e <> "' while parsing '" <> s <> "'.")
+          (\ res ->
+            one (VersionComponentNumber $ fst res)
+            <> splitVersion (snd res)
+          )
+          eDigitsPart
+
+    | x `elem` separators -> splitVersion xs
+
+    | otherwise -> one charsPart <> splitVersion rest2
+  ) `whenJust` Text.uncons s
  where
   -- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44
   separators :: String

src/Nix/Cited.hs

@@ -16,8 +16,9 @@ import           Control.Monad.Free             ( Free(Pure, Free) )
 
 data Provenance m v =
   Provenance
-    { _lexicalScope :: Scopes m v
-    , _originExpr   :: NExprLocF (Maybe v)
+    { getLexicalScope :: Scopes m v
+      --  2021-11-09: NOTE: Better name?
+    , getOriginExpr   :: NExprLocF (Maybe v)
       -- ^ When calling the function x: x + 2 with argument x = 3, the
       --   'originExpr' for the resulting value will be 3 + 2, while the
       --   'contextExpr' will be @(x: x + 2) 3@, preserving not only the
@@ -27,8 +28,8 @@ data Provenance m v =
 
 data NCited m v a =
   NCited
-    { _provenance :: [Provenance m v]
-    , _cited      :: a
+    { getProvenance :: [Provenance m v]
+    , getCited      :: a
     }
     deriving (Generic, Typeable, Functor, Foldable, Traversable, Show)
 
@@ -37,11 +38,11 @@ instance Applicative (NCited m v) where
   (<*>) (NCited xs f) (NCited ys x) = NCited (xs <> ys) (f x)
 
 instance Comonad (NCited m v) where
-  duplicate p = NCited (_provenance p) p
-  extract = _cited
+  duplicate p = NCited (getProvenance p) p
+  extract = getCited
 
 instance ComonadEnv [Provenance m v] (NCited m v) where
-  ask = _provenance
+  ask = getProvenance
 
 $(makeLenses ''Provenance)
 $(makeLenses ''NCited)
@@ -55,7 +56,7 @@ class HasCitations m v a where
   addProvenance :: Provenance m v -> a -> a
 
 instance HasCitations m v (NCited m v a) where
-  citations = _provenance
+  citations = getProvenance
   addProvenance x (NCited p v) = NCited (x : p) v
 
 instance HasCitations1 m v f

src/Nix/Expr/Strings.hs

@@ -39,14 +39,16 @@ runAntiquoted nl f _ EscapedNewline = f nl
 runAntiquoted _  _ k (Antiquoted r) = k r
 
 -- | Split a stream representing a string with antiquotes on line breaks.
-splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]]
-splitLines = uncurry (flip (:)) . go where
-  go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls
+splitLines :: forall r . [Antiquoted Text r] -> [[Antiquoted Text r]]
+splitLines = uncurry (flip (:)) . go
+ where
+  go :: [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
+  go (Plain t : xs) = (one (Plain l) <>) <$> foldr f (go xs) ls
    where
     (l : ls) = T.split (== '\n') t
     f prefix (finished, current) = ((Plain prefix : current) : finished, mempty)
-  go (Antiquoted a   : xs) = (Antiquoted a :) <$> go xs
-  go (EscapedNewline : xs) = (EscapedNewline :) <$> go xs
+  go (Antiquoted a   : xs) = (one (Antiquoted a) <>) <$> go xs
+  go (EscapedNewline : xs) = (one EscapedNewline <>) <$> go xs
   go []                    = mempty
 
 -- | Join a stream of strings containing antiquotes again. This is the inverse
@@ -108,10 +110,17 @@ stripIndent xs =
 
 escapeCodes :: [(Char, Char)]
 escapeCodes =
-  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('\\', '\\'), ('$', '$'), ('"', '"')]
+  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('"', '"'), ('$', '$'), ('\\', '\\')]
 
 fromEscapeCode :: Char -> Maybe Char
 fromEscapeCode = (`lookup` (swap <$> escapeCodes))
 
 toEscapeCode :: Char -> Maybe Char
 toEscapeCode = (`lookup` escapeCodes)
+
+escapeMap :: [(Text, Text)]
+escapeMap =
+  [("\n", "\\n"), ("\r", "\\r"), ("\t", "\\t"), ("\"", "\\\""), ("${", "\\${"), ("\\", "\\\\")]
+
+escapeString :: Text -> Text
+escapeString = applyAll (fmap (uncurry T.replace) escapeMap)

src/Nix/Expr/Types.hs

@@ -776,9 +776,9 @@ getFreeVars e =
     (NAbs (ParamSet varname _ pset) expr) ->
       Set.difference
         -- Include all free variables from the expression and the default arguments
-        (getFreeVars expr <> (Set.unions $ getFreeVars <$> mapMaybe snd pset))
+        (getFreeVars expr <> Set.unions (getFreeVars <$> mapMaybe snd pset))
         -- But remove the argument name if existing, and all arguments in the parameter set
-        ((one `whenJust` varname) <> (Set.fromList $ fst <$> pset))
+        ((one `whenJust` varname) <> Set.fromList (fst <$> pset))
     (NLet         bindings expr   ) ->
       Set.difference
         (getFreeVars expr <> bindFreeVars bindings)

src/Nix/Normal.hs

@@ -100,7 +100,9 @@ normalizeValueF f = run . iterNValueM run (flip go) (fmap Free . sequenceNValue'
       (do
         i <- ask
         when (i > 2000) $ fail "Exceeded maximum normalization depth of 2000 levels"
-        lifted (lifted $ f t) $ local succ . k
+        (lifted . lifted)
+          (f t)
+          (local succ . k)
       )
       (pure $ pure t)
       b

src/Nix/Parser.hs

@@ -271,73 +271,78 @@ nixAntiquoted p =
     antiquotedLexeme
     <|> Plain <$> p
 
-nixString' :: Parser (NString NExprLoc)
-nixString' = label "string" $ lexeme $ doubleQuoted <|> indented
+escapeCode :: Parser Char
+escapeCode =
+  msum
+    [ c <$ char e | (c, e) <- escapeCodes ]
+  <|> anySingle
+
+stringChar
+  :: Parser ()
+  -> Parser ()
+  -> Parser (Antiquoted Text NExprLoc)
+  -> Parser (Antiquoted Text NExprLoc)
+stringChar end escStart esc =
+  antiquoted
+  <|> Plain . one <$> char '$'
+  <|> esc
+  <|> Plain . fromString <$> some plainChar
+  where
+  plainChar :: Parser Char
+  plainChar =
+    notFollowedBy (end <|> void (char '$') <|> escStart) *> anySingle
+
+doubleQuoted :: Parser (NString NExprLoc)
+doubleQuoted =
+  label "double quoted string" $
+    DoubleQuoted . removeEmptyPlains . mergePlain <$>
+      inQuotationMarks (many $ stringChar quotationMark (void $ char '\\') doubleEscape)
+  where
+  inQuotationMarks :: Parser a -> Parser a
+  inQuotationMarks expr = quotationMark *> expr <* quotationMark
+
+  quotationMark :: Parser ()
+  quotationMark = void $ char '"'
+
+  doubleEscape :: Parser (Antiquoted Text r)
+  doubleEscape = Plain . one <$> (char '\\' *> escapeCode)
+
+
+indented :: Parser (NString NExprLoc)
+indented =
+  label "indented string" $
+    stripIndent <$>
+      inIndentedQuotation (many $ join stringChar indentedQuotationMark indentedEscape)
  where
-  doubleQuoted :: Parser (NString NExprLoc)
-  doubleQuoted =
-    label "double quoted string" $
-      DoubleQuoted . removeEmptyPlains . mergePlain <$>
-        inQuotationMarks (many $ stringChar quotationMark (void $ char '\\') doubleEscape)
-   where
-    inQuotationMarks :: Parser a -> Parser a
-    inQuotationMarks expr = quotationMark *> expr <* quotationMark
+  -- | Read escaping inside of the "'' <expr> ''"
+  indentedEscape :: Parser (Antiquoted Text r)
+  indentedEscape =
+    try $
+      do
+        indentedQuotationMark
+        (Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$'))
+          <|>
+            do
+              _ <- char '\\'
+              c <- escapeCode
 
-    quotationMark :: Parser ()
-    quotationMark = void $ char '"'
+              pure $
+                bool
+                  EscapedNewline
+                  (Plain $ one c)
+                  (c /= '\n')
 
-    doubleEscape :: Parser (Antiquoted Text r)
-    doubleEscape = Plain . one <$> (char '\\' *> escapeCode)
+  -- | Enclosed into indented quatation "'' <expr> ''"
+  inIndentedQuotation :: Parser a -> Parser a
+  inIndentedQuotation expr = indentedQuotationMark *> expr <* indentedQuotationMark
 
-  indented :: Parser (NString NExprLoc)
-  indented =
-    label "indented string" $
-      stripIndent <$>
-        inIndentedQuotation (many $ join stringChar indentedQuotationMark indentedEscape)
-   where
-    indentedEscape :: Parser (Antiquoted Text r)
-    indentedEscape =
-      try $
-        do
-          indentedQuotationMark
-          (Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$'))
-            <|>
-              do
-                _ <- char '\\'
-                c <- escapeCode
-
-                pure $
-                  bool
-                    EscapedNewline
-                    (Plain $ one c)
-                    (c /= '\n')
-
-    inIndentedQuotation :: Parser a -> Parser a
-    inIndentedQuotation expr = indentedQuotationMark *> expr <* indentedQuotationMark
-
-    indentedQuotationMark :: Parser ()
-    indentedQuotationMark = label "\"''\"" . void $ chunk "''"
-
-  stringChar
-    :: Parser ()
-    -> Parser ()
-    -> Parser (Antiquoted Text NExprLoc)
-    -> Parser (Antiquoted Text NExprLoc)
-  stringChar end escStart esc =
-    antiquoted
-    <|> Plain . one <$> char '$'
-    <|> esc
-    <|> Plain . fromString <$> some plainChar
-   where
-    plainChar :: Parser Char
-    plainChar =
-      notFollowedBy (end <|> void (char '$') <|> escStart) *> anySingle
+  -- | Symbol "''"
+  indentedQuotationMark :: Parser ()
+  indentedQuotationMark = label "\"''\"" . void $ chunk "''"
 
-  escapeCode :: Parser Char
-  escapeCode =
-    msum
-      [ c <$ char e | (c, e) <- escapeCodes ]
-    <|> anySingle
+
+nixString' :: Parser (NString NExprLoc)
+nixString' = label "string" $ lexeme $ doubleQuoted <|> indented
 
 nixString :: Parser NExprLoc
 nixString = annNStr <$> annotateLocation1 nixString'
@@ -587,6 +592,7 @@ nixOperators selector =
     one $ binaryR NImpl "->"
   ]
 
+--  2021-11-09: NOTE: rename OperatorInfo accessors to `get*`
 --  2021-08-10: NOTE:
 --  All this is a sidecar:
 --  * This type
@@ -596,11 +602,13 @@ nixOperators selector =
 --  * getSpecialOperation
 --  can reduced in favour of adding precedence field into @NOperatorDef@.
 -- details: https://github.com/haskell-nix/hnix/issues/982
-data OperatorInfo = OperatorInfo
-  { precedence    :: Int
-  , associativity :: NAssoc
-  , operatorName  :: Text
-  } deriving (Eq, Ord, Generic, Typeable, Data, Show)
+data OperatorInfo =
+  OperatorInfo
+    { precedence    :: Int
+    , associativity :: NAssoc
+    , operatorName  :: Text
+    }
+ deriving (Eq, Ord, Generic, Typeable, Data, Show)
 
 detectPrecedence
   :: Ord a