7 files changed, 124 insertions(+), 138 deletions(-)

M rhapsode.cabal
M src/CExports.hs
D src/Input.hs
M src/Render.hs
M src/Types.hs
M src/main.c
M useragent.css

@@ 51,10 51,10 @@ cabal-version:       >=1.10
 
 library
   -- .hs or .lhs file containing the Main module.
-  exposed-modules: CExports, Input, Links, Render, Types
+  exposed-modules: CExports, Links, Render
   
   -- Modules included in this library.
-  other-modules:       SSML, SpeechStyle
+  other-modules:       Types, SSML, SpeechStyle
   
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:    

@@ 1,4 1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
 module CExports where
 
 import Types


@@ 6,15 6,29 @@ import Network.URI.Fetch (Session)
 
 import Render (c_renderDoc)
 import Links (c_extractLinks)
+
 import qualified Text.XML as XML
+import           Text.XML (Document(..), Prologue(..), Element(..))
 import qualified Data.Text as Txt
 import qualified Data.Text.Lazy as Txt (fromStrict)
 import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as B
+
+import           Network.URI
+import           Network.URI.Fetch
+import           Network.URI.Fetch.XML (fetchDocument, loadVisited)
+
+import System.IO
+import System.Directory
+import System.FilePath ((</>))
+import Data.FileEmbed
+import Data.CSS.Preprocessor.Conditions (conditionalStyles)
 
 -- Types I can export to C
 import Foreign.StablePtr
 import Foreign.C.String
 import Foreign.Marshal.Array
+import Data.Maybe (fromMaybe)
 
 -- FIXME: Segfaults, was intended for a playlist feature
 --foreign export ccall c_fetchURLs :: StablePtr Session -> PtrPage -> CArray CString -> IO (CArray PtrPage)


@@ 61,3 75,77 @@ c_ssmlHasMark c_ident c_ssml = do
     case XML.parseText XML.def $ Txt.fromStrict $ Txt.pack ssml of
         Left _ -> return False
         Right doc -> return $ ssmlHasMark (Txt.pack ident) $ XML.documentRoot doc
+
+foreign export ccall c_initialReferer :: IO (StablePtr (Page RhapsodeCSS))
+
+c_initialReferer = do
+    cwd <- getCurrentDirectory
+    hist <- loadVisited "rhapsode"
+    newStablePtr $ Page {
+        -- Default to URIs being relative to CWD.
+        pageURL = URI {uriScheme = "file:", uriPath = cwd,
+            uriAuthority = Nothing, uriQuery = "", uriFragment = ""},
+        -- Blank values:
+        css = conditionalStyles nullURI "temp",
+        domain = "temp",
+        html = Document {
+            documentPrologue = Prologue [] Nothing [],
+            documentRoot = Element "temp" M.empty [],
+            documentEpilogue = []
+        },
+        pageTitle = "", pageMIME = "", apps = [],
+        backStack = [], forwardStack = [], visitedURLs = hist,
+        initCSS = conditionalStyles,
+        appName = "rhapsode"
+    }
+
+foreign export ccall c_freePage :: StablePtr (Page RhapsodeCSS) -> IO ()
+
+c_freePage = freeStablePtr
+
+--------
+---- Network requests
+--------
+foreign export ccall c_newSession :: IO (StablePtr Session)
+foreign export ccall c_freeSession :: StablePtr Session -> IO ()
+
+c_newSession = do
+    sess <- newSession
+    newStablePtr $ sess {aboutPages = map lazify $(embedDir $ buildDirFile "about")}
+  where lazify (a, b) = (a, B.fromStrict b)
+c_freeSession = freeStablePtr
+
+
+foreign export ccall c_fetchURL :: StablePtr Session -> CString -> StablePtr (Page RhapsodeCSS) -> CString -> IO (StablePtr (Page RhapsodeCSS))
+
+c_fetchURL c_session c_mimes c_referer c_uri = do
+    session <- deRefStablePtr c_session
+    mimes <- peekCString c_mimes
+    referer <- deRefStablePtr c_referer
+    uri <- peekCString c_uri
+    let uri' = nullURI `fromMaybe` parseURIReference uri `relativeTo` pageURL referer
+    doc <- fetchDocument session referer uri'
+    newStablePtr doc
+
+foreign export ccall c_enableLogging :: StablePtr Session -> IO (StablePtr Session)
+
+c_enableLogging c_session = do
+    ret <- deRefStablePtr c_session >>= enableLogging
+    freeStablePtr c_session
+    newStablePtr ret
+
+foreign export ccall c_writeLog :: CString -> StablePtr Session -> IO ()
+
+c_writeLog c_path c_session = do
+    path <- peekCString c_path
+    withFile path AppendMode (\logfile -> deRefStablePtr c_session >>= writeLog logfile)
+
+foreign export ccall c_lastVisited :: CString -> IO CString
+c_lastVisited def = do
+    path <- (</> "history.gmni") <$> getXdgDirectory XdgData "rhapsode"
+    exists <- doesFileExist path
+    if not exists then return def else do
+        file <- readFile path
+        case map words $ lines file of
+            (_:url:_):_ -> newCString url
+            _ -> return def

