From 8161527bf5f88a97bb07a81f4967f6ec008455d0 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 11 Feb 2021 16:24:23 +1300
Subject: [PATCH] Add compile flag for executable extensions thereby fixing
 build system.

Might also be some crash fixes in here, I just realized I haven't committed these changes.
---
 hurl.cabal                      | 10 +++++++++-
 src/Network/MIME/Info.hs        |  4 ++--
 src/Network/URI/Fetch.hs        |  2 ++
 src/Network/URI/XDG/MimeInfo.hs |  9 ++++++---
 4 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/hurl.cabal b/hurl.cabal
index 266c4b3..d911060 100644
--- a/hurl.cabal
+++ b/hurl.cabal
@@ -78,6 +78,11 @@ Flag rewriters
   Default:		True
   Manual: 		True
 
+Flag executables
+  Description:  Support executable plugins exposing a `ext:` URI scheme.
+  Default:      True
+  Manual:       True
+
 source-repository head
     type: git
     location: https://git.adrian.geek.nz/hurl.git
@@ -96,7 +101,7 @@ library
   build-depends:       base >=4.9 && <5, text >= 1.2 && <1.3,
                        network-uri >=2.6 && <2.7, bytestring >= 0.10 && < 0.11,
                        async >= 2.1 && < 2.3, filepath, directory >= 1.3.2,
-                       process >= 1.2 && <2.0, time >= 1.6
+                       time >= 1.6
   
   -- Directories containing source files.
   hs-source-dirs:      src
@@ -129,6 +134,9 @@ library
     CPP-options:   -DWITH_PLUGIN_REWRITES
     build-depends: regex, regex-tdfa >= 1.2 && < 1.4
     other-modules: Network.URI.PlugIns.Rewriters
+  if flag(executables)
+    CPP-options:   -DWITH_PLUGIN_EXEC
+    build-depends: process >= 1.2 && <2.0
 
 executable hurl
   -- .hs file containing the Main module
diff --git a/src/Network/MIME/Info.hs b/src/Network/MIME/Info.hs
index f8ca9e4..c5c43ae 100644
--- a/src/Network/MIME/Info.hs
+++ b/src/Network/MIME/Info.hs
@@ -8,7 +8,7 @@ import Network.URI.Locale (rfc2616Locale)
 import Network.URI.Types (Application(..))
 
 import qualified Data.Map as M
-import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar)
+import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
 import System.IO.Unsafe (unsafePerformIO)
 import Data.Char (toLower)
 
@@ -25,7 +25,7 @@ mimeInfo = unsafePerformIO $ do
     inner mime _ _ cache | Just val <- mime `M.lookup` cache = return val
     inner mime locales cache' cache = do
         ret <- readMimeInfo locales mime
-        putMVar cache' $ M.insert mime ret cache
+        modifyMVar_ cache' $ return . M.insert mime ret
         return ret
 
 #ifndef WITH_XDG
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 9645e97..eb4d6b3 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -206,6 +206,7 @@ fetchURL' session mimes uri
     | Just uri' <- applyRewriter (rewriter session) uri = fetchURL' session mimes uri'
 #endif
 
+#ifdef WITH_PLUGIN_EXEC
 fetchURL' session@Session { appName = appname, locale = l } mimes
         uri@(URI "ext:" Nothing path query _) = do
     dir <- getXdgDirectory XdgData "nz.geek.adrian.hurl"
@@ -236,6 +237,7 @@ fetchURL' session@Session { appName = appname, locale = l } mimes
     strip = dropWhile isSpace . dropWhileEnd isSpace
     isSuccess ExitSuccess = True
     isSuccess _ = False
+#endif
 
 fetchURL' session mimes uri@(URI {uriScheme = "about:", uriPath = ""}) =
     fetchURL' session mimes $ uri {uriPath = "version"}
diff --git a/src/Network/URI/XDG/MimeInfo.hs b/src/Network/URI/XDG/MimeInfo.hs
index 0e7f399..dd3345a 100644
--- a/src/Network/URI/XDG/MimeInfo.hs
+++ b/src/Network/URI/XDG/MimeInfo.hs
@@ -16,15 +16,18 @@ import Control.Monad (forM)
 import Control.Exception (catch)
 import Data.Maybe (catMaybes, maybeToList, fromMaybe, mapMaybe)
 
+import System.Directory (getHomeDirectory)
+
 readMimeInfo :: [String] -> String -> IO Application
 readMimeInfo locales mime = do
     dirs <- lookupEnv "XDG_DATA_DIRS"
     homedir <- lookupEnv "XDG_DATA_HOME"
-    let dirs' = fromMaybe' "~/.local/share/" homedir :
+    cwd <- getHomeDirectory
+    let dirs' = fromMaybe' (cwd </> ".local/share/") homedir :
             split ':' (fromMaybe' "/usr/local/share/:/usr/share/" dirs)
 
     files <- forM dirs' $ \dir -> do
-        let file = dir </> mime <.> "xml"
+        let file = dir </> "mime" </> mime <.> "xml"
         exists <- doesFileExist file
         if exists then (Just <$> XML.readFile def file) `catch` handleBadXML else return Nothing
 
@@ -49,7 +52,7 @@ readMimeInfo' locales mime el = Application {
     }
   where
     readEl key attr fallback
-        | (val:_) <- [v | l <- locales ++ [""], v <- maybeToList $ lookup key els] = unpack val
+        | (val:_) <- [v | l <- locales ++ [""], v <- maybeToList $ lookup l els] = unpack val
         | otherwise = fallback
       where els = readEl' (pack key) attr $ elementNodes el
     readEl' key Nothing (NodeElement (Element name attrs childs):sibs)
-- 
2.30.2