From 9946bf63055c178274fe2e4efabf5061ecb89913 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 30 Dec 2020 21:26:26 +1300
Subject: [PATCH] Log browser history in memory

---
 rhapsode.cabal |  2 +-
 src/Input.hs   | 26 +++++++++++++++++++++++++-
 src/Types.hs   |  7 ++++++-
 3 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/rhapsode.cabal b/rhapsode.cabal
index 53d2db0..b025667 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
+        file-embed >= 0.0.9 && < 0.1, time, text-trie >= 0.2.5
   
   -- Directories containing source files.
   hs-source-dirs:      src
diff --git a/src/Input.hs b/src/Input.hs
index 67dff66..64a21cd 100644
--- a/src/Input.hs
+++ b/src/Input.hs
@@ -29,6 +29,10 @@ import System.Directory
 import System.FilePath ((</>))
 import Data.FileEmbed
 
+-- For history
+import qualified Data.Trie.Text as Trie
+import Control.Concurrent.MVar
+
 -- For C API
 import Types
 import Data.HTML2CSS (html2css)
@@ -114,9 +118,14 @@ logHistory ret@Page {Types.url = url', html = doc} = do
     createDirectoryIfMissing True dir
     now <- getCurrentTime
     let title = Txt.unpack $ getTitle $ XML.documentRoot doc
+    let urlStr = uriToString id url' ""
     appendFile (dir </> "history.gmni") $ intercalate " " [
-        "=>", uriToString id url' "", show now, title
+        "=>", urlStr, show now, title
       ]
+
+    hist <- visitedURLs
+    modifyMVar_ hist $ return . Trie.insert (Txt.pack urlStr) ()
+
     return ret { pageTitle = title }
   where
     getTitle (XML.Element "title" _ childs) = Txt.concat [txt | XML.NodeContent txt <- childs]
@@ -125,6 +134,20 @@ 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
 --------
@@ -210,6 +233,7 @@ 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/Types.hs b/src/Types.hs
index 5567a89..c6cebf1 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Types(CArray, Page(..), Application(..)) where
+module Types(CArray, Page(..), Application(..), visitedURLs) where
 
 import System.Directory (getCurrentDirectory) -- default referer URI
 import SpeechStyle (SpeechStyle)
@@ -9,6 +9,8 @@ import Text.XML
 import qualified Data.Map.Strict as M
 import Network.URI
 import Network.URI.Fetch (Application(..))
+import Data.Trie.Text (Trie)
+import Control.Concurrent.MVar
 
 import Foreign.Ptr
 import Foreign.StablePtr
@@ -26,6 +28,9 @@ data Page = Page {
     forwardStack :: [(String, URI)]
 }
 
+visitedURLs :: IO (MVar (Trie ()))
+visitedURLs = newEmptyMVar
+
 foreign export ccall c_initialReferer :: IO (StablePtr Page)
 
 c_initialReferer = do
-- 
2.30.2