summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-08-15 17:47:21 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-08-15 17:47:21 -0400
commit486748cfec17ae28582c2f3902fef3d7007489f5 (patch)
tree7b7440a85b1669401bfb3f0524f241b047f23fb2 /Utility
parentca03dfb45b6a542bc0c5e917d2d33a0baab754c2 (diff)
memoize construction of the Request -> Request function to apply the UrlOptions
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Url.hs26
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]