support tarballs in NIX_PATH and -I
This commit is contained in:
Jude Taylor
parent
7d549d67c6
commit
368f7e038c
|
|
@ -292,27 +292,32 @@ builtinsList = sequence [
|
|||
-- Primops
|
||||
|
||||
foldNixPath :: forall e m r. MonadNix e m
|
||||
=> (FilePath -> Maybe String -> r -> m r) -> r -> m r
|
||||
=> (FilePath -> Maybe String -> NixPathEntryType -> r -> m r) -> r -> m r
|
||||
foldNixPath f z = do
|
||||
mres <- lookupVar @_ @(NThunk m) "__includes"
|
||||
dirs <- case mres of
|
||||
Nothing -> return []
|
||||
Just v -> fromNix @[Text] v
|
||||
menv <- getEnvVar "NIX_PATH"
|
||||
foldrM go z $ dirs ++ case menv of
|
||||
foldrM go z $ map fromInclude dirs ++ case menv of
|
||||
Nothing -> []
|
||||
Just str -> Text.splitOn ":" (Text.pack str)
|
||||
Just str -> uriAwareSplit (Text.pack str)
|
||||
where
|
||||
go x rest = case Text.splitOn "=" x of
|
||||
[p] -> f (Text.unpack p) Nothing rest
|
||||
[n, p] -> f (Text.unpack p) (Just (Text.unpack n)) rest
|
||||
fromInclude x
|
||||
| "://" `Text.isInfixOf` x = (x, PathEntryURI)
|
||||
| otherwise = (x, PathEntryPath)
|
||||
go (x, ty) rest = case Text.splitOn "=" x of
|
||||
[p] -> f (Text.unpack p) Nothing ty rest
|
||||
[n, p] -> f (Text.unpack p) (Just (Text.unpack n)) ty rest
|
||||
_ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " ++ show x
|
||||
|
||||
nixPath :: MonadNix e m => m (NValue m)
|
||||
nixPath = fmap nvList $ flip foldNixPath [] $ \p mn rest ->
|
||||
nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
|
||||
pure $ valueThunk
|
||||
(flip nvSet mempty $ M.fromList
|
||||
[ ("path", valueThunk $ nvPath p)
|
||||
[ case ty of
|
||||
PathEntryPath -> ("path", valueThunk $ nvPath p)
|
||||
PathEntryURI -> ("uri", valueThunk $ nvStr (Text.pack p) mempty)
|
||||
, ("prefix", valueThunk $
|
||||
nvStr (Text.pack (fromMaybe "" mn)) mempty) ]) : rest
|
||||
|
||||
|
|
@ -1011,43 +1016,6 @@ exec_ xs = do
|
|||
xs <- traverse (fromValue @Text . force') ls
|
||||
exec (map Text.unpack xs)
|
||||
|
||||
fetchTarball :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
fetchTarball v = v >>= \case
|
||||
NVSet s _ -> case M.lookup "url" s of
|
||||
Nothing -> throwError $ ErrorCall
|
||||
"builtins.fetchTarball: Missing url attribute"
|
||||
Just url -> force url $ go (M.lookup "sha256" s)
|
||||
v@NVStr {} -> go Nothing v
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.fetchTarball: Expected URI or set, got " ++ show v
|
||||
where
|
||||
go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
|
||||
go msha = \case
|
||||
NVStr uri _ -> fetch uri 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
|
||||
fetch :: Text -> Maybe (NThunk m) -> m (NValue m)
|
||||
fetch uri msha = case takeExtension (Text.unpack uri) of
|
||||
".tgz" -> undefined
|
||||
".gz" -> undefined
|
||||
".bz2" -> undefined
|
||||
".xz" -> undefined
|
||||
".tar" -> undefined
|
||||
ext -> throwError $ ErrorCall $ "builtins.fetchTarball: Unsupported extension '"
|
||||
++ ext ++ "'"
|
||||
-}
|
||||
|
||||
fetch :: Text -> Maybe (NThunk m) -> m (NValue m)
|
||||
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 ++ "\"; }"
|
||||
|
||||
fetchurl :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
fetchurl v = v >>= \case
|
||||
NVSet s _ -> attrsetGet "url" s >>= force ?? (go (M.lookup "sha256" s))
|
||||
|
|
|
|||
|
|
@ -715,23 +715,28 @@ findPathBy finder l name = do
|
|||
go :: Maybe FilePath -> NThunk m -> m (Maybe FilePath)
|
||||
go p@(Just _) _ = pure p
|
||||
go Nothing l = force l $ fromValue >=>
|
||||
\(s :: HashMap Text (NThunk m)) ->
|
||||
case M.lookup "path" s of
|
||||
Just p -> force p $ fromValue >=> \(Path path) ->
|
||||
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))
|
||||
_ -> tryPath path Nothing
|
||||
Nothing ->
|
||||
throwError $ ErrorCall $ "__nixPath must be a list of attr sets"
|
||||
++ " with 'path' elements, but saw: " ++ show s
|
||||
\(s :: HashMap Text (NThunk m)) -> do
|
||||
p <- resolvePath s
|
||||
force p $ fromValue >=> \(Path path) ->
|
||||
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))
|
||||
_ -> tryPath path Nothing
|
||||
|
||||
tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =
|
||||
finder $ p <///> joinPath ns
|
||||
tryPath p _ = finder $ p <///> name
|
||||
|
||||
resolvePath s = case M.lookup "path" s of
|
||||
Just t -> return t
|
||||
Nothing -> case M.lookup "uri" s of
|
||||
Just ut -> thunk $ fetchTarball (force ut pure)
|
||||
Nothing ->
|
||||
throwError $ ErrorCall $ "__nixPath must be a list of attr sets"
|
||||
++ " with 'path' elements, but saw: " ++ show s
|
||||
|
||||
findPathM :: forall e m. (MonadNix e m, MonadIO m) =>
|
||||
[NThunk m] -> FilePath -> m FilePath
|
||||
findPathM l name = findPathBy path l name
|
||||
|
|
@ -799,3 +804,40 @@ evalExprLoc expr = do
|
|||
where
|
||||
phi = Eval.eval @_ @(NValue m) @(NThunk m) @m . annotated . getCompose
|
||||
raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x
|
||||
|
||||
fetchTarball :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m)
|
||||
fetchTarball v = v >>= \case
|
||||
NVSet s _ -> case M.lookup "url" s of
|
||||
Nothing -> throwError $ ErrorCall
|
||||
"builtins.fetchTarball: Missing url attribute"
|
||||
Just url -> force url $ go (M.lookup "sha256" s)
|
||||
v@NVStr {} -> go Nothing v
|
||||
v -> throwError $ ErrorCall $
|
||||
"builtins.fetchTarball: Expected URI or set, got " ++ show v
|
||||
where
|
||||
go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
|
||||
go msha = \case
|
||||
NVStr uri _ -> fetch uri 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
|
||||
fetch :: Text -> Maybe (NThunk m) -> m (NValue m)
|
||||
fetch uri msha = case takeExtension (Text.unpack uri) of
|
||||
".tgz" -> undefined
|
||||
".gz" -> undefined
|
||||
".bz2" -> undefined
|
||||
".xz" -> undefined
|
||||
".tar" -> undefined
|
||||
ext -> throwError $ ErrorCall $ "builtins.fetchTarball: Unsupported extension '"
|
||||
++ ext ++ "'"
|
||||
-}
|
||||
|
||||
fetch :: Text -> Maybe (NThunk m) -> m (NValue m)
|
||||
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 ++ "\"; }"
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ import qualified Data.HashMap.Lazy as M
|
|||
import Data.List (sortOn)
|
||||
import Data.Monoid (Endo)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Vector as V
|
||||
import Lens.Family2 as X
|
||||
import Lens.Family2.Stock (_1, _2)
|
||||
|
|
@ -108,3 +109,17 @@ toEncodingSorted = \case
|
|||
$ M.toList m
|
||||
A.Array l -> A.list toEncodingSorted $ V.toList l
|
||||
v -> A.toEncoding v
|
||||
|
||||
data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Show, Eq)
|
||||
|
||||
-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon
|
||||
-- (i.e. @https://...@)
|
||||
uriAwareSplit :: Text -> [(Text, NixPathEntryType)]
|
||||
uriAwareSplit = go where
|
||||
go str = case Text.break (== ':') str of
|
||||
(e1, e2)
|
||||
| Text.null e2 -> [(e1, PathEntryPath)]
|
||||
| Text.pack "://" `Text.isPrefixOf` e2 ->
|
||||
let ((suffix, _):path) = go (Text.drop 3 e2)
|
||||
in (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
|
||||
| otherwise -> (e1, PathEntryPath) : go (Text.drop 1 e2)
|
||||
|
|
|
|||
Loading…
Reference in a new issue