From 4729cb48433586eeb0de9d481e97b182f863b7b4 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 4 Jan 2021 20:49:59 +1300
Subject: [PATCH] Refactor persisted alternate styles!

---
 src/Input.hs | 51 ++++++++++++++++++++-------------------------------
 1 file changed, 20 insertions(+), 31 deletions(-)

diff --git a/src/Input.hs b/src/Input.hs
index 6c745fc..2cae0b1 100644
--- a/src/Input.hs
+++ b/src/Input.hs
@@ -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
 --------
-- 
2.30.2