3 files changed, 49 insertions(+), 106 deletions(-)

M rhapsode.cabal
M src/Main.hs
D user-agent.css

@@ 60,7 60,10 @@ executable rhapsode
   -- other-extensions:    
   
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.10, http-client, http-client-tls, bytestring
+  build-depends:       base >=4.9 && <4.10,
+        http-client, http-client-tls, bytestring,
+        html-conduit, xml-conduit, text, containers,
+        network-uri
   
   -- Directories containing source files.
   hs-source-dirs:      src

@@ 1,11 1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
 import System.Environment
 
 import qualified Network.HTTP.Client as HTTP
+import           Network.HTTP.Client.Internal
 import qualified Network.HTTP.Client.TLS as TLS
-import qualified Data.ByteString.Lazy as Bytes
+import           Network.URI
+import qualified Text.HTML.DOM as HTML
+import qualified Text.XML as XML
+import Data.Text (unpack)
+import qualified Data.Map as M
+import qualified Data.ByteString.Lazy.Char8 as C8
 
+import DefaultCSS
 
 main :: IO ()
 main = do


@@ 14,4 22,39 @@ main = do
     request <- HTTP.parseRequest url
     manager <- HTTP.newManager TLS.tlsManagerSettings
     response <- HTTP.httpLbs request manager
-    Bytes.putStrLn $ HTTP.responseBody response
+    let html = XML.documentRoot $ HTML.parseLBS $ HTTP.responseBody response
+    style <- retreiveStyles html manager request
+    putStrLn $ unlines style
+
+retreiveStyles html manager base = do
+    css <- externalStyles html manager base
+    return $ userAgentCSS : css ++ internalStyles html
+
+externalStyles html manager base = go $ linkedStyles html
+    where -- TODO parallelise loads
+        go (link:links) = do
+            request <- setUriRelative base link
+            response <- HTTP.httpLbs request manager
+            rest <- go links
+            return (C8.unpack (HTTP.responseBody response) : rest)
+        go [] = return []
+
+linkedStyles (XML.Element "link" attrs _)
+    | Just link <- "href" `M.lookup` attrs,
+        Just "stylesheet" <- "rel" `M.lookup` attrs,
+        Just uri <- parseURIReference $ unpack link = [uri]
+linkedStyles (XML.Element _ _ children) =
+    concat [linkedStyles el | XML.NodeElement el <- children]
+
+internalStyles (XML.Element "style" _ children) = [strContent children]
+internalStyles (XML.Element _ _ children) =
+    concat [internalStyles el | XML.NodeElement el <- children]
+
+
+strContent (XML.NodeContent text : rest) = unpack text ++ strContent rest
+-- We do want to read in comments for CSS, just not for display.
+strContent (XML.NodeComment text : rest) = unpack text ++ strContent rest
+strContent (XML.NodeElement (XML.Element _ _ children):rest) =
+    strContent children ++ strContent rest
+strContent (_:rest) = strContent rest
+strContent [] = ""

