From 04cb2efa35fc1b761dbf5d8d19c0160c82f9dc8b Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 7 Jan 2021 19:20:18 +1300
Subject: [PATCH] Load executable extensions from more directories.

---
 src/Network/URI/Fetch.hs | 39 ++++++++++++++++++++++-----------------
 1 file changed, 22 insertions(+), 17 deletions(-)

diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 2910d19..9645e97 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -206,24 +206,29 @@ fetchURL' session mimes uri
     | Just uri' <- applyRewriter (rewriter session) uri = fetchURL' session mimes uri'
 #endif
 
-fetchURL' session mimes uri@(URI {uriScheme = "ext:", uriAuthority = Nothing,
-        uriPath = path, uriQuery = query}) = do
+fetchURL' session@Session { appName = appname, locale = l } mimes
+        uri@(URI "ext:" Nothing path query _) = do
     dir <- getXdgDirectory XdgData "nz.geek.adrian.hurl"
-    let program = dir </> "bin" </> path
-    let args = case query of {
-        '?':rest -> split (== '&') rest;
-        _ -> []
-    }
-    (exitcode, stdout, stderr) <- readProcessWithExitCode program args ""
-    let response = if isSuccess exitcode then stdout else stderr
-    let (header, body) = breakOn '\n' response
-    case strip header of
-        'm':'i':'m':'e':mimetype -> return (uri, strip mimetype, Left $ Txt.pack body)
-        'u':'r':'l':header' | Just uri' <- parseURIReference $ strip header' ->
-            fetchURL' (session {redirectCount = redirectCount session - 1}) mimes $
-                relativeTo uri' uri
-        _ | isSuccess exitcode -> return (uri, "text/html", Left $ Txt.pack response)
-        _ -> return (uri, mimeERR, Left $ Txt.pack response)
+    sysdirs <- getXdgDirectoryList XdgDataDirs
+    let dirs = concat [[dir' </> appname, dir'] | dir' <- dir : sysdirs]
+    programs <- findExecutablesInDirectories dirs ("bin" </> path)
+    case programs of
+      [] -> return (uri, mimeERR, Left $ Txt.pack $ trans l $ ReadFailed "404")
+      program:_ -> do
+        let args = case query of {
+            '?':rest -> split (== '&') rest;
+            _ -> []
+        }
+        (exitcode, stdout, stderr) <- readProcessWithExitCode program args ""
+        let response = if isSuccess exitcode then stdout else stderr
+        let (header, body) = breakOn '\n' response
+        case strip header of
+            'm':'i':'m':'e':mimetype -> return (uri, strip mimetype, Left $ Txt.pack body)
+            'u':'r':'l':header' | Just uri' <- parseURIReference $ strip header' ->
+                fetchURL' (session {redirectCount = redirectCount session - 1}) mimes $
+                    relativeTo uri' uri
+            _ | isSuccess exitcode -> return (uri, "text/html", Left $ Txt.pack response)
+            _ -> return (uri, mimeERR, Left $ Txt.pack response)
   where
     split p s = case dropWhile p s of
         "" -> []
-- 
2.30.2