From e7cfb212f5763078ad56b808b6dbe657a8951b0e Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 31 Dec 2020 09:22:56 +1300
Subject: [PATCH] Write out file for discovering new pages.

---
 src/Links.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/src/Links.hs b/src/Links.hs
index 069a00a..40191af 100644
--- a/src/Links.hs
+++ b/src/Links.hs
@@ -15,10 +15,15 @@ import Foreign.Marshal.Array
 import Control.Monad (forM)
 import Control.Exception (catch)
 
-import System.Directory -- For locating links.xml
+import System.Directory -- For locating links.xml, suggestions.gmni
 import System.FilePath
 import System.IO (hPrint, stderr) -- For error reporting
 
+import Data.Trie.Text (Trie)
+import qualified Data.Trie.Text as Trie
+import Data.List (nub)
+import Control.Concurrent.MVar (readMVar)
+
 data Link = Link {
     label :: Text,
     title :: Text,
@@ -111,11 +116,33 @@ readBookmarks = do
     handleInvalid err@(InvalidXMLFile _ _) = hPrint stderr err >> nodoc
     nodoc = return $ Document (Prologue [] Nothing []) (Element "empty" M.empty []) []
 
+-- | Write out a file of most frequently encountered unvisited links.
+-- Hopefully this'll help surfers rely less on YouTube, et al's hueristics.
+updateSuggestions :: Page -> IO ()
+updateSuggestions page = do
+    hist <- readMVar $ visitedURLs page
+    let links = extractLinks $ html page
+    let domain = maybe "" show $ uriAuthority $ url page
+
+    dir <- getXdgDirectory XdgData "rhapsode"
+    let path = dir </> "suggestions.gmni"
+    exists <- doesFileExist path
+    suggestions <- if not exists then return [] else do
+        file <- Prelude.readFile path
+        return [line' | line <- lines file, line'@(_:uri':_) <- [words line], not (pack uri' `Trie.member` hist)]
+
+    let suggestions' = suggestions ++ nub [["=>", uri', domain] | link <- links,
+            let uri' = uriToString id (href link) "", not (pack uri' `Trie.member` hist)]
+
+    createDirectoryIfMissing True dir
+    Prelude.writeFile path $ unlines $ map unwords suggestions'
+
 -- C API
 foreign export ccall c_extractLinks :: StablePtr Page -> IO (CArray CString)
 
 c_extractLinks c_page = do
     page <- deRefStablePtr c_page
+    forkIO $ updateSuggestions page -- background process for useful navigation aid.
     bookmarks <- readBookmarks
     ret <- forM (linksFromPage page ++ extractLinks bookmarks) $ \link -> do
         c_label <- text2cstring $ strip $ label link
-- 
2.30.2