~alcinnz/hurl

70b80f77ae0e662b690f2829073e086eed7c7b8a — Adrian Cochrane 4 years ago f0682c0
Support executable extensions.
1 files changed, 29 insertions(+), 2 deletions(-)

M src/Network/URI/Fetch.hs
M src/Network/URI/Fetch.hs => src/Network/URI/Fetch.hs +29 -2
@@ 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