{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.URI.Fetch(Session(locale, aboutPages, redirectCount, cachingEnabled), newSession,
fetchURL, fetchURL', fetchURLs, submitURL, mimeERR, htmlERR,
dispatchByMIME, appsForMIME, Application(..), dispatchByApp,
saveDownload, downloadToURI,
LogRecord(..), enableLogging, retrieveLog, writeLog) where
import Network.URI.Types
import qualified Data.Text as Txt
import Data.Text (Text)
import Network.URI
import qualified Data.ByteString as Strict
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Char8 as C8
import Network.URI.Charset
import Control.Exception
import System.IO.Error (isEOFError)
import Control.Concurrent.Async (forConcurrently)
import Data.Maybe (fromMaybe, listToMaybe, isJust)
import Data.Either (isLeft)
import Text.Read (readMaybe)
import Data.Char (isSpace)
import System.Exit (ExitCode(..))
import System.Directory
import System.FilePath
import Control.Concurrent.MVar
import Data.Time.Clock
import System.IO
import Control.Monad
import Data.List as L
#ifdef WITH_HTTP_URI
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.OpenSSL as TLS
import qualified OpenSSL.Session as TLS
import Network.HTTP.Types
import Data.List (intercalate)
import Control.Concurrent (forkIO)
import Network.URI.Cache
#endif
#ifdef WITH_RAW_CONNECTIONS
import qualified OpenSSL as TLS
import qualified OpenSSL.Session as TLS
import qualified System.IO.Streams.SSL as TLSConn
import System.IO.Streams
#endif
#ifdef WITH_DATA_URI
import qualified Data.ByteString.Base64.URL.Lazy as B64
#endif
import Network.URI.Locale
import Network.URI.Messages
#ifdef WITH_XDG
import Network.URI.XDG
#endif
#ifdef WITH_PLUGIN_REWRITES
import Network.URI.PlugIns.Rewriters
#endif
data Session = Session {
#ifdef WITH_HTTP_URI
Session -> Manager
managerHTTP :: HTTP.Manager,
Session -> MVar CookieJar
globalCookieJar :: MVar HTTP.CookieJar,
Session -> FilePath
cookiesPath :: FilePath,
Session -> Maybe (MVar CookieJar)
retroactiveCookies :: Maybe (MVar HTTP.CookieJar),
#endif
#ifdef WITH_RAW_CONNECTIONS
Session -> SSLContext
connCtxt :: TLS.SSLContext,
#endif
#ifdef WITH_XDG
Session -> XDGConfig
apps :: XDGConfig,
#endif
#ifdef WITH_PLUGIN_REWRITES
Session -> Rewriter
rewriter :: Rewriter,
#endif
Session -> [FilePath]
locale :: [String],
Session -> [(FilePath, ByteString)]
aboutPages :: [(FilePath, ByteString)],
Session -> Maybe (MVar [LogRecord])
requestLog :: Maybe (MVar [LogRecord]),
Session -> Int
redirectCount :: Int,
Session -> Bool
cachingEnabled :: Bool,
Session -> FilePath
appName :: String
}
data LogRecord = LogRecord {
LogRecord -> URI
url :: URI,
LogRecord -> [FilePath]
accept :: [String],
LogRecord -> URI
redirected :: URI,
LogRecord -> FilePath
mimetype :: String,
LogRecord -> Either Text ByteString
response :: Either Text ByteString,
LogRecord -> UTCTime
begin :: UTCTime,
LogRecord -> UTCTime
end :: UTCTime
}
newSession :: IO Session
newSession :: IO Session
newSession = FilePath -> IO Session
newSession' FilePath
""
newSession' :: String -> IO Session
newSession' :: FilePath -> IO Session
newSession' FilePath
appname = do
([FilePath]
ietfLocale, [FilePath]
unixLocale) <- IO ([FilePath], [FilePath])
rfc2616Locale
#ifdef WITH_HTTP_URI
SSLContext
httpsCtxt <- IO SSLContext
TLS.context
SSLContext -> IO ()
TLS.contextSetDefaultCiphers SSLContext
httpsCtxt
SSLContext -> FilePath -> IO ()
TLS.contextSetCADirectory SSLContext
httpsCtxt FilePath
"/etc/ssl/certs"
SSLContext -> VerificationMode -> IO ()
TLS.contextSetVerificationMode SSLContext
httpsCtxt (VerificationMode -> IO ()) -> VerificationMode -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Maybe (Bool -> X509StoreCtx -> IO Bool)
-> VerificationMode
TLS.VerifyPeer Bool
True Bool
True Maybe (Bool -> X509StoreCtx -> IO Bool)
forall a. Maybe a
Nothing
Manager
managerHTTP' <- ManagerSettings -> IO Manager
HTTP.newManager (ManagerSettings -> IO Manager) -> ManagerSettings -> IO Manager
forall a b. (a -> b) -> a -> b
$ IO SSLContext -> ManagerSettings
TLS.opensslManagerSettings (IO SSLContext -> ManagerSettings)
-> IO SSLContext -> ManagerSettings
forall a b. (a -> b) -> a -> b
$ SSLContext -> IO SSLContext
forall (m :: * -> *) a. Monad m => a -> m a
return SSLContext
httpsCtxt
FilePath
cookiesDir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"nz.geek.adrian.hurl.cookies"
let cookiesPath' :: FilePath
cookiesPath' = FilePath
cookiesDir FilePath -> FilePath -> FilePath
</> FilePath
appname
Bool
cookiesExist <- FilePath -> IO Bool
doesFileExist FilePath
cookiesPath'
Maybe [Cookie]
cookies <- if Bool
cookiesExist then FilePath -> Maybe [Cookie]
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe [Cookie]) -> IO FilePath -> IO (Maybe [Cookie])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
cookiesPath' else Maybe [Cookie] -> IO (Maybe [Cookie])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Cookie]
forall a. Maybe a
Nothing
UTCTime
now <- IO UTCTime
getCurrentTime
let cookies' :: CookieJar
cookies' = [Cookie] -> CookieJar
HTTP.createCookieJar ([Cookie] -> CookieJar) -> [Cookie] -> CookieJar
forall a b. (a -> b) -> a -> b
$ [Cookie] -> Maybe [Cookie] -> [Cookie]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Cookie]
cookies
MVar CookieJar
cookieJar <- CookieJar -> IO (MVar CookieJar)
forall a. a -> IO (MVar a)
newMVar (CookieJar -> IO (MVar CookieJar))
-> CookieJar -> IO (MVar CookieJar)
forall a b. (a -> b) -> a -> b
$ CookieJar -> UTCTime -> CookieJar
HTTP.evictExpiredCookies CookieJar
cookies' UTCTime
now
MVar CookieJar
cookieJar' <- CookieJar -> IO (MVar CookieJar)
forall a. a -> IO (MVar a)
newMVar (CookieJar -> IO (MVar CookieJar))
-> CookieJar -> IO (MVar CookieJar)
forall a b. (a -> b) -> a -> b
$ [Cookie] -> CookieJar
HTTP.createCookieJar []
#endif
#ifdef WITH_RAW_CONNECTIONS
SSLContext
connCtxt <- IO SSLContext
TLS.context
SSLContext -> IO ()
TLS.contextSetDefaultCiphers SSLContext
connCtxt
SSLContext -> FilePath -> IO ()
TLS.contextSetCADirectory SSLContext
connCtxt FilePath
"/etc/ssl/certs"
SSLContext -> VerificationMode -> IO ()
TLS.contextSetVerificationMode SSLContext
connCtxt (VerificationMode -> IO ()) -> VerificationMode -> IO ()
forall a b. (a -> b) -> a -> b
$
Bool
-> Bool
-> Maybe (Bool -> X509StoreCtx -> IO Bool)
-> VerificationMode
TLS.VerifyPeer Bool
True Bool
True (Maybe (Bool -> X509StoreCtx -> IO Bool) -> VerificationMode)
-> Maybe (Bool -> X509StoreCtx -> IO Bool) -> VerificationMode
forall a b. (a -> b) -> a -> b
$ (Bool -> X509StoreCtx -> IO Bool)
-> Maybe (Bool -> X509StoreCtx -> IO Bool)
forall a. a -> Maybe a
Just ((Bool -> X509StoreCtx -> IO Bool)
-> Maybe (Bool -> X509StoreCtx -> IO Bool))
-> (Bool -> X509StoreCtx -> IO Bool)
-> Maybe (Bool -> X509StoreCtx -> IO Bool)
forall a b. (a -> b) -> a -> b
$ \Bool
valid X509StoreCtx
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
valid
#endif
#ifdef WITH_XDG
XDGConfig
apps' <- [FilePath] -> IO XDGConfig
loadXDGConfig [FilePath]
unixLocale
#endif
#ifdef WITH_PLUGIN_REWRITES
Rewriter
rewriters <- FilePath -> IO Rewriter
parseRewriters FilePath
appname
#endif
Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return Session :: Manager
-> MVar CookieJar
-> FilePath
-> Maybe (MVar CookieJar)
-> SSLContext
-> XDGConfig
-> Rewriter
-> [FilePath]
-> [(FilePath, ByteString)]
-> Maybe (MVar [LogRecord])
-> Int
-> Bool
-> FilePath
-> Session
Session {
#ifdef WITH_HTTP_URI
managerHTTP :: Manager
managerHTTP = Manager
managerHTTP',
globalCookieJar :: MVar CookieJar
globalCookieJar = MVar CookieJar
cookieJar,
cookiesPath :: FilePath
cookiesPath = FilePath
cookiesPath',
retroactiveCookies :: Maybe (MVar CookieJar)
retroactiveCookies = MVar CookieJar -> Maybe (MVar CookieJar)
forall a. a -> Maybe a
Just MVar CookieJar
cookieJar',
#endif
#ifdef WITH_RAW_CONNECTIONS
connCtxt :: SSLContext
connCtxt = SSLContext
connCtxt,
#endif
#ifdef WITH_XDG
apps :: XDGConfig
apps = XDGConfig
apps',
#endif
#ifdef WITH_PLUGIN_REWRITES
rewriter :: Rewriter
rewriter = Rewriter
rewriters,
#endif
locale :: [FilePath]
locale = [FilePath]
ietfLocale,
aboutPages :: [(FilePath, ByteString)]
aboutPages = [],
requestLog :: Maybe (MVar [LogRecord])
requestLog = Maybe (MVar [LogRecord])
forall a. Maybe a
Nothing,
redirectCount :: Int
redirectCount = Int
5,
cachingEnabled :: Bool
cachingEnabled = Bool
True,
appName :: FilePath
appName = FilePath
appname
}
llookup :: a -> a -> [(a, a)] -> a
llookup a
key a
fallback [(a, a)]
map = a
fallback a -> Maybe a -> a
forall a. a -> Maybe a -> a
`fromMaybe` [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a
v | (a
k, a
v) <- [(a, a)]
map, a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
key]
parsePort :: p -> FilePath -> p
parsePort p
fallback (Char
':':FilePath
port) = p
fallback p -> Maybe p -> p
forall a. a -> Maybe a -> a
`fromMaybe` FilePath -> Maybe p
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
port
parsePort p
fallback FilePath
_ = p
fallback
fetchURL :: Session
-> [String]
-> URI
-> IO (String, Either Text ByteString)
fetchURL :: Session
-> [FilePath] -> URI -> IO (FilePath, Either Text ByteString)
fetchURL Session
sess [FilePath]
mimes URI
uri = do
(URI
_, FilePath
mime, Either Text ByteString
resp) <- Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
sess [FilePath]
mimes URI
uri
(FilePath, Either Text ByteString)
-> IO (FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
mime, Either Text ByteString
resp)
fetchURLLogged :: MVar [LogRecord]
-> Session
-> [FilePath]
-> URI
-> IO (URI, FilePath, Either Text ByteString)
fetchURLLogged MVar [LogRecord]
log Session
sess [FilePath]
mimes URI
uri = do
UTCTime
begin' <- IO UTCTime
getCurrentTime
res :: (URI, FilePath, Either Text ByteString)
res@(URI
redirected', FilePath
mimetype', Either Text ByteString
response') <- Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
sess [FilePath]
mimes URI
uri
UTCTime
end' <- IO UTCTime
getCurrentTime
MVar [LogRecord] -> ([LogRecord] -> IO [LogRecord]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [LogRecord]
log (([LogRecord] -> IO [LogRecord]) -> IO ())
-> ([LogRecord] -> IO [LogRecord]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[LogRecord]
log' -> [LogRecord] -> IO [LogRecord]
forall (m :: * -> *) a. Monad m => a -> m a
return (
URI
-> [FilePath]
-> URI
-> FilePath
-> Either Text ByteString
-> UTCTime
-> UTCTime
-> LogRecord
LogRecord URI
uri [FilePath]
mimes URI
redirected' FilePath
mimetype' Either Text ByteString
response' UTCTime
begin' UTCTime
end' LogRecord -> [LogRecord] -> [LogRecord]
forall a. a -> [a] -> [a]
: [LogRecord]
log')
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI, FilePath, Either Text ByteString)
res
fetchURLs :: Session -> [String] -> [URI] -> ((URI, String, Either Text ByteString) -> IO a) -> IO [(URI, a)]
fetchURLs :: Session
-> [FilePath]
-> [URI]
-> ((URI, FilePath, Either Text ByteString) -> IO a)
-> IO [(URI, a)]
fetchURLs Session
sess [FilePath]
mimes [URI]
uris (URI, FilePath, Either Text ByteString) -> IO a
cb = do
let fetch :: Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetch = case Session -> Maybe (MVar [LogRecord])
requestLog Session
sess of {Maybe (MVar [LogRecord])
Nothing -> Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL'; Just MVar [LogRecord]
log -> MVar [LogRecord]
-> Session
-> [FilePath]
-> URI
-> IO (URI, FilePath, Either Text ByteString)
fetchURLLogged MVar [LogRecord]
log}
let sess' :: Session
sess' = Session
sess {
#ifdef WITH_HTTP_URI
retroactiveCookies :: Maybe (MVar CookieJar)
retroactiveCookies = Maybe (MVar CookieJar)
forall a. Maybe a
Nothing
#endif
}
[URI] -> (URI -> IO a) -> IO [a]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [URI]
uris (\URI
u -> Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetch Session
sess' [FilePath]
mimes URI
u IO (URI, FilePath, Either Text ByteString)
-> ((URI, FilePath, Either Text ByteString) -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (URI, FilePath, Either Text ByteString) -> IO a
cb) IO [a] -> ([a] -> IO [(URI, a)]) -> IO [(URI, a)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(URI, a)] -> IO [(URI, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(URI, a)] -> IO [(URI, a)])
-> ([a] -> [(URI, a)]) -> [a] -> IO [(URI, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [URI] -> [a] -> [(URI, a)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [URI]
uris
mimeERR, htmlERR :: String
mimeERR :: FilePath
mimeERR = FilePath
"txt/x-error\t"
htmlERR :: FilePath
htmlERR = FilePath
"html/x-error\t"
submitURL :: Session -> [String] -> URI -> Text -> String -> IO (URI, String, Either Text ByteString)
#ifdef WITH_HTTP_URI
submitURL :: Session
-> [FilePath]
-> URI
-> Text
-> FilePath
-> IO (URI, FilePath, Either Text ByteString)
submitURL Session
session [FilePath]
accept URI
uri Text
"POST" FilePath
query | URI -> FilePath
uriScheme URI
uri FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"http:", FilePath
"https:"] = do
Maybe CookieJar
csrfCookies <- case Session -> Maybe (MVar CookieJar)
retroactiveCookies Session
session of {
Just MVar CookieJar
cookies -> CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just (CookieJar -> Maybe CookieJar)
-> IO CookieJar -> IO (Maybe CookieJar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar CookieJar -> IO CookieJar
forall a. MVar a -> IO a
readMVar MVar CookieJar
cookies;
Maybe (MVar CookieJar)
Nothing -> Maybe CookieJar -> IO (Maybe CookieJar)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CookieJar
forall a. Maybe a
Nothing
}
Session
-> [FilePath]
-> URI
-> (Request -> Request)
-> (Response ByteString -> IO ())
-> IO (URI, FilePath, Either Text ByteString)
forall t a.
Session
-> [FilePath]
-> URI
-> (Request -> t)
-> (Response ByteString -> IO a)
-> IO (URI, FilePath, Either Text ByteString)
fetchHTTPCached Session
session [FilePath]
accept URI
uri (\Request
req -> Request
req {
cookieJar :: Maybe CookieJar
HTTP.cookieJar = Maybe CookieJar -> Maybe CookieJar -> Maybe CookieJar
forall a. Maybe a -> Maybe a -> Maybe a
firstJust Maybe CookieJar
csrfCookies (Maybe CookieJar -> Maybe CookieJar)
-> Maybe CookieJar -> Maybe CookieJar
forall a b. (a -> b) -> a -> b
$ Request -> Maybe CookieJar
HTTP.cookieJar Request
req,
method :: Method
HTTP.method = Method
"POST",
requestBody :: RequestBody
HTTP.requestBody = Method -> RequestBody
HTTP.RequestBodyBS (Method -> RequestBody) -> Method -> RequestBody
forall a b. (a -> b) -> a -> b
$ FilePath -> Method
C8.pack FilePath
query
}) ((Response ByteString -> IO ())
-> IO (URI, FilePath, Either Text ByteString))
-> (Response ByteString -> IO ())
-> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ \Response ByteString
resp -> do
let cookies :: CookieJar
cookies = Response ByteString -> CookieJar
forall body. Response body -> CookieJar
HTTP.responseCookieJar Response ByteString
resp
MVar CookieJar -> CookieJar -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Session -> MVar CookieJar
globalCookieJar Session
session) CookieJar
cookies
FilePath -> FilePath -> IO ()
writeFile (Session -> FilePath
cookiesPath Session
session) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [Cookie] -> FilePath
forall a. Show a => a -> FilePath
show ([Cookie] -> FilePath) -> [Cookie] -> FilePath
forall a b. (a -> b) -> a -> b
$ CookieJar -> [Cookie]
HTTP.destroyCookieJar CookieJar
cookies
#endif
submitURL Session
session [FilePath]
mimes URI
uri Text
_method FilePath
query = Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
session [FilePath]
mimes URI
uri { uriQuery :: FilePath
uriQuery = Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
query }
fetchURL' :: Session -> [String] -> URI -> IO (URI, String, Either Text ByteString)
fetchURL' :: Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session {redirectCount :: Session -> Int
redirectCount = Int
0, locale :: Session -> [FilePath]
locale = [FilePath]
locale'} [FilePath]
_ URI
uri =
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
locale' Errors
ExcessiveRedirects)
#ifdef WITH_PLUGIN_REWRITES
fetchURL' Session
session [FilePath]
mimes URI
uri
| Just URI
uri' <- Rewriter -> URI -> Maybe URI
applyRewriter (Session -> Rewriter
rewriter Session
session) URI
uri = Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
session [FilePath]
mimes URI
uri'
#endif
#ifdef WITH_PLUGIN_EXEC
fetchURL' session :: Session
session@Session { appName :: Session -> FilePath
appName = FilePath
appname, locale :: Session -> [FilePath]
locale = [FilePath]
l } [FilePath]
mimes
uri :: URI
uri@(URI FilePath
"ext:" Maybe URIAuth
Nothing FilePath
path FilePath
query FilePath
_) = do
FilePath
dir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"nz.geek.adrian.hurl"
[FilePath]
sysdirs <- XdgDirectoryList -> IO [FilePath]
getXdgDirectoryList XdgDirectoryList
XdgDataDirs
let dirs :: [FilePath]
dirs = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath
dir' FilePath -> FilePath -> FilePath
</> FilePath
appname, FilePath
dir'] | FilePath
dir' <- FilePath
dir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
sysdirs]
[FilePath]
programs <- [FilePath] -> FilePath -> IO [FilePath]
findExecutablesInDirectories [FilePath]
dirs (FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
path)
case [FilePath]
programs of
[] -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
l (Errors -> FilePath) -> Errors -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Errors
ReadFailed FilePath
"404")
FilePath
program:[FilePath]
_ -> do
let args :: [FilePath]
args = case FilePath
query of {
Char
'?':FilePath
rest -> (Char -> Bool) -> FilePath -> [FilePath]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&') FilePath
rest;
FilePath
_ -> []
}
(ExitCode
exitcode, FilePath
stdout, FilePath
stderr) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
program [FilePath]
args FilePath
""
let response :: FilePath
response = if ExitCode -> Bool
isSuccess ExitCode
exitcode then FilePath
stdout else FilePath
stderr
let (FilePath
header, FilePath
body) = Char -> FilePath -> (FilePath, FilePath)
forall a. Eq a => a -> [a] -> ([a], [a])
breakOn Char
'\n' FilePath
response
case FilePath -> FilePath
strip FilePath
header of
Char
'm':Char
'i':Char
'm':Char
'e':FilePath
mimetype -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath -> FilePath
strip FilePath
mimetype, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
body)
Char
'u':Char
'r':Char
'l':FilePath
header' | Just URI
uri' <- FilePath -> Maybe URI
parseURIReference (FilePath -> Maybe URI) -> FilePath -> Maybe URI
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
strip FilePath
header' ->
Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' (Session
session {redirectCount :: Int
redirectCount = Session -> Int
redirectCount Session
session Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}) [FilePath]
mimes (URI -> IO (URI, FilePath, Either Text ByteString))
-> URI -> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$
URI -> URI -> URI
relativeTo URI
uri' URI
uri
FilePath
_ | ExitCode -> Bool
isSuccess ExitCode
exitcode -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
"text/html", Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
response)
FilePath
_ -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
response)
where
split :: (Char -> Bool) -> FilePath -> [FilePath]
split Char -> Bool
p FilePath
s = case (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
p FilePath
s of
FilePath
"" -> []
FilePath
s' -> let (FilePath
w, FilePath
s'') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p FilePath
s' in FilePath
w FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> FilePath -> [FilePath]
split Char -> Bool
p FilePath
s''
strip :: FilePath -> FilePath
strip = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
isSuccess :: ExitCode -> Bool
isSuccess ExitCode
ExitSuccess = Bool
True
isSuccess ExitCode
_ = Bool
False
#endif
fetchURL' Session
session [FilePath]
mimes uri :: URI
uri@(URI {uriScheme :: URI -> FilePath
uriScheme = FilePath
"about:", uriPath :: URI -> FilePath
uriPath = FilePath
""}) =
Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
session [FilePath]
mimes (URI -> IO (URI, FilePath, Either Text ByteString))
-> URI -> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ URI
uri {uriPath :: FilePath
uriPath = FilePath
"version"}
fetchURL' Session {aboutPages :: Session -> [(FilePath, ByteString)]
aboutPages = [(FilePath, ByteString)]
pages} [FilePath]
_ url :: URI
url@URI {uriScheme :: URI -> FilePath
uriScheme = FilePath
"about:", uriPath :: URI -> FilePath
uriPath = FilePath
path} =
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
url,
Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
Txt.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Method -> Text
convertCharset FilePath
"utf-8" (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Method
B.toStrict (ByteString -> Method) -> ByteString -> Method
forall a b. (a -> b) -> a -> b
$
FilePath -> ByteString -> [(FilePath, ByteString)] -> ByteString
forall a a. Eq a => a -> a -> [(a, a)] -> a
llookup (FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".mime") ByteString
"text/html" [(FilePath, ByteString)]
pages,
ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> [(FilePath, ByteString)] -> ByteString
forall a a. Eq a => a -> a -> [(a, a)] -> a
llookup FilePath
path ByteString
"" [(FilePath, ByteString)]
pages)
#ifdef WITH_HTTP_URI
fetchURL' Session
session [FilePath]
accept URI
uri | URI -> FilePath
uriScheme URI
uri FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"http:", FilePath
"https:"] =
Session
-> [FilePath]
-> URI
-> (Request -> Request)
-> (Response ByteString -> IO ())
-> IO (URI, FilePath, Either Text ByteString)
forall t a.
Session
-> [FilePath]
-> URI
-> (Request -> t)
-> (Response ByteString -> IO a)
-> IO (URI, FilePath, Either Text ByteString)
fetchHTTPCached Session
session [FilePath]
accept URI
uri Request -> Request
forall a. a -> a
id Response ByteString -> IO ()
forall body. Response body -> IO ()
saveCookies
where
saveCookies :: Response body -> IO ()
saveCookies Response body
resp
| Just MVar CookieJar
cookies <- Session -> Maybe (MVar CookieJar)
retroactiveCookies Session
session = MVar CookieJar -> CookieJar -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar CookieJar
cookies (CookieJar -> IO ()) -> CookieJar -> IO ()
forall a b. (a -> b) -> a -> b
$ Response body -> CookieJar
forall body. Response body -> CookieJar
HTTP.responseCookieJar Response body
resp
| Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
#ifdef WITH_GEMINI_URI
fetchURL' sess :: Session
sess@Session {connCtxt :: Session -> SSLContext
connCtxt = SSLContext
ctxt, locale :: Session -> [FilePath]
locale = [FilePath]
l} [FilePath]
mimes uri :: URI
uri@URI {
uriScheme :: URI -> FilePath
uriScheme = FilePath
"gemini:", uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just (URIAuth FilePath
_ FilePath
host FilePath
port)
} = SSLContext
-> FilePath
-> PortNumber
-> (InputStream Method
-> OutputStream Method
-> SSL
-> IO (URI, FilePath, Either Text ByteString))
-> IO (URI, FilePath, Either Text ByteString)
forall a.
SSLContext
-> FilePath
-> PortNumber
-> (InputStream Method -> OutputStream Method -> SSL -> IO a)
-> IO a
TLSConn.withConnection SSLContext
ctxt FilePath
host (PortNumber -> FilePath -> PortNumber
forall p. Read p => p -> FilePath -> p
parsePort PortNumber
1965 FilePath
port) ((InputStream Method
-> OutputStream Method
-> SSL
-> IO (URI, FilePath, Either Text ByteString))
-> IO (URI, FilePath, Either Text ByteString))
-> (InputStream Method
-> OutputStream Method
-> SSL
-> IO (URI, FilePath, Either Text ByteString))
-> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ \InputStream Method
input OutputStream Method
output SSL
_ -> do
OutputStream Method -> Maybe Method -> IO ()
forall a. OutputStream a -> Maybe a -> IO ()
writeTo OutputStream Method
output (Maybe Method -> IO ()) -> Maybe Method -> IO ()
forall a b. (a -> b) -> a -> b
$ Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method) -> Method -> Maybe Method
forall a b. (a -> b) -> a -> b
$ FilePath -> Method
C8.pack (FilePath -> Method) -> FilePath -> Method
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id URI
uri FilePath
"\r\n"
Handle
input' <- InputStream Method -> IO Handle
inputStreamToHandle InputStream Method
input
FilePath
header <- Handle -> IO FilePath
hGetLine Handle
input'
case FilePath -> (Char, Char, Text)
parseHeader FilePath
header of
(Char
'1', Char
_, Text
label) -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
"application/xhtml+xml", Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Txt.concat [
Text
"<form><label>",
Text -> Text -> Text -> Text
Txt.replace Text
"<" Text
"<" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
Txt.replace Text
"&" Text
"&" Text
label,
Text
"<input /></label></form>"
])
(Char
'2', Char
_, Text
mime) -> do
Method
body <- Handle -> IO Method
Strict.hGetContents Handle
input'
let mime' :: [FilePath]
mime' = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
L.map (Text -> FilePath
Txt.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Txt.strip) ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Txt.splitOn Text
";" Text
mime
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString))
-> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ URI
-> [FilePath]
-> ByteString
-> (URI, FilePath, Either Text ByteString)
forall a.
a
-> [FilePath]
-> ByteString
-> (a, FilePath, Either Text ByteString)
resolveCharset' URI
uri [FilePath]
mime' (ByteString -> (URI, FilePath, Either Text ByteString))
-> ByteString -> (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ Method -> ByteString
B.fromStrict Method
body
(Char
'3', Char
_, Text
redirect) | Just URI
redirect' <- FilePath -> Maybe URI
parseURIReference (FilePath -> Maybe URI) -> FilePath -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack Text
redirect ->
Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
sess {
redirectCount :: Int
redirectCount = Session -> Int
redirectCount Session
sess Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
} [FilePath]
mimes (URI -> IO (URI, FilePath, Either Text ByteString))
-> URI -> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ URI -> URI -> URI
relativeTo URI
redirect' URI
uri
(Char
_, Char
_, Text
err) -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left Text
err)
where
parseHeader :: String -> (Char, Char, Text)
parseHeader :: FilePath -> (Char, Char, Text)
parseHeader (Char
major:Char
minor:FilePath
meta) = (Char
major, Char
minor, Text -> Text
Txt.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
meta)
parseHeader FilePath
_ = (Char
'4', Char
'1', FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
l Errors
MalformedResponse)
handleIOErr :: IOError -> IO Strict.ByteString
handleIOErr :: IOError -> IO Method
handleIOErr IOError
_ = Method -> IO Method
forall (m :: * -> *) a. Monad m => a -> m a
return Method
""
#endif
#ifdef WITH_FILE_URI
fetchURL' Session {locale :: Session -> [FilePath]
locale = [FilePath]
l} (FilePath
defaultMIME:[FilePath]
_) uri :: URI
uri@URI {uriScheme :: URI -> FilePath
uriScheme = FilePath
"file:"} = do
ByteString
response <- FilePath -> IO ByteString
B.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
uriPath URI
uri
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
defaultMIME, ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
response)
IO (URI, FilePath, Either Text ByteString)
-> (IOError -> IO (URI, FilePath, Either Text ByteString))
-> IO (URI, FilePath, Either Text ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
e -> do
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR,
Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
l (Errors -> FilePath) -> Errors -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Errors
ReadFailed (FilePath -> Errors) -> FilePath -> Errors
forall a b. (a -> b) -> a -> b
$ IOError -> FilePath
forall e. Exception e => e -> FilePath
displayException (IOError
e :: IOException))
#endif
#ifdef WITH_DATA_URI
fetchURL' Session
_ (FilePath
defaultMIME:[FilePath]
_) uri :: URI
uri@URI {uriScheme :: URI -> FilePath
uriScheme = FilePath
"data:"} =
let request :: FilePath
request = URI -> FilePath
uriPath URI
uri FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ URI -> FilePath
uriQuery URI
uri FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ URI -> FilePath
uriFragment URI
uri
in case Char -> FilePath -> (FilePath, FilePath)
forall a. Eq a => a -> [a] -> ([a], [a])
breakOn Char
',' (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
unEscapeString FilePath
request of
(FilePath
"", FilePath
response) -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
defaultMIME, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
response)
(FilePath
mime', FilePath
response) | Char
'4':Char
'6':Char
'e':Char
's':Char
'a':Char
'b':Char
';':FilePath
mime <- FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
mime' ->
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString))
-> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either FilePath ByteString
B64.decode (ByteString -> Either FilePath ByteString)
-> ByteString -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ Method -> ByteString
B.fromStrict (Method -> ByteString) -> Method -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Method
C8.pack FilePath
response of
Left FilePath
str -> (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
unEscapeString FilePath
str)
Right ByteString
bytes -> (URI
uri, FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
mime, ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
bytes)
(FilePath
mime, FilePath
response) -> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mime, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack FilePath
response)
#endif
#ifdef WITH_XDG
fetchURL' Session {locale :: Session -> [FilePath]
locale = [FilePath]
l, apps :: Session -> XDGConfig
apps = XDGConfig
a} [FilePath]
_ uri :: URI
uri@(URI {uriScheme :: URI -> FilePath
uriScheme = FilePath
s}) = do
Errors
app <- XDGConfig -> URI -> FilePath -> IO Errors
dispatchURIByMIME XDGConfig
a URI
uri (FilePath
"x-scheme-handler/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
init FilePath
s)
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
htmlERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
l (Errors -> FilePath) -> Errors -> FilePath
forall a b. (a -> b) -> a -> b
$ Errors
app)
#else
fetchURL' Session {locale = l} _ URI {uriScheme = scheme} =
return (uri, mimeERR, Left $ Txt.pack $ trans l $ UnsupportedScheme scheme)
#endif
dispatchByMIME :: Session -> String -> URI -> IO (Maybe String)
#if WITH_XDG
dispatchByMIME :: Session -> FilePath -> URI -> IO (Maybe FilePath)
dispatchByMIME Session {locale :: Session -> [FilePath]
locale = [FilePath]
l, apps :: Session -> XDGConfig
apps = XDGConfig
a} FilePath
mime URI
uri = do
Errors
err <- XDGConfig -> URI -> FilePath -> IO Errors
dispatchURIByMIME XDGConfig
a URI
uri FilePath
mime
Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case Errors
err of
UnsupportedMIME FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing
Errors
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans [FilePath]
l Errors
err
#else
dispatchByMIME _ _ _ = return Nothing
#endif
appsForMIME :: Session -> String -> IO [Application]
#if WITH_XDG
appsForMIME :: Session -> FilePath -> IO [Application]
appsForMIME Session { apps :: Session -> XDGConfig
apps = XDGConfig
a, locale :: Session -> [FilePath]
locale = [FilePath]
l } = XDGConfig -> [FilePath] -> FilePath -> IO [Application]
queryHandlers' XDGConfig
a [FilePath]
l
#else
appsForMIME _ _ = []
#endif
dispatchByApp :: Session -> Application -> String -> URI -> IO Bool
#if WITH_XDG
dispatchByApp :: Session -> Application -> FilePath -> URI -> IO Bool
dispatchByApp session :: Session
session@Session { locale :: Session -> [FilePath]
locale = [FilePath]
l } Application { appId :: Application -> FilePath
appId = FilePath
app} FilePath
mime URI
uri = do
Either FilePath Bool
try1 <- [FilePath] -> URI -> FilePath -> IO (Either FilePath Bool)
launchApp' [FilePath]
l URI
uri FilePath
app
case Either FilePath Bool
try1 of
Left FilePath
app -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Right Bool
False -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right Bool
True -> do
FilePath
temp <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
getTemporaryDirectory
(URI, FilePath, Either Text ByteString)
resp <- Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
session [FilePath
mime] URI
uri
URI
uri' <- URI
-> FilePath -> (URI, FilePath, Either Text ByteString) -> IO URI
saveDownload (FilePath
-> Maybe URIAuth -> FilePath -> FilePath -> FilePath -> URI
URI FilePath
"file:" Maybe URIAuth
forall a. Maybe a
Nothing FilePath
"" FilePath
"" FilePath
"") FilePath
temp (URI, FilePath, Either Text ByteString)
resp
Either FilePath Bool -> Bool
forall a b. Either a b -> Bool
isLeft (Either FilePath Bool -> Bool)
-> IO (Either FilePath Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> URI -> FilePath -> IO (Either FilePath Bool)
launchApp' [FilePath]
l URI
uri' FilePath
app
#else
dispatchByApp _ _ _ _ = return False
#endif
#ifdef WITH_HTTP_URI
fetchHTTPCached :: Session
-> [FilePath]
-> URI
-> (Request -> t)
-> (Response ByteString -> IO a)
-> IO (URI, FilePath, Either Text ByteString)
fetchHTTPCached Session
session accept :: [FilePath]
accept@(FilePath
defaultMIME:[FilePath]
_) URI
uri Request -> t
cbReq Response ByteString -> IO a
cbResp = do
(Maybe (Text, ByteString), Maybe ResponseHeaders)
cached <- if Session -> Bool
cachingEnabled Session
session then URI -> IO (Maybe (Text, ByteString), Maybe ResponseHeaders)
readCacheHTTP URI
uri else (Maybe (Text, ByteString), Maybe ResponseHeaders)
-> IO (Maybe (Text, ByteString), Maybe ResponseHeaders)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, ByteString)
forall a. Maybe a
Nothing, Maybe ResponseHeaders
forall a. Maybe a
Nothing)
Either URI (Text, ByteString)
response <- case (Maybe (Text, ByteString), Maybe ResponseHeaders)
cached of
(Just (Text
mime, ByteString
body), Maybe ResponseHeaders
Nothing) -> Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either URI (Text, ByteString)
forall a b. b -> Either a b
Right (Text
mime, ByteString
body)
(Maybe (Text, ByteString)
cached, Maybe ResponseHeaders
cachingHeaders) -> do
Request
request <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
HTTP.requestFromURI URI
uri
CookieJar
cookieJar <- MVar CookieJar -> IO CookieJar
forall a. MVar a -> IO a
readMVar (MVar CookieJar -> IO CookieJar) -> MVar CookieJar -> IO CookieJar
forall a b. (a -> b) -> a -> b
$ Session -> MVar CookieJar
globalCookieJar Session
session
let request' :: t
request' = Request -> t
cbReq (Request -> t) -> Request -> t
forall a b. (a -> b) -> a -> b
$ Request
request {
cookieJar :: Maybe CookieJar
HTTP.cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just (CookieJar -> Maybe CookieJar) -> CookieJar -> Maybe CookieJar
forall a b. (a -> b) -> a -> b
$ CookieJar
cookieJar,
requestHeaders :: ResponseHeaders
HTTP.requestHeaders = [
(HeaderName
"Accept", FilePath -> Method
C8.pack (FilePath -> Method) -> FilePath -> Method
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
accept),
(HeaderName
"Accept-Language", FilePath -> Method
C8.pack (FilePath -> Method) -> FilePath -> Method
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ Session -> [FilePath]
locale Session
session)
] ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. [a] -> [a] -> [a]
++ ResponseHeaders -> Maybe ResponseHeaders -> ResponseHeaders
forall a. a -> Maybe a -> a
fromMaybe [] Maybe ResponseHeaders
cachingHeaders,
redirectCount :: Int
HTTP.redirectCount = Int
0
}
Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
request (Manager -> IO (Response ByteString))
-> Manager -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Session -> Manager
managerHTTP Session
session
Response ByteString -> IO a
cbResp Response ByteString
response
case (
Response ByteString -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ByteString
response,
Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
response,
[Method
val | (HeaderName
"content-type", Method
val) <- Response ByteString -> ResponseHeaders
forall body. Response body -> ResponseHeaders
HTTP.responseHeaders Response ByteString
response]
) of
(Status Int
304 Method
_, ByteString
_, [Method]
_) | Just cached' :: (Text, ByteString)
cached'@(Text
_, ByteString
body) <- Maybe (Text, ByteString)
cached -> do
URI -> Response ByteString -> IO ()
cacheHTTP URI
uri (Response ByteString -> IO ()) -> Response ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Response ByteString
response { responseBody :: ByteString
HTTP.responseBody = ByteString
body }
Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either URI (Text, ByteString)
forall a b. b -> Either a b
Right (Text, ByteString)
cached'
(Status Int
code Method
_, ByteString
_, [Method]
_) | Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
300 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
400,
Just Method
location <- HeaderName -> ResponseHeaders -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"location" (ResponseHeaders -> Maybe Method)
-> ResponseHeaders -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ResponseHeaders
forall body. Response body -> ResponseHeaders
HTTP.responseHeaders Response ByteString
response,
Just URI
uri' <- FilePath -> Maybe URI
parseURIReference (FilePath -> Maybe URI) -> FilePath -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Method -> FilePath
C8.unpack Method
location ->
Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ URI -> Either URI (Text, ByteString)
forall a b. a -> Either a b
Left (URI -> Either URI (Text, ByteString))
-> URI -> Either URI (Text, ByteString)
forall a b. (a -> b) -> a -> b
$ URI -> URI -> URI
relativeTo URI
uri' URI
uri
(Status Int
_ Method
msg, ByteString
"", [Method]
_) -> Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either URI (Text, ByteString)
forall a b. b -> Either a b
Right (FilePath -> Text
Txt.pack FilePath
mimeERR, Method -> ByteString
B.fromStrict Method
msg)
(Status
_, ByteString
body, (Method
mimetype:[Method]
_)) -> do
URI -> Response ByteString -> IO ()
cacheHTTP URI
uri Response ByteString
response
IO () -> IO ThreadId
forkIO IO ()
cleanCacheHTTP
let mime :: Text
mime = Text -> Text
Txt.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Method -> Text
convertCharset FilePath
"utf-8" Method
mimetype
Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either URI (Text, ByteString)
forall a b. b -> Either a b
Right (Text
mime, ByteString
body)
(Status
_, ByteString
response, []) -> Either URI (Text, ByteString) -> IO (Either URI (Text, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString)))
-> Either URI (Text, ByteString)
-> IO (Either URI (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either URI (Text, ByteString)
forall a b. b -> Either a b
Right (FilePath -> Text
Txt.pack FilePath
defaultMIME, ByteString
response)
case Either URI (Text, ByteString)
response of
Left URI
redirect ->
let session' :: Session
session' = Session
session { redirectCount :: Int
redirectCount = Session -> Int
redirectCount Session
session Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
in Session
-> [FilePath] -> URI -> IO (URI, FilePath, Either Text ByteString)
fetchURL' Session
session' [FilePath]
accept URI
redirect
Right (Text
mime, ByteString
body) ->
let mime' :: [FilePath]
mime' = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
L.map (Text -> FilePath
Txt.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Txt.strip) ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Txt.splitOn Text
";" Text
mime
in (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString))
-> (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall a b. (a -> b) -> a -> b
$ URI
-> [FilePath]
-> ByteString
-> (URI, FilePath, Either Text ByteString)
forall a.
a
-> [FilePath]
-> ByteString
-> (a, FilePath, Either Text ByteString)
resolveCharset' URI
uri [FilePath]
mime' ByteString
body
IO (URI, FilePath, Either Text ByteString)
-> (HttpException -> IO (URI, FilePath, Either Text ByteString))
-> IO (URI, FilePath, Either Text ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \HttpException
e -> do (URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans (Session -> [FilePath]
locale Session
session) (Errors -> FilePath) -> Errors -> FilePath
forall a b. (a -> b) -> a -> b
$ HttpException -> Errors
Http HttpException
e)
fetchHTTPCached Session
session [] URI
uri Request -> t
_ Response ByteString -> IO a
_ =
(URI, FilePath, Either Text ByteString)
-> IO (URI, FilePath, Either Text ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
uri, FilePath
mimeERR, Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Errors -> FilePath
trans (Session -> [FilePath]
locale Session
session) (Errors -> FilePath) -> Errors -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Errors
UnsupportedMIME FilePath
"")
#endif
saveDownload :: URI -> FilePath -> (URI, String, Either Text ByteString) -> IO URI
saveDownload :: URI
-> FilePath -> (URI, FilePath, Either Text ByteString) -> IO URI
saveDownload URI
baseURI FilePath
dir (URI {uriPath :: URI -> FilePath
uriPath = FilePath
path}, FilePath
mime, Either Text ByteString
resp) = do
FilePath
dest <- FilePath -> IO FilePath
unusedFilename (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName' FilePath
path)
case Either Text ByteString
resp of
Left Text
txt -> FilePath -> FilePath -> IO ()
writeFile FilePath
dest (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack Text
txt
Right ByteString
bytes -> FilePath -> ByteString -> IO ()
B.writeFile FilePath
dest ByteString
bytes
URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> IO URI) -> URI -> IO URI
forall a b. (a -> b) -> a -> b
$ URI
baseURI {uriPath :: FilePath
uriPath = FilePath
dest}
where
takeFileName' :: FilePath -> FilePath
takeFileName' FilePath
s = case FilePath -> FilePath
takeFileName FilePath
s of { FilePath
"" -> FilePath
"index"; FilePath
f -> FilePath
f}
unusedFilename :: FilePath -> IO FilePath
unusedFilename FilePath
path = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
if Bool
exists then Integer -> IO FilePath
forall a. (Num a, Show a) => a -> IO FilePath
go Integer
0 else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
where
go :: a -> IO FilePath
go a
n = do
let path' :: FilePath
path' = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
n
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path'
if Bool
exists then a -> IO FilePath
go (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'
downloadToURI :: (URI, String, Either Text ByteString) -> URI
downloadToURI :: (URI, FilePath, Either Text ByteString) -> URI
downloadToURI (URI
_, FilePath
mime, Left Text
txt) = URI
nullURI {
uriScheme :: FilePath
uriScheme = FilePath
"data:",
uriPath :: FilePath
uriPath = FilePath
mime FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> FilePath -> FilePath
escapeURIString Char -> Bool
isReserved (Text -> FilePath
Txt.unpack Text
txt)
}
downloadToURI (URI
_, FilePath
mime, Right ByteString
bytes) = URI
nullURI {
uriScheme :: FilePath
uriScheme = FilePath
"data:",
uriPath :: FilePath
uriPath = FilePath
mime FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";base64," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Method -> FilePath
C8.unpack (ByteString -> Method
B.toStrict (ByteString -> Method) -> ByteString -> Method
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
bytes)
}
enableLogging :: Session -> IO Session
enableLogging :: Session -> IO Session
enableLogging Session
session = do
MVar [LogRecord]
log <- [LogRecord] -> IO (MVar [LogRecord])
forall a. a -> IO (MVar a)
newMVar []
Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return Session
session { requestLog :: Maybe (MVar [LogRecord])
requestLog = MVar [LogRecord] -> Maybe (MVar [LogRecord])
forall a. a -> Maybe a
Just MVar [LogRecord]
log }
retrieveLog :: Session -> IO [LogRecord]
retrieveLog :: Session -> IO [LogRecord]
retrieveLog session :: Session
session@Session { requestLog :: Session -> Maybe (MVar [LogRecord])
requestLog = Just MVar [LogRecord]
log } = MVar [LogRecord] -> [LogRecord] -> IO [LogRecord]
forall a. MVar a -> a -> IO a
swapMVar MVar [LogRecord]
log []
retrieveLog Session
_ = [LogRecord] -> IO [LogRecord]
forall (m :: * -> *) a. Monad m => a -> m a
return []
writeLog :: Handle -> Session -> IO ()
writeLog :: Handle -> Session -> IO ()
writeLog Handle
out Session
session = do
[FilePath] -> IO ()
writeRow [FilePath
"URL", FilePath
"Redirected", FilePath
"Accept", FilePath
"MIMEtype", FilePath
"Size", FilePath
"Begin", FilePath
"End", FilePath
"Duration"]
[LogRecord]
log <- Session -> IO [LogRecord]
retrieveLog Session
session
[LogRecord] -> (LogRecord -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LogRecord]
log ((LogRecord -> IO ()) -> IO [()])
-> (LogRecord -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \LogRecord
record -> [FilePath] -> IO ()
writeRow [
URI -> FilePath
forall a. Show a => a -> FilePath
show (URI -> FilePath) -> URI -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> URI
url LogRecord
record, URI -> FilePath
forall a. Show a => a -> FilePath
show (URI -> FilePath) -> URI -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> URI
redirected LogRecord
record,
[FilePath] -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> [FilePath]
accept LogRecord
record, FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> FilePath
mimetype LogRecord
record,
case LogRecord -> Either Text ByteString
response LogRecord
record of
Left Text
txt -> Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Int
Txt.length Text
txt
Right ByteString
bs -> Int64 -> FilePath
forall a. Show a => a -> FilePath
show (Int64 -> FilePath) -> Int64 -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
bs,
UTCTime -> FilePath
forall a. Show a => a -> FilePath
show (UTCTime -> FilePath) -> UTCTime -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> UTCTime
begin LogRecord
record, UTCTime -> FilePath
forall a. Show a => a -> FilePath
show (UTCTime -> FilePath) -> UTCTime -> FilePath
forall a b. (a -> b) -> a -> b
$ LogRecord -> UTCTime
end LogRecord
record,
NominalDiffTime -> FilePath
forall a. Show a => a -> FilePath
show (LogRecord -> UTCTime
end LogRecord
record UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` LogRecord -> UTCTime
end LogRecord
record)
]
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
writeRow :: [FilePath] -> IO ()
writeRow = Handle -> FilePath -> IO ()
hPutStrLn Handle
out (FilePath -> IO ())
-> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
L.intercalate FilePath
"\t"
breakOn :: a -> [a] -> ([a], [a])
breakOn a
c (a
a:[a]
as) | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a = ([], [a]
as)
| Bool
otherwise = let ([a]
x, [a]
y) = a -> [a] -> ([a], [a])
breakOn a
c [a]
as in (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
x, [a]
y)
breakOn a
_ [] = ([], [])
firstJust :: Maybe a -> Maybe a -> Maybe a
firstJust a :: Maybe a
a@(Just a
_) Maybe a
_ = Maybe a
a
firstJust Maybe a
Nothing Maybe a
b = Maybe a
b