From 70b80f77ae0e662b690f2829073e086eed7c7b8a Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 7 Dec 2020 20:40:00 +1300
Subject: [PATCH] Support executable extensions.

---
 src/Network/URI/Fetch.hs | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 58bd6ae..12fea99 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -23,6 +23,9 @@ import           Control.Concurrent.Async (forConcurrently)
 -- for about: URIs & port parsing, all standard lib
 import Data.Maybe (fromMaybe, listToMaybe)
 import Text.Read (readMaybe)
+-- for executable extensions, all standard lib
+import Data.Char (isSpace)
+import System.Exit (ExitCode(..))
 
 -- for saveDownload
 import System.Directory
@@ -192,6 +195,32 @@ 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
+    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)
+  where
+    split p s = case dropWhile p s of
+        "" -> []
+        s' -> let (w, s'') = break p s' in w : split p s''
+    strip = dropWhile isSpace . dropWhileEnd isSpace
+    isSuccess ExitSuccess = True
+    isSuccess _ = False
+
 fetchURL' session mimes uri@(URI {uriScheme = "about:", uriPath = ""}) =
     fetchURL' session mimes $ uri {uriPath = "version"}
 fetchURL' Session {aboutPages = pages} _ url@URI {uriScheme = "about:", uriPath = path} =
@@ -362,8 +391,6 @@ writeLog out session = do
 
 -- Utils
 
-#ifdef WITH_DATA_URI
 breakOn c (a:as) | c == a = ([], as)
     | otherwise = let (x, y) = breakOn c as in (a:x, y)
 breakOn _ [] = ([], [])
-#endif
-- 
2.30.2