diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 821efeb..7fbfaa5 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -36,7 +36,7 @@ import Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS import Data.Char (isDigit) import Data.Coerce -import Data.Foldable (foldlM) +import Data.Foldable (foldlM, foldrM) import qualified Data.HashMap.Lazy as M import Data.List import Data.Maybe @@ -224,13 +224,35 @@ call2 f arg1 arg2 = force f $ \f' -> -- Primops +foldNixPath :: forall e m r. + (Scoped e (NThunk m) m, MonadEffects m, + Framed e m, MonadThrow m, MonadVar m, MonadFile m) + => (FilePath -> Maybe String -> r -> m r) -> r -> m r +foldNixPath f z = do + mres <- lookupVar @_ @(NThunk m) "__includes" + dirs <- case mres of + Nothing -> return [] + Just v -> force v $ \case + NVList xs -> forM xs $ flip force $ \case + NVStr s _ -> pure s + _ -> error "impossible" + _ -> error "impossible" + menv <- getEnvVar "NIX_PATH" + foldrM go z $ dirs ++ case menv of + Nothing -> [] + Just str -> Text.splitOn ":" (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 + _ -> throwError $ "Unexpected entry in NIX_PATH: " ++ show x + nixPath :: MonadBuiltins e m => m (NValue m) -nixPath = fmap NVList $ foldNixPath [] $ \acc p mn -> pure $ +nixPath = fmap NVList $ flip foldNixPath [] $ \p mn rest -> pure $ (valueThunk . flip NVSet M.empty . M.fromList $ - [ ("path", valueThunk $ NVPath p) - , ("prefix", valueThunk $ - NVStr (Text.pack (fromMaybe "" mn)) mempty) ]) - : acc + [ ("path", valueThunk $ NVPath p) + , ("prefix", valueThunk $ + NVStr (Text.pack (fromMaybe "" mn)) mempty) ]) : rest toString :: MonadBuiltins e m => NThunk m -> m (NValue m) toString str = do diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 8bd34ce..0670212 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -17,6 +17,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -88,12 +89,16 @@ instance ConvertValue (NValue m) Float where instance ConvertValue (NValue m) Text where ofVal = flip NVStr mempty - wantVal = \case NVStr t _ -> Just t; _ -> Nothing + wantVal = \case + NVStr t _ -> Just t + NVPath p -> Just (Text.pack p) + _ -> Nothing instance ConvertValue (NValue m) (Maybe Text) where ofVal (Just s) = NVStr s mempty ofVal Nothing = NVConstant NNull wantVal (NVStr s _) = Just (Just s) + wantVal (NVPath s) = Just (Just (Text.pack s)) wantVal (NVConstant NNull) = Just Nothing wantVal _ = Nothing @@ -379,28 +384,51 @@ instance (MonadFix m, MonadThrow m, MonadIO m) => MonadEffects (Lazy m) where ++ " __cur_file is in scope," ++ " but is not a path; it is: " ++ show v - pure $ cwd origPath + pure $ cwd origPath liftIO $ removeDotDotIndirections <$> canonicalizePath absPath - findEnvPath name = foldNixPath Nothing go >>= \case - Nothing -> throwError $ "file '" ++ name - ++ "' was not found in the Nix search path" - ++ " (add it using $NIX_PATH or -I)" - Just path -> return path + findEnvPath name = do + mres <- lookupVar @_ @(NThunk (Lazy m)) "__nixPath" + mpath <- case mres of + Nothing -> error "impossible" + Just x -> force x $ \case + NVList l -> foldM go Nothing l + v -> throwError $ + "__nixPath must be a list of attr sets, but saw: " + ++ show v + case mpath of + Nothing -> + throwError $ "file '" ++ name + ++ "' was not found in the Nix search path" + ++ " (add it using $NIX_PATH or -I)" + Just path -> return path where - go p@(Just _) _ _ = pure p - go Nothing p Nothing = do - traceM $ "[p] = " ++ p - traceM $ "name = " ++ name - traceM $ "cand = " ++ p name - nixFilePath $ p name - go Nothing p (Just n) - | n':ns <- splitDirectories name, n == n' = do - traceM $ "[n, p] = " ++ n ++ ", " ++ p - traceM $ "name = " ++ name - traceM $ "cand = " ++ p joinPath ns - nixFilePath $ p joinPath ns - go _ _ _ = return Nothing + -- jww (2018-04-13): Introduce abstractions to make working with Nix + -- values like this within Haskell much easier! + go :: Maybe FilePath -> NThunk (Lazy m) -> Lazy m (Maybe FilePath) + go p@(Just _) _ = pure p + go Nothing l = force l $ \case + v@(NVSet s _) -> case M.lookup "path" s of + Just p -> force p $ \p' -> case wantVal p' of + Just (path :: Text) -> case M.lookup "prefix" s of + Nothing -> tryPath (Text.unpack path) Nothing + Just pf -> force pf $ \pf' -> case wantVal pf' of + Just (pfx :: Text) | not (Text.null pfx) -> + tryPath (Text.unpack path) + (Just (Text.unpack pfx)) + _ -> tryPath (Text.unpack path) Nothing + _ -> throwError $ "__nixPath must be a list of attr sets" + ++ " with textual 'path' elements, but saw: " ++ show v + Nothing -> + throwError $ "__nixPath must be a list of attr sets" + ++ " with 'path' elements, but saw: " + ++ show v + v -> throwError $ "__nixPath must be a list of attr sets" + ++ " with textual 'path' elements, but saw: " ++ show v + + tryPath p (Just n) | n':ns <- splitDirectories name, n == n' = + nixFilePath $ p joinPath ns + tryPath p _ = nixFilePath $ p name pathExists = liftIO . fileExist @@ -480,44 +508,23 @@ removeDotDotIndirections = intercalate "/" . go [] . splitOn "/" pathToDefaultNixFile :: FilePath -> IO FilePath pathToDefaultNixFile p = do isDir <- doesDirectoryExist p - pure $ if isDir - then p "default.nix" - else p + pure $ if isDir then p "default.nix" else p + +infixr 9 +() :: FilePath -> FilePath -> FilePath +x y | isAbsolute y || "." `isPrefixOf` y = x y + | otherwise = joinByLargestOverlap x y + where + joinByLargestOverlap (splitDirectories -> xs) (splitDirectories -> ys) = + joinPath $ head [ xs ++ drop (length tx) ys + | tx <- tails xs, tx `elem` inits ys ] nixFilePath :: (MonadEffects m, MonadIO m) => FilePath -> m (Maybe FilePath) nixFilePath path = do path <- makeAbsolutePath path - traceM $ "path = " ++ path exists <- liftIO $ doesDirectoryExist path - traceM $ "exists = " ++ show exists - path' <- - if exists - then makeAbsolutePath $ path "default.nix" - else return path - traceM $ "path' = " ++ path' + path' <- if exists + then makeAbsolutePath $ path "default.nix" + else return path exists <- liftIO $ doesFileExist path' - traceM $ "exists = " ++ show exists return $ if exists then Just path' else Nothing - -foldNixPath :: forall e m r. - (Scoped e (NThunk m) m, MonadEffects m, - Framed e m, MonadThrow m, MonadVar m, MonadFile m) - => r -> (r -> FilePath -> Maybe String -> m r) -> m r -foldNixPath z f = do - mres <- lookupVar @_ @(NThunk m) "__includes" - dirs <- case mres of - Nothing -> return [] - Just v -> force v $ \case - NVList xs -> forM xs $ flip force $ \case - NVStr s _ -> pure s - _ -> error "impossible" - _ -> error "impossible" - menv <- getEnvVar "NIX_PATH" - foldM go z $ dirs ++ case menv of - Nothing -> [] - Just str -> Text.splitOn ":" (Text.pack str) - where - go acc x = case Text.splitOn "=" x of - [p] -> f acc (Text.unpack p) Nothing - [n, p] -> f acc (Text.unpack p) (Just (Text.unpack n)) - _ -> throwError $ "Unexpected entry in NIX_PATH: " ++ show x diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index 7e01072..7e42265 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -125,8 +125,9 @@ assertEval files = catch go $ \case -- used, then apply those arguments after evaluation (see -- Main.hs). assertLangOk name - ("nix=../../../../data/nix/corepkgs" : - "dir4" : include opts) + (include opts ++ + [ "nix=../../../../data/nix/corepkgs" + , "lang/dir4" ]) Opts.CompletionInvoked _ -> error "unused" _ -> assertFailure $ "Unknown test type " ++ show files where