1 files changed, 29 insertions(+), 2 deletions(-)

M 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