picnoir
/
hnix
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into xml-string-context

This commit is contained in:
Ken Micklas 2018-12-10 15:48:29 -05:00
parent 195d4531cd 281644a3b2
commit 824615aabe
14 changed files with 288 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
hnix.cabal
View File

@ -454,6 +454,7 @@ library
Nix.Expr.Types
Nix.Expr.Types.Annotated
Nix.Frames
Nix.Json
Nix.Lint
Nix.Normal
Nix.Options

4
main/Main.hs
View File

@ -29,6 +29,7 @@ import Data.Text.Prettyprint.Doc.Render.Text
import Nix
import Nix.Convert
import qualified Nix.Eval as Eval
import Nix.Json
-- import Nix.Lint
import Nix.Options.Parser
import qualified Nix.Type.Env as Env
@ -145,7 +146,8 @@ main = do
. TL.decodeUtf8
. A.encodingToLazyByteString
. toEncodingSorted
<=< fromNix
. snd
<=< nvalueToJSON
| strict opts =
liftIO . print . prettyNValueNF <=< normalForm
| values opts =

220
src/Nix/Builtins.hs
View File

@ -38,7 +38,6 @@ import qualified "hashing" Crypto.Hash.SHA1 as SHA1
import qualified "hashing" Crypto.Hash.SHA256 as SHA256
import qualified "hashing" Crypto.Hash.SHA512 as SHA512
#else
import Data.ByteString.Base16 as Base16
import qualified "cryptohash-md5" Crypto.Hash.MD5 as MD5
import qualified "cryptohash-sha1" Crypto.Hash.SHA1 as SHA1
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
@ -52,6 +51,7 @@ import Data.Array
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Lazy as LBS
import Data.Char (isDigit)
import Data.Fix
@ -59,6 +59,7 @@ import Data.Foldable (foldrM)
import qualified Data.HashMap.Lazy as M
import Data.List
import Data.Maybe
import Data.Scientific
import Data.Set (Set)
import qualified Data.Set as S
import Data.String.Interpolate.IsString
@ -70,6 +71,7 @@ import qualified Data.Text.Lazy.Builder as Builder
import Data.These (fromThese)
import qualified Data.Time.Clock.POSIX as Time
import Data.Traversable (for, mapM)
import qualified Data.Vector as V
import Nix.Atoms
import Nix.Convert
import Nix.Effects
@ -78,12 +80,13 @@ import Nix.Exec
import Nix.Expr.Types
import Nix.Expr.Types.Annotated
import Nix.Frames
import Nix.String
import Nix.Json
import Nix.Normal
import Nix.Options
import Nix.Parser hiding (nixPath)
import Nix.Render
import Nix.Scope
import Nix.String
import Nix.Thunk
import Nix.Utils
import Nix.Value
@ -139,7 +142,7 @@ force' = force ?? pure
builtinsList :: forall e m. MonadNix e m => m [ Builtin m ]
builtinsList = sequence [
do version <- toValue ("2.0" :: Text)
do version <- toValue (principledMakeNixStringWithoutContext "2.0")
pure $ Builtin Normal ("nixVersion", version)
, do version <- toValue (5 :: Int)
@ -160,7 +163,7 @@ builtinsList = sequence [
, add2 Normal "catAttrs" catAttrs
, add2 Normal "compareVersions" compareVersions_
, add Normal "concatLists" concatLists
, add' Normal "concatStringsSep" (arity2 Text.intercalate)
, add' Normal "concatStringsSep" (arity2 principledIntercalateNixString)
, add0 Normal "currentSystem" currentSystem
, add0 Normal "currentTime" currentTime_
, add2 Normal "deepSeq" deepSeq
@ -253,15 +256,13 @@ builtinsList = sequence [
, add2 Normal "split" split_
, add Normal "splitVersion" splitVersion_
, add0 Normal "storeDir" (return $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
, add' Normal "stringLength" (arity1 Text.length)
, add' Normal "stringLength" (arity1 $ Text.length . principledStringIgnoreContext)
, add' Normal "sub" (arity2 ((-) @Integer))
, add' Normal "substring" substring
, add Normal "tail" tail_
, add0 Normal "true" (return $ nvConstant $ NBool True)
, add TopLevel "throw" throw_
, add' Normal "toJSON"
(arity1 $ decodeUtf8 . LBS.toStrict . A.encodingToLazyByteString
. toEncodingSorted)
, add Normal "toJSON" prim_toJSON
, add2 Normal "toFile" toFile
, add Normal "toPath" toPath
, add TopLevel "toString" toString
@ -298,9 +299,9 @@ foldNixPath f z = do
mres <- lookupVar "__includes"
dirs <- case mres of
Nothing -> return []
Just v -> fromNix @[Text] v
Just v -> fromNix v
menv <- getEnvVar "NIX_PATH"
foldrM go z $ map fromInclude dirs ++ case menv of
foldrM go z $ map (fromInclude . principledStringIgnoreContext) dirs ++ case menv of
Nothing -> []
Just str -> uriAwareSplit (Text.pack str)
where
@ -327,7 +328,7 @@ toString str = str >>= coerceToString DontCopyToStore CoerceAny >>= toNix
hasAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
hasAttr x y =
fromValue @Text x >>= \key ->
fromValue x >>= fromStringNoContext >>= \key ->
fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->
toNix $ M.member key aset
@ -343,7 +344,7 @@ hasContext =
getAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
getAttr x y =
fromValue @Text x >>= \key ->
fromValue x >>= fromStringNoContext >>= \key ->
fromValue @(AttrSet (NThunk m), AttrSet SourcePos) y >>= \(aset, _) ->
attrsetGet key aset >>= force'
@ -467,7 +468,7 @@ splitVersion s = case Text.uncons s of
in thisComponent : splitVersion rest
splitVersion_ :: MonadNix e m => m (NValue m) -> m (NValue m)
splitVersion_ = fromStringNoContext >=> \s ->
splitVersion_ = fromValue >=> fromStringNoContext >=> \s ->
return $ nvList $ flip map (splitVersion s) $ \c ->
valueThunk $ nvStr $ principledMakeNixStringWithoutContext $ versionComponentToString c
@ -480,8 +481,8 @@ compareVersions s1 s2 =
compareVersions_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
compareVersions_ t1 t2 =
fromStringNoContext t1 >>= \s1 ->
fromStringNoContext t2 >>= \s2 ->
fromValue t1 >>= fromStringNoContext >>= \s1 ->
fromValue t2 >>= fromStringNoContext >>= \s2 ->
return $ nvConstant $ NInt $ case compareVersions s1 s2 of
LT -> -1
EQ -> 0
@ -507,29 +508,43 @@ splitDrvName s =
in (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)
parseDrvName :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
parseDrvName = fromValue >=> \(s :: Text) -> do
parseDrvName = fromValue >=> fromStringNoContext >=> \s -> do
let (name :: Text, version :: Text) = splitDrvName s
-- jww (2018-04-15): There should be an easier way to write this.
(toValue =<<) $ sequence $ M.fromList
[ ("name" :: Text, thunk (toValue @_ @_ @(NValue m) name))
, ("version", thunk (toValue version)) ]
[ ("name" :: Text, thunk (toValue @_ @_ @(NValue m) $ principledMakeNixStringWithoutContext name))
, ("version", thunk (toValue $ principledMakeNixStringWithoutContext version)) ]
match_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
match_ pat str =
fromValue pat >>= \p ->
fromValue str >>= \s -> do
fromValue pat >>= fromStringNoContext >>= \p ->
fromValue str >>= \ns -> do
-- NOTE: Currently prim_match in nix/src/libexpr/primops.cc ignores the
-- context of its second argument. This is probably a bug but we're
-- going to preserve the behavior here until it is fixed upstream.
-- Relevant issue: https://github.com/NixOS/nix/issues/2547
let s = principledStringIgnoreContext ns
let re = makeRegex (encodeUtf8 p) :: Regex
let mkMatch t = if Text.null t
then toValue () -- Shorthand for Null
else toValue $ principledMakeNixStringWithoutContext t
case matchOnceText re (encodeUtf8 s) of
Just ("", sarr, "") -> do
let s = map fst (elems sarr)
nvList <$> traverse (toValue . decodeUtf8)
nvList <$> traverse (mkMatch . decodeUtf8)
(if length s > 1 then tail s else s)
_ -> pure $ nvConstant NNull
split_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
split_ pat str =
fromValue pat >>= \p ->
fromValue str >>= \s -> do
fromValue pat >>= fromStringNoContext >>= \p ->
fromValue str >>= \ns -> do
-- NOTE: Currently prim_split in nix/src/libexpr/primops.cc ignores the
-- context of its second argument. This is probably a bug but we're
-- going to preserve the behavior here until it is fixed upstream.
-- Relevant issue: https://github.com/NixOS/nix/issues/2547
let s = principledStringIgnoreContext ns
let re = makeRegex (encodeUtf8 p) :: Regex
haystack = encodeUtf8 s
return $ nvList $
@ -553,14 +568,14 @@ splitMatches numDropped (((_,(start,len)):captures):mts) haystack =
thunkStr s = valueThunk (nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s)))
substring :: MonadNix e m => Int -> Int -> Text -> Prim m Text
substring :: MonadNix e m => Int -> Int -> NixString -> Prim m NixString
substring start len str = Prim $
if start < 0 --NOTE: negative values of 'len' are OK
then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start
else pure $ Text.take len $ Text.drop start str
else pure $ principledModifyNixContents (Text.take len . Text.drop start) str
attrNames :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
attrNames = fromValue @(ValueSet m) >=> toNix . sort . M.keys
attrNames = fromValue @(ValueSet m) >=> toNix . map principledMakeNixStringWithoutContext . sort . M.keys
attrValues :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
attrValues = fromValue @(ValueSet m) >=>
@ -592,16 +607,15 @@ filter_ fun xs = fun >>= \f ->
catAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
catAttrs attrName xs =
fromValue @Text attrName >>= \n ->
fromValue attrName >>= fromStringNoContext >>= \n ->
fromValue @[NThunk m] xs >>= \l ->
fmap (nvList . catMaybes) $
forM l $ fmap (M.lookup n) . fromValue
baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m)
baseNameOf x = x >>= \case
NVStr ns -> pure $ nvStr (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
NVPath path -> pure $ nvPath $ takeFileName path
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
baseNameOf x = do
ns <- coerceToString DontCopyToStore CoerceStringy =<< x
pure $ nvStr (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
bitAnd :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
bitAnd x y =
@ -626,7 +640,9 @@ dirOf x = x >>= \case
-- jww (2018-04-28): This should only be a string argument, and not coerced?
unsafeDiscardStringContext :: MonadNix e m => m (NValue m) -> m (NValue m)
unsafeDiscardStringContext = fromValue @Text >=> toNix
unsafeDiscardStringContext mnv = do
ns <- fromValue mnv
toNix $ principledMakeNixStringWithoutContext $ principledStringIgnoreContext ns
seq_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
seq_ a b = a >> b
@ -705,39 +721,44 @@ genericClosure = fromValue @(AttrSet (NThunk m)) >=> \s ->
replaceStrings :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m)
replaceStrings tfrom tto ts =
fromNix tfrom >>= \(from :: [Text]) ->
fromNix tto >>= \(to :: [Text]) ->
fromValue ts >>= \(s :: Text) -> do
when (length from /= length to) $
fromNix tfrom >>= \(nsFrom :: [NixString]) ->
fromNix tto >>= \(nsTo :: [NixString]) ->
fromValue ts >>= \(ns :: NixString) -> do
let from = map principledStringIgnoreContext nsFrom
when (length nsFrom /= length nsTo) $
throwError $ ErrorCall $
"'from' and 'to' arguments to 'replaceStrings'"
++ " have different lengths"
let lookupPrefix s = do
(prefix, replacement) <-
find ((`Text.isPrefixOf` s) . fst) $ zip from to
find ((`Text.isPrefixOf` s) . fst) $ zip from nsTo
let rest = Text.drop (Text.length prefix) s
return (prefix, replacement, rest)
finish = LazyText.toStrict . Builder.toLazyText
go orig result = case lookupPrefix orig of
finish b = principledMakeNixString (LazyText.toStrict $ Builder.toLazyText b)
go orig result ctx = case lookupPrefix orig of
Nothing -> case Text.uncons orig of
Nothing -> finish result
Just (h, t) -> go t $ result <> Builder.singleton h
Just (prefix, replacement, rest) -> case prefix of
"" -> case Text.uncons rest of
Nothing -> finish $ result <> Builder.fromText replacement
Just (h, t) -> go t $ mconcat
[ result
, Builder.fromText replacement
, Builder.singleton h
]
_ -> go rest $ result <> Builder.fromText replacement
toNix $ go s mempty
Nothing -> finish result ctx
Just (h, t) -> go t (result <> Builder.singleton h) ctx
Just (prefix, replacementNS, rest) ->
let replacement = principledStringIgnoreContext replacementNS
newCtx = principledGetContext replacementNS
in case prefix of
"" -> case Text.uncons rest of
Nothing -> finish (result <> Builder.fromText replacement) (ctx <> newCtx)
Just (h, t) -> go t (mconcat
[ result
, Builder.fromText replacement
, Builder.singleton h
]) (ctx <> newCtx)
_ -> go rest (result <> Builder.fromText replacement) (ctx <> newCtx)
toNix $ go (principledStringIgnoreContext ns) mempty $ principledGetContext ns
removeAttrs :: forall e m. MonadNix e m
=> m (NValue m) -> m (NValue m) -> m (NValue m)
removeAttrs set = fromNix >=> \(toRemove :: [Text]) ->
removeAttrs set = fromNix >=> \(nsToRemove :: [NixString]) ->
fromValue @(AttrSet (NThunk m),
AttrSet SourcePos) set >>= \(m, p) ->
AttrSet SourcePos) set >>= \(m, p) -> do
toRemove <- mapM fromStringNoContext nsToRemove
toNix (go m toRemove, go p toRemove)
where
go = foldl' (flip M.delete)
@ -763,10 +784,15 @@ functionArgs fun = fun >>= \case
toFile :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
toFile name s = do
name' <- fromValue name
name' <- fromStringNoContext =<< fromValue name
s' <- fromValue s
mres <- toFile_ (Text.unpack name') (Text.unpack s')
toNix $ Text.pack $ unStorePath mres
-- TODO Using hacky here because we still need to turn the context into
-- runtime references of the resulting file.
-- See prim_toFile in nix/src/libexpr/primops.cc
mres <- toFile_ (Text.unpack name') (Text.unpack $ hackyStringIgnoreContext s')
let t = Text.pack $ unStorePath mres
sc = StringContext t DirectPath
toNix $ principledMakeNixStringWithSingletonContext t sc
toPath :: MonadNix e m => m (NValue m) -> m (NValue m)
toPath = fromValue @Path >=> toNix @Path
@ -789,7 +815,7 @@ isList :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
isList = hasKind @[NThunk m]
isString :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
isString = hasKind @Text
isString = hasKind @NixString
isInt :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
isInt = hasKind @Int
@ -809,7 +835,9 @@ isFunction func = func >>= \case
_ -> toValue False
throw_ :: MonadNix e m => m (NValue m) -> m (NValue m)
throw_ = fromValue >=> throwError . ErrorCall . Text.unpack
throw_ mnv = do
ns <- coerceToString CopyToStore CoerceStringy =<< mnv
throwError . ErrorCall . Text.unpack $ principledStringIgnoreContext ns
import_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
import_ = scopedImport (pure (nvSet M.empty M.empty))
@ -834,9 +862,10 @@ scopedImport asetArg pathArg =
importPath @m path'
getEnv_ :: MonadNix e m => m (NValue m) -> m (NValue m)
getEnv_ = fromValue >=> \s -> do
getEnv_ = fromValue >=> fromStringNoContext >=> \s -> do
mres <- getEnvVar (Text.unpack s)
toNix $ case mres of
toNix $ principledMakeNixStringWithoutContext $
case mres of
Nothing -> ""
Just v -> Text.pack v
@ -878,32 +907,37 @@ listToAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
listToAttrs = fromValue @[NThunk m] >=> \l ->
fmap (flip nvSet M.empty . M.fromList . reverse) $
forM l $ fromValue @(AttrSet (NThunk m)) >=> \s -> do
name <- attrsetGet "name" s
name <- fromStringNoContext =<< fromValue =<< attrsetGet "name" s
val <- attrsetGet "value" s
fromValue name <&> (, val)
pure (name, val)
hashString :: MonadNix e m => Text -> Text -> Prim m Text
hashString algo s = Prim $ do
-- prim_hashString from nix/src/libexpr/primops.cc
-- fail if context in the algo arg
-- propagate context from the s arg
hashString :: MonadNix e m => NixString -> NixString -> Prim m NixString
hashString nsAlgo ns = Prim $ do
algo <- fromStringNoContext nsAlgo
let f g = pure $ principledModifyNixContents g ns
case algo of
"md5" -> pure $
"md5" -> f $ \s ->
#if MIN_VERSION_hashing(0, 1, 0)
Text.pack $ show (hash (encodeUtf8 s) :: MD5.MD5)
#else
decodeUtf8 $ Base16.encode $ MD5.hash $ encodeUtf8 s
#endif
"sha1" -> pure $
"sha1" -> f $ \s ->
#if MIN_VERSION_hashing(0, 1, 0)
Text.pack $ show (hash (encodeUtf8 s) :: SHA1.SHA1)
#else
decodeUtf8 $ Base16.encode $ SHA1.hash $ encodeUtf8 s
#endif
"sha256" -> pure $
"sha256" -> f $ \s ->
#if MIN_VERSION_hashing(0, 1, 0)
Text.pack $ show (hash (encodeUtf8 s) :: SHA256.SHA256)
#else
decodeUtf8 $ Base16.encode $ SHA256.hash $ encodeUtf8 s
#endif
"sha512" -> pure $
"sha512" -> f $ \s ->
#if MIN_VERSION_hashing(0, 1, 0)
Text.pack $ show (hash (encodeUtf8 s) :: SHA512.SHA512)
#else
@ -913,9 +947,12 @@ hashString algo s = Prim $ do
++ "expected \"md5\", \"sha1\", \"sha256\", or \"sha512\", got " ++ show algo
placeHolder :: MonadNix e m => m (NValue m) -> m (NValue m)
placeHolder = fromValue @Text >=> \_ -> do
h <- runPrim (hashString "sha256" "fdasdfas")
toNix h
placeHolder = fromValue >=> fromStringNoContext >=> \t -> do
h <- runPrim (hashString (principledMakeNixStringWithoutContext "sha256")
(principledMakeNixStringWithoutContext ("nix-output:" <> t)))
toNix $ principledMakeNixStringWithoutContext $ Text.cons '/' $ printHash32 $
-- The result coming out of hashString is base16 encoded
fst $ Base16.decode $ encodeUtf8 $ principledStringIgnoreContext h
absolutePathFromValue :: MonadNix e m => NValue m -> m FilePath
absolutePathFromValue = \case
@ -952,7 +989,7 @@ data FileType
deriving (Show, Read, Eq, Ord)
instance Applicative m => ToNix FileType m (NValue m) where
toNix = toNix . \case
toNix = toNix . principledMakeNixStringWithoutContext . \case
FileTypeRegular -> "regular" :: Text
FileTypeDirectory -> "directory"
FileTypeSymlink -> "symlink"
@ -972,18 +1009,40 @@ readDir_ pathThunk = do
pure (Text.pack item, t)
toNix (M.fromList itemsWithTypes)
fromJSON :: MonadNix e m => m (NValue m) -> m (NValue m)
fromJSON = fromValue >=> \encoded ->
fromJSON :: forall e m. (MonadNix e m, Typeable m) => m (NValue m) -> m (NValue m)
fromJSON = fromValue >=> fromStringNoContext >=> \encoded ->
case A.eitherDecodeStrict' @A.Value $ encodeUtf8 encoded of
Left jsonError ->
throwError $ ErrorCall $ "builtins.fromJSON: " ++ jsonError
Right v -> toValue v
Right v -> jsonToNValue v
where
jsonToNValue = \case
A.Object m -> flip nvSet M.empty
<$> traverse (thunk . jsonToNValue) m
A.Array l -> nvList <$>
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)
. jsonToNValue $ x) (V.toList l)
A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s
A.Number n -> pure $ nvConstant $ case floatingOrInteger n of
Left r -> NFloat r
Right i -> NInt i
A.Bool b -> pure $ nvConstant $ NBool b
A.Null -> pure $ nvConstant NNull
prim_toJSON
:: MonadNix e m
=> m (NValue m)
-> m (NValue m)
prim_toJSON x = do
(ctx, v) <- nvalueToJSON =<< x
let t = decodeUtf8 $ LBS.toStrict $ A.encodingToLazyByteString $ toEncodingSorted v
pure $ nvStr $ principledMakeNixString t ctx
toXML_ :: MonadNix e m => m (NValue m) -> m (NValue m)
toXML_ v = v >>= normalForm >>= pure . nvStr . toXML
typeOf :: MonadNix e m => m (NValue m) -> m (NValue m)
typeOf v = v >>= toNix @Text . \case
typeOf v = v >>= toNix . principledMakeNixStringWithoutContext . \case
NVConstant a -> case a of
NInt _ -> "int"
NFloat _ -> "float"
@ -1013,7 +1072,7 @@ tryEval e = catch (onSuccess <$> e) (pure . onError)
trace_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
trace_ msg action = do
traceEffect . Text.unpack =<< fromValue @Text msg
traceEffect . Text.unpack . principledStringIgnoreContext =<< fromValue msg
action
-- TODO: remember error context
@ -1023,8 +1082,11 @@ addErrorContext _ action = action
exec_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
exec_ xs = do
ls <- fromValue @[NThunk m] xs
xs <- traverse (fromValue @Text . force') ls
exec (map Text.unpack xs)
xs <- traverse (coerceToString DontCopyToStore CoerceStringy <=< force') ls
-- TODO 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 (map (Text.unpack . hackyStringIgnoreContext) xs)
fetchurl :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
fetchurl v = v >>= \case

103
src/Nix/Convert.hs
View File

@ -27,27 +27,35 @@ module Nix.Convert where
import Control.Monad
import Control.Monad.Free
import Data.Aeson (toJSON)
import qualified Data.Aeson as A
import Data.ByteString
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Vector as V
import Nix.Atoms
import Nix.Effects
import Nix.Expr.Types
import Nix.Expr.Types.Annotated
import Nix.Frames
import Nix.String
import Nix.Normal
import Nix.Thunk
import Nix.Utils
import Nix.Value
{-
IMPORTANT NOTE
We used to have Text instances of FromValue, ToValue, FromNix, and ToNix.
However, we're removing these instances because they are dangerous due to the
fact that they hide the way string contexts are handled. It's better to have to
explicitly handle string context in a way that is appropriate for the situation.
Do not add these instances back!
-}
class FromValue a m v where
fromValue :: v -> m a
fromValueMay :: v -> m (Maybe a)
@ -145,32 +153,6 @@ instance Convertible e m
Just b -> pure b
_ -> throwError $ Expectation TFloat v
instance (Convertible e m, MonadEffects m)
=> FromValue Text m (NValueNF m) where
fromValueMay = \case
Free (NVStrF ns) -> pure $ hackyGetStringNoContext ns
Free (NVPathF p) -> Just . Text.pack . unStorePath <$> addPath p
Free (NVSetF s _) -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fromValueMay @Text p
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
_ -> throwError $ ExpectationNF (TString NoContext) v
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
=> FromValue Text m (NValue m) where
fromValueMay = \case
NVStr ns -> pure $ hackyGetStringNoContext ns
NVPath p -> Just . Text.pack . unStorePath <$> addPath p
NVSet s _ -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fromValueMay @Text p
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
_ -> throwError $ Expectation (TString NoContext) v
instance (Convertible e m, MonadEffects m)
=> FromValue NixString m (NValueNF m) where
fromValueMay = \case
@ -178,7 +160,7 @@ instance (Convertible e m, MonadEffects m)
Free (NVPathF p) -> Just . hackyMakeNixStringWithoutContext . Text.pack . unStorePath <$> addPath p
Free (NVSetF s _) -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fmap hackyMakeNixStringWithoutContext <$> fromValueMay @Text p
Just p -> fromValueMay p
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
@ -191,7 +173,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
NVPath p -> Just . hackyMakeNixStringWithoutContext . Text.pack . unStorePath <$> addPath p
NVSet s _ -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fmap hackyMakeNixStringWithoutContext <$> fromValueMay @Text p
Just p -> fromValueMay p
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
@ -314,26 +296,6 @@ instance (MonadThunk (NValue m) (NThunk m) m, FromValue a m (NValue m))
fromValueMay = force ?? fromValueMay
fromValue = force ?? fromValue
instance (Convertible e m, MonadEffects m)
=> FromValue A.Value m (NValueNF m) where
fromValueMay = \case
Free (NVConstantF a) -> pure $ Just $ case a of
NInt n -> toJSON n
NFloat n -> toJSON n
NBool b -> toJSON b
NNull -> A.Null
Free (NVStrF ns) -> pure $ toJSON <$> hackyGetStringNoContext ns
Free (NVListF l) ->
fmap (A.Array . V.fromList) . sequence
<$> traverse fromValueMay l
Free (NVSetF m _) ->
fmap A.Object . sequence <$> traverse fromValueMay m
Free (NVPathF p) -> Just . toJSON . unStorePath <$> addPath p
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
_ -> throwError $ CoercionToJsonNF v
class ToValue a m v where
toValue :: a -> m v
@ -367,12 +329,6 @@ instance Applicative m => ToValue Float m (NValueNF m) where
instance Applicative m => ToValue Float m (NValue m) where
toValue = pure . nvConstant . NFloat
instance Applicative m => ToValue Text m (NValueNF m) where
toValue = pure . Free . NVStrF . hackyMakeNixStringWithoutContext
instance Applicative m => ToValue Text m (NValue m) where
toValue = pure . nvStr . hackyMakeNixStringWithoutContext
instance Applicative m => ToValue NixString m (NValueNF m) where
toValue = pure . Free . NVStrF
@ -400,7 +356,7 @@ instance Applicative m => ToValue StorePath m (NValue m) where
instance MonadThunk (NValue m) (NThunk m) m
=> ToValue SourcePos m (NValue m) where
toValue (SourcePos f l c) = do
f' <- toValue (Text.pack f)
f' <- pure $ nvStr $ principledMakeNixStringWithoutContext (Text.pack f)
l' <- toValue (unPos l)
c' <- toValue (unPos c)
let pos = M.fromList
@ -446,21 +402,6 @@ whileForcingThunk :: forall s e m r. (Framed e m, Exception s, Typeable m)
whileForcingThunk frame =
withFrame Debug (ForcingThunk @m) . withFrame Debug frame
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
=> ToValue A.Value m (NValue m) where
toValue = \case
A.Object m -> flip nvSet M.empty
<$> traverse (thunk . toValue @_ @_ @(NValue m)) m
A.Array l -> nvList <$>
traverse (\x -> thunk . whileForcingThunk (CoercionFromJson @m x)
. toValue $ x) (V.toList l)
A.String s -> pure $ nvStr $ hackyMakeNixStringWithoutContext s
A.Number n -> pure $ nvConstant $ case floatingOrInteger n of
Left r -> NFloat r
Right i -> NInt i
A.Bool b -> pure $ nvConstant $ NBool b
A.Null -> pure $ nvConstant NNull
class FromNix a m v where
fromNix :: v -> m a
default fromNix :: FromValue a m v => v -> m a
@ -500,8 +441,6 @@ instance Convertible e m => FromNix Integer m (NValueNF m) where
instance Convertible e m => FromNix Integer m (NValue m) where
instance Convertible e m => FromNix Float m (NValueNF m) where
instance Convertible e m => FromNix Float m (NValue m) where
instance (Convertible e m, MonadEffects m) => FromNix Text m (NValueNF m) where
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix Text m (NValue m) where
instance (Convertible e m, MonadEffects m) => FromNix NixString m (NValueNF m) where
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix NixString m (NValue m) where
instance Convertible e m => FromNix ByteString m (NValueNF m) where
@ -512,13 +451,6 @@ instance (Convertible e m, FromValue a m (NValueNF m), Show a) => FromNix [a] m
instance Convertible e m => FromNix (HashMap Text (NValueNF m)) m (NValueNF m) where
instance Convertible e m => FromNix (HashMap Text (NValueNF m), HashMap Text SourcePos) m (NValueNF m) where
instance Convertible e m => FromNix (HashMap Text (NThunk m), HashMap Text SourcePos) m (NValue m) where
instance (Convertible e m, MonadEffects m, MonadThunk (NValue m) (NThunk m) m) => FromNix A.Value m (NValueNF m) where
instance (Convertible e m, MonadEffects m,
MonadThunk (NValue m) (NThunk m) m)
=> FromNix A.Value m (NValue m) where
fromNixMay = fromNixMay <=< normalForm
fromNix = fromNix <=< normalForm
instance (Monad m, FromNix a m v) => FromNix a m (m v) where
fromNixMay = (>>= fromNixMay)
@ -563,8 +495,6 @@ instance Applicative m => ToNix Integer m (NValueNF m) where
instance Applicative m => ToNix Integer m (NValue m) where
instance Applicative m => ToNix Float m (NValueNF m) where
instance Applicative m => ToNix Float m (NValue m) where
instance Applicative m => ToNix Text m (NValueNF m) where
instance Applicative m => ToNix Text m (NValue m) where
instance Applicative m => ToNix NixString m (NValueNF m) where
instance Applicative m => ToNix NixString m (NValue m) where
instance Applicative m => ToNix ByteString m (NValueNF m) where
@ -574,7 +504,6 @@ instance Applicative m => ToNix Path m (NValue m) where
instance Applicative m => ToNix (HashMap Text (NValueNF m)) m (NValueNF m) where
instance Applicative m => ToNix (HashMap Text (NValueNF m), HashMap Text SourcePos) m (NValueNF m) where
instance Applicative m => ToNix (HashMap Text (NThunk m), HashMap Text SourcePos) m (NValue m) where
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m) => ToNix A.Value m (NValue m) where
instance Applicative m => ToNix Bool m (NExprF r) where
instance Applicative m => ToNix () m (NExprF r) where

31
src/Nix/Exec.hs
View File

@ -394,8 +394,8 @@ execBinaryOp scope span op lval rarg = do
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVPath p, NVStr ns) -> case op of
NEq -> toBool $ Just p == fmap Text.unpack (hackyGetStringNoContext ns)
NNEq -> toBool $ Just p /= fmap Text.unpack (hackyGetStringNoContext ns)
NEq -> toBool False -- From eqValues in nix/src/libexpr/eval.cc
NNEq -> toBool True
NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack (hackyStringIgnoreContext ns))
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
@ -478,9 +478,9 @@ coerceToString ctsm clevel = go
where
t = Text.pack $ unStorePath sp
fromStringNoContext :: MonadNix e m => m (NValue m) -> m Text
fromStringNoContext =
fromValue >=> \s -> case principledGetStringNoContext s of
fromStringNoContext :: MonadNix e m => NixString -> m Text
fromStringNoContext ns =
case principledGetStringNoContext ns of
Just str -> return str
Nothing -> throwError $ ErrorCall
"expected string with no context"
@ -591,10 +591,13 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
mapMaybeM op = foldr f (return [])
where f x xs = op x >>= (<$> xs) . (++) . maybeToList
--handleEntry :: Bool -> (Text, NThunk (Lazy m)) -> Lazy m (Maybe (Text, NThunk (Lazy m)))
handleEntry ignoreNulls (k, v) = fmap (k,) <$> case k of
-- The `args' attribute is special: it supplies the command-line
-- arguments to the builder.
"args" -> Just <$> convertNix @[Text] v
-- TODO This use of coerceToString is probably not right and may
-- not have the right arguments.
"args" -> force v (\v2 -> Just <$> coerceNix v2)
"__ignoreNulls" -> pure Nothing
_ -> force v $ \case
NVConstant NNull | ignoreNulls -> pure Nothing
@ -662,8 +665,11 @@ findPathBy finder l name = do
case M.lookup "prefix" s of
Nothing -> tryPath path Nothing
Just pf -> force pf $ fromValueMay >=> \case
Just (pfx :: Text) | not (Text.null pfx) ->
tryPath path (Just (Text.unpack pfx))
Just (nsPfx :: NixString) ->
let pfx = hackyStringIgnoreContext nsPfx
in if not (Text.null pfx)
then tryPath path (Just (Text.unpack pfx))
else tryPath path Nothing
_ -> tryPath path Nothing
tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =
@ -778,10 +784,11 @@ fetchTarball v = v >>= \case
fetch uri Nothing =
nixInstantiateExpr $ "builtins.fetchTarball \"" ++
Text.unpack uri ++ "\""
fetch url (Just m) = fromValue m >>= \sha ->
nixInstantiateExpr $ "builtins.fetchTarball { "
++ "url = \"" ++ Text.unpack url ++ "\"; "
++ "sha256 = \"" ++ Text.unpack sha ++ "\"; }"
fetch url (Just m) = fromValue m >>= \nsSha ->
let sha = hackyStringIgnoreContext nsSha
in nixInstantiateExpr $ "builtins.fetchTarball { "
++ "url = \"" ++ Text.unpack url ++ "\"; "
++ "sha256 = \"" ++ Text.unpack sha ++ "\"; }"
exec :: (MonadExec m, Framed e m, MonadThrow m, Alternative m, MonadCatch m, MonadFix m, MonadEffects m, GEq (Ref m), MonadAtomicRef m, Typeable m, Has e Options, Has e SrcSpan, Scoped (NThunk m) m) => [String] -> m (NValue m)
exec args = either throwError evalExprLoc =<< exec' args

38
src/Nix/Json.hs Normal file
View File

@ -0,0 +1,38 @@
{-# LANGUAGE FlexibleContexts #-}
module Nix.Json where
import qualified Data.Aeson as A
import qualified Data.HashSet as HS
import qualified Data.Text as Text
import qualified Data.Vector as V
import Nix.Atoms
import Nix.Effects
import Nix.Exec
import Nix.Frames
import Nix.String
import Nix.Thunk
import Nix.Value
nvalueToJSON
:: MonadNix e m
=> NValue m
-> m (HS.HashSet StringContext, A.Value)
nvalueToJSON v = case v of
NVConstant a -> retEmpty $ case a of
NInt n -> A.toJSON n
NFloat n -> A.toJSON n
NBool b -> A.toJSON b
NNull -> A.Null
NVStr ns -> pure (principledGetContext ns, A.toJSON $ principledStringIgnoreContext ns)
NVList l -> do
(ctxs, vals) <- unzip <$> traverse (`force` nvalueToJSON) l
return (HS.unions ctxs, A.Array $ V.fromList vals)
NVSet m _ ->
fmap A.Object . sequence <$> traverse (`force` nvalueToJSON) m
NVPath p -> do
fp <- unStorePath <$> addPath p
return (HS.singleton $ StringContext (Text.pack fp) DirectPath, A.toJSON fp)
_ -> throwError $ CoercionToJson v
where
retEmpty a = pure (mempty, a)

4
src/Nix/Render/Frame.hs
View File

@ -153,7 +153,9 @@ renderValueFrame level = fmap (:[]) . \case
desc | level <= Error = "Cannot coerce "
| otherwise = "While coercing "
CoercionToJsonNF _v -> pure "CoercionToJsonNF"
CoercionToJson v -> do
v' <- renderValue level "" "" v
pure $ "CoercionToJson " <> v'
CoercionFromJson _j -> pure "CoercionFromJson"
ExpectationNF _t _v -> pure "ExpectationNF"
Expectation t v -> do

13
src/Nix/String.hs
View File

@ -4,6 +4,8 @@
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Nix.String (
NixString
, principledGetContext
, principledMakeNixString
, principledMempty
, StringContext(..)
, ContextFlavor(..)
@ -57,6 +59,9 @@ data NixString = NixString
instance Hashable NixString
principledGetContext :: NixString -> S.HashSet StringContext
principledGetContext = nsContext
-- | Combine two NixStrings using mappend
principledMempty :: NixString
principledMempty = NixString "" mempty
@ -111,7 +116,7 @@ principledGetStringNoContext (NixString s c) | null c = Just s
principledStringIgnoreContext :: NixString -> Text
principledStringIgnoreContext (NixString s _) = s
-- | Extract the string contents from a NixString even if the NixString has an associated context
-- | Extract the string contents from a NixString even if the NixString has an associated context
hackyStringIgnoreContext :: NixString -> Text
hackyStringIgnoreContext (NixString s _) = s
@ -127,7 +132,7 @@ hackyMakeNixStringWithoutContext = flip NixString mempty
principledMakeNixStringWithoutContext :: Text -> NixString
principledMakeNixStringWithoutContext = flip NixString mempty
-- | Modify the string part of the NixString -- ignores the context
-- | Modify the string part of the NixString, leaving the context unchanged
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
principledModifyNixContents f (NixString s c) = NixString (f s) c
@ -135,6 +140,10 @@ principledModifyNixContents f (NixString s c) = NixString (f s) c
principledMakeNixStringWithSingletonContext :: Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)
-- | Create a NixString from a Text and context
principledMakeNixString :: Text -> S.HashSet StringContext -> NixString
principledMakeNixString s c = NixString s c
-- | A monad for accumulating string context while producing a result string.
newtype WithStringContext a = WithStringContext (Writer (S.HashSet StringContext) a)
deriving (Functor, Applicative, Monad, MonadWriter (S.HashSet StringContext))

27
src/Nix/Utils.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
@ -13,6 +14,9 @@ import Control.Monad
import Control.Monad.Fix
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Fix
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M
@ -123,3 +127,26 @@ uriAwareSplit = go where
let ((suffix, _):path) = go (Text.drop 3 e2)
in (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
| otherwise -> (e1, PathEntryPath) : go (Text.drop 1 e2)
printHash32 :: ByteString -> Text
printHash32 bs = go (base32Len bs - 1) ""
where
go n s
| n >= 0 = go (n-1) (Text.snoc s $ nextCharHash32 bs n)
| otherwise = s
nextCharHash32 :: ByteString -> Int -> Char
nextCharHash32 bs n = Text.index base32Chars (c .&. 0x1f)
where
b = n * 5
i = b `div` 8
j = b `mod` 8
c = fromIntegral $ shiftR (B.index bs i) j .|. mask
mask = if i >= B.length bs - 1
then 0
else shiftL (B.index bs (i+1)) (8 - j)
-- e, o, u, and t are omitted (see base32Chars in nix/src/libutil/hash.cc)
base32Chars = "0123456789abcdfghijklmnpqrsvwxyz"
base32Len :: ByteString -> Int
base32Len bs = ((B.length bs * 8 - 1) `div` 5) + 1

4
src/Nix/Value.hs
View File

@ -260,8 +260,6 @@ valueEq :: MonadThunk (NValue m) (NThunk m) m
valueEq = curry $ \case
(NVConstant lc, NVConstant rc) -> pure $ lc == rc
(NVStr ls, NVStr rs) -> pure $ principledStringIgnoreContext ls == principledStringIgnoreContext rs
(NVStr ns, NVConstant NNull) -> pure (hackyGetStringNoContext ns == Just "")
(NVConstant NNull, NVStr ns) -> pure (Just "" == hackyGetStringNoContext ns)
(NVList ls, NVList rs) -> alignEqM thunkEq ls rs
(NVSet lm _, NVSet rm _) -> do
let compareAttrs = alignEqM thunkEq lm rm
@ -357,7 +355,7 @@ data ValueFrame m
| Multiplication (NValue m) (NValue m)
| Division (NValue m) (NValue m)
| Coercion ValueType ValueType
| CoercionToJsonNF (NValueNF m)
| CoercionToJson (NValue m)
| CoercionFromJson A.Value
| ExpectationNF ValueType (NValueNF m)
| Expectation ValueType (NValue m)

18
tests/eval-compare/builtins.replaceStrings-01.nix Normal file
View File

@ -0,0 +1,18 @@
with builtins;
let a1 = toFile "foo" "foo contents"; # /nix/store/pqwdc5m06lxl8gmzcd26ifwsdhq9fj7k-foo
a2 = toFile "bar" "bar contents"; # /nix/store/4q6kxj1ym13yfp1bcdrzrwa1la6dqgp5-bar
b = dirOf a1;
c = substring 3 1 b;
d = replaceStrings ["b"] [c] "abc";
e = replaceStrings ["k"] [c] "abc";
f = replaceStrings ["y"] [c] (dirOf a2);
g = replaceStrings ["s"] [c] (dirOf a2);
h = replaceStrings ["y"] ["z"] "abc";
in [ b c d e f g h # TODO Add a1 here when we have correct store hashing working
(hasContext d)
(hasContext e)
(hasContext f)
(hasContext g)
(hasContext h)
]

8
tests/eval-compare/builtins.toJSON.nix Normal file
View File

@ -0,0 +1,8 @@
with builtins;
let f = toFile "foo" "foo contents"; # /nix/store/pqwdc5m06lxl8gmzcd26ifwsdhq9fj7k-foo
objA = { a = 15; b = substring 1 3 (dirOf f); };
objB = { a = 42; b = "hello"; };
in [ (hasContext (toJSON objA))
(hasContext (toJSON objB))
]

1
tests/eval-compare/paths-01.nix Normal file
View File

@ -0,0 +1 @@
baseNameOf foo/bar

1
tests/eval-compare/placeholder.nix Normal file
View File

@ -0,0 +1 @@
builtins.placeholder "foo"