summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdrian Cochrane <adrian@openwork.nz>2021-02-11 16:24:23 +1300
committerAdrian Cochrane <adrian@openwork.nz>2021-02-11 16:24:23 +1300
commit8161527bf5f88a97bb07a81f4967f6ec008455d0 (patch)
tree0d27f9a1885a8ffca446546461fd642d73846a80
parentb9a5ac6590efc13856015f854f4fa38a5b05eada (diff)
downloadhurl-8161527bf5f88a97bb07a81f4967f6ec008455d0.tar.gz
hurl-8161527bf5f88a97bb07a81f4967f6ec008455d0.tar.bz2
hurl-8161527bf5f88a97bb07a81f4967f6ec008455d0.zip
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.
-rw-r--r--hurl.cabal10
-rw-r--r--src/Network/MIME/Info.hs4
-rw-r--r--src/Network/URI/Fetch.hs2
-rw-r--r--src/Network/URI/XDG/MimeInfo.hs9
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)