First stab at threepenny gui

1 files changed, 78 insertions, 0 deletions

diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs
new file mode 100644
index 0000000..d96083e
--- /dev/null
+++ b/webgui/src/Main.hs
@@ -0,0 +1,78 @@
+module Main (main) where
+
+import qualified Graphics.UI.Threepenny       as UI
+import           Graphics.UI.Threepenny.Core
+
+import           Thermoprint.Client
+
+import qualified Options.Applicative as Opt
+import           System.Environment
+
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as CBS
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Maybe
+import           Data.Monoid
+import           Text.Read
+
+main :: IO ()
+main = config >>= Opt.execParser . opts >>= flip startGUI setup
+  where
+    opts config = Opt.info (Opt.helper <*> config)
+      ( Opt.fullDesc
+        <> Opt.progDesc "Run a webgui to Thermoprint.Client"
+      )
+
+config :: IO (Opt.Parser Config)
+config = do
+  p <- fromMaybe 8023 . (readMaybe =<<) <$> lookupEnv portEnv
+  a <- fromMaybe "localhost" <$> lookupEnv hostEnv
+  return $ (\port addr -> defaultConfig { jsPort = port, jsAddr = addr })
+    <$> optional (Opt.option Opt.auto $ port p)
+    <*> optional (fmap CBS.pack $ Opt.strOption $ addr a)
+  where
+    port def = Opt.long "port"
+      <> Opt.short 'p'
+      <> Opt.metavar "PORT"
+      <> Opt.help ("Port to bind to; default read from $" <> portEnv) 
+      <> Opt.value def
+      <> Opt.showDefault
+    addr def = Opt.long "addr"
+      <> Opt.short 'a'
+      <> Opt.metavar "HOST"
+      <> Opt.help ("Host to listen on; default read from $" <> hostEnv)
+      <> Opt.value def
+      <> Opt.showDefault
+    hostEnv = "ADDR"
+    portEnv = "PORT"
+
+setup :: Window -> UI ()
+setup window = void $ do
+  return window # set UI.title "Thermoprint"
+
+  title <- UI.input
+    # set UI.id_ "title"
+  content <- UI.textarea
+    # set UI.id_ "content"
+  draftTable <- UI.table
+
+  saveBtn <- UI.button #+ [string "Save"]
+  discBtn <- UI.button #+ [string "Discard"]
+  prntBtn <- UI.button #+ [string "Print"]
+
+  getBody window #+ [ row [ column [ UI.h1 #+ [string "Current draft"]
+                                   , row [UI.label # set text "Title" # set UI.for "title", element title]
+                                   , element content
+                                   , row [ element saveBtn
+                                         , element prntBtn
+                                         , element discBtn
+                                         ]
+                                   ]
+                          , column [ UI.h1 #+ [string "Saved drafts"]
+                                   , element draftTable
+                                   ]
+                          ]
+                    ]