7 files changed, 29 insertions(+), 13 deletions(-)

M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger.hs
R tpl/{latin1.html => keyboards/latin1.html}
R tpl/{latin1-accent-lower.html => keyboards/latin1/latin1-accent-lower.html}
R tpl/{latin1-accent.html => keyboards/latin1/latin1-accent.html}
R tpl/{latin1-symbol.html => keyboards/latin1/latin1-symbol.html}
R tpl/{latin1-upper.html => keyboards/latin1/latin1-upper.html}

@@ 65,17 65,32 @@ renderInput form ix input@Input {inputType="radio", inputName=k', value=v'} [] q
 renderInput form ix input@Input { inputType="<select>" } [] qs =
     template "select.html" form ix input qs
 renderInput form ix input [keyboard] qs =
-    template (Txt.unpack keyboard ++ ".html") form ix input qs
-renderInput form ix input [keyboard, ""] qs =
-    template (Txt.unpack keyboard ++ ".html") form ix input qs
+    renderInput form ix input [keyboard, ""] qs
+renderInput form ix input [keyboard, ""] qs | Just (Just _) <- resolveSource path =
+    template path form ix input qs
+  where path = "keyboards/" ++ Txt.unpack keyboard ++ ".html"
+renderInput form ix input [keyboard, ""] qs = do
+    configpath <- getXdgDirectory XdgConfig "bureaucromancy"
+    exists <- doesFileExist $ configpath </> "keyboard"
+    namespace <- if exists then readFile' $ configpath </> "keyboard"
+        else return "latin1"
+    let path = "keyboards/" ++ namespace ++ "/" ++ Txt.unpack keyboard ++ ".html"
+    let path2 = "keyboards/" ++ namespace ++ ".html"
+    let keyboard'
+            | Just (Just _) <- resolveSource path = path
+            | Just (Just _) <- resolveSource path2 = path2
+            | otherwise = "keyboards/latin1.html"
+    template keyboard' form ix input qs
 renderInput form ix input [] qs = do
     path <- getXdgDirectory XdgConfig "bureaucromancy"
     exists <- doesFileExist $ path </> "keyboard"
     keyboard <- if exists then readFile' $ path </> "keyboard"
         else return "latin1"
-    let keyboard' | Just (Just _) <- resolveSource (keyboard ++ ".html") = keyboard
+    let keyboard'
+            | Just (Just _) <- resolveSource ("keyboards/" ++ keyboard ++ ".html")
+                = keyboard
             | otherwise = "latin1"
-    template (keyboard' ++ ".html") form ix input qs
+    template ("keyboards/" ++ keyboard' ++ ".html") form ix input qs
 renderInput _ _ input _ _ =
     return $ Just $ Txt.concat ["Unknown input type: ", inputType input]
 

@@ 48,9 48,10 @@ template name form ix input query
     xURI _ = return $ toGVal ()
 
 resolveSource :: FilePath -> Maybe (Maybe [Char])
-resolveSource = Just . fmap utf8 .
-    flip lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) .
-    ('/':) . normalise
+resolveSource ('/':path) = resolveSource path
+resolveSource path = Just $ fmap utf8 $
+    flip lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) $
+    normalise $ '/':path
 
 query2gval :: Monad m => Query -> GVal m
 query2gval qs =

@@ 1,4 1,4 @@
-{% extends "base.html" %}
+{% extends "/base.html" %}
 
 {%- block control -%}<section>
   <p><span style="white-space: pre">{{ input.value }}</span>

@@ 1,4 1,4 @@
-{% extends "base.html" %}
+{% extends "/base.html" %}
 
 {%- block control -%}<section>
   <p><span style="white-space: pre">{{ input.value }}</span>

@@ 1,4 1,4 @@
-{% extends "base.html" %}
+{% extends "/base.html" %}
 
 {%- block control -%}<section>
   <p><span style="white-space: pre">{{ input.value }}</span>

@@ 1,4 1,4 @@
-{% extends "base.html" %}
+{% extends "/base.html" %}
 
 {%- block control -%}<section>
   <p><span style="white-space: pre">{{ input.value }}</span>

@@ 1,4 1,4 @@
-{% extends "base.html" %}
+{% extends "/base.html" %}
 
 {%- block control -%}<section>
   <p><span style="white-space: pre">{{ input.value }}</span>