From a9c0bfc0deb71749e8559c4f60d290c7d0c0756f Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 28 Dec 2020 20:28:07 +1300 Subject: [PATCH] Add 'pseudolinks' for tab history, apps, & bookmarks. --- ISSUES/chrome/{ => help-wanted}/bookmarks.md | 0 ISSUES/chrome/{ => help-wanted}/clipboard.md | 0 ISSUES/chrome/help-wanted/history.md | 8 +++++ ISSUES/chrome/{ => help-wanted}/topsites.md | 0 ISSUES/chrome/history.md | 5 --- ISSUES/chrome/reload.md | 2 -- ISSUES/chrome/tab-history.md | 2 -- ISSUES/docs/stylize_css_reference.md | 7 ---- ISSUES/docs/update_changelog.md | 3 -- ISSUES/docs/update_license.md | 12 ------- ISSUES/in-progress/links.md | 6 ++-- rhapsode.cabal | 2 +- src/Input.hs | 34 ++++++++++++------ src/Links.hs | 38 +++++++++++++++++++- src/Types.hs | 6 ++-- 15 files changed, 76 insertions(+), 49 deletions(-) rename ISSUES/chrome/{ => help-wanted}/bookmarks.md (100%) rename ISSUES/chrome/{ => help-wanted}/clipboard.md (100%) create mode 100644 ISSUES/chrome/help-wanted/history.md rename ISSUES/chrome/{ => help-wanted}/topsites.md (100%) delete mode 100644 ISSUES/chrome/history.md delete mode 100644 ISSUES/chrome/reload.md delete mode 100644 ISSUES/chrome/tab-history.md delete mode 100644 ISSUES/docs/stylize_css_reference.md delete mode 100644 ISSUES/docs/update_changelog.md delete mode 100644 ISSUES/docs/update_license.md diff --git a/ISSUES/chrome/bookmarks.md b/ISSUES/chrome/help-wanted/bookmarks.md similarity index 100% rename from ISSUES/chrome/bookmarks.md rename to ISSUES/chrome/help-wanted/bookmarks.md diff --git a/ISSUES/chrome/clipboard.md b/ISSUES/chrome/help-wanted/clipboard.md similarity index 100% rename from ISSUES/chrome/clipboard.md rename to ISSUES/chrome/help-wanted/clipboard.md diff --git a/ISSUES/chrome/help-wanted/history.md b/ISSUES/chrome/help-wanted/history.md new file mode 100644 index 0000000..a4c6ef9 --- /dev/null +++ b/ISSUES/chrome/help-wanted/history.md @@ -0,0 +1,8 @@ +# History +**NOTE:** Rhapsode does include history support today, but it's got poor UX. +Still this existing support is useful as a datasource for a better UX! + +This page should have a prepopulated "petname". + +A single page should be rendered for each day, be punctuated by the hour mark, +and include navigation links to other years, months, and days. diff --git a/ISSUES/chrome/topsites.md b/ISSUES/chrome/help-wanted/topsites.md similarity index 100% rename from ISSUES/chrome/topsites.md rename to ISSUES/chrome/help-wanted/topsites.md diff --git a/ISSUES/chrome/history.md b/ISSUES/chrome/history.md deleted file mode 100644 index 5d37fda..0000000 --- a/ISSUES/chrome/history.md +++ /dev/null @@ -1,5 +0,0 @@ -# History -This page should have a prepopulated "petname". - -A single page should be rendered for each day, be punctuated by the hour mark, -and include navigation links to other years, months, and days. \ No newline at end of file diff --git a/ISSUES/chrome/reload.md b/ISSUES/chrome/reload.md deleted file mode 100644 index 14d492f..0000000 --- a/ISSUES/chrome/reload.md +++ /dev/null @@ -1,2 +0,0 @@ -# Reload pages -Important browser feature, especially since the data isn't otherwise live. \ No newline at end of file diff --git a/ISSUES/chrome/tab-history.md b/ISSUES/chrome/tab-history.md deleted file mode 100644 index 00838f2..0000000 --- a/ISSUES/chrome/tab-history.md +++ /dev/null @@ -1,2 +0,0 @@ -# Navigate back/forward in history -There should be "psuedo-links" for the last and next visited pages. \ No newline at end of file diff --git a/ISSUES/docs/stylize_css_reference.md b/ISSUES/docs/stylize_css_reference.md deleted file mode 100644 index a6826c1..0000000 --- a/ISSUES/docs/stylize_css_reference.md +++ /dev/null @@ -1,7 +0,0 @@ -# Stylize HTML included in `css-reference.html` to visually seperate a tag from a description - -Currently, the included CSS Reference file is visually difficult to read. - -While the software may be developed with Visually Impaired users as a primary target demographic, that does not mean it should shy away from making its end-developer documentation easy to parse both with Rhapsode via audio, *and* visually for those who do not use the software but would like to step up their accessibility game. - -This could be achived with some simple HTML5/CSS styling, like changing the background color and changing tag font to Monospace. diff --git a/ISSUES/docs/update_changelog.md b/ISSUES/docs/update_changelog.md deleted file mode 100644 index 13f5cc9..0000000 --- a/ISSUES/docs/update_changelog.md +++ /dev/null @@ -1,3 +0,0 @@ -# Update or Remove the CHANGELOG - -The changelog doesn't show anything aside from the initial release version. This should either be updated or removed. diff --git a/ISSUES/docs/update_license.md b/ISSUES/docs/update_license.md deleted file mode 100644 index 5a4cc3e..0000000 --- a/ISSUES/docs/update_license.md +++ /dev/null @@ -1,12 +0,0 @@ -# Include specific public domain license mechanism in LICENSE for audio - -The license file *(as of 6450441)* (in regards to audio files) does not specify a specific strong public domain clause or creative commons license: - - ``` - Sound files are in the public domain. The rest of the code, and it's documentation, - is under the GNU GPL v3+. - ``` - -While not strictly necessary for public domain audio works (at least, to my [ariana.giroux@gmail.com] knowledge and in Canada), this is not something that will hold up in court. It is best to include a Creative Commons license that would apply to the audio files. My [ariana.giroux@gmail.com] suggestion would be to utilize a `CC BY` creative commons license. - -This license is extremely permissive, only requiring credit back to the original author via derivative and commercial applications. This is already required for the code base via the GPL, so including a similar requirement for the audio files is not a stretch. diff --git a/ISSUES/in-progress/links.md b/ISSUES/in-progress/links.md index fa2614c..3d76ae9 100644 --- a/ISSUES/in-progress/links.md +++ b/ISSUES/in-progress/links.md @@ -21,9 +21,9 @@ These different types of links would be styled differently during the clarificat - [x] Extract links from page - [x] Switch to C for access to needed libraries -- [ ] Filter links based on user input +- [x] Filter links based on user input - [ ] Integrate voice recognition (CMU Pocket Sphinx or Mozilla Deep Speech) -- [ ] Implement "petnames" configured via an XBEL-derived format. +- [x] Implement "petnames" configured via an XBEL-derived format. ## Petnames Petnames would be a core part of Rhapsode's "chrome", as this would serve as a @@ -32,4 +32,4 @@ also be the means by which users can access any navigation controls packaged up with Rhapsode. It would even give a great experience for unmodified (JS-free) search engines, -which you could bring up by name and immediately be prompted for a query. \ No newline at end of file +which you could bring up by name and immediately be prompted for a query. diff --git a/rhapsode.cabal b/rhapsode.cabal index 5935170..53d2db0 100644 --- a/rhapsode.cabal +++ b/rhapsode.cabal @@ -64,7 +64,7 @@ library html-conduit, xml-conduit, text, containers, data-default-class, network-uri, stylist >= 2.2 && <3, css-syntax, xml-conduit-stylist >= 2.2 && <3, scientific, - async, hurl >= 1.4.2.0, filepath, temporary, + async, hurl >= 1.5, filepath, temporary, file-embed >= 0.0.9 && < 0.1, time -- Directories containing source files. diff --git a/src/Input.hs b/src/Input.hs index 1a3380c..67dff66 100644 --- a/src/Input.hs +++ b/src/Input.hs @@ -38,17 +38,29 @@ import Foreign.C.String utf8' bytes = convertCharset "utf-8" $ B.toStrict bytes +fetchDocument http referer mime uri@URI { uriScheme = 'n':'o':'c':'a':'c':'h':'e':'+':scheme } = + fetchDocument http { cachingEnabled = False } referer mime uri { uriScheme = scheme } +fetchDocument http referer mime URI { uriScheme = "app:", uriPath = appID } = do + dispatchByApp http Application { + name = "", icon = nullURI, description = "", + appId = appID + } (pageMIME referer) $ Types.url referer + return referer -- TODO play an error or success sound fetchDocument http referer mime uri = fetchURL' http mime uri >>= parseDocument' referer http -parseDocument' ref sess resp@(_, mime, _) = parseDocument ref sess resp >>= logHistory >>= return . annotate - where - annotate x@Page { Types.url = uri'} | Types.url x == uri' = x { pageMIME = mime } - | ((_, back):backs) <- backStack ref, back == uri' = - x { pageMIME = mime, backStack = backs, forwardStack = entry x:forwardStack ref } - | ((_, next):nexts) <- forwardStack ref, next == uri' = - x { pageMIME = mime, forwardStack = nexts, backStack = entry x:backStack ref } - | otherwise = - x { pageMIME = mime, forwardStack = entry x:forwardStack ref, backStack = backStack ref } - entry x = (pageTitle x, Types.url x) + +parseDocument' ref sess resp@(_, mime, _) = do + page <- parseDocument ref sess resp >>= logHistory + apps' <- appsForMIME sess mime + return $ attachHistory $ page { pageMIME = mime, apps = apps' } + where + attachHistory x@Page { Types.url = uri'} | Types.url x == uri' = x + | ((_, back):backs) <- backStack ref, back == uri' = + x { backStack = backs, forwardStack = entry x:forwardStack ref } + | ((_, next):nexts) <- forwardStack ref, next == uri' = + x { forwardStack = nexts, backStack = entry x:backStack ref } + | otherwise = + x { forwardStack = entry x:forwardStack ref, backStack = backStack ref } + entry x = (pageTitle x, Types.url x) parseDocument ref sess (uri, "html/x-error\t", resp) = parseDocument ref sess (uri, "text/html", resp) parseDocument _ _ (uri, "text/html", Left text) = pageForDoc uri $ HTML.parseLT $ fromStrict text parseDocument _ _ (uri, "text/html", Right bytes) = pageForDoc uri $ HTML.parseLBS bytes @@ -95,7 +107,7 @@ pageForText uri txt = pageForDoc uri XML.Document { } pageForDoc uri doc = return Page {Types.url = uri, html = doc, css = html2css doc uri, - pageTitle = "", pageMIME = "", backStack = [], forwardStack = []} + pageTitle = "", pageMIME = "", apps = [], backStack = [], forwardStack = []} logHistory ret@Page {Types.url = url', html = doc} = do dir <- getXdgDirectory XdgData "rhapsode" diff --git a/src/Links.hs b/src/Links.hs index 0b47c92..abc882f 100644 --- a/src/Links.hs +++ b/src/Links.hs @@ -13,6 +13,11 @@ import Foreign.StablePtr import Foreign.C.String import Foreign.Marshal.Array import Control.Monad (forM) +import Control.Exception (catch) + +import System.Directory -- For locating links.xml +import System.FilePath +import System.IO (hPrint, stderr) -- For error reporting data Link = Link { label :: Text, @@ -65,12 +70,43 @@ nodesText (NodeContent text:nodes) = text +++ nodesText nodes nodesText (_:nodes) = nodesText nodes nodesText [] = "" +linksFromPage :: Page -> [Link] +linksFromPage Page { + url = url', + pageTitle = title', + html = html', + apps = apps', + backStack = back', forwardStack = forward' + } = -- TODO internationalize! + link' "reload" title' url' : + link' "reload without cache" "Fetch again from server without checking for a local copy" + url' { uriScheme = "nocache+" ++ uriScheme url' } : + [link' "back" t u | (t, u) <- head' back'] ++ + [link' "forward" t u | (t, u) <- head' forward' ] ++ + [link' n desc $ URI "app:" Nothing id "" "" | Application n _ desc id <- apps'] ++ + extractLinks html' + +head' (a:_) = [a] +head' [] = [] +link' l t h = Link (pack l) (pack t) h + +readBookmarks :: IO Document +readBookmarks = do + dir <- getXdgDirectory XdgData "rhapsode" + let file = dir "links.xml" + exists <- doesFileExist file + if exists then Text.XML.readFile def file `catch` handleInvalid else nodoc + where + handleInvalid err@(InvalidXMLFile _ _) = hPrint stderr err >> nodoc + nodoc = return $ Document (Prologue [] Nothing []) (Element "empty" M.empty []) [] + -- C API foreign export ccall c_extractLinks :: StablePtr Page -> IO (CArray CString) c_extractLinks c_page = do page <- deRefStablePtr c_page - ret <- forM (extractLinks $ html page) $ \link -> do + bookmarks <- readBookmarks + ret <- forM (linksFromPage page ++ extractLinks bookmarks) $ \link -> do c_label <- text2cstring $ strip $ label link c_title <- text2cstring $ strip $ title link c_href <- newCString $ uriToString id (href link) "" diff --git a/src/Types.hs b/src/Types.hs index aa2d893..5567a89 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Types(CArray, Page(..)) where +module Types(CArray, Page(..), Application(..)) where import System.Directory (getCurrentDirectory) -- default referer URI import SpeechStyle (SpeechStyle) @@ -8,6 +8,7 @@ import Data.CSS.Preprocessor.Text (TextStyle) import Text.XML import qualified Data.Map.Strict as M import Network.URI +import Network.URI.Fetch (Application(..)) import Foreign.Ptr import Foreign.StablePtr @@ -20,6 +21,7 @@ data Page = Page { html :: Document, pageTitle :: String, pageMIME :: String, + apps :: [Application], backStack :: [(String, URI)], forwardStack :: [(String, URI)] } @@ -39,7 +41,7 @@ c_initialReferer = do documentRoot = Element "temp" M.empty [], documentEpilogue = [] }, - pageTitle = "", pageMIME = "", + pageTitle = "", pageMIME = "", apps = [], backStack = [], forwardStack = [] } -- 2.30.2