@@ 1,84 0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-module Input(fetchDocument, readStrict) where
-
-import           Data.Text.Lazy (fromStrict)
-import qualified Data.Text as Txt
-import qualified Data.Text.IO as Txt
-import           Data.Text.Encoding
-import qualified Data.Text.Lazy as LTxt
-import qualified Data.ByteString.Lazy as B
-import qualified Text.XML as XML
-import           Network.URI
-import           Network.URI.Fetch
-import           Network.URI.Fetch.XML (fetchDocument)
-import           Network.URI.Charset
-import qualified Data.Map as M
-import qualified Data.Set as Set
-import           Data.List (intercalate)
-import           Data.Time.Clock
-
--- For alternative styles
-import qualified Data.CSS.Syntax.Tokens as CSSTok
-import Data.CSS.Syntax.StyleSheet
-import Data.CSS.Preprocessor.Conditions (conditionalStyles)
-
-import System.IO
-import System.IO.Temp
-import System.Directory
-import System.FilePath ((</>))
-import Data.FileEmbed
-
--- For C API
-import Types
-import Data.Maybe (fromMaybe)
-import Foreign.StablePtr
-import Foreign.C.String
-
---------
----- C API
---------
-foreign export ccall c_newSession :: IO (StablePtr Session)
-foreign export ccall c_freeSession :: StablePtr Session -> IO ()
-
-c_newSession = do
-    sess <- newSession
-    newStablePtr $ sess {aboutPages = map lazify $(embedDir $ buildDirFile "about")}
-  where lazify (a, b) = (a, B.fromStrict b)
-c_freeSession = freeStablePtr
-
-
-foreign export ccall c_fetchURL :: StablePtr Session -> CString -> StablePtr (Page RhapsodeCSS) -> CString -> IO (StablePtr (Page RhapsodeCSS))
-
-c_fetchURL c_session c_mimes c_referer c_uri = do
-    session <- deRefStablePtr c_session
-    mimes <- peekCString c_mimes
-    referer <- deRefStablePtr c_referer
-    uri <- peekCString c_uri
-    let uri' = nullURI `fromMaybe` parseURIReference uri `relativeTo` pageURL referer
-    doc <- fetchDocument session referer uri'
-    newStablePtr doc
-
-foreign export ccall c_enableLogging :: StablePtr Session -> IO (StablePtr Session)
-
-c_enableLogging c_session = do
-    ret <- deRefStablePtr c_session >>= enableLogging
-    freeStablePtr c_session
-    newStablePtr ret
-
-foreign export ccall c_writeLog :: CString -> StablePtr Session -> IO ()
-
-c_writeLog c_path c_session = do
-    path <- peekCString c_path
-    withFile path AppendMode (\logfile -> deRefStablePtr c_session >>= writeLog logfile)
-
-foreign export ccall c_lastVisited :: CString -> IO CString
-c_lastVisited def = do
-    path <- (</> "history.gmni") <$> getXdgDirectory XdgData "rhapsode"
-    exists <- doesFileExist path
-    if not exists then return def else do
-        file <- readFile path
-        case map words $ lines file of
-            (_:url:_):_ -> newCString url
-            _ -> return def

