Implement top-level __findFile.

Fixes haskell-nix#248.

src/Nix/Builtins.hs

@@ -222,6 +222,7 @@ builtinsList = sequence [
     , add  TopLevel "placeholder"                placeHolder
     , add  Normal   "readDir"                    readDir_
     , add  Normal   "readFile"                   readFile_
+    , add2 Normal   "findFile"                   findFile_
     , add2 TopLevel "removeAttrs"                removeAttrs
     , add3 Normal   "replaceStrings"             replaceStrings
     , add2 TopLevel "scopedImport"               scopedImport
@@ -325,7 +326,7 @@ unsafeGetAttrPos x y = x >>= \x' -> y >>= \y' -> case (x', y') of
     (NVStr key _, NVSet _ apos) -> case M.lookup key apos of
         Nothing -> pure $ nvConstant NNull
         Just delta -> toValue delta
-    (x, y) -> throwError $ ErrorCall $ "Invalid types for builtin.unsafeGetAttrPos: "
+    (x, y) -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPos: "
                  ++ show (x, y)
 
 -- This function is a bit special in that it doesn't care about the contents
@@ -862,6 +863,19 @@ readFile_ :: MonadNix e m => m (NValue m) -> m (NValue m)
 readFile_ path =
     path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix
 
+findFile_ :: forall e m. MonadNix e m
+          => m (NValue m) -> m (NValue m) -> m (NValue m)
+findFile_ aset filePath =
+    aset >>= \aset' ->
+    filePath >>= \filePath' ->
+    case (aset', filePath') of
+      (NVList x, NVStr name _) -> do
+          mres <- findPath x (Text.unpack name)
+          pure $ nvPath mres
+      (NVList _, y)  -> throwError $ ErrorCall $ "expected a string, got " ++ show y
+      (x, NVStr _ _) -> throwError $ ErrorCall $ "expected a list, got " ++ show x
+      (x, y)         -> throwError $ ErrorCall $ "Invalid types for builtins.findFile: " ++ show (x, y)
+
 data FileType
    = FileTypeRegular
    | FileTypeDirectory

src/Nix/Effects.hs

@@ -19,6 +19,10 @@ class MonadFile m => MonadEffects m where
     makeAbsolutePath :: FilePath -> m FilePath
     findEnvPath :: String -> m FilePath
 
+    -- | Having an explicit list of sets corresponding to the NIX_PATH
+    -- and a file path try to find an existing path
+    findPath :: [NThunk m] -> FilePath -> m FilePath
+
     pathExists :: FilePath -> m Bool
     importPath :: AttrSet (NThunk m) -> FilePath -> m (NValue m)
 

src/Nix/Exec.hs

@@ -531,6 +531,8 @@ instance (MonadFix m, MonadCatch m, MonadIO m, Alternative m,
 
     findEnvPath = findEnvPathM
 
+    findPath = findPathM
+
     pathExists = liftIO . fileExist
 
     importPath scope origPath = do
@@ -642,12 +644,12 @@ instance (MonadFix m, MonadCatch m, MonadIO m, Alternative m,
           -- return response
         let status = statusCode (responseStatus response)
         if  status /= 200
-          then throwError $ ErrorCall $ 
+          then throwError $ ErrorCall $
                  "fail, got " ++ show status ++ " when fetching url:" ++ urlstr
           else -- do
             -- let bstr = responseBody response
             -- liftIO $ print bstr
-            throwError $ ErrorCall $ 
+            throwError $ ErrorCall $
               "success in downloading but hnix-store is not yet ready; url = " ++ urlstr
 
     traceEffect = liftIO . putStrLn
@@ -705,49 +707,66 @@ x <///> y | isAbsolute y || "." `isPrefixOf` y = x </> y
         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
-    exists <- liftIO $ doesDirectoryExist path
-    path' <- if exists
-            then makeAbsolutePath $ path </> "default.nix"
-            else return path
-    exists <- liftIO $ doesFileExist path'
-    return $ if exists then Just path' else Nothing
+findPathBy :: forall e m. (MonadNix e m, MonadIO m) =>
+            (FilePath -> m (Maybe FilePath)) ->
+            [NThunk m] -> FilePath -> m FilePath
+findPathBy finder l name = do
+    mpath <- foldM go Nothing l
+    case mpath of
+        Nothing ->
+            throwError $ ErrorCall $ "file '" ++ name
+                ++ "' was not found in the Nix search path"
+                ++ " (add it using $NIX_PATH or -I)"
+        Just path -> return path
+    where
+      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
+
+      tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =
+          finder $ p <///> joinPath ns
+      tryPath p _ = finder $ p <///> name
+
+findPathM :: forall e m. (MonadNix e m, MonadIO m) =>
+            [NThunk m] -> FilePath -> m FilePath
+findPathM l name = findPathBy path l name
+    where
+      path :: (MonadEffects m, MonadIO m) => FilePath -> m (Maybe FilePath)
+      path path = do
+          path <- makeAbsolutePath path
+          exists <- liftIO $ doesPathExist path
+          return $ if exists then Just path else Nothing
 
 findEnvPathM :: forall e m. (MonadNix e m, MonadIO m)
              => FilePath -> m FilePath
 findEnvPathM name = do
     mres <- lookupVar @_ @(NThunk m) "__nixPath"
-    mpath <- case mres of
+    case mres of
         Nothing -> error "impossible"
         Just x -> force x $ fromValue >=> \(l :: [NThunk m]) ->
-            foldM go Nothing l
-    case mpath of
-        Nothing ->
-            throwError $ ErrorCall $ "file '" ++ name
-                ++ "' was not found in the Nix search path"
-                ++ " (add it using $NIX_PATH or -I)"
-        Just path -> return path
-  where
-    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
-
-    tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =
-        nixFilePath $ p <///> joinPath ns
-    tryPath p _ = nixFilePath $ p <///> name
+          findPathBy nixFilePath l name
+    where
+      nixFilePath :: (MonadEffects m, MonadIO m) => FilePath -> m (Maybe FilePath)
+      nixFilePath path = do
+          path <- makeAbsolutePath path
+          exists <- liftIO $ doesDirectoryExist path
+          path' <- if exists
+                  then makeAbsolutePath $ path </> "default.nix"
+                  else return path
+          exists <- liftIO $ doesFileExist path'
+          return $ if exists then Just path' else Nothing
 
 addTracing :: (MonadNix e m, Has e Options, MonadIO m,
               MonadReader Int n, Alternative n)