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