From 29768fbfd764b9fd3c2f514a372aeaa14dc6f7f5 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 17 Apr 2020 19:22:10 +1200
Subject: [PATCH] Upstream save function, with intelligent filenaming.

---
 hurl.cabal               |  4 ++--
 src/Network/URI/Fetch.hs | 24 +++++++++++++++++++++++-
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/hurl.cabal b/hurl.cabal
index c0888e1..7688511 100644
--- a/hurl.cabal
+++ b/hurl.cabal
@@ -95,7 +95,7 @@ library
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.9 && <=4.12, text >= 1.2 && <1.3,
                        network-uri >=2.6 && <2.7, bytestring >= 0.10 && < 0.11,
-                       async >= 2.1 && < 2.3
+                       async >= 2.1 && < 2.3, filepath, directory
   
   -- Directories containing source files.
   hs-source-dirs:      src
@@ -117,7 +117,7 @@ library
     build-depends: base64-bytestring >=1.0 && <2.0
   if flag(freedesktop)
     CPP-options:   -DWITH_XDG
-    build-depends: filepath, directory, process >= 1.2 && <2.0
+    build-depends: process >= 1.2 && <2.0
     other-modules: Network.URI.XDG.Ini, Network.URI.XDG.MimeApps, Network.URI.XDG.DesktopEntry, Network.URI.XDG
   if flag(freedesktop) && flag(appstream)
     CPP-options:   -DWITH_APPSTREAM
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 5287a37..b0cf658 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Retrieves documents for a URL, supporting multiple URL schemes that can be
 -- disabled at build-time for reduced dependencies.
-module Network.URI.Fetch(Session, locale, newSession, fetchURL, dispatchByMIME) where
+module Network.URI.Fetch(Session, locale, newSession, fetchURL, dispatchByMIME, saveDownload) where
 
 import qualified Data.Text as Txt
 import           Data.Text (Text)
@@ -18,6 +18,10 @@ import           Control.Concurrent.Async (forConcurrently)
 import Data.Maybe (fromMaybe, listToMaybe)
 import Text.Read (readMaybe)
 
+-- for saveDownload
+import System.Directory
+import System.FilePath
+
 #ifdef WITH_HTTP_URI
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.HTTP.Client.TLS as TLS
@@ -218,6 +222,24 @@ dispatchByMIME Session {locale = l, apps = a} mime uri = do
 dispatchByMIME _ _ _ = return Nothing
 #endif
 
+saveDownload :: URI -> FilePath -> (URI, String, Either Text ByteString) -> IO URI
+saveDownload baseURI dir (URI {uriPath = path}, mime, resp) = do
+    dest <- unusedFilename (dir </> takeFileName path)
+    case resp of
+        Left txt -> writeFile dest $ Txt.unpack txt
+        Right bytes -> B.writeFile dest bytes
+    -- TODO set user.mime file attribute.
+    return $ baseURI {uriPath = dest}
+
+unusedFilename path = do
+        exists <- doesFileExist path
+        if exists then go 0 else return path
+    where
+        go n = do
+            let path' = path ++ show n
+            exists <- doesFileExist path'
+            if exists then go (n+1) else return path'
+
 -- Utils
 
 #ifdef WITH_DATA_URI
-- 
2.30.2