
   0 | module Text.HTML.Extra.Node
   1 | 
   2 | import Data.Linear.Sink
   3 | import Data.List
   4 | 
   5 | import public Text.HTML
   6 | import public Text.HTML.DomID
   7 | import public Text.HTML.Extra.Class
   8 | import public Text.HTML.Select
   9 | 
  10 | %default total
  11 | 
  12 | --------------------------------------------------------------------------------
  13 | -- Utilities
  14 | --------------------------------------------------------------------------------
  15 | 
  16 | ||| ID of an element to which logging messages can be sent.
  17 | export
  18 | AsyncLog : DomID
  19 | AsyncLog = "async-dom-log"
  20 | 
  21 | export %inline
  22 | nodeSep : HTMLNode
  23 | nodeSep = div [class sep] []
  24 | 
  25 | export %inline
  26 | spacer : HTMLNode
  27 | spacer = div [class spacer] []
  28 | 
  29 | export %inline
  30 | separate : HTMLNodes -> HTMLNodes
  31 | separate = intersperse nodeSep
  32 | 
  33 | --------------------------------------------------------------------------------
  34 | -- Icons
  35 | --------------------------------------------------------------------------------
  36 | 
  37 | ||| An icon showing a warning triangle with an exclamation mark
  38 | export
  39 | iwarn : HTMLNode
  40 | 
  41 | export
  42 | iok : HTMLNode
  43 | 
  44 | export
  45 | iadd : HTMLNode
  46 | 
  47 | export
  48 | icancel : HTMLNode
  49 | 
  50 | export
  51 | idelete : HTMLNode
  52 | 
  53 | export
  54 | iexpanded : HTMLNode
  55 | 
  56 | export
  57 | icollapsed : HTMLNode
  58 | 
  59 | export
  60 | ireload : HTMLNode
  61 | 
  62 | export
  63 | isortDec : HTMLNode
  64 | 
  65 | export
  66 | isortInc : HTMLNode
  67 | 
  68 | export
  69 | inoSort : HTMLNode
  70 | 
  71 | --------------------------------------------------------------------------------
  72 | -- Widgets
  73 | --------------------------------------------------------------------------------
  74 | 
  75 | ||| Creates a text label for a probably editable field
  76 | |||
  77 | ||| @ uid   : ID used in "for" attribute
  78 | ||| @ txt   : actual textual content
  79 | export
  80 | lbl : DomID -> String -> HTMLNode
  81 | lbl uiid txt = label [forID uiid] [Text txt]
  82 | 
  83 | ||| A clickable button in the UI firing the given event on a left click.
  84 | export %inline
  85 | btn : Sink e => e -> String -> List (Attribute Tag.Button) -> HTMLNode
  86 | btn ev txt as = button (onClick ev :: as) [Text txt]
  87 | 
  88 | ||| A clickable button in the UI firing the given event on a left click.
  89 | export %inline
  90 | icn :
  91 |      {auto snk : Sink e}
  92 |   -> {default icon cl : Class}
  93 |   -> HTMLNode
  94 |   -> e
  95 |   -> List (Attribute Tag.Button)
  96 |   -> HTMLNode
  97 | icn n ev as = button (class cl :: onClick ev :: as) [n]
  98 | 
  99 | --------------------------------------------------------------------------------
 100 | --          Editing
 101 | --------------------------------------------------------------------------------
 102 | 
 103 | export %inline
 104 | deleteNode : Sink e => e -> HTMLNode
 105 | deleteNode ev = icn {cl = deleteIcon} idelete ev []
 106 | 
 107 | export %inline
 108 | addNode : Sink e => e -> HTMLNode
 109 | addNode ev = icn {cl = addIcon} iadd ev []
 110 | 
 111 | ||| An `<input>` element of the given class.
 112 | export %inline
 113 | inp : Sink e => (String -> e) -> List (Attribute Tag.Input) -> HTMLNode
 114 | inp f as = input (onInput f :: as)
 115 | 
 116 | ||| A select element displaying the values of type `v`
 117 | ||| shown in the given list.
 118 | |||
 119 | ||| It fires events of type `t`, and uses two functions, one for
 120 | ||| converting elements to events and one for displaying elements.
 121 | export %inline
 122 | sel : Sink t => Eq v => (v -> t) -> (v -> String) -> List v -> Maybe v -> HTMLNode
 123 | sel f g vs i = selectFromListBy' vs ((i ==) . Just) g f []
 124 | 
 125 | --------------------------------------------------------------------------------
 126 | -- Icons SVGs
 127 | --------------------------------------------------------------------------------
 128 | 
 129 | iwarn = Raw "<svg viewBox='0 0 6.61 6.61'><g transform='matrix(.902 0 0 .902 .319 .685)' fill='none' stroke-width='.419'><g stroke='currentcolor' stroke-linecap='round' stroke-linejoin='round'><path transform='translate(1.35,3)' d='m4.86 2.42-2.9-2e-7-2.9 1e-7 2.9-5.03 1.45 2.51z' stroke-width='.419'/><path d='m3.31 2.05v1.71' stroke-width='.629'/><path d='m3.31 4.63v.0865' stroke-width='.629'/></g></g></svg>"
 130 | iok = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m1.32 3.97 1.32 1.06 2.65-3.7-2.74 3-1.23-.351' fill='currentcolor' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 131 | iadd = Raw "<svg viewBox='0 0 6.61 6.61'><path transform='scale(.265)' d='m11 5v6h-6v3h6v6h3v-6h6v-3h-6v-6h-3z' fill='currentcolor' stroke='currentcolor' stroke-width='.3'/></svg>"
 132 | icancel = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m4.43 1.62-1.12 1.12-1.12-1.12-.561.561 1.12 1.12-1.12 1.12.561.561 1.12-1.12 1.12 1.12.561-.561-1.12-1.12 1.12-1.12z' fill='currentcolor' stroke='currentcolor' stroke-width='.0794'/></svg>"
 133 | idelete = icancel
 134 | iexpanded = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m5.12 1.9-1.81 3.22-1.81-3.22 1.81 1.41z' fill='currentcolor' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 135 | icollapsed = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m1.9 1.5 3.22 1.81-3.22 1.81 1.41-1.81z' fill='currentcolor' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 136 | ireload = Raw "<svg viewBox='0 0 6.61 6.61'><g transform='rotate(-30 3.23 3.6)' fill='currentcolor'><path transform='scale(.265)' d='m12.5 2a10.5 10.5 0 00-10.5 10.5 10.5 10.5 0 0010.5 10.5v-3a7.5 7.5 0 01-7.5-7.5 7.5 7.5 0 017.5-7.5 7.5 7.5 0 017.5 7.5h3a10.5 10.5 0 00-10.5-10.5z'/><path d='m4.51 3.11h2.44l-1.22 2.19z' fill-rule='evenodd' stroke-width='1.84'/></g></svg>"
 137 | isortDec = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m5.12 3.7-1.81 2.12-1.81-2.12z' fill='currentcolor' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/><path d='m5.12 2.91-1.81-2.12-1.81 2.12z' fill='none' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 138 | isortInc = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m5.12 3.7-1.81 2.12-1.81-2.12z' fill='none' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/><path d='m5.12 2.91-1.81-2.12-1.81 2.12z' fill='currentcolor' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 139 | inoSort = Raw "<svg viewBox='0 0 6.61 6.61'><path d='m5.12 3.7-1.81 2.12-1.81-2.12z' fill='none' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/><path d='m5.12 2.91-1.81-2.12-1.81 2.12z' fill='none' fill-rule='evenodd' stroke='currentcolor' stroke-width='.0794'/></svg>"
 140 |