@@ 1,103 0,0 @@
-head, link, meta, style, script, title, base {speak: never}
-datalist, template {speak: never}
-
-/** Forms **/
-/* Hide buttons that don't do anything */
-button[type=button] {speak: never}
-button[formaction] {speak: always}
-
-button::before, input[type=button]::before, input[type=submit]::before {
-    content: "Button";
-    pitch: high;
-}
-select::before, textarea::before, input::before {content: "Input"; pitch: high}
-output::before {content: "Output"; pitch: high}
-text-area, button, select, input, output {pitch: low}
-input, output {content: attr(value)}
-text-area {speak-as: literal-punctuation}
-
-option:not([checked]) {speak: never}
-select[multiple] option {cue-before: url(bulletpoint.wav)}
-
-/* Forms themselves require a label in order to support navigation */
-form::before {content: "Form"}
-form[action]::before {content: attr(action)}
-form[alt]::before {content: attr(alt)}
-form[title]::before {content: attr(title)}
-
-/** Tables **/
-table::before {content: "Table"; voice-volume: x-soft}
-tr {cue-before: url(bulletpoint.wav)}
-td, th {cue-before: url(bulletpoint.wav) -1db}
-th::th /* Rhapsode-specific, selects inlined table headers */ {speak: never;}
-table caption {voice-volume: soft}
-
-/** Sectioning **/
-footer, header {voice-volume: soft}
-h1, h2, h3, h4, h5, h6, legend, th, summary, dt {voice-stress: strong}
-h1 {pause: x-strong; voice-rate: x-slow}
-h2 {pause: strong; voice-rate: slow}
-h3, th, summary, legend, dt {pause: medium; voice-rate: medium}
-h4 {pause: weak; voice-rate: fast}
-h5, h6 {pause: x-weak; voice-rate: fast}
-h6 {pitch: high}
-
-/** Text **/
-hr {pause: x-strong}
-p, pre, samp, blockquote {pause: strong}
-pre, address, samp {speak-as: literal-punctuation}
-
-:link {cue-before: url(link.wav); voice-rate: slow}
-:link:visited {cue-before: url(link.wav) -1db}
-
-b, strong {voice-rate: x-slow}
-i, em {voice-stress: strong}
-br {pause: medium}
-code {speak-as: literal-punctuation}
-s, del {voice-volume: x-soft}
-u, ins {voice-volume: loud}
-
-/** lists **/
-li, dt, dd {cue-before: url(bulletpoint.wav); pause: strong}
-li li, dd dt, dd dd {cue-before: url(bulletpoint.wav) -1db}
-li li li, dd dd dt, dd dd dd {cue-before: url(bulletpoint.wav) -2db}
-li li li li, dd dd dd dt, dd dd dd dd {cue-before: url(bulletpoint.wav) -3db}
-li li li li li, dd dd dd dd dt, dd dd dd dd dd {
-    cue-before: url(bulletpoint.wav) -4db
-}
-li li li li li li, dd dd dd dd dd dt, dd dd dd dd dd dd {
-    cue-before: url(bulletpoint.wav) -5db
-}
-
-ol {counter-reset: -rhaps-ol1}
-ol ol {counter-reset: -rhaps-ol2}
-ol ol ol {counter-reset: -rhaps-ol3}
-ol ol ol ol {counter-reset: -rhaps-ol4}
-ol ol ol ol ol {counter-reset: -rhaps-ol5}
-ol ol ol ol ol ol {counter-reset: -rhaps-ol6}
-ol li::before {content: counter(-rhaps-ol1)}
-ol ol li::before {content: counters(-rhaps-ol1, -rhaps-ol2)}
-ol ol ol li::before {content: counters(-rhaps-ol1, -rhaps-ol2, -rhaps-ol3)}
-ol ol ol ol li::before {
-    content: counters(-rhaps-ol1, -rhaps-ol2, -rhaps-ol3, -rhaps-ol4)
-}
-ol ol ol ol ol li::before {
-    content: counters(-rhaps-ol1, -rhaps-ol2, -rhaps-ol3, -rhaps-ol4, -rhaps-ol5)
-}
-ol ol ol ol ol ol li::before {
-    content: counters(-rhaps-ol1, -rhaps-ol2, -rhaps-ol3, -rhaps-ol4, -rhaps-ol5, -rhaps-ol6)
-}
-
-
-/** HTML6 **/
-abbr[title]::after {content: attr(title); voice-volume: x-soft}
-abbr {speak-as: spell-out}
-
-q, blockquote {voice-family: neutral 2}
-cite {voice-stress: reduce}
-dialog:not([open]) {speak: never}
-kbd {speak-as: spell-out}
-progress {content: attr(value) "of" attr(max)}
-sub {voice-rate: x-fast}
-sup {voice-rate: fast} 
-var {voice-rate: slow}>
\ No newline at end of file