0 | module CyBy.UI.JS
  1 |
  2 | import Data.List
  3 | import HTTP.API.Decode
  4 | import Text.HTML.Select
  5 |
  6 | import public CyBy.UI.HTML
  7 | import public Web.Async
  8 |
  9 | %default total
 10 |
 11 | --------------------------------------------------------------------------------
 12 | -- Logging
 13 | --------------------------------------------------------------------------------
 14 |
 15 | data LogEv = Clear | Lvl LogLevel
 16 |
 17 | printErr : JSErr -> JS [] ()
 18 | printErr x = putStrLn "Error: \{dispErr x}"
 19 |
 20 | export
 21 | logNode : LogLevel -> List String -> HTMLNode
 22 | logNode l msgs =
 23 |   li []
 24 |     [ label [class $ level l] [Text $ "[\{l}]"]
 25 |     , div [] $ intersperse (br []) (map Text msgs)
 26 |     ]
 27 |
 28 | export
 29 | uilog : IORef LogLevel => Logger JS
 30 | uilog @{ref} =
 31 |   MkLogger $ \l,ml => Prelude.do
 32 |     x <- readref ref
 33 |     when (l >= x) $ handle [printErr] (prepend (elemRef CyByLog) $ logNode l ml)
 34 |
 35 | levels : List LogLevel
 36 | levels = [Trace,Debug,Info,Warn,Error,Fatal]
 37 |
 38 | appLog : Sink LogEv => HTMLNode
 39 | appLog =
 40 |   section
 41 |     [ class drawLog ]
 42 |     [ header []
 43 |         [ label [] [Text "Log"]
 44 |         , spacer
 45 |         , button [onClick Clear] ["Clear"]
 46 |         , selectFromList' levels (Just Info) show Lvl []
 47 |         ]
 48 |     , ul [ref CyByLog] []
 49 |     ]
 50 |
 51 | public export
 52 | record Logger where
 53 |   constructor L
 54 |   node   : HTMLNode
 55 |   stream : AsyncStream JS [] Void
 56 |   logger : Logger JS
 57 |
 58 | onev : (ref : IORef LogLevel) => LogEv -> Async JS [] ()
 59 | onev Clear   = handle [printErr] $ children (elemRef CyByLog) []
 60 | onev (Lvl x) = writeref ref x
 61 |
 62 | export
 63 | logger : LogLevel -> Act Logger
 64 | logger l = Prelude.do
 65 |   ref  <- newref l
 66 |   E es <- event LogEv
 67 |   pure $ L appLog (foreach onev es) uilog
 68 |
 69 | --------------------------------------------------------------------------------
 70 | -- Input Validation
 71 | --------------------------------------------------------------------------------
 72 |
 73 | validIcon : DOMLocal => Ref Tag.Div -> EditRes t -> HTMLNode
 74 | validIcon r (Valid _)   = div [class iconPlaceholder, Id r] []
 75 | validIcon r (Invalid s) = div [class iconError, Id r, title s] [iwarn]
 76 | validIcon r Missing     =
 77 |   div [class iconMissing, Id r, title $ editRes {t} Missing] [iwarn]
 78 |
 79 | export
 80 | validated : DOMLocal => Editor t -> Editor t
 81 | validated ed =
 82 |   E $ \m => Prelude.do
 83 |     lbl     <- uniqueRef Tag.Div
 84 |     W ns vs <- ed.widget m
 85 |     pure $ W
 86 |       [div [class validatedInput] $ ns ++ [validIcon lbl $ Missing {t}]]
 87 |       (observe (replace lbl . validIcon lbl) vs)
 88 |
 89 | --------------------------------------------------------------------------------
 90 | -- Select Editors
 91 | --------------------------------------------------------------------------------
 92 |
 93 | parameters {auto loc : DOMLocal}
 94 |            {auto eq  : Eq t}
 95 |
 96 |   export %inline
 97 |   seledit : Maybe Class -> (v -> t) -> (v -> String) -> List v -> Editor t
 98 |   seledit c f g vs = E $ Widget.sel f g vs $ class <$> toList c
 99 |
100 |   export %inline
101 |   selEdit : (v -> t) -> (v -> String) -> List v -> Editor t
102 |   selEdit = seledit Nothing
103 |
104 |   export %inline
105 |   selEditC : Class -> (v -> t) -> (v -> String) -> List v -> Editor t
106 |   selEditC = seledit . Just
107 |
108 | --------------------------------------------------------------------------------
109 | -- Input Editors
110 | --------------------------------------------------------------------------------
111 |
112 | parameters {auto loc : DOMLocal}
113 |
114 |   export
115 |   input :
116 |        (dec : String -> EditRes t)
117 |     -> InputType
118 |     -> (init : Maybe t -> String)
119 |     -> Editor t
120 |   input dec tpe init = validated $ txtEdit dec tpe init []
121 |
122 |   ||| Specialized version of `input` for entering floating point numbers.
123 |   export
124 |   double : Editor Double
125 |   double = input read Text (maybe "0.0" show)
126 |
127 |   ||| Specialized version of `input` for natural numbers.
128 |   export
129 |   nat : Editor Nat
130 |   nat = input read Text (maybe "0" show)
131 |
132 |   ||| Specialized version of `input` for entering integers.
133 |   export
134 |   integer : Editor Integer
135 |   integer = input read Text (maybe "0" show)
136 |
137 |   ||| Specialized version of `input` for entering 8-bit unsigned integers.
138 |   export
139 |   bits8 : Editor Bits8
140 |   bits8 = input read Text (maybe "0" show)
141 |
142 |   ||| Specialized version of `input` for entering 16-bit unsigned integers.
143 |   export
144 |   bits16 : Editor Bits16
145 |   bits16 = input read Text (maybe "0" show)
146 |
147 |   ||| Specialized version of `input` for entering 32-bit unsigned integers.
148 |   export
149 |   bits32 : Editor Bits32
150 |   bits32 = input read Text (maybe "0" show)
151 |
152 |   ||| Specialized version of `input` for entering 64-bit unsigned integers.
153 |   export
154 |   bits64 : Editor Bits64
155 |   bits64 = input read Text (maybe "0" show)
156 |
157 |   ||| Specialized version of `input` for entering 8-bit signed integers.
158 |   export
159 |   int8 : Editor Int8
160 |   int8 = input read Text (maybe "0" show)
161 |
162 |   ||| Specialized version of `input` for entering 16-bit signed integers.
163 |   export
164 |   int16 : Editor Int16
165 |   int16 = input read Text (maybe "0" show)
166 |
167 |   ||| Specialized version of `input` for entering 32-bit signed integers.
168 |   export
169 |   int32 : Editor Int32
170 |   int32 = input read Text (maybe "0" show)
171 |
172 |   ||| Specialized version of `input` for entering 64-bit signed integers.
173 |   export
174 |   int64 : Editor Int64
175 |   int64 = input read Text (maybe "0" show)
176 |