~alcinnz/bureaucromancy: Render onscreen keyboards (not interactive yet).

4 files changed, 27 insertions(+), 6 deletions(-)

M bureaucromancy.cabal
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger.hs
M tpl/base.html

M bureaucromancy.cabal => bureaucromancy.cabal +1 -1

@@ 74,7 74,7 @@ library
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.16.4.0, ginger, file-embed-lzma, file-embed, mtl,
             bytestring, text, xml-conduit, network-uri, regex-tdfa, containers,
-            filepath
+            filepath, directory
 
     -- Directories containing source files.
     hs-source-dirs:   src

M src/Text/HTML/Form/WebApp.hs => src/Text/HTML/Form/WebApp.hs +17 -2

@@ 6,9 6,12 @@ import Data.Text as Txt
 import Data.Text.Encoding as Txt
 import Text.Read (readMaybe)
 import Network.URI (unEscapeString)
+import System.IO (readFile')
+import System.FilePath ((</>))
+import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist)
 
 import Text.HTML.Form (Form(..), Input(..))
-import Text.HTML.Form.WebApp.Ginger (template)
+import Text.HTML.Form.WebApp.Ginger (template, resolveSource)
 import Text.HTML.Form.Query (renderQueryString)
 
 renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe Text)


@@ 16,7 19,7 @@ renderPage form (n:path) query
     | Just ix <- readMaybe $ Txt.unpack n, ix < Prelude.length (inputs form) =
         renderInput form ix (inputs form !! ix) path query
 renderPage form [] _ = return $ Just $ Txt.concat [
-    "<a href='/0?", Txt.pack $ renderQueryString form, "/'>Start!</a>"]
+    "<a href='/0/?", Txt.pack $ renderQueryString form, "'>Start!</a>"]
 renderPage _ _ _ = return Nothing
 
 renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->


@@ 44,6 47,18 @@ renderInput form ix input@Input {inputType="radio", inputName=k', value=v'} [] q
     template "checkbox.html" form ix input $ set k' v' qs
 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 [] 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
+            | otherwise = "latin1"
+    template (keyboard' ++ ".html") form ix input qs
 renderInput _ _ input _ _ =
     return $ Just $ Txt.concat ["Unknown input type: ", inputType input]

M src/Text/HTML/Form/WebApp/Ginger.hs => src/Text/HTML/Form/WebApp/Ginger.hs +5 -3

@@ 1,5 1,5 @@
 {-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
-module Text.HTML.Form.WebApp.Ginger(template) where
+module Text.HTML.Form.WebApp.Ginger(template, resolveSource) where
 
 import Text.HTML.Form
 import Text.HTML.Form.Query (renderQueryString')


@@ 48,7 48,7 @@ template name form ix input query
     xURI _ = return $ toGVal ()
 
 resolveSource :: FilePath -> Maybe (Maybe [Char])
-resolveSource = Just . fmap B8.unpack .
+resolveSource = Just . fmap utf8 .
     flip lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) .
     ('/':) . normalise
 


@@ 61,7 61,6 @@ query2gval qs =
     }
   where
     q = '?':renderQueryString' [(utf8 k, utf8 $ fromMaybe "" v) | (k, v) <- qs]
-    utf8 = Txt.unpack . Txt.decodeUtf8
     gElem :: Monad m => [ByteString] -> Function m
     gElem xs [(_, x)] | Just x' <- asBytes x = return$toGVal$Prelude.elem x' xs
     gElem _ _ = return $ toGVal ()


@@ 162,3 161,6 @@ list' = toGVal
 
 groupSort :: Eq k => [(k, Maybe v)] -> [(k, [v])]
 groupSort q = [(k, [v | (k', Just v) <- q, k == k']) | k <- nub $ Prelude.map fst q]
+
+utf8 :: ByteString -> String
+utf8 = Txt.unpack . Txt.decodeUtf8

M tpl/base.html => tpl/base.html +4 -0

@@ 2,6 2,7 @@
 <html>
 <head>
   <title>{{form.method}} {{form.action}}</title>
+  <meta charset=utf-8 />
   <style>
     body { background: black; color: #eee; font: medium sans-serif; }
     h1 { text-align: center }


@@ 21,6 22,9 @@
     nav { column-count: 4 } /* FIXME: Screen width issues? */
     nav dl { margin: 0 }
     dt, dd { break-inside: avoid }
+
+    table td:not([colspan]) { width: 25% }
+    table td { text-align: center }
   </style>
 </head>
 <body>