From 92cd8d1ee8b53e98a82c4b1d20c5aefcf02292ec Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 19 Jan 2022 17:13:20 +0200 Subject: [PATCH 1/5] String: m refactor --- src/Nix/String.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Nix/String.hs b/src/Nix/String.hs index 8e43ed627..a7b7dbde5 100644 --- a/src/Nix/String.hs +++ b/src/Nix/String.hs @@ -154,9 +154,11 @@ fromNixLikeContext = -- | Extract the string contents from a NixString that has no context getStringNoContext :: NixString -> Maybe Text -getStringNoContext (NixString c s) - | null c = pure s - | otherwise = mempty +getStringNoContext a@(NixString c s) = + bool + (pure s) + mempty + (hasContext a) -- | Extract the string contents from a NixString even if the NixString has an associated context ignoreContext :: NixString -> Text From 285e017a539bcf3407f2c16b9f7024c8d5fbd9f5 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 19 Jan 2022 19:36:28 +0200 Subject: [PATCH 2/5] String: ignoreContext -> getStringIgnoreContext --- main/Main.hs | 4 ++-- src/Nix/Builtins.hs | 46 +++++++++++++++++++-------------------- src/Nix/Effects/Basic.hs | 6 ++--- src/Nix/Eval.hs | 2 +- src/Nix/Exec.hs | 2 +- src/Nix/Pretty.hs | 4 ++-- src/Nix/String.hs | 6 ++--- src/Nix/Value.hs | 4 ++-- src/Nix/Value/Equal.hs | 4 ++-- tests/Main.hs | 2 +- tests/NixLanguageTests.hs | 2 +- 11 files changed, 41 insertions(+), 41 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 034b6cbf8..024efe265 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -185,8 +185,8 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl -- 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 = out (ignoreContext . toXML) normalForm - | isJson = out (ignoreContext . mempty . toJSONNixString) normalForm + | isXml = out (getStringIgnoreContext . toXML) normalForm + | isJson = out (getStringIgnoreContext . mempty . toJSONNixString) normalForm | isStrict = out (show . prettyNValue) normalForm | isValues = out (show . prettyNValueProv) removeEffects | otherwise = out (show . prettyNValue) removeEffects diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 731b84e88..a7748d36b 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -142,7 +142,7 @@ instance Comonad f => Eq (WValue t f m) where WValue (NVConstant (NFloat x)) == WValue (NVConstant (NFloat y)) = x == y WValue (NVPath x ) == WValue (NVPath y ) = x == y WValue (NVStr x) == WValue (NVStr y) = - ignoreContext x == ignoreContext y + getStringIgnoreContext x == getStringIgnoreContext y _ == _ = False instance Comonad f => Ord (WValue t f m) where @@ -154,7 +154,7 @@ instance Comonad f => Ord (WValue t f m) where WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NFloat y)) = x <= y WValue (NVPath x ) <= WValue (NVPath y ) = x <= y WValue (NVStr x) <= WValue (NVStr y) = - ignoreContext x <= ignoreContext y + getStringIgnoreContext x <= getStringIgnoreContext y _ <= _ = False -- ** Helpers @@ -207,7 +207,7 @@ foldNixPath z f = foldrM fun z - $ (fromInclude . ignoreContext <$> dirs) + $ (fromInclude . getStringIgnoreContext <$> dirs) <> uriAwareSplit `whenJust` mPath <> one (fromInclude $ "nix=" <> fromString (coerce dataDir) <> "/nix/corepkgs") where @@ -358,7 +358,7 @@ absolutePathFromValue = NVStr ns -> do let - path = coerce . toString $ ignoreContext ns + path = coerce . toString $ getStringIgnoreContext ns unless (isAbsolute path) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path" pure path @@ -479,7 +479,7 @@ unsafeDiscardOutputDependencyNix -> m (NValue t f m) unsafeDiscardOutputDependencyNix nv = do - (nc, ns) <- (getStringContext &&& ignoreContext) <$> fromValue nv + (nc, ns) <- (getStringContext &&& getStringIgnoreContext) <$> fromValue nv toValue $ mkNixString (HS.map discard nc) ns where discard :: StringContext -> StringContext @@ -502,7 +502,7 @@ unsafeGetAttrPosNix nvX nvY = maybe (pure nvNull) toValue - (M.lookup @VarName (coerce $ ignoreContext ns) apos) + (M.lookup @VarName (coerce $ getStringIgnoreContext ns) apos) _xy -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPosNix: " <> show _xy -- This function is a bit special in that it doesn't care about the contents @@ -685,7 +685,7 @@ matchNix pat str = -- going to preserve the behavior here until it is fixed upstream. -- Relevant issue: https://github.com/NixOS/nix/issues/2547 let - s = ignoreContext ns + s = getStringIgnoreContext ns re = makeRegex p :: Regex mkMatch t = bool @@ -722,7 +722,7 @@ splitNix pat str = -- going to preserve the behavior here until it is fixed upstream. -- Relevant issue: https://github.com/NixOS/nix/issues/2547 let - s = ignoreContext ns + s = getStringIgnoreContext ns regex = makeRegex p :: Regex haystack = encodeUtf8 s @@ -935,7 +935,7 @@ dirOfNix nvdir = unsafeDiscardStringContextNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) unsafeDiscardStringContextNix = - inHask (mkNixStringWithoutContext . ignoreContext) + inHask (mkNixStringWithoutContext . getStringIgnoreContext) -- | Evaluate `a` to WHNF to collect its topmost effect. seqNix @@ -1082,7 +1082,7 @@ replaceStringsNix tfrom tto ts = where formMatchReplaceTailInfo (m, r) = (m, r, Text.drop (Text.length m) input) - fromKeysToValsMap = zip (ignoreContext <$> fromKeys) toVals + fromKeysToValsMap = zip (getStringIgnoreContext <$> fromKeys) toVals -- Not passing args => It is constant that gets embedded into `go` => It is simple `go` tail recursion passOneChar = @@ -1117,7 +1117,7 @@ replaceStringsNix tfrom tto ts = updatedOutput = output <> replacement updatedCtx = ctx <> replacementCtx - replacement = Builder.fromText $ ignoreContext replacementNS + replacement = Builder.fromText $ getStringIgnoreContext replacementNS replacementCtx = getStringContext replacementNS -- The bug modifies the content => bug demands `pass` to be a real function => @@ -1129,7 +1129,7 @@ replaceStringsNix tfrom tto ts = (\(c, i) -> go updatedCtx i $ output <> Builder.singleton c) -- If there are chars - pass one char & continue (Text.uncons input) -- chip first char - toValue $ go (getStringContext string) (ignoreContext string) mempty + toValue $ go (getStringContext string) (getStringIgnoreContext string) mempty removeAttrsNix :: forall e t f m @@ -1185,7 +1185,7 @@ toFileNix name s = mres <- toFile_ (coerce $ toString name') - (ignoreContext s') + (getStringIgnoreContext s') let storepath = coerce (fromString @Text) mres @@ -1203,7 +1203,7 @@ pathExistsNix nvpath = toValue =<< case path of NVPath p -> doesPathExist p - NVStr ns -> doesPathExist $ coerce $ toString $ ignoreContext ns + NVStr ns -> doesPathExist $ coerce $ toString $ getStringIgnoreContext ns _v -> throwError $ ErrorCall $ "builtins.pathExists: expected path, got " <> show _v isPathNix @@ -1257,7 +1257,7 @@ isFunctionNix nv = throwNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) throwNix = - throwError . ErrorCall . toString . ignoreContext + throwError . ErrorCall . toString . getStringIgnoreContext <=< coerceStringlikeToNixString CopyToStore -- | Implementation of Nix @import@ clause. @@ -1392,7 +1392,7 @@ lessThanNix ta tb = (NFloat a, NInt b) -> pure $ a < fromInteger b (NFloat a, NFloat b) -> pure $ a < b _ -> badType - (NVStr a, NVStr b) -> pure $ ignoreContext a < ignoreContext b + (NVStr a, NVStr b) -> pure $ getStringIgnoreContext a < getStringIgnoreContext b _ -> badType -- | Helper function, generalization of @concat@ operations. @@ -1544,7 +1544,7 @@ placeHolderNix p = bytes :: NixString -> ByteString bytes = encodeUtf8 . body - body = ignoreContext + body = getStringIgnoreContext readFileNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) readFileNix = toValue <=< Nix.Render.readFile <=< absolutePathFromValue <=< demand @@ -1563,7 +1563,7 @@ findFileNix nvaset nvfilepath = case (aset, filePath) of (NVList x, NVStr ns) -> do - mres <- findPath @t @f @m x $ coerce $ toString $ ignoreContext ns + mres <- findPath @t @f @m x $ coerce $ toString $ getStringIgnoreContext ns pure $ mkNVPath mres @@ -1702,7 +1702,7 @@ traceNix -> m (NValue t f m) traceNix msg action = do - traceEffect @t @f @m . toString . ignoreContext =<< fromValue msg + traceEffect @t @f @m . toString . getStringIgnoreContext =<< fromValue msg pure action -- Please, can function remember fail context @@ -1722,7 +1722,7 @@ execNix xs = -- 2018-11-19: NOTE: Still need to do something with the context here -- See prim_exec in nix/src/libexpr/primops.cc -- Requires the implementation of EvalState::realiseContext - exec $ ignoreContext <$> xs' + exec $ getStringIgnoreContext <$> xs' fetchurlNix :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) @@ -1845,7 +1845,7 @@ appendContextNix tx ty = outs <- demand touts case outs of - NVList vs -> traverse (fmap ignoreContext . fromValue) vs + NVList vs -> traverse (fmap getStringIgnoreContext . fromValue) vs _x -> throwError $ ErrorCall $ "Invalid types for context value outputs in builtins.appendContext: " <> show _x ) (M.lookup "outputs" atts) @@ -1868,7 +1868,7 @@ appendContextNix tx ty = toNixLikeContext $ getStringContext ns ) - $ ignoreContext ns + $ getStringIgnoreContext ns toValue . addContext =<< traverse getPathNOuts attrs @@ -1980,7 +1980,7 @@ builtinsList = , add Normal "splitVersion" splitVersionNix , add0 Normal "storeDir" (pure $ mkNVStrWithoutContext "/nix/store") --, add Normal "storePath" storePath - , add' Normal "stringLength" (arity1 $ Text.length . ignoreContext) + , add' Normal "stringLength" (arity1 $ Text.length . getStringIgnoreContext) , add' Normal "sub" (arity2 ((-) @Integer)) , add' Normal "substring" substringNix , add Normal "tail" tailNix diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs index d5e98ca0a..dc9808e6a 100644 --- a/src/Nix/Effects/Basic.hs +++ b/src/Nix/Effects/Basic.hs @@ -144,7 +144,7 @@ findPathBy finder ls name = tryPath path $ whenJust (\ nsPfx -> - let pfx = ignoreContext nsPfx in + let pfx = getStringIgnoreContext nsPfx in pure $ coerce $ toString pfx `whenFalse` Text.null pfx ) mns @@ -191,7 +191,7 @@ fetchTarball = -> m (NValue t f m) fetchFromString msha = \case - NVStr ns -> fetch (ignoreContext ns) msha + NVStr ns -> fetch (getStringIgnoreContext ns) msha v -> throwError $ ErrorCall $ "builtins.fetchTarball: Expected URI or string, got " <> show v {- jww (2018-04-11): This should be written using pipes in another module @@ -216,7 +216,7 @@ fetchTarball = do nsSha <- fromValue =<< demand v - let sha = ignoreContext nsSha + let sha = getStringIgnoreContext nsSha nixInstantiateExpr $ "builtins.fetchTarball { " <> "url = \"" <> uri <> "\"; " <> "sha256 = \"" <> sha <> "\"; }" diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index 2728ca1d5..52d30338a 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -467,7 +467,7 @@ evalSetterKeyName = \case StaticKey k -> pure $ pure k DynamicKey k -> - coerce . ignoreContext <<$>> runAntiquoted "\n" assembleString (fromValueMay =<<) k + coerce . getStringIgnoreContext <<$>> runAntiquoted "\n" assembleString (fromValueMay =<<) k assembleString :: forall v m diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 3f9dc07e8..d8748c162 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -70,7 +70,7 @@ mkNVStrWithProvenance -> NixString -> NValue t f m mkNVStrWithProvenance scopes span x = - addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ mkNVStr x + addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . getStringIgnoreContext $ x) $ mkNVStr x mkNVPathWithProvenance :: MonadCited t f m diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index e7c83a15d..92162eb69 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -349,7 +349,7 @@ valueToExpr = iterNValueByDiscardWith thk (Fix . phi) phi :: NValue' t f m NExpr -> NExprF NExpr phi (NVConstant' a ) = NConstant a - phi (NVStr' ns ) = NStr $ DoubleQuoted $ one $ Plain $ ignoreContext ns + phi (NVStr' ns ) = NStr $ DoubleQuoted $ one $ Plain $ getStringIgnoreContext ns phi (NVList' l ) = NList l phi (NVSet' p s) = NSet mempty [ NamedVar (one $ StaticKey k) v (fromMaybe nullPos $ (`M.lookup` p) k) @@ -423,7 +423,7 @@ printNix = where phi :: NValue' t f m Text -> Text phi (NVConstant' a ) = atomText a - phi (NVStr' ns) = "\"" <> escapeString (ignoreContext ns) <> "\"" + phi (NVStr' ns) = "\"" <> escapeString (getStringIgnoreContext ns) <> "\"" phi (NVList' l ) = "[ " <> unwords l <> " ]" phi (NVSet' _ s) = "{ " <> diff --git a/src/Nix/String.hs b/src/Nix/String.hs index a7b7dbde5..74d839423 100644 --- a/src/Nix/String.hs +++ b/src/Nix/String.hs @@ -13,7 +13,7 @@ module Nix.String , hasContext , intercalateNixString , getStringNoContext - , ignoreContext + , getStringIgnoreContext , mkNixStringWithoutContext , mkNixStringWithSingletonContext , modifyNixContents @@ -161,8 +161,8 @@ getStringNoContext a@(NixString c s) = (hasContext a) -- | Extract the string contents from a NixString even if the NixString has an associated context -ignoreContext :: NixString -> Text -ignoreContext (NixString _ s) = s +getStringIgnoreContext :: NixString -> Text +getStringIgnoreContext (NixString _ s) = s -- | Get the contents of a 'NixString' and write its context into the resulting set. extractNixString :: Monad m => NixString -> WithStringContextT m Text diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index aafdc25a5..5f8f5236e 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -157,7 +157,7 @@ instance Show r => Show (NValueF p m r) where showsPrec d = \case (NVConstantF atom ) -> showsCon1 "NVConstant" atom - (NVStrF ns ) -> showsCon1 "NVStr" $ ignoreContext ns + (NVStrF ns ) -> showsCon1 "NVStr" $ getStringIgnoreContext ns (NVListF lst ) -> showsCon1 "NVList" lst (NVSetF _ attrs) -> showsCon1 "NVSet" attrs (NVClosureF params _ ) -> showsCon1 "NVClosure" params @@ -285,7 +285,7 @@ instance (Comonad f, Show a) => Show (NValue' t f m a) where instance Comonad f => Show1 (NValue' t f m) where liftShowsPrec sp sl p = \case NVConstant' atom -> showsUnaryWith showsPrec "NVConstantF" p atom - NVStr' ns -> showsUnaryWith showsPrec "NVStrF" p $ ignoreContext ns + NVStr' ns -> showsUnaryWith showsPrec "NVStrF" p $ getStringIgnoreContext ns NVList' lst -> showsUnaryWith (liftShowsPrec sp sl) "NVListF" p lst NVSet' _ attrs -> showsUnaryWith (liftShowsPrec sp sl) "NVSetF" p attrs NVPath' path -> showsUnaryWith showsPrec "NVPathF" p path diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index 556d9d182..8766b45c7 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -82,7 +82,7 @@ isDerivationM f m = -- We should probably really make sure the context is empty here -- but the C++ implementation ignores it. False - ((==) "derivation" . ignoreContext) + ((==) "derivation" . getStringIgnoreContext) <$> f t isDerivation @@ -113,7 +113,7 @@ valueFEqM attrsEq eq = (NVConstantF (NFloat x), NVConstantF (NInt y)) -> pure $ x == fromInteger y (NVConstantF (NInt x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y (NVConstantF lc , NVConstantF rc ) -> pure $ lc == rc - (NVStrF ls , NVStrF rs ) -> pure $ (\ i -> i ls == i rs) ignoreContext + (NVStrF ls , NVStrF rs ) -> pure $ (\ i -> i ls == i rs) getStringIgnoreContext (NVListF ls , NVListF rs ) -> alignEqM eq ls rs (NVSetF _ lm , NVSetF _ rm ) -> attrsEq lm rm (NVPathF lp , NVPathF rp ) -> pure $ lp == rp diff --git a/tests/Main.hs b/tests/Main.hs index 2baff1548..a353ce201 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -56,7 +56,7 @@ ensureNixpkgsCanParse = time <- getCurrentTime runWithBasicEffectsIO (defaultOptions time) $ Nix.nixEvalExprLoc mempty expr - let dir = ignoreContext ns + let dir = getStringIgnoreContext ns exists <- fileExist $ toString dir unless exists $ errorWithoutStackTrace $ diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index 2494de8dc..a278e73c6 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -168,7 +168,7 @@ assertLangOk opts fileBaseName = assertLangOkXml :: Options -> Path -> Assertion assertLangOkXml opts fileBaseName = do - actual <- ignoreContext . toXML <$> hnixEvalFile opts (addNixExt fileBaseName) + actual <- getStringIgnoreContext . toXML <$> hnixEvalFile opts (addNixExt fileBaseName) expected <- read fileBaseName ".exp.xml" assertEqual mempty expected actual From c2207d89a7e95fdc5aa50dc825f21779eeb8a70e Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 19 Jan 2022 20:29:22 +0200 Subject: [PATCH 3/5] String: getString(->If)NoContext --- src/Nix/Builtins.hs | 2 +- src/Nix/Convert.hs | 6 +++--- src/Nix/Effects/Derivation.hs | 2 +- src/Nix/Exec.hs | 4 ++-- src/Nix/String.hs | 11 ++++------- 5 files changed, 11 insertions(+), 14 deletions(-) diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index a7748d36b..3bb03b8da 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -1749,7 +1749,7 @@ fetchurlNix = maybe (throwError $ ErrorCall "builtins.fetchurl: unsupported arguments to url") pure - (getStringNoContext ns) + (getStringIfNoContext ns) partitionNix :: forall e t f m diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index 4ad3944b0..88f4d465c 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -238,7 +238,7 @@ instance Convertible e t f m fromValueMay = pure . \case - NVStr' ns -> encodeUtf8 <$> getStringNoContext ns + NVStr' ns -> encodeUtf8 <$> getStringIfNoContext ns _ -> mempty fromValue = fromMayToValue $ TString mempty @@ -249,7 +249,7 @@ instance Convertible e t f m fromValueMay = pure . \case - NVStr' ns -> getStringNoContext ns + NVStr' ns -> getStringIfNoContext ns _ -> mempty fromValue = fromMayToValue $ TString mempty @@ -262,7 +262,7 @@ instance ( Convertible e t f m fromValueMay = \case NVPath' p -> pure $ pure $ coerce p - NVStr' ns -> pure $ coerce . toString <$> getStringNoContext ns + NVStr' ns -> pure $ coerce . toString <$> getStringIfNoContext ns NVSet' _ s -> maybe stub diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index fe0989024..027aea5d0 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -422,7 +422,7 @@ buildDerivationWithContext drvAttrs = do maybe (lift $ throwError $ ErrorCall $ "The string " <> show ns <> " is not allowed to have a context.") pure - (getStringNoContext ns) + (getStringIfNoContext ns) assertNonNull :: MonadNix e t f m => Text -> WithStringContextT m Text assertNonNull t = do diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index d8748c162..fc93d2466 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -434,7 +434,7 @@ execBinaryOpForced scope span op lval rval = maybe (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412 (\ rs2 -> mkPathP <$> toAbsolutePath @t @f (ls <> coerce (toString rs2))) - (getStringNoContext rs) + (getStringIfNoContext rs) (NVPath ls, NVPath rs) -> mkPathP <$> toAbsolutePath @t @f (ls <> rs) (ls@NVSet{}, NVStr rs) -> @@ -513,7 +513,7 @@ fromStringNoContext ns = maybe (throwError $ ErrorCall $ "expected string with no context, but got " <> show ns) pure - (getStringNoContext ns) + (getStringIfNoContext ns) addTracing ::( MonadNix e t f m diff --git a/src/Nix/String.hs b/src/Nix/String.hs index 74d839423..7aca3f5cf 100644 --- a/src/Nix/String.hs +++ b/src/Nix/String.hs @@ -12,7 +12,7 @@ module Nix.String , fromNixLikeContext , hasContext , intercalateNixString - , getStringNoContext + , getStringIfNoContext , getStringIgnoreContext , mkNixStringWithoutContext , mkNixStringWithSingletonContext @@ -153,12 +153,9 @@ fromNixLikeContext = S.fromList . (uncurry toStringContexts <=< M.toList . getNixLikeContext) -- | Extract the string contents from a NixString that has no context -getStringNoContext :: NixString -> Maybe Text -getStringNoContext a@(NixString c s) = - bool - (pure s) - mempty - (hasContext a) +getStringIfNoContext :: NixString -> Maybe Text +getStringIfNoContext a@(NixString _ s) = + whenFalse (pure s) (hasStringContext a) -- | Extract the string contents from a NixString even if the NixString has an associated context getStringIgnoreContext :: NixString -> Text From ef8e2368c3962c7e745fabae2ff5d65c719d99f5 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 19 Jan 2022 20:31:41 +0200 Subject: [PATCH 4/5] String: has(->String)Context --- src/Nix/Builtins.hs | 2 +- src/Nix/String.hs | 6 +++--- src/Nix/Value.hs | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 3bb03b8da..0ad2f3164 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -457,7 +457,7 @@ hasAttrNix x y = toValue $ M.member key aset hasContextNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) -hasContextNix = inHask hasContext +hasContextNix = inHask hasStringContext getAttrNix :: forall e t f m diff --git a/src/Nix/String.hs b/src/Nix/String.hs index 7aca3f5cf..4e4bd784c 100644 --- a/src/Nix/String.hs +++ b/src/Nix/String.hs @@ -10,7 +10,7 @@ module Nix.String , NixLikeContextValue(..) , toNixLikeContext , fromNixLikeContext - , hasContext + , hasStringContext , intercalateNixString , getStringIfNoContext , getStringIgnoreContext @@ -142,8 +142,8 @@ mkNixString = NixString -- ** Checkers -- | Returns True if the NixString has an associated context -hasContext :: NixString -> Bool -hasContext (NixString c _) = not $ null c +hasStringContext :: NixString -> Bool +hasStringContext (NixString c _) = not $ null c -- ** Getters diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index 5f8f5236e..defca2965 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -736,7 +736,7 @@ valueType = NNull -> TNull NVStrF ns -> TString $ - HasContext `whenTrue` hasContext ns + HasContext `whenTrue` hasStringContext ns NVListF{} -> TList NVSetF{} -> TSet NVClosureF{} -> TClosure From 319e5d2a6c3f1a2d3d59355e82ce9b292e8644af Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Wed, 19 Jan 2022 20:32:48 +0200 Subject: [PATCH 5/5] Builtins: m refactor --- src/Nix/Builtins.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 0ad2f3164..77e851172 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -1791,8 +1791,8 @@ currentTimeNix = derivationStrictNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) derivationStrictNix = derivationStrict -getRecursiveSizeNix :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m) -getRecursiveSizeNix = fmap (mkNVConstant . NInt . fromIntegral) . recursiveSize +valueSizeNix :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m) +valueSizeNix = fmap (mkNVConstant . NInt . fromIntegral) . recursiveSize getContextNix :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) @@ -1994,7 +1994,7 @@ builtinsList = , add Normal "unsafeDiscardOutputDependency" unsafeDiscardOutputDependencyNix , add Normal "unsafeDiscardStringContext" unsafeDiscardStringContextNix , add2 Normal "unsafeGetAttrPos" unsafeGetAttrPosNix - , add Normal "valueSize" getRecursiveSizeNix + , add Normal "valueSize" valueSizeNix ] where