~alcinnz/rhapsode

4729cb48433586eeb0de9d481e97b182f863b7b4 — Adrian Cochrane 3 years ago d6a13c9
Refactor persisted alternate styles!
1 files changed, 20 insertions(+), 31 deletions(-)

M src/Input.hs
M src/Input.hs => src/Input.hs +20 -31
@@ 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
--------