From 8bf7b85dffbcad8f1659e7d4f495160473b0e991 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 31 Dec 2020 07:08:41 +1300 Subject: [PATCH] Remove global variable, move to Page field. --- rhapsode.cabal | 2 +- src/Input.hs | 30 +++++++++--------------------- src/Render.hs | 2 ++ src/Types.hs | 31 +++++++++++++++++++++++++------ 4 files changed, 37 insertions(+), 28 deletions(-) diff --git a/rhapsode.cabal b/rhapsode.cabal index b025667..10b31b5 100644 --- a/rhapsode.cabal +++ b/rhapsode.cabal @@ -65,7 +65,7 @@ library network-uri, stylist >= 2.2 && <3, css-syntax, xml-conduit-stylist >= 2.2 && <3, scientific, async, hurl >= 1.5, filepath, temporary, - file-embed >= 0.0.9 && < 0.1, time, text-trie >= 0.2.5 + file-embed >= 0.0.9 && < 0.1, time, text-trie >= 0.2.5, parallel >= 1 -- Directories containing source files. hs-source-dirs: src diff --git a/src/Input.hs b/src/Input.hs index 64a21cd..8adf070 100644 --- a/src/Input.hs +++ b/src/Input.hs @@ -110,10 +110,14 @@ pageForText uri txt = pageForDoc uri XML.Document { XML.documentEpilogue = [] } -pageForDoc uri doc = return Page {Types.url = uri, html = doc, css = html2css doc uri, - pageTitle = "", pageMIME = "", apps = [], backStack = [], forwardStack = []} - -logHistory ret@Page {Types.url = url', html = doc} = do +pageForDoc uri doc = do + hist <- newEmptyMVar + return Page {Types.url = uri, html = doc, css = html2css doc uri, + -- These fields are all blank, to be filled in later by logHistory & parseDocument' + pageTitle = "", pageMIME = "", apps = [], + backStack = [], forwardStack = [], visitedURLs = hist} + +logHistory ret@Page {Types.url = url', html = doc, visitedURLs = hist} = do dir <- getXdgDirectory XdgData "rhapsode" createDirectoryIfMissing True dir now <- getCurrentTime @@ -123,10 +127,9 @@ logHistory ret@Page {Types.url = url', html = doc} = do "=>", urlStr, show now, title ] - hist <- visitedURLs modifyMVar_ hist $ return . Trie.insert (Txt.pack urlStr) () - return ret { pageTitle = title } + return ret { pageTitle = title, visitedURLs = hist } where getTitle (XML.Element "title" _ childs) = Txt.concat [txt | XML.NodeContent txt <- childs] getTitle (XML.Element "h1" _ childs) = Txt.concat [txt | XML.NodeContent txt <- childs] @@ -134,20 +137,6 @@ logHistory ret@Page {Types.url = url', html = doc} = do | title:_ <- [getTitle el | XML.NodeElement el <- childs] = title | otherwise = "" -loadVisited :: IO () -loadVisited = do - dir <- getXdgDirectory XdgData "rhapsode" - let path = dir "history.gmni" - exists <- doesFileExist path - - hist <- visitedURLs - if exists then do - file <- readFile path - putMVar hist $ Trie.fromList [ - (Txt.pack uri, ()) | _:uri:_ <- map words $ lines file - ] - else putMVar hist Trie.empty - -------- ---- CSS charset sniffing -------- @@ -233,7 +222,6 @@ foreign export ccall c_newSession :: IO (StablePtr Session) foreign export ccall c_freeSession :: StablePtr Session -> IO () c_newSession = do - loadVisited sess <- newSession newStablePtr $ sess {aboutPages = map lazify $(embedDir "about")} where lazify (a, b) = (a, B.fromStrict b) diff --git a/src/Render.hs b/src/Render.hs index 111ed91..009e6e8 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -126,9 +126,11 @@ downloadAssets session mimes (StyleAssets _ assets) = do filterMIMEs mimes cb download@(_, mime, _) | mime `elem` mimes = cb download | otherwise = return nullURI + -------- ---- C API -------- + foreign export ccall c_renderDoc :: StablePtr Session -> StablePtr Page -> Bool -> IO CString -- Hard to C bindings without IO c_renderDoc c_session c_page rewriteURLs = do diff --git a/src/Types.hs b/src/Types.hs index c6cebf1..fab1a3e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Types(CArray, Page(..), Application(..), visitedURLs) where +module Types(CArray, Page(..), Application(..)) where import System.Directory (getCurrentDirectory) -- default referer URI import SpeechStyle (SpeechStyle) @@ -9,8 +9,15 @@ import Text.XML import qualified Data.Map.Strict as M import Network.URI import Network.URI.Fetch (Application(..)) + +-- For the in-memory history log import Data.Trie.Text (Trie) +import qualified Data.Text as Txt +import qualified Data.Trie.Text as Trie import Control.Concurrent.MVar +import System.Directory +import System.FilePath (()) +import Control.Parallel (par) import Foreign.Ptr import Foreign.StablePtr @@ -25,16 +32,28 @@ data Page = Page { pageMIME :: String, apps :: [Application], backStack :: [(String, URI)], - forwardStack :: [(String, URI)] + forwardStack :: [(String, URI)], + -- Probably don't need an MVar here, but let's be safe! + visitedURLs :: MVar (Trie ()) } -visitedURLs :: IO (MVar (Trie ())) -visitedURLs = newEmptyMVar - foreign export ccall c_initialReferer :: IO (StablePtr Page) +loadVisited :: IO (MVar (Trie ())) +loadVisited = do + dir <- getXdgDirectory XdgData "rhapsode" + let path = dir "history.gmni" + exists <- doesFileExist path + + if exists then do + file <- Prelude.readFile path + let hist = Trie.fromList [(Txt.pack uri, ()) | _:uri:_ <- map words $ lines file] + hist `par` newMVar hist + else newMVar Trie.empty + c_initialReferer = do cwd <- getCurrentDirectory + hist <- loadVisited newStablePtr $ Page { -- Default to URIs being relative to CWD. url = URI {uriScheme = "file:", uriPath = cwd, @@ -47,7 +66,7 @@ c_initialReferer = do documentEpilogue = [] }, pageTitle = "", pageMIME = "", apps = [], - backStack = [], forwardStack = [] + backStack = [], forwardStack = [], visitedURLs = hist } foreign export ccall c_freePage :: StablePtr Page -> IO () -- 2.30.2