From ec9a251c225a8a6bb25846b76fc8998ccf575cc4 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 6 Aug 2019 20:03:13 +1200
Subject: [PATCH] Load userstyles.

---
 rhapsode.cabal |  2 +-
 src/Main.hs    | 17 ++++++++++++++++-
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/rhapsode.cabal b/rhapsode.cabal
index 254bee2..bab865d 100644
--- a/rhapsode.cabal
+++ b/rhapsode.cabal
@@ -60,7 +60,7 @@ executable rhapsode
   -- other-extensions:    
   
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.10,
+  build-depends:       base >=4.9 && <4.10, directory,
         http-client, http-client-tls, bytestring,
         html-conduit, xml-conduit, text, containers,
         network-uri,
diff --git a/src/Main.hs b/src/Main.hs
index d8a01a9..dad06be 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -24,6 +24,7 @@ import qualified Data.List as L
 import qualified Data.Map as M
 import Data.Scientific (toRealFloat)
 import Data.Maybe (fromJust)
+import System.Directory as Dir
 
 import DefaultCSS
 import StyleTree
@@ -49,7 +50,7 @@ renderElLBS el = XML.renderLBS XML.def $ XML.Document {
 
 retreiveStyles html manager base = do
     style <- H2C.externalStylesForURL authorStyle testMedia html base loadURL
-    return style
+    loadUserStyles style
   where
     emptyStyle :: Style.QueryableStyleSheet StyleTree
     emptyStyle = Style.queryableStyleSheet
@@ -61,6 +62,20 @@ retreiveStyles html manager base = do
         response <- HTTP.httpLbs request manager
         return $ Txt.pack $ C8.unpack $ HTTP.responseBody response
 
+loadUserStyles styles = do
+    dir <- Dir.getXdgDirectory Dir.XdgConfig "rhapsode"
+    exists <- Dir.doesDirectoryExist dir
+    loadDirectory dir exists
+  where
+    loadDirectory _ False = return styles
+    loadDirectory dir True = do
+        files <- Dir.listDirectory dir
+        loadFiles (H2C.cssPriorityUser styles) files
+    loadFiles style (file:files) = do
+        source <- readFile file
+        CSS.parse style (Txt.pack source) `loadFiles` files
+    loadFiles style [] = return style
+
 testMedia attrs = media == Nothing || media == Just "speech"
     where media = "media" `M.lookup` attrs
 
-- 
2.30.2