@@ 75,35 75,25 @@ parseDocument _ _ (uri, 't':'e':'x':'t':'/':'g':'e':'m':'i':'n':'i':';':'l':'a':
pageForDoc uri $ parseGemini (Just lang) $ utf8' bytes
parseDocument _ _ (uri, "text/gemini", Left text) = pageForDoc uri $ parseGemini Nothing text
parseDocument _ _ (uri, "text/gemini", Right bytes) = pageForDoc uri $ parseGemini Nothing $ utf8' bytes
-parseDocument referer _ (uri, "text/css", Left text)
- | uri'@URI {uriAuthority = Just host} <- Types.url referer = do
+parseDocument a b (a', b'@"text/css", Right bytes) =
+ parseDocument a b (a', b', Left $ applyCSScharset (map Txt.unpack charsets) $ B.toStrict bytes)
+parseDocument referer@Page {Types.url = uri'} _ (uri, "text/css", Left text)
+ | URI {uriAuthority = Just host} <- Types.url referer = do
-- Save this per-domain setting
dir <- (</> "domain") <$> getXdgDirectory XdgConfig "rhapsode"
createDirectoryIfMissing True dir
- let header = Txt.pack (uriToString id uri "") `Txt.append` "\n"
- Txt.writeFile (dir </> uriRegName host) $ Txt.append header text
+ Txt.writeFile (dir </> uriRegName host) $
+ CSSTok.serialize $ map absolutizeCSS $ CSSTok.tokenize text
- return referer {
+ return ret
+ | otherwise = return ret
+ where
+ ret = referer {
css = parseForURL (conditionalStyles uri' "document") uri text
}
- | otherwise = return referer {
- css = parseForURL (conditionalStyles (Types.url referer) "document") uri text
- }
-parseDocument referer _ (uri, "text/css", Right bytes)
- | uri'@URI {uriAuthority = Just host} <- Types.url referer = do
- -- Save this per-domain setting
- dir <- (</> "domain") <$> getXdgDirectory XdgConfig "rhapsode"
- createDirectoryIfMissing True dir
- let header = Txt.pack (uriToString id uri "") `Txt.append` "\n"
- Txt.writeFile (dir </> uriRegName host) $ Txt.append header text
-
- return referer {
- css = parseForURL (conditionalStyles uri' "document") uri text
- }
- | otherwise = return referer {
- css = parseForURL (conditionalStyles (Types.url referer) "document") uri text
- }
- where text = applyCSScharset (map Txt.unpack charsets) $ B.toStrict bytes
+ absolutizeCSS (CSSTok.Url text) | Just rel <- parseRelativeReference $ Txt.unpack text =
+ CSSTok.Url $ Txt.pack $ uriToStr' $ relativeTo rel uri'
+ absolutizeCSS tok = tok
parseDocument ref sess (uri, mime, body) | mime' /= mime = parseDocument ref sess (uri, mime', body)
where mime' = takeWhile (/= ';') mime
@@ 141,11 131,8 @@ pageForDoc uri doc = do
dir <- getXdgDirectory XdgConfig "rhapsode"
let path = dir </> "domain" </> uriRegName host
hasAltStyle <- doesFileExist path
- if not hasAltStyle then authorStyle else do
- conf <- Txt.readFile path
- let (uriTxt, css) = Txt.break (== '\n') conf
- let uri' = fromMaybe nullURI $ parseAbsoluteURI $ Txt.unpack uriTxt
- return $ parseForURL (conditionalStyles uri "document") uri' css
+ if not hasAltStyle then authorStyle else
+ parse (conditionalStyles uri "document") <$> Txt.readFile path
hist <- newEmptyMVar
return Page {Types.url = uri, html = doc, css = styles,
@@ 158,12 145,11 @@ logHistory ret@Page {Types.url = url', html = doc, visitedURLs = hist} = do
createDirectoryIfMissing True dir
now <- getCurrentTime
let title = Txt.unpack $ getTitle $ XML.documentRoot doc
- let urlStr = uriToString id url' ""
appendFile (dir </> "history.gmni") $ intercalate " " [
- "=>", urlStr, show now, title
+ "=>", uriToStr' url', show now, title
]
- modifyMVar_ hist $ return . Trie.insert (Txt.pack urlStr) ()
+ modifyMVar_ hist $ return . Trie.insert (Txt.pack $ uriToStr' url') ()
return ret { pageTitle = title, visitedURLs = hist }
where
@@ 173,6 159,9 @@ logHistory ret@Page {Types.url = url', html = doc, visitedURLs = hist} = do
| title:_ <- [getTitle el | XML.NodeElement el <- childs] = title
| otherwise = ""
+uriToStr' :: URI -> String
+uriToStr' uri = uriToString id uri ""
+
--------
---- CSS charset sniffing
--------