@@ 22,7 22,7 @@ import qualified Data.CSS.Preprocessor.Conditions as CSSCond
 import           Data.CSS.Preprocessor.Assets
 import qualified Data.CSS.Preprocessor.PsuedoClasses as CSSPseudo
 import qualified Data.CSS.Preprocessor.Text as CSSTxt
-import           Stylist (cssPriorityAgent, cssPriorityUser)
+import           Stylist (cssPriorityAgent, cssPriorityUser, attrTest, elementPath)
 import           Data.HTML2CSS (el2stylist)
 
 import           Network.URI


@@ 106,16 106,16 @@ loadUserStyles styles = do
         CSS.parse style (Txt.pack source) `loadFiles` files
     loadFiles style [] = return style
 
+parsePath ('.':anchor) = [] : parsePath anchor
+parsePath (c:anchor) | n:path' <- parsePath anchor, c >= '0' && c <= '9' = (c:n):path'
+parsePath [] = [[]]
+parsePath _ = []
+
 targetSel "" = [CSSTok.Ident "main"]
 targetSel "#" = [CSSTok.Colon, CSSTok.Ident "root"]
 targetSel ('#':'.':anchor) =
-    CSSTok.Colon : CSSTok.Ident "root" : concat [ selLayer n | n <- path anchor]
+    CSSTok.Colon : CSSTok.Ident "root" : concat [ selLayer n | n <- parsePath anchor]
   where
