
   0 | module Text.HTML.Node
   1 | 
   2 | import JS
   3 | import Data.String
   4 | import FS.Concurrent.Signal
   5 | import Text.HTML.Attribute
   6 | import Text.HTML.Event
   7 | import Text.HTML.Ref
   8 | import Text.HTML.Tag
   9 | 
  10 | %default total
  11 | 
  12 | public export
  13 | data HTMLNode : Type where
  14 |   El    :  {tag   : String}
  15 |         -> (0 tpe : HTMLTag tag)
  16 |         -> List (Attribute tpe)
  17 |         -> List HTMLNode
  18 |         -> HTMLNode
  19 | 
  20 |   ||| Data constructor for empty elements
  21 |   EEl   :  {tag   : String}
  22 |         -> (0 tpe : HTMLTag tag)
  23 |         -> List (Attribute tpe)
  24 |         -> HTMLNode
  25 | 
  26 |   Raw   : String -> HTMLNode
  27 | 
  28 |   Text  : String -> HTMLNode
  29 | 
  30 |   Empty : HTMLNode
  31 | 
  32 | public export
  33 | 0 HTMLNodes : Type
  34 | HTMLNodes = List HTMLNode
  35 | 
  36 | export %inline
  37 | FromString HTMLNode where
  38 |   fromString = Text
  39 | 
  40 | ||| True if the given node is the empty node
  41 | export %inline
  42 | isEmpty : HTMLNode -> Bool
  43 | isEmpty Empty = True
  44 | isEmpty _     = False
  45 | 
  46 | ||| True if the given node is not the empty node
  47 | export %inline
  48 | nonEmpty : HTMLNode -> Bool
  49 | nonEmpty = not . isEmpty
  50 | 
  51 | ||| An optional node that is set to `Empty` if the given `Bool` is `False`.
  52 | export
  53 | nodeIf : Bool -> Lazy HTMLNode -> HTMLNode
  54 | nodeIf True n  = n
  55 | nodeIf False _ = Empty
  56 | 
  57 | ||| Converts an optional value to a `HTMLNode`
  58 | export %inline
  59 | nodeMaybe : (a -> HTMLNode) -> Maybe a -> HTMLNode
  60 | nodeMaybe f = maybe Empty f
  61 | 
  62 | ||| Prepend a list of attributes to a node's list of attributes.
  63 | export
  64 | withAttributes :
  65 |      ({0 s : _} -> {0 t : HTMLTag s} -> List (Attribute t))
  66 |   -> HTMLNode
  67 |   -> HTMLNode
  68 | withAttributes a (El tp as ns) = El tp (a ++ as) ns
  69 | withAttributes a (EEl tp as)   = EEl tp (a ++ as)
  70 | withAttributes a n             = n
  71 | 
  72 | ||| Prepend an attribute to a node's list of attributes.
  73 | export %inline
  74 | withAttribute :
  75 |      ({0 s : _} -> {0 t : HTMLTag s} -> Attribute t)
  76 |   -> HTMLNode
  77 |   -> HTMLNode
  78 | withAttribute a = withAttributes [a]
  79 | 
  80 | ||| Prepend the given ID to a node's list of attributes.
  81 | export
  82 | withId : String -> HTMLNode -> HTMLNode
  83 | withId s (El tp as ns) = El tp (Id (Id s) :: as) ns
  84 | withId s (EEl tp as)   = EEl tp (Id (Id s) :: as)
  85 | withId s n             = n
  86 | 
  87 | ||| Prepend the given event to a node's list of attributes.
  88 | export
  89 | withEv : Sink e => DOMEvent e -> HTMLNode -> HTMLNode
  90 | withEv ev (El tp as ns) = El tp (Event ev :: as) ns
  91 | withEv ev (EEl tp as)   = EEl tp (Event ev :: as)
  92 | withEv ev n             = n
  93 | 
  94 | export %inline
  95 | a : List (Attribute A) -> HTMLNodes -> HTMLNode
  96 | a = El _
  97 | 
  98 | export %inline
  99 | address : List (Attribute Address) -> HTMLNodes -> HTMLNode
 100 | address = El _
 101 | 
 102 | export %inline
 103 | area : List (Attribute Area) -> HTMLNode
 104 | area = EEl _
 105 | 
 106 | export %inline
 107 | article : List (Attribute Article) -> HTMLNodes -> HTMLNode
 108 | article = El _
 109 | 
 110 | export %inline
 111 | aside : List (Attribute Aside) -> HTMLNodes -> HTMLNode
 112 | aside = El _
 113 | 
 114 | export %inline
 115 | audio : List (Attribute Audio) -> HTMLNodes -> HTMLNode
 116 | audio = El _
 117 | 
 118 | export %inline
 119 | base : List (Attribute Base) -> HTMLNode
 120 | base = EEl _
 121 | 
 122 | export %inline
 123 | blockquote : List (Attribute Blockquote) -> HTMLNodes -> HTMLNode
 124 | blockquote = El _
 125 | 
 126 | export %inline
 127 | body : List (Attribute Tag.Body) -> HTMLNodes -> HTMLNode
 128 | body = El _
 129 | 
 130 | export %inline
 131 | br : List (Attribute Br) -> HTMLNode
 132 | br = EEl _
 133 | 
 134 | export %inline
 135 | button : List (Attribute Tag.Button) -> HTMLNodes -> HTMLNode
 136 | button = El _
 137 | 
 138 | export %inline
 139 | canvas : List (Attribute Canvas) -> HTMLNodes -> HTMLNode
 140 | canvas = El _
 141 | 
 142 | export %inline
 143 | caption : List (Attribute Caption) -> HTMLNodes -> HTMLNode
 144 | caption = El _
 145 | 
 146 | export %inline
 147 | col : List (Attribute Col) -> HTMLNode
 148 | col = EEl _
 149 | 
 150 | export %inline
 151 | colgroup : List (Attribute Colgroup) -> HTMLNodes -> HTMLNode
 152 | colgroup = El _
 153 | 
 154 | export %inline
 155 | data_ : List (Attribute Data) -> HTMLNodes -> HTMLNode
 156 | data_ = El _
 157 | 
 158 | export %inline
 159 | datalist : List (Attribute Datalist) -> HTMLNodes -> HTMLNode
 160 | datalist = El _
 161 | 
 162 | export %inline
 163 | del : List (Attribute Del) -> HTMLNodes -> HTMLNode
 164 | del = El _
 165 | 
 166 | export %inline
 167 | details : List (Attribute Details) -> HTMLNodes -> HTMLNode
 168 | details = El _
 169 | 
 170 | export %inline
 171 | dialog : List (Attribute Dialog) -> HTMLNodes -> HTMLNode
 172 | dialog = El _
 173 | 
 174 | export %inline
 175 | div : List (Attribute Div) -> HTMLNodes -> HTMLNode
 176 | div = El _
 177 | 
 178 | export %inline
 179 | dl : List (Attribute Dl) -> HTMLNodes -> HTMLNode
 180 | dl = El _
 181 | 
 182 | export %inline
 183 | embed : List (Attribute Embed) -> HTMLNode
 184 | embed as = El _ as []
 185 | 
 186 | export %inline
 187 | fieldset : List (Attribute FieldSet) -> HTMLNodes -> HTMLNode
 188 | fieldset = El _
 189 | 
 190 | export %inline
 191 | footer : List (Attribute Footer) -> HTMLNodes -> HTMLNode
 192 | footer = El _
 193 | 
 194 | export %inline
 195 | form : List (Attribute Form) -> HTMLNodes -> HTMLNode
 196 | form = El _
 197 | 
 198 | export %inline
 199 | h1 : List (Attribute H1) -> HTMLNodes -> HTMLNode
 200 | h1 = El _
 201 | 
 202 | export %inline
 203 | h2 : List (Attribute H2) -> HTMLNodes -> HTMLNode
 204 | h2 = El _
 205 | 
 206 | export %inline
 207 | h3 : List (Attribute H3) -> HTMLNodes -> HTMLNode
 208 | h3 = El _
 209 | 
 210 | export %inline
 211 | h4 : List (Attribute H4) -> HTMLNodes -> HTMLNode
 212 | h4 = El _
 213 | 
 214 | export %inline
 215 | h5 : List (Attribute H5) -> HTMLNodes -> HTMLNode
 216 | h5 = El _
 217 | 
 218 | export %inline
 219 | h6 : List (Attribute H6) -> HTMLNodes -> HTMLNode
 220 | h6 = El _
 221 | 
 222 | export %inline
 223 | header : List (Attribute Header) -> HTMLNodes -> HTMLNode
 224 | header = El _
 225 | 
 226 | export %inline
 227 | hr : List (Attribute HR) -> HTMLNode
 228 | hr = EEl _
 229 | 
 230 | export %inline
 231 | html : List (Attribute Html) -> HTMLNodes -> HTMLNode
 232 | html = El _
 233 | 
 234 | export %inline
 235 | iframe : List (Attribute IFrame) -> HTMLNodes -> HTMLNode
 236 | iframe = El _
 237 | 
 238 | export %inline
 239 | img : List (Attribute Img) -> HTMLNode
 240 | img = EEl _
 241 | 
 242 | export %inline
 243 | input : List (Attribute Tag.Input) -> HTMLNode
 244 | input = EEl _
 245 | 
 246 | export %inline
 247 | ins : List (Attribute Ins) -> HTMLNodes -> HTMLNode
 248 | ins = El _
 249 | 
 250 | export %inline
 251 | label : List (Attribute Label) -> HTMLNodes -> HTMLNode
 252 | label = El _
 253 | 
 254 | export %inline
 255 | legend : List (Attribute Legend) -> HTMLNodes -> HTMLNode
 256 | legend = El _
 257 | 
 258 | export %inline
 259 | li : List (Attribute Li) -> HTMLNodes -> HTMLNode
 260 | li = El _
 261 | 
 262 | export %inline
 263 | link : List (Attribute Link) -> HTMLNode
 264 | link = EEl _
 265 | 
 266 | export %inline
 267 | map : List (Attribute Tag.Map) -> HTMLNodes -> HTMLNode
 268 | map = El _
 269 | 
 270 | export %inline
 271 | menu : List (Attribute Menu) -> HTMLNodes -> HTMLNode
 272 | menu = El _
 273 | 
 274 | export %inline
 275 | meta : List (Attribute Meta) -> HTMLNode
 276 | meta = EEl _
 277 | 
 278 | export %inline
 279 | meter : List (Attribute Meter) -> HTMLNodes -> HTMLNode
 280 | meter = El _
 281 | 
 282 | export %inline
 283 | object : List (Attribute Tag.Object) -> HTMLNodes -> HTMLNode
 284 | object = El _
 285 | 
 286 | export %inline
 287 | ol : List (Attribute Ol) -> HTMLNodes -> HTMLNode
 288 | ol = El _
 289 | 
 290 | export %inline
 291 | optgroup : List (Attribute OptGroup) -> HTMLNodes -> HTMLNode
 292 | optgroup = El _
 293 | 
 294 | export %inline
 295 | option : List (Attribute Option) -> HTMLNodes -> HTMLNode
 296 | option = El _
 297 | 
 298 | export %inline
 299 | output : List (Attribute Output) -> HTMLNodes -> HTMLNode
 300 | output = El _
 301 | 
 302 | export %inline
 303 | p : List (Attribute P) -> HTMLNodes -> HTMLNode
 304 | p = El _
 305 | 
 306 | export %inline
 307 | param : List (Attribute Param) -> HTMLNode
 308 | param = EEl _
 309 | 
 310 | export %inline
 311 | picture : List (Attribute Picture) -> HTMLNodes -> HTMLNode
 312 | picture = El _
 313 | 
 314 | export %inline
 315 | pre : List (Attribute Pre) -> HTMLNodes -> HTMLNode
 316 | pre = El _
 317 | 
 318 | export %inline
 319 | progress : List (Attribute Progress) -> HTMLNodes -> HTMLNode
 320 | progress = El _
 321 | 
 322 | export %inline
 323 | q : List (Attribute Q) -> HTMLNodes -> HTMLNode
 324 | q = El _
 325 | 
 326 | export %inline
 327 | script : List (Attribute Script) -> HTMLNodes -> HTMLNode
 328 | script = El _
 329 | 
 330 | export %inline
 331 | section : List (Attribute Section) -> HTMLNodes -> HTMLNode
 332 | section = El _
 333 | 
 334 | export %inline
 335 | select : List (Attribute Select) -> HTMLNodes -> HTMLNode
 336 | select = El _
 337 | 
 338 | export %inline
 339 | slot : List (Attribute Slot) -> HTMLNodes -> HTMLNode
 340 | slot = El _
 341 | 
 342 | export %inline
 343 | source : List (Attribute Source) -> HTMLNode
 344 | source as = El _ as []
 345 | 
 346 | export %inline
 347 | span : List (Attribute Span) -> HTMLNodes -> HTMLNode
 348 | span = El _
 349 | 
 350 | export %inline
 351 | style : List (Attribute Style) -> HTMLNodes -> HTMLNode
 352 | style = El _
 353 | 
 354 | export %inline
 355 | table : List (Attribute Table) -> HTMLNodes -> HTMLNode
 356 | table = El _
 357 | 
 358 | export %inline
 359 | tbody : List (Attribute Tbody) -> HTMLNodes -> HTMLNode
 360 | tbody = El _
 361 | 
 362 | export %inline
 363 | td : List (Attribute Td) -> HTMLNodes -> HTMLNode
 364 | td = El _
 365 | 
 366 | export %inline
 367 | template : List (Attribute Template) -> HTMLNodes -> HTMLNode
 368 | template = El _
 369 | 
 370 | export %inline
 371 | textarea : List (Attribute TextArea) -> HTMLNodes -> HTMLNode
 372 | textarea = El _
 373 | 
 374 | export %inline
 375 | tfoot : List (Attribute Tfoot) -> HTMLNodes -> HTMLNode
 376 | tfoot = El _
 377 | 
 378 | export %inline
 379 | th : List (Attribute Th) -> HTMLNodes -> HTMLNode
 380 | th = El _
 381 | 
 382 | export %inline
 383 | thead : List (Attribute Thead) -> HTMLNodes -> HTMLNode
 384 | thead = El _
 385 | 
 386 | export %inline
 387 | time : List (Attribute Tag.Time) -> HTMLNodes -> HTMLNode
 388 | time = El _
 389 | 
 390 | export %inline
 391 | title : List (Attribute Title) -> HTMLNodes -> HTMLNode
 392 | title = El _
 393 | 
 394 | export %inline
 395 | tr : List (Attribute Tr) -> HTMLNodes -> HTMLNode
 396 | tr = El _
 397 | 
 398 | export %inline
 399 | track : List (Attribute Track) -> HTMLNode
 400 | track = EEl _
 401 | 
 402 | export %inline
 403 | ul : List (Attribute Ul) -> HTMLNodes -> HTMLNode
 404 | ul = El _
 405 | 
 406 | export %inline
 407 | video : List (Attribute Video) -> HTMLNodes -> HTMLNode
 408 | video = El _
 409 | 
 410 | --------------------------------------------------------------------------------
 411 | --          Rendering Html
 412 | --------------------------------------------------------------------------------
 413 | 
 414 | export
 415 | escape : String -> String
 416 | escape = fastConcat . map esc . unpack
 417 | 
 418 |   where
 419 |     esc : Char -> String
 420 |     esc '<'          = "&lt;"
 421 |     esc '>'          = "&gt;"
 422 |     esc '&'          = "&amp;"
 423 |     esc '"'          = "&quot;"
 424 |     esc '\''         = "&#x27"
 425 |     esc '\n'         = "\n"
 426 |     esc '\r'         = "\r"
 427 |     esc '\t'         = "\t"
 428 |     esc c            = if c < ' ' then "" else singleton c
 429 | 
 430 | attrs : List (Attribute t) -> String
 431 | attrs as = let s = displayAttributes as in if null s then "" else " " ++ s
 432 | 
 433 | export
 434 | render : HTMLNode -> String
 435 | render n = case n of
 436 |   Raw x             => x
 437 |   Text x            => escape x
 438 |   EEl {tag} _ as    => "<\{tag}\{attrs as}>"
 439 |   El  {tag} _ as ns => "<\{tag}\{attrs as}>\{go [<] ns}</\{tag}>"
 440 |   Empty             => ""
 441 | 
 442 |   where
 443 |     go : SnocList String -> HTMLNodes -> String
 444 |     go ss (n :: ns) = go (ss :< render n) ns
 445 |     go ss []        = concat $ ss <>> []
 446 | 
 447 | export
 448 | renderMany : HTMLNodes -> String
 449 | renderMany = fastConcat . map render
 450 |