blob: d96083edda3547b93aa776d550fe9e11d3fa7f28 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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
]
]
]
|