-    path ('.':anchor) = [] : path anchor
-    path (c:anchor) | n:path' <- path anchor, c >= '0' && c <= '9' = (c:n):path'
-    path [] = [[]]
-    path _ = []
-
     selLayer n = [
         CSSTok.Delim '>',
         CSSTok.Colon, CSSTok.Function "nth-child",


@@ 124,20 124,40 @@ targetSel ('#':'.':anchor) =
 targetSel ('#':id) = [CSSTok.Hash CSSTok.HUnrestricted $ Txt.pack id]
 targetSel _ = []
 
+targetWithinSel _ "#" = []
+targetWithinSel _ ('#':'.':anchor) = map (fromMaybe 0 . readMaybe) $ parsePath anchor
+targetWithinSel tree ('#':id)
+    | (el:_) <- treeFind tree $ attrTest Nothing "id" $ CSSSel.Include $ Txt.pack id =
+        elementPath el
+targetWithinSel _ _ = []
+
 testVisited :: Set.Set Text -> URI -> String -> Bool
 testVisited hist base val = uriToText url `Set.member` hist
   where
     url = fromMaybe nullURI (parseURIReference val) `relativeTo` base
     uriToText uri = pack $ uriToString id uri ""
 
-rhapsodePseudoFilter url hist =
+rhapsodePseudoFilter url hist tree =
     -- Note: not all links must have an href tag, but it's not a bad approximation visited links must.
     -- Doing it this way is easier to implement in Haskell Stylist.
     CSSPseudo.addTest "visited" Nothing "href" (CSSSel.PropertyFunc $ testVisited hist url) $
     CSSPseudo.addRewrite "link" "[src], [href], details > summary, tr:first-of-type th" $
     CSSPseudo.addRewrite' "target" (targetSel $ uriFragment url) $
+    CSSPseudo.addContains "target-within" (targetWithinSel tree $ uriFragment url) $
     CSSPseudo.htmlPsuedoFilter Style.queryableStyleSheet
 
+-- Apparantly I forgot to export this API...
+treeFind :: StyleTree p -> (p -> Bool) -> [p]
+treeFind p test = filter test $ treeFlattenAll p
+
+-- And forgot to export this too...
+treeFlattenAll :: StyleTree p -> [p]
+treeFlattenAll = treeFlattenAll' . children
+treeFlattenAll' :: [StyleTree p] -> [p]
+treeFlattenAll' (StyleTree p []:ps) = p : treeFlattenAll' ps
+treeFlattenAll' (StyleTree p childs:sibs) = p : treeFlattenAll' childs ++ treeFlattenAll' sibs
+treeFlattenAll' [] = []
+
 --------
 ---- Download assets
 --------


@@ 169,7 189,8 @@ c_renderDoc c_session c_page rewriteURLs = do
     session <- deRefStablePtr c_session
     page <- deRefStablePtr c_page
     css' <- retreiveStyles session $ css page
-    let pseudoFilter = rhapsodePseudoFilter (pageURL page) $ visitedURLs page
+    let html' = XML.documentRoot $ html page
+    let pseudoFilter = rhapsodePseudoFilter (pageURL page) (visitedURLs page) (el2stylist html')
     qCSS <- if rewriteURLs then do
         assets <- downloadAssets session [
                 "audio/vnd.wav"

@@ 1,57 1,17 @@
-{-# LANGUAGE OverloadedStrings #-}
 module Types(CArray, Page(..), Application(..), RhapsodeCSS, buildDirFile, readStrict) where
 
-import System.Directory (getCurrentDirectory) -- default referer URI
 import SpeechStyle (SpeechStyle)
 import Data.CSS.Preprocessor.Conditions (ConditionalStyles, conditionalStyles)
 import Data.CSS.Preprocessor.Text (TextStyle)
-import Text.XML
-import qualified Data.Map.Strict as M
-import Network.URI
+
 import Network.URI.Fetch (Application(..), url)
 import Network.URI.Fetch.XML (Page(..), loadVisited, readStrict)
 
--- For the in-memory history log
-import qualified Data.Set as Set
-import Data.Set (Set)
-import Data.Text (Text(..))
-import qualified Data.Text as Txt
-import System.Directory
 import System.FilePath ((</>))
-import Control.Parallel (par)
-
 import Foreign.Ptr
-import Foreign.StablePtr
 
 buildDir = "."
 buildDirFile = (buildDir </>)
 
 type CArray a = Ptr a
 type RhapsodeCSS = ConditionalStyles (TextStyle SpeechStyle)
-
-foreign export ccall c_initialReferer :: IO (StablePtr (Page RhapsodeCSS))
-
-c_initialReferer = do
-    cwd <- getCurrentDirectory
-    hist <- loadVisited "rhapsode"
-    newStablePtr $ Page {
-        -- Default to URIs being relative to CWD.
-        pageURL = URI {uriScheme = "file:", uriPath = cwd,
-            uriAuthority = Nothing, uriQuery = "", uriFragment = ""},
-        -- Blank values:
-        css = conditionalStyles nullURI "temp",
-        domain = "temp",
-        html = Document {
-            documentPrologue = Prologue [] Nothing [],
-            documentRoot = Element "temp" M.empty [],
-            documentEpilogue = []
-        },
-        pageTitle = "", pageMIME = "", apps = [],
-        backStack = [], forwardStack = [], visitedURLs = hist,
-        initCSS = conditionalStyles,
-        appName = "rhapsode"
-    }
-
-foreign export ccall c_freePage :: StablePtr (Page RhapsodeCSS) -> IO ()
-
-c_freePage = freeStablePtr

@@ 529,6 529,7 @@ int main(int argc, char **argv) {
 
         v2j_profile = "";
     } else if (dir_exists(v2j_profile)) v2j_profile = "";
+    use_wakeword &= *v2j_profile != '\0';
 
     char *ssml, **links, *uri;
     int read_links = 0;

@@ 118,7 118,7 @@ aside {voice-volume: soft}
 mark {voice-range: high; voice-pitch: high; cue-before: url(about:found.wav)}
 
 details > :not(summary:first-of-type) {speak: never}
-details:target > *, details[open] > * {speak: always}
+details:target > *, details:target-within > *, details[open] > * {speak: always}
 
 /* Localized into:
 - English