5 files changed, 18 insertions(+), 19 deletions(-)

M hurl.cabal
M src/Network/URI/Fetch.hs
M src/Network/URI/Locale.hs
M src/Network/URI/XDG/AppStream.hs
M src/Network/URI/XDG/MimeApps.hs

@@ 105,6 105,8 @@ library
   
   -- Directories containing source files.
   hs-source-dirs:      src
+
+  ghc-options: -fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns
   
   -- Base language which the package is written in.
   default-language:    Haskell2010

@@ 94,7 94,7 @@ data Session = Session {
     -- | Additional files to serve from about: URIs.
     aboutPages :: [(FilePath, ByteString)],
     -- | Log of timestamped/profiled URL requests
-    requestLog :: MVar [LogRecord],
+    requestLog :: Maybe (MVar [LogRecord]),
     -- | How many redirects to follow for Gemini or HTTP(S) requests
     redirectCount :: Int,
     -- | Whether to cache network responses, avoiding sending requests


@@ 140,7 140,6 @@ newSession' appname = do
 #ifdef WITH_PLUGIN_REWRITES
     rewriters <- parseRewriters appname
 #endif
-    log <- newEmptyMVar
 
     return Session {
 #ifdef WITH_HTTP_URI


@@ 157,7 156,7 @@ newSession' appname = do
 #endif
         locale = ietfLocale,
         aboutPages = [],
-        requestLog = log,
+        requestLog = Nothing,
         redirectCount = 5,
         cachingEnabled = True
     }


@@ 175,19 174,18 @@ fetchURL sess mimes uri = do
     (_, mime, resp) <- fetchURL' sess mimes uri
     return (mime, resp)
 
-fetchURLLogged sess mimes uri = do
+fetchURLLogged log sess mimes uri = do
     begin' <- getCurrentTime
     res@(redirected', mimetype', response') <- fetchURL' sess mimes uri
     end' <- getCurrentTime
-    modifyMVar_ (requestLog sess) $ \log -> return (
-        LogRecord uri mimes redirected' mimetype' response' begin' end' : log)
+    modifyMVar_ log $ \log' -> return (
+        LogRecord uri mimes redirected' mimetype' response' begin' end' : log')
     return res
 
 -- | Concurrently fetch given URLs.
 fetchURLs :: Session -> [String] -> [URI] -> ((URI, String, Either Text ByteString) -> IO a) -> IO [(URI, a)]
 fetchURLs sess mimes uris cb = do
-    shouldntLog <- isEmptyMVar $ requestLog sess
-    let fetch = if shouldntLog then fetchURL' else fetchURLLogged
+    let fetch = case requestLog sess of {Nothing -> fetchURL'; Just log -> fetchURLLogged log}
     forConcurrently uris (\u -> fetch sess mimes u >>= cb) >>= return . L.zip uris
 
 -- | Internal MIMEtypes for error reporting


@@ 283,10 281,7 @@ fetchURL' session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "h
         Right (mime, body) ->
             let mime' = L.map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" mime
             in return $ resolveCharset' uri mime' body
-  `catches` [
-    Handler $ \e -> do return (uri, mimeERR, Left $ Txt.pack $ trans (locale session) $ Http e),
-    Handler $ \(ErrorCall msg) -> do return (uri, mimeERR, Left $ Txt.pack msg)
-  ]
+  `catch` \e -> do return (uri, mimeERR, Left $ Txt.pack $ trans (locale session) $ Http e)
 #endif
 
 #ifdef WITH_GEMINI_URI


@@ 421,15 416,14 @@ downloadToURI (_, mime, Right bytes) = nullURI {
     }
 
 -- Logging API
-enableLogging :: Session -> IO ()
+enableLogging :: Session -> IO Session
 enableLogging session = do
-    logInactive <- isEmptyMVar $ requestLog session
-    if logInactive then putMVar (requestLog session) [] else return ()
+    log <- newMVar []
+    return session { requestLog = Just log }
 
 retrieveLog :: Session -> IO [LogRecord]
-retrieveLog session = do
-    logInactive <- isEmptyMVar $ requestLog session
-    if logInactive then return [] else takeMVar $ requestLog session
+retrieveLog session@Session { requestLog = Just log } = swapMVar log []
+retrieveLog _ = return []
 
 writeLog :: Handle -> Session -> IO ()
 writeLog out session = do

@@ 44,4 44,5 @@ firstJust [] fallback = fallback
 
 split b (a:as) | a `elem` b = [] : split b as
         | (head':tail') <- split b as = (a:head') : tail'
+        | otherwise = [a:as]
 split _ [] = [[]]

@@ 91,7 91,7 @@ mergeComponents' (comp:comps) = let base = mergeComponents' comps in
         "append" -> M.unionWith (++) comp base
         "replace" -> M.union comp base
         "remove-component" -> M.empty
-        "" -> comp
+        _ -> comp
 
 localizeComponent :: [String] -> Component -> Component
 localizeComponent locales comp = let locales' = map Txt.pack locales in

@@ 50,6 50,7 @@ queryHandlers config mime = nub (
 
 queryHandlers' group (config:configs) mime =
     queryHandlers'' group config mime ++ queryHandlers' group configs mime
+queryHandlers' group [] mime = []
 queryHandlers'' group config mime
     | Just apps <- iniLookup group mime config = filter (/= "") $ split ';' apps
     | otherwise = []


@@ 62,4 63,5 @@ fromMaybe' a Nothing = a
 
 split b (a:as) | a == b = [] : split b as
         | (head':tail') <- split b as = (a:head') : tail'
+        | otherwise = [a:as]
 split _ [] = [[]]