memoize construction of the Request -> Request function to apply the UrlOptions

1 files changed, 12 insertions, 14 deletions

diff --git a/Utility/Url.hs b/Utility/Url.hs
index 073e36821..f7c028d8b 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -10,7 +10,8 @@
 module Utility.Url (
 	URLString,
 	UserAgent,
-	UrlOptions(..),
+	UrlOptions,
+	mkUrlOptions,
 	check,
 	checkBoth,
 	exists,
@@ -35,30 +36,27 @@ type Headers = [String]
 
 type UserAgent = String
 
-data BaseUrlOptions = BaseUrlOptions
+data UrlOptions = UrlOptions
 	{ userAgent :: Maybe UserAgent
 	, reqHeaders :: Headers
 	, reqParams :: [CommandParam]
+	, applyRequest :: Request -> Request
 	}
 
-instance Default BaseUrlOptions
+instance Default UrlOptions
   where
-	def = UrlOptions Nothing [] []
-
-data UrlOptions = UrlOptions
-	{ urlOptions :: BaseUrlOptions
-	, applyRequest :: Request -> Request
-	}
+	def = UrlOptions Nothing [] [] id
 
-mkUrlOptions :: BaseUrlOptions -> UrlOptions
-mkUrlOptions uo = UrlOptions uo applyrequest
+mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> UrlOptions
+mkUrlOptions useragent reqheaders reqparams =
+	UrlOptions useragent reqheaders reqparams applyrequest
   where
 	applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders }
 	addedheaders = uaheader ++ otherheaders
-	uaheader = case userAgent uo of
+	uaheader = case useragent of
 		Nothing -> []
 		Just ua -> [(hUserAgent, B8.fromString ua)]
-	otherheaders = map toheader (reqHeaders uo)
+	otherheaders = map toheader reqheaders
 	toheader s =
 		let (h, v) = separate (== ':') s
 		    h' = CI.mk (B8.fromString h)
@@ -67,7 +65,7 @@ mkUrlOptions uo = UrlOptions uo applyrequest
 			_ -> (h', B8.fromString v)
 
 addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]
-addUserAgent (UrlOptions uo) ps = case userAgent uo of
+addUserAgent uo ps = case userAgent uo of
 	Nothing -> ps
 	-- --user-agent works for both wget and curl commands
 	Just ua -> ps ++ [Param "--user-agent", Param ua]