fix strip in JSON.toAPLJAX

fix strip in JSON.toAPLJAX

:class JSON

⍝ Converts JSON (as a character vector) to and from XML and APL.
⍝ The APL format may also save shape information.
⍝ It also includes namespaces but the namespace representation may lose data
⍝ when an object name contains characters that are not valid in APL names.
⍝ Both the APL and XML forms are 100% lossless otherwise.
⍝ This means that:
⍝    json ≡ fromAPL toAPL json   and   json ≡ fromXML toXML json

    ⎕IO←⎕ML←1 ⋄ ⎕pp←34                      ⍝ Version 2.00

    toNum←{(v n)←⎕VFI fixNum ⍵ ⋄ (v≡,1):⊃n ⋄ ⍬}
    deQuote←{'\\"'⎕R'"'⊢'\\\\'⎕R'\\'⊢'""'strip ⍵}
    isRef←{(0=≡⍵)∧326=⎕DR ⍵}
    if←/⍨
    trim←⌽∘{(+/∧\' '=⍵)↓⍵}⍣2
    us←{≠\⍵≠⍺\t≠¯1↓0,t←⍺/≠\¯1↓0,⍵} ⍝ partitioned ≠\
    isChar←{0 2∊⍨10|⎕dr ⍵}
    isSingle←{(1=≢,⍵)∧2>≡⍵}
    isSimple←{(0∊⍴⍴⍵)∧0=≡⍵}
    isJSON←{0::0 ⋄ ~0∊⍴ toXML ⍵}
    fixNum←{b←'-'=V←⍵ ⋄ (b/V)←'¯' ⋄ ∧/b←'+'≠V:V ⋄ (b≥¯1⌽v∊'eE')/V}
    fmtNum←{(2|⎕dr ⍵)⍲∨/b←'¯'=r←⍕⍵:r ⋄ (b/r)←'-' ⋄ r}
    strip←{⍺←'{}' ⋄ ∧/⍺=(1↑⍵),¯1↑⍵:1↓¯1↓⍵ ⋄ ⍵}
    validName←{('.'∊⍵)<0≤⎕NC ⍵}
    beginsWith←{⍵≡(⍴⍵)↑⍺}
    :field public shared true←{⍵⊣⍵.⎕DF'true'}⎕NS ''
    :field public shared false←{⍵⊣⍵.⎕DF'false'}⎕NS ''

    :section fromAPL

    ∇ r←{options}fromAPL array;typ;ic;drop;ns;preserve;quote;qp;jqopt;t
    ⍝ An APL object is either a simple scalar (number, character or ref) or an array
    ⍝ represented by a list of [rank,shape, if we preserve it, then data]
      :Access public shared
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf
      qp←(quote preserve jqopt)←3↑options  ⍝ do we quote the names and preserve APL shape?
      :If isSimple array
          r←fmtNum array ⋄ →0 if 2|typ←⎕DR array ⍝ numbers
          :If ⎕NULL≡array
              r←'null'
          :ElseIf typ=326 ⍝ ref (ns)
              'Cannot work on JSON itself'⎕SIGNAL 611 if ⎕THIS≡array
              r←qp APLObject array
          :ElseIf jqopt
              t←array~' '
              :If 'function'≡8↑t ⋄ r←array
              :ElseIf '⍎'=1↑t ⋄ r←(∨\~array∊' ⍎')/array ⋄
              :ElseIf '⍕'=1↑t ⋄ r←1⌽'""',(~<\' '=array)/array ⋄ :EndIf
          :Else
              r←1⌽'""',JAchars array
          :EndIf
      :Else ⍝ is not simple (array)
          drop←preserve<ic←isChar array
          r←drop↓'[',preserve/',',⍨(⍕⍴⍴array),∊',',¨⍕¨⍴array
          :If 0∊⍴array
              :If ~preserve ⋄ →0⊣r←(1+ic)⊃'[]' '""' ⋄ :EndIf
              r,←qp fromAPL⊃array ⍝ prototype
          :ElseIf ic
              :If jqopt
              :AndIf ∨/(array~' ')∘beginsWith¨'function' 'ej.' '$('(,'⍎') ⍝!!! for jQuery (and Syncfusion) options, treat things beginning with function or ej. as literals
                  r←('⍎'=1↑array)↓array
              :Else
                  r,←1⌽'""',JAchars,array ⍝ strings are displayed as such
              :EndIf
          :Else
              ns←⍬⍴(~preserve)×0⌈¯1+⍴⍴array
              r,←1↓∊',',¨qp∘fromAPL¨,↓⍣ns⊢array
          :EndIf
          r,←drop↓']'
      :EndIf
    ∇

    ∇ js←{trUni}JAchars apl;fnrbt;str;b;ucs;⎕IO
      :Access public shared
     ⍝ Get JSON characters from an APL string
      :If 0<⍴js←str←,apl
          :If 1∊b←str∊fnrbt←'"\/',⎕UCS 12 10 13 8 9
              (b/str)←'\"' '\\' '\/' '\f' '\n' '\r' '\b' '\t'[fnrbt⍳b/str]
          :EndIf
          :If 1∊b←128<ucs←⎕UCS apl
          :AndIf {6::⍵ ⋄ trUni}1
              ⎕IO←0 ⋄ (b/str)←'\u'∘,¨⊂[0](⎕D,⎕A)[(4⍴16)⊤b/ucs]
          :EndIf
          js←∊str
      :EndIf
    ∇

    ∇ j←ns APLfn name;rep
     ⍝ Create a JSON string from an APL fn
      'Invalid fn name'⎕SIGNAL 611 if~(ns.⎕NC name)∊3 4
      rep←fromAPL ns.⎕NR name   ⍝ the code
      j←'"\u2207',name,'":',rep ⍝ its ∇name
    ∇

    ∇ r←options APLObject NS;n;name;quote;preserve
     ⍝ Create a name-value pair JSON string from a namespace
      (quote preserve)←2↑options
      r←,'{'
      :For n :In n←NS.⎕NL-2 9.1
          r,←(quote makeString n),':'    ⍝ the name
          r,←(options fromAPL NS⍎n),','  ⍝ the value
      :EndFor
      :If (0∊⍴n)∧(⊂name←⍕NS)∊'true' 'false' ⋄ →0⊣r←name
      :Else
          :For n :In NS.⎕NL-preserve/3
              r,←(NS APLfn n),','
          :EndFor
      :EndIf
      r←'}',⍨(-1<⍴r)↓r
    ∇

    ∇ r←q makeString name;Q
    ⍝ Find the real string associated with an APL variable name
      :If q∨←'⍙'∊1↑r←name
          r←⎕UCS⊃⌽⎕VFI{b\⍵/⍨b←~⍵∊'⍙_'}name
         ⍝ Special characters " and \ must be taken into account
          ((r∊'"\')/r),⍨←'\'
      :EndIf
      r←Q,(∊r),Q←q/'"'
    ∇

    ∇ r←name Name data
      :Access public shared
      r←name{r←⎕NS'' ⋄ r⊣r⍎⍺,'←⍵'}data
    ∇

⍝   ---------------------------------------------------------------------
    :endsection fromAPL

    :section toAPL

    ∇ obj←{options}toAPL str;c1;b
     ⍝ This fn takes a JSON string and turns it into an APL object
     ⍝ The string must follow specific rules in order to be accepted
      :Access public shared
      str←,str
      ⎕SIGNAL(⊂('EN' 11)('Message' 'Argument is not a simple character vector'))if~isChar str
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf       ⍝ do we preserve APL shape?
      :If '{'=c1←1↑str←trim str~⎕UCS 8 9 10 13 ⍝ is this a ns?
          ⎕SIGNAL(⊂('EN' 2)('Message' 'Invalid JSON - expected }'))if'}'≠¯1↑str
          obj←options parseNS strip str
      :ElseIf '['=c1                           ⍝ an array maybe?
          ⎕SIGNAL(⊂('EN' 2)('Message' 'Invalid JSON - expected ]'))if']'≠¯1↑str
          obj←,⍣(~options)⊢options parseAPLArray 1↓¯1↓str
      :ElseIf '"'=c1
          obj←AJchars 1↓¯1↓str                 ⍝ a string?
      :ElseIf (,1)≡⎕IO⊃b←⎕VFI fixNum str       ⍝ a single number
          obj←⊃⊃⌽b
      :ElseIf 'null'≡str ⋄ obj←⎕NULL
      :ElseIf 'true'≡str ⋄ obj←true
      :ElseIf 'false'≡str ⋄ obj←false
      :Else ⋄ obj←⎕NS'' ⋄ obj.⎕DF str          ⍝ true/false
      :EndIf
    ∇

    ∇ str←AJchars str;sl;msk;bfnrt;u;b;x;⎕IO;Hex;i
     ⍝ Get APL chars from a JSON string
      →0↓⍨⍴,str ⋄ ⎕IO←0
      :If ∨/sl←(¯1⌽msk←isBslash str)∧str∊bfnrt←'bfnrtu'
          b←sl\~u←'u'=sl/str
          (b/str)←⎕UCS 8 12 10 13 9[bfnrt⍳b/str]
          :If ∨/b←sl\u ⍝ any \Uxxxx number?
              Hex←⎕D,'abcdef',⎕D,'ABCDEF'
              x←16⊥⍉16|Hex⍳str[i←(b/⍳⍴b)∘.+1+⍳4]
              (b/str)←⎕UCS x
              msk[i]←1 ⍝ mask out these positions
          :EndIf
      :EndIf
      str←,⊃,/(~msk)/str
    ∇

    ∇ ns←preserve parseNS s;txt;level;split;n;names;val;msg
     ⍝ Surrounding '{}'s not present here
     ⍝ Elements are separated by ','
      ns←#.⎕NS'' ⋄ →0↓⍨⍴txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      n←+/split←1,(s∊',:')∧txt<level=0
      msg←'Invalid JSON: ',(1+2|n)⊃'unbalanced braces or brackets' 'bad format'
      msg ⎕SIGNAL 600 if(2|n)∨0≠¯1↑level
      (names val)←↓⍉trim¨(n÷2)2⍴1↓¨split⊂';',s
      names←{makeName deQuote ⍵}¨names
      :For n s :InEach names val
          val←preserve toAPL s
          :If '∇'≠1↑n
              ⍎'ns.',n,'←val'
          :Else ⍝ it's a fn
              {}÷((1↓n)≢ns.⎕FX val)/'Invalid fn defn'
          :EndIf
      :EndFor
    ∇

    ∇ r←makeName str
     ⍝ Make up a name for an APL variable
      :Access public shared
      →0↓⍨('⍙'∊1↑r)∨~validName r←str
      r←'⍙',∊'_',¨⍕¨⎕UCS str
    ∇

    ∇ r←parseName name
    ⍝ parses a name created by makeName
      :Access public shared
      →0↓⍨{∧/⍵∊⎕D,'⍙_'}r←name
      r←⎕UCS r{2⊃⎕VFI ⍵\⍵/⍺}r∊⎕D
    ∇
    ∇ array←preserveShape parseAPLArray str;p;rank;n;txt;level;split;shape
     ⍝ Rank and shape precede data
      shape←⍬
      :If preserveShape
          rank←toNum(¯1+p←str⍳',')↑str ⋄ str←p↓str
          :While rank>0 ⋄ shape,←toNum(¯1+p←str⍳',')↑str ⋄ str←p↓str ⋄ rank-←1 ⋄ :EndWhile
      :EndIf

     ⍝ For empty arrays we exit if we don't need to preserve the shape
      →(preserveShape∨~0∊⍴str)↓⍴array←⍬

     ⍝ There will alway be at least ONE element (the prototype) so we need to do this:
     ⍝ Elements are separated by ',' - find them
      txt←isText str
      level←(+\txt<str∊'[{')-+\txt<str∊']}'
      'Bad [{}] nesting'⎕SIGNAL 600 if level∨.<0
      split←1,(txt<str=',')∧level=0
      array←preserveShape toAPL¨1↓¨split⊂';',str
      array←(⊃⍣((∨/str∘≡¨'true' 'false')∨preserveShape∧∧/txt))array
      →preserveShape↓0
      array←shape⍴array
    ∇

    :endsection toAPL

    :section JavaScript

    ∇ r←toJQueryParameters arr;t;p;i
    ⍝ Format APL data in a manner consistent with most jQuery-style parameter
    ⍝ arr is one of:
    ⍝ - namespace reference
    ⍝ - character vector of formatted jQuery parameters
    ⍝ - nested vector of names/values
    ⍝ N.B. - be careful with scalar names and character values ('h' 'a')('b' (1 2 3)) >> {ha:{b:[1,2,3]}} because 'h' 'a' ≡ 'ha'

      :Access public shared
      :If isRef arr
          r←0 0 1 fromAPL arr
      :Else
⍝          arr←,arr
          :If isChar arr ⍝ simple charvec?
              →0⌿⍨'}{'≡2↑¯1⌽r←arr
          :AndIf isJSON r←'{',(strip arr),'}'
              →0 ⍝ treat it like a parameters vector
          :Else
              :If 1=≡arr   ⍝ only way this happens is with scalar name
                  arr←,⊂(,⊃arr)(1↓arr)
              :ElseIf (2=⍴arr)∧isChar⊃arr ⍝ id
                  arr←,⊂arr
              :EndIf
              r←'{'
              :For i :In ⍳⍴arr
                  p←i⊃arr
                  :If (isChar p)<isChar⊃p
                      r,←(1⊃p),':'
                      :Select |≡t←{(⊃⍣(1<≡⍵))⍵}1↓p
                      :CaseList 0 1
                          r,←fromAPL{(⊃⍣(isSingle ⍵))⍵}t
                      :Else
                          r,←toJQueryParameters⊃t
                      :EndSelect
                  :Else
                      r,←fromAPL p
                  :EndIf
                  r,←','
              :EndFor
              r←(¯1↓r),'}'
          :EndIf
      :EndIf
    ∇

    ∇ r←toAPLJAX nvp;verb;fmt;value;sel;x;d;strip
    ⍝ formats name/value pairs in a manner suitable for processing by the client side of APLJAX
    ⍝ essentially there are 4 verbs:
    ⍝ ('execute' javascript)
    ⍝ ('replace' selector)('data' html)
    ⍝ ('append' selector)('data' html)
    ⍝ ('prepend' selector)('data' html)
      :Access public shared
      nvp←,nvp
      :If 0∊⍴nvp ⋄ r←'[]' ⋄ :Return ⋄ :EndIf
      strip←{(⊂(1↑⍵),¯1↑⍵)∊'""' '[]' '{}':1↓¯1↓⍵ ⋄ ⍵}
      fmt←{(isChar ⍵)>(isJSON ⍵)∨t←'⍎'=1↑,⍵:'"',(JAchars ⍵),'"'
          ⋄ t:1↓⍕⍵
          ⋄ strip toAPLJAX ⍵}
      r←'['
      :Select |≡nvp
      :Case 1  ⍝ if depth 1, assume it's a JSON character string already
          r←⍕nvp ⋄ :Return
      :Case 2 ⍝ vector of vectors
          :While ~0∊⍴nvp
              :Select verb←⊃nvp
              :Case 'execute'
                  r,←'{"',verb,'":',(fmt⊃1↓2↑nvp),'},'
                  nvp↓⍨←2
              :CaseList 'replace' 'prepend' 'append'
                  x sel d value←4↑nvp
                  r,←'{"',verb,'":"',sel,'","',d,'":',(fmt value),'},'
                  nvp↓⍨←4
              :Else
              :EndSelect
          :EndWhile
      :Case 3  ⍝ could be (('execute' 'foo')('execute' 'goo')) OR (('replace' 'sel')('data' 'foo'))
          :Select verb←⊃⊃nvp
          :Case 'execute'
              r,←∊',',⍨¨strip¨toAPLJAX¨nvp
          :Else
              (x sel)(d value)←nvp
              r,←'{"',verb,'":"',sel,'","',d,'":',(fmt value),'},'
          :EndSelect
      :Case 4
          r,←∊',',⍨¨strip¨toAPLJAX¨nvp
      :EndSelect
⍝
⍝      :For p :In ,nvp
⍝          :Select |≡p
⍝          :Case 0
⍝              r,←(⍕p),']'
⍝          :Case 1
⍝              r,←(fromAPL p),']'
⍝          :Case 2
⍝              :If 2=⍴,p
⍝                  d←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ strip fromNVP ⍵}2⊃p
⍝                  r,←'{"',(1⊃p),'":',d,'},'
⍝              :Else
⍝                  r,←(fromAPL⊃p),']'
⍝              :EndIf
⍝          :Case 3
⍝              r,←'{'
⍝              :If (1=≡⊃p)∧2=⍴,p
⍝                  :If isChar⊃p
⍝                      r,←'"',(⊃p),'":',(strip toAPLJAX 2⊃p),','
⍝                  :Else
⍝                      r←fromAPL p
⍝                  :EndIf
⍝              :Else
⍝                  :For x :In p
⍝                      d←{1<⍴⍴⍵:∊(↓⍕⍵),¨⊂'<br/>' ⋄ ⍵}2⊃x
⍝                      d←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ ⍕⍵}d
⍝                      r,←'"',(1⊃x),'":',d,','
⍝                  :EndFor
⍝              :EndIf
⍝              r←(¯1↓r),'},'
⍝          :EndSelect
⍝      :EndFor
      r←(¯1↓r),']'
    ∇

    ∇ r←a formatData w
      :Access public shared
      r←a{0∊⍴z←⎕NS¨(⊃⍴⍵)⍴⊂'':z
          z⊣z(⍺{⍺.⍎'(',(⍕⍺⍺),')←⍵'})¨(↓⍣(2=⍬⍴⍴⍴⍵))⍵}w
    ∇

    ∇ r←aa Add(a w)
      :Access public shared
      r←a(aa{'{}'≡(1↑⍺⍺),¯1↑⍺⍺:(¯1↓⍺⍺),',',⍺,':',⍵,'}' ⋄ ⍺⍺,',',⍺,':',⍵})w
    ∇

    :EndSection

    :Section XML                                                 ⍝ DanB 2011/12

    ∇ xml←{name}toXML str;c1;end;b;tag;beg;item
     ⍝ Parse JSON string into XML
      :Access public shared
      :If 0=⎕NC'name' ⋄ name←'json' ⋄ :EndIf
      tag←''≢name
     ⍝ An empty name is an indication that we want the Value only w/o a complete Tag
      end←tag/'</',name,'>' ⋄ beg←tag/'<',name ⋄ item←tag/'<item'
      :If '{'=c1←1↑str←trim str~⎕UCS 8 9 10 13
          'Invalid JSON: expected }'⎕SIGNAL 600 if'}'≠¯1↑str
          xml←beg,' type="object">',(parseObj strip str),end
      :ElseIf '['=c1
          'Invalid JSON: expected ]'⎕SIGNAL 600 if']'≠¯1↑str
          xml←beg,' type="array">',(parseArr'[]'strip str),end
      :ElseIf '"'=c1
          xml←item,'>',(XJchars'""'strip str),tag/'</item>' ⍝ we could add  type="string"
      :ElseIf ∨/b←'null' 'true' 'false'∊⊂str
          xml←item,' type="',((b⍳1)⊃1 2/'null' 'boolean'),'">',(~1↑b)/str
          xml←xml,(tag/'</item>')
      :ElseIf (,1)≡⎕IO⊃b←⎕VFI fixNum str ⍝ allow nn+Emm
          xml←item,' type="number">',str ⍝ we could also use '17⍕b'
          xml←xml,(tag/'</item>')
      :Else
          'INVALID JSON'⎕SIGNAL 11
      :EndIf
    ∇

    ∇ str←{options}fromXML xml;head;Q;b;ot;n;type
     ⍝ Parse XML statement into JSON
      :Access public shared
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf     ⍝ do we quote names?
      n←⍴head←xml↑⍨'>'⍳⍨xml←trim xml
      xml←{'>'≠¯1↑⍵:⍵ ⋄ ⍵↓⍨-'<'⍳⍨⌽⍵}n↓xml
      :If 'array'≡type←5↑(head⍳'"')↓head
          →0↓⍨⍴xml{⍺}str←'[]'
          str←'[',(1↓∊',',¨options∘fromXML¨cutItems xml),']'
      :ElseIf 'objec'≡type
          →0↓⍨⍴xml{⍺}str←'{}'
          str←'{',(1↓∊',',¨options∘getObject¨cutObjects xml),'}'
      :Else ⍝ may be boolean or null if empty
          :If ~'='∊head ⋄ str←Q,(JXchars xml),Q←'"'
          :ElseIf 0∊⍴xml ⋄ str←'null'
          :Else ⋄ str←xml ⍝ boolean?
          :EndIf
      :EndIf
    ∇

    ∇ str←XJchars str;set;sl;msk;bfnrt;u;b;x;⎕IO;Hex;i
     ⍝ Get XML from a JSON string
      →0↓⍨⍴,str ⋄ ⎕IO←0
      sl←(¯1⌽msk←isBslash str)∧str∊bfnrt←'bfnrtu'
      :If ∨/b←str∊set←'<>&"' ⍝ we could also change other specific chars here
          (b/str)←'<' '>' '&' '"'[set⍳b/str]
      :EndIf
      :If ∨/sl
          b←sl\~u←'u'=sl/str
          (b/str)←⎕UCS 8 12 10 13 9[bfnrt⍳b/str]
          :If ∨/b←sl\u ⍝ any \Uxxxx number?
              Hex←⎕D,'abcdef',⎕D,'ABCDEF'
              x←16⊥⍉16|Hex⍳str[i←(b/⍳⍴b)∘.+1+⍳4]
              (b/str)←⎕UCS x
              msk[i]←1 ⍝ mask out these positions
          :EndIf
      :EndIf
      str←⊃,/(~msk)/str
    ∇

    ∇ str←JXchars str;char;b;msk;i;rep;seq;fnrbt
     ⍝ Get JSON from an XML &..; sequences
      msk←1 ⋄ seq←';&#x'∘,¨'CAD89cad' ⋄ fnrbt←⎕UCS 12 10 13 8 9
      :For char rep :InEach ('<' '>' '"' '&',seq)('<>"&',8⍴fnrbt)
          i←b/⍳⍴b←char⍷str
          msk>←≠\(¯1⌽b)∨(-⍴b)↑(-⍴char)↓b
          str[i]←rep
      :EndFor
      str←msk/str
      str←JAchars str
    ∇

    ∇ slash←isBslash txt;t
     ⍝ Find where real backslashes are
      slash←'\'=txt           ⍝ need to check for multiple \
      t←slash>¯1↓0,slash      ⍝ start of each group of \
      slash←slash∧t us slash  ⍝ where the real \ are
    ∇

    ∇ mask←isText json;t;slash;quote
      quote←'"'=json          ⍝ find double quotes (they delimit strings)
      slash←isBslash json
      quote←quote>¯1↓0,slash  ⍝ where the real " are
      mask←quote∨≠\quote
    ∇

    ∇ list←parseArr s;txt;level;split
     ⍝ Surrounding '[]'s not present here
     ⍝ Elements are separated by ','
      →(s∧.=' ')⍴⍴list←''
     ⍝ Find the separating commas
      txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      split←1,(s=',')∧txt<level=0
      list←∊'item'∘toXML¨1↓¨split⊂';',s
    ∇

    ∇ obj←parseObj s;txt;level;split;n;pairs;x
     ⍝ Surrounding '{}'s not present here
     ⍝ Elements are separated by ','
      →(s∧.=' ')⍴⍴obj←''
     ⍝ Find the separating commas
      txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      n←+/split←1,(s∊',:')∧txt<level=0
      'Invalid JSON: unbalanced braces or brackets'⎕SIGNAL 600 if(2|n)∨0≠¯1↑level
      x←0,{0}¨pairs←trim¨(n÷2)2⍴1↓¨split⊂';',s
      x[;1]←n←{validName⊢n←deQuote ⍵:'<',n ⋄ 1⌽'"<SN name="',XJchars n}¨pairs[;1]
      x[;3]←{1⌽'></',1↓(¯1+⍵⍳' ')↑⍵}¨n ⍝ end tag
      x[;2]←''∘toXML¨pairs[;2]
      obj←⊃,/,x
    ∇

    ∇ vtv←cutObjects xml;b;n;ot;level
      b←'<'=xml ⋄ n←1↓0,⍨'/'=xml
      level←(+\ot←b>n)-+\b∧n
      vtv←(ot∧level=1)⊂xml
    ∇

    ∇ vtv←cutItems xml;level;start;mask
     ⍝ Cut XML into pieces based on the <item> tag
      mask←0≠level←(+\start←'<item'⍷xml)-+\'</item'⍷xml
      vtv←(mask/start∧level=1)⊂mask/xml
    ∇

    ∇ str←quote getObject xml;n;head;name;b;Q;data
     ⍝ Transform XML into JSON
      n←⍴head←xml↑⍨'>'⍳⍨xml←trim xml ⋄ data←trim{⍵↓⍨-'<'⍳⍨⌽⍵}n↓xml
      name←'<>'strip head
      :If ∨/b←'name='⍷head
          name←JXchars{⍵↑⍨¯1+⍵⍳'"'}(5+b⍳1)↓head
      :Else ⋄ b←' '=name ⍝ 2<+/name='"'
          name←(¯1+b⍳1)↑name
      :EndIf
      :If quote
      :OrIf ~validName name
          name←Q,name,Q←'"'
      :EndIf

     ⍝ If the type is boolean or number then nothing to do.
      :If ∨/b←'type='⍷head
          :Select 5↑(5+b⍳1)↓head
          :Case 'array'
              data←1⌽'][',1↓⊃,/',',¨quote∘fromXML¨cutItems xml
          :Case 'objec'
              data←1⌽'}{',1↓⊃,/',',¨quote∘getObject¨cutObjects data
        ⍝ If null then the result is 'null'
          :Case 'null"'
              data←'null'
          :EndSelect
      :Else ⍝ string
          data←Q,(JXchars data),Q←'"'
      :EndIf
      str←name,':',data
    ∇

    :endsection XML

    :section Utils

    ∇ r←{level}Tree ns;n;t;nms
 ⍝ Return indented name tree of APL namespace representation of JSON array
 ⍝ ns - reference to namespace created by JSON.toAPL
      :Access public shared
      r←''
      :If 0=⎕NC'level' ⋄ level←0 ⋄ :EndIf
      :If 2<≡nms←ns.⎕NL-2 9 ⋄ nms←⊃,/nms ⋄ :EndIf
      :For n :In nms
          r,←⊂((2×level)⍴' '),n
          t←ns⍎n
          :Select ⊃ns.⎕NC n
          :Case 2
              :If 326=⎕DR t
                  r,←(level+1)Tree⊃t
              :EndIf
          :Case 9
              r,←(level+1)Tree⊃t
          :EndSelect
      :EndFor
      :If level=0 ⋄ r←↑r ⋄ :EndIf
    ∇

    ∇ r←{level}TreeNames ns;n;t;nms;l
 ⍝ Return namelist of APL namespace representation of JSON array
 ⍝ ns - reference to namespace created by JSON.toAPL
      :Access public shared
      r←''
      :If 0=⎕NC'level' ⋄ level←'' ⋄ :EndIf
      :If 2<≡nms←ns.⎕NL-2 9 ⋄ nms←⊃,/nms ⋄ :EndIf
      :For n :In nms
          l←level,(0∊⍴level)↓'.',n
          t←ns⍎n
          :Select ⊃ns.⎕NC n
          :Case 2
              :If 326=⎕DR t
                  r,←l TreeNames⊃t
              :Else
                  r,←⊂l
              :EndIf
          :Case 9
              r,←l TreeNames⊃t
          :EndSelect
      :EndFor
    ∇
    :endsection

    :section test

    ∇ testAPL;apl;ns;ns2;js;t;bad;rl
      :Access public shared
      {}÷js≡fromAPL toAPL js←'[]'
      {}÷js≡fromAPL toAPL js←'[{}]'
      {}÷js≡fromAPL toAPL js←'[[]]'
      {}÷js≡fromAPL toAPL js←'[{"":12}]'
      {}÷js≡fromAPL toAPL js←'[{"2":null}]'
      {}÷js≡fromAPL toAPL js←'[1]'
      {}÷js≡fromAPL toAPL js←'[true]'
      {}÷js≡fromAPL toAPL js←'["true"]'
      {}÷js≡fromAPL toAPL js←'[false,{}]'
      {}÷js≡fromAPL toAPL js←'null'
      {}÷js≡fromAPL toAPL js←'[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3]]'
      {}÷js≡fromAPL toAPL js←'[null,[]]'
      {}÷js≡fromAPL toAPL js←'[[["J","zz0",["C",[32767,"C3",4.288882164521665],"0","O"]]]]'
      js←'[["42",[32767],-128,["CsaD",2.849477978087825],"2N"],"Q",["$,1"],[[127],["VI6B",false,"51"],"H",'
      js,←'"FSHMNY*",[null,"C","\u00A3",true,32768,"54"],"1"],["\u00A3","BGRKW",2.1447],"3",["MGOB","O",["*C",32'
      js,←'767,"N","K",2.84925],false,[42.59174222]]]'
      {}÷js≡t←fromAPL toAPL js
      js←'[[["M",["K",2.84,"Zz"],"6"],["&ZV"],[[null,"H8",32768,"\u00A394"],["G",false],["MJ",32767,"P"],["Y"]],'
      js,←'["J"],["9B$B0"],[["N",0.046117597181290375,-128]]]]'
      {}÷js≡t←fromAPL toAPL js
      {}÷js≡t←fromAPL toAPL js←'[[],[]]'
      {}÷js≡t←fromAPL toAPL js←'["2"]'
      bad←{600:: ⋄ ÷fromAPL toAPL ⍵}
      bad¨'[{[]}]' '[][]]' '{}{}' '[][]' '[[][]]' '{"\""}'
      {}÷js≡fromAPL toAPL js←'{}'
      {}÷js≡fromAPL toAPL js←'{";":[]}'
      {}÷js≡fromAPL toAPL js←'{"\"":21}'
      {}÷'{z1:"dsa"}'≡t←fromAPL toAPL js←'{"z1":"dsa"}'
      {}÷js≡t←1 fromAPL toAPL js←'{"z1":"dsa"}'
     ⍝ There are no "scalar strings", scalars chars MUST be ravelled
      {}÷apl≡0 toAPL 0 fromAPL apl←,⍳2 3
      {}÷apl≡t←0 toAPL 0 fromAPL apl←(54,⊂,'s')(⎕D'zzzz' 567)('asd'('zz'(⍳8)))
      {}÷apl≡t←1 toAPL 0 1 fromAPL apl←'asd' '',⊂2 1 1⍴99,⊂2 3⍴⎕NULL,(⊂,'s'),2 'asd'(⍪90)(1 2 3)
      {}÷apl≡t←1 toAPL 0 1 fromAPL apl←2 13⍴⎕NULL,(⊂,'s'),⍳8
      ns←⎕NS'' ⋄ ns.(a b c)←apl←2 'dsadsa'(0 23⍴5)
      ns2←1 toAPL 0 1 fromAPL ns
      {}÷9=⎕NC'ns2' ⋄ {}÷(⍪'abc')≡ns2.⎕NL 2 ⋄ {}÷apl≡ns2.(a b c)
      {}÷(↓apl)≡0 toAPL 0 fromAPL apl←⍳2 3
      :For t :In ⍳210
          rl←⎕RL ⋄ js←fromAPL ns←makeDict 3 ¯9 2 1
          {}÷js≡t←fromAPL toAPL js
      :EndFor
    ∇

    ∇ testXML;apl;js;q;noQ;chk
      :Access public shared
      noQ←{⍺:⍵ ⋄ '([{,])"(.*?)":'⎕R'\1\2:'⊢⍵}
      chk←{x←÷(q noQ ⍵)≡q fromXML toXML ⍵}
      :For q :In 0 1
          q chk apl←fromAPL 2 13⍴⎕NULL,'s',⍳8
          q chk apl←fromAPL apl(⍳3 4)
          q chk apl←fromAPL 2 2 2 2 2 3 3⍴⎕AV,⎕UCS⍳32
          q chk apl←fromAPL''
          q chk apl←fromAPL'''asd' '',⊂2 1 1⍴99,⊂2 3⍴⎕NULL,(⊂,'s'),2 'asd'(⍪90)(1 2 3)
          q chk js←'{"z1":"dsa"}'
          {}÷js≡q fromXML toXML js←'{"\"":21}'
          q chk js←'{"z1":"dsa","cxz":[1,2,[33,44]]}'
          q chk js←'{"z1":{"a":"bcder"}}'
      :EndFor
    ∇

    ∇ testjQuery;disp
      :Access public shared
      disp←{⍵⊣⍞←⍕⍵}
      {''}disp toJQueryParameters disp'hello' 'world'
      {''}disp toJQueryParameters disp'h' 'world'
      {''}disp toJQueryParameters disp('hello'('world' 12))
      {''}disp toJQueryParameters disp('h'(12 13 14))
      {''}disp toJQueryParameters disp(('h'(12 13 14))('b'(('cc'(13 'brian'))('cd' 23))))

    ∇

    ⎕RL←(2*30)|×/{⍵+0=2|⍵}⎕AI

    ∇ ns←makeDict arg;depth;Nentries;i;name;value;⎕IO;VC;nvc
     ⍝ Create a dictionnary. This is a list of name/value pairs encapsulated in a namespace.
     ⍝ The argument specifies the depth of the dictionnary, the number (<0→max) of entries
     ⍝ and other parameters in the make up of objects themselves.
     ⍝ Ex: makeDict 3 ¯9 2 1 will create a dictionnary 3 levels deep of max 9 names each depth 2 of vectors
      ns←⎕NS⍴⎕IO←0 ⋄ nvc←⍴VC←⎕AV~⎕UCS 0 8 9 10 13 4
      Nentries←{⍵≥0:⍵ ⋄ (×⍺)⌈?1+|⍵}/(depth Nentries)←2↑arg←arg,(⍴,arg)↓1 ¯10
      :For i :In ?⍨Nentries
          :While ('.'∊name)∨0≠ns.⎕NC name←makeName VC[?nvc⍴⍨{⍺⌊?3+⍵}⍣4⍨30] ⋄ :EndWhile
          :If (depth>1)∧(i=1)∨1=?2 ⍝ recurse dictionnaries?
              value←makeDict arg-(⍴arg)↑1
          :Else
              value←⍬ makeUpSomething⍨2↓arg
          :EndIf
          name ns.{⍎⍺,'←⍵'}value
      :EndFor
    ∇

      makeUpSomething←{ ⍝ build a structure at random from the argument
          ⎕IO←0         ⍝ ⍺ is depth, ⍴⍴, ⍴/axis, types to use (<0 means random)
         ⍝ Each leaf will be of one type, or mixed if ⍵ is ⍬
         ⍝ A depth ≤1 can generate strings
         ⍝ If ⍴⍴ or ⍴ are <0 then they constitude a maximum
          ne←¯8 ⋄ rk←-?16 ⋄ la←1 rk ne 31 0 ⋄ ⍺←la
          rk←noscalar⌈{⍵≥0:⍵ ⋄ ?1+|⍵}1⊃(de rk ne type noscalar)←la←⍺,(⍴,⍺)↓la
          type←⌽2 2 2 2 2 2 2⊤type ⍝ boolean, int, float, char, nulls, complex, DECF
          n←×/sh←ne genShape rk
          ne=0:sh⍴0
          data←,{~0∊⍴⍵:⍵ ⋄ ∊type/(false true)(127 ¯128 32767 ¯32769)R(⎕D,⎕A,'%&*£$')⎕NULL(+⌿1 ¯3.7J1.1∘.×R)({⎕FR←645 ⋄ ⍟|○⍵}R←¯6.04E¯23 5.5 ¯23.2(*1)(-÷3)1000000000000000000)}⍵
          de≤1:sh{⍺≢⍬:⍵ ⋄ ,⍣(isChar ⍵)+⍵}v←data[?sh⍴⍴data]
          v←sh⍴(?n)⌽n↑1  ⍝ at least one element must NOT be a simple scalar
          ∇{⍵ ⍺⍺ data}¨(4↑la-1↑⍨⍴la)∘,¨v

      }

      genShape←{⎕IO←0 ⋄ ⍺>0:⍵⍴⍺ ⍝ exact shape
          1⌈?⍵⍴|⍺               ⍝ generate a shape of rank ⍵
      }

    :endsection tests

:Endclass ⍝ JSONdb  $Revision: 22317 $

:class JSON

⍝ Converts JSON (as a character vector) to and from XML and APL.
⍝ The APL format may also save shape information.
⍝ It also includes namespaces but the namespace representation may lose data
⍝ when an object name contains characters that are not valid in APL names.
⍝ Both the APL and XML forms are 100% lossless otherwise.
⍝ This means that:
⍝    json ≡ fromAPL toAPL json   and   json ≡ fromXML toXML json

    ⎕IO←⎕ML←1 ⋄ ⎕pp←34                      ⍝ Version 2.00

    toNum←{(v n)←⎕VFI fixNum ⍵ ⋄ (v≡,1):⊃n ⋄ ⍬}
    deQuote←{'\\"'⎕R'"'⊢'\\\\'⎕R'\\'⊢'""'strip ⍵}
    isRef←{(0=≡⍵)∧326=⎕DR ⍵}
    if←/⍨
    trim←⌽∘{(+/∧\' '=⍵)↓⍵}⍣2
    us←{≠\⍵≠⍺\t≠¯1↓0,t←⍺/≠\¯1↓0,⍵} ⍝ partitioned ≠\
    isChar←{0 2∊⍨10|⎕dr ⍵}
    isSingle←{(1=≢,⍵)∧2>≡⍵}
    isSimple←{(0∊⍴⍴⍵)∧0=≡⍵}
    isJSON←{0::0 ⋄ ~0∊⍴ toXML ⍵}
    fixNum←{b←'-'=V←⍵ ⋄ (b/V)←'¯' ⋄ ∧/b←'+'≠V:V ⋄ (b≥¯1⌽v∊'eE')/V}
    fmtNum←{(2|⎕dr ⍵)⍲∨/b←'¯'=r←⍕⍵:r ⋄ (b/r)←'-' ⋄ r}
    strip←{⍺←'{}' ⋄ ∧/⍺=(1↑⍵),¯1↑⍵:1↓¯1↓⍵ ⋄ ⍵}
    validName←{('.'∊⍵)<0≤⎕NC ⍵}
    beginsWith←{⍵≡(⍴⍵)↑⍺}
    :field public shared true←{⍵⊣⍵.⎕DF'true'}⎕NS ''
    :field public shared false←{⍵⊣⍵.⎕DF'false'}⎕NS ''

    :section fromAPL

    ∇ r←{options}fromAPL array;typ;ic;drop;ns;preserve;quote;qp;jqopt;t
    ⍝ An APL object is either a simple scalar (number, character or ref) or an array
    ⍝ represented by a list of [rank,shape, if we preserve it, then data]
      :Access public shared
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf
      qp←(quote preserve jqopt)←3↑options  ⍝ do we quote the names and preserve APL shape?
      :If isSimple array
          r←fmtNum array ⋄ →0 if 2|typ←⎕DR array ⍝ numbers
          :If ⎕NULL≡array
              r←'null'
          :ElseIf typ=326 ⍝ ref (ns)
              'Cannot work on JSON itself'⎕SIGNAL 611 if ⎕THIS≡array
              r←qp APLObject array
          :ElseIf jqopt
              t←array~' '
              :If 'function'≡8↑t ⋄ r←array
              :ElseIf '⍎'=1↑t ⋄ r←(∨\~array∊' ⍎')/array ⋄
              :ElseIf '⍕'=1↑t ⋄ r←1⌽'""',(~<\' '=array)/array ⋄ :EndIf
          :Else
              r←1⌽'""',JAchars array
          :EndIf
      :Else ⍝ is not simple (array)
          drop←preserve<ic←isChar array
          r←drop↓'[',preserve/',',⍨(⍕⍴⍴array),∊',',¨⍕¨⍴array
          :If 0∊⍴array
              :If ~preserve ⋄ →0⊣r←(1+ic)⊃'[]' '""' ⋄ :EndIf
              r,←qp fromAPL⊃array ⍝ prototype
          :ElseIf ic
              :If jqopt
              :AndIf ∨/(array~' ')∘beginsWith¨'function' 'ej.' '$('(,'⍎') ⍝!!! for jQuery (and Syncfusion) options, treat things beginning with function or ej. as literals
                  r←('⍎'=1↑array)↓array
              :Else
                  r,←1⌽'""',JAchars,array ⍝ strings are displayed as such
              :EndIf
          :Else
              ns←⍬⍴(~preserve)×0⌈¯1+⍴⍴array
              r,←1↓∊',',¨qp∘fromAPL¨,↓⍣ns⊢array
          :EndIf
          r,←drop↓']'
      :EndIf
    ∇

    ∇ js←{trUni}JAchars apl;fnrbt;str;b;ucs;⎕IO
      :Access public shared
     ⍝ Get JSON characters from an APL string
      :If 0<⍴js←str←,apl
          :If 1∊b←str∊fnrbt←'"\/',⎕UCS 12 10 13 8 9
              (b/str)←'\"' '\\' '\/' '\f' '\n' '\r' '\b' '\t'[fnrbt⍳b/str]
          :EndIf
          :If 1∊b←128<ucs←⎕UCS apl
          :AndIf {6::⍵ ⋄ trUni}1
              ⎕IO←0 ⋄ (b/str)←'\u'∘,¨⊂[0](⎕D,⎕A)[(4⍴16)⊤b/ucs]
          :EndIf
          js←∊str
      :EndIf
    ∇

    ∇ j←ns APLfn name;rep
     ⍝ Create a JSON string from an APL fn
      'Invalid fn name'⎕SIGNAL 611 if~(ns.⎕NC name)∊3 4
      rep←fromAPL ns.⎕NR name   ⍝ the code
      j←'"\u2207',name,'":',rep ⍝ its ∇name
    ∇

    ∇ r←options APLObject NS;n;name;quote;preserve
     ⍝ Create a name-value pair JSON string from a namespace
      (quote preserve)←2↑options
      r←,'{'
      :For n :In n←NS.⎕NL-2 9.1
          r,←(quote makeString n),':'    ⍝ the name
          r,←(options fromAPL NS⍎n),','  ⍝ the value
      :EndFor
      :If (0∊⍴n)∧(⊂name←⍕NS)∊'true' 'false' ⋄ →0⊣r←name
      :Else
          :For n :In NS.⎕NL-preserve/3
              r,←(NS APLfn n),','
          :EndFor
      :EndIf
      r←'}',⍨(-1<⍴r)↓r
    ∇

    ∇ r←q makeString name;Q
    ⍝ Find the real string associated with an APL variable name
      :If q∨←'⍙'∊1↑r←name
          r←⎕UCS⊃⌽⎕VFI{b\⍵/⍨b←~⍵∊'⍙_'}name
         ⍝ Special characters " and \ must be taken into account
          ((r∊'"\')/r),⍨←'\'
      :EndIf
      r←Q,(∊r),Q←q/'"'
    ∇

    ∇ r←name Name data
      :Access public shared
      r←name{r←⎕NS'' ⋄ r⊣r⍎⍺,'←⍵'}data
    ∇

⍝   ---------------------------------------------------------------------
    :endsection fromAPL

    :section toAPL

    ∇ obj←{options}toAPL str;c1;b
     ⍝ This fn takes a JSON string and turns it into an APL object
     ⍝ The string must follow specific rules in order to be accepted
      :Access public shared
      str←,str
      ⎕SIGNAL(⊂('EN' 11)('Message' 'Argument is not a simple character vector'))if~isChar str
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf       ⍝ do we preserve APL shape?
      :If '{'=c1←1↑str←trim str~⎕UCS 8 9 10 13 ⍝ is this a ns?
          ⎕SIGNAL(⊂('EN' 2)('Message' 'Invalid JSON - expected }'))if'}'≠¯1↑str
          obj←options parseNS strip str
      :ElseIf '['=c1                           ⍝ an array maybe?
          ⎕SIGNAL(⊂('EN' 2)('Message' 'Invalid JSON - expected ]'))if']'≠¯1↑str
          obj←,⍣(~options)⊢options parseAPLArray 1↓¯1↓str
      :ElseIf '"'=c1
          obj←AJchars 1↓¯1↓str                 ⍝ a string?
      :ElseIf (,1)≡⎕IO⊃b←⎕VFI fixNum str       ⍝ a single number
          obj←⊃⊃⌽b
      :ElseIf 'null'≡str ⋄ obj←⎕NULL
      :ElseIf 'true'≡str ⋄ obj←true
      :ElseIf 'false'≡str ⋄ obj←false
      :Else ⋄ obj←⎕NS'' ⋄ obj.⎕DF str          ⍝ true/false
      :EndIf
    ∇

    ∇ str←AJchars str;sl;msk;bfnrt;u;b;x;⎕IO;Hex;i
     ⍝ Get APL chars from a JSON string
      →0↓⍨⍴,str ⋄ ⎕IO←0
      :If ∨/sl←(¯1⌽msk←isBslash str)∧str∊bfnrt←'bfnrtu'
          b←sl\~u←'u'=sl/str
          (b/str)←⎕UCS 8 12 10 13 9[bfnrt⍳b/str]
          :If ∨/b←sl\u ⍝ any \Uxxxx number?
              Hex←⎕D,'abcdef',⎕D,'ABCDEF'
              x←16⊥⍉16|Hex⍳str[i←(b/⍳⍴b)∘.+1+⍳4]
              (b/str)←⎕UCS x
              msk[i]←1 ⍝ mask out these positions
          :EndIf
      :EndIf
      str←,⊃,/(~msk)/str
    ∇

    ∇ ns←preserve parseNS s;txt;level;split;n;names;val;msg
     ⍝ Surrounding '{}'s not present here
     ⍝ Elements are separated by ','
      ns←#.⎕NS'' ⋄ →0↓⍨⍴txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      n←+/split←1,(s∊',:')∧txt<level=0
      msg←'Invalid JSON: ',(1+2|n)⊃'unbalanced braces or brackets' 'bad format'
      msg ⎕SIGNAL 600 if(2|n)∨0≠¯1↑level
      (names val)←↓⍉trim¨(n÷2)2⍴1↓¨split⊂';',s
      names←{makeName deQuote ⍵}¨names
      :For n s :InEach names val
          val←preserve toAPL s
          :If '∇'≠1↑n
              ⍎'ns.',n,'←val'
          :Else ⍝ it's a fn
              {}÷((1↓n)≢ns.⎕FX val)/'Invalid fn defn'
          :EndIf
      :EndFor
    ∇

    ∇ r←makeName str
     ⍝ Make up a name for an APL variable
      :Access public shared
      →0↓⍨('⍙'∊1↑r)∨~validName r←str
      r←'⍙',∊'_',¨⍕¨⎕UCS str
    ∇

    ∇ r←parseName name
    ⍝ parses a name created by makeName
      :Access public shared
      →0↓⍨{∧/⍵∊⎕D,'⍙_'}r←name
      r←⎕UCS r{2⊃⎕VFI ⍵\⍵/⍺}r∊⎕D
    ∇
    ∇ array←preserveShape parseAPLArray str;p;rank;n;txt;level;split;shape
     ⍝ Rank and shape precede data
      shape←⍬
      :If preserveShape
          rank←toNum(¯1+p←str⍳',')↑str ⋄ str←p↓str
          :While rank>0 ⋄ shape,←toNum(¯1+p←str⍳',')↑str ⋄ str←p↓str ⋄ rank-←1 ⋄ :EndWhile
      :EndIf

     ⍝ For empty arrays we exit if we don't need to preserve the shape
      →(preserveShape∨~0∊⍴str)↓⍴array←⍬

     ⍝ There will alway be at least ONE element (the prototype) so we need to do this:
     ⍝ Elements are separated by ',' - find them
      txt←isText str
      level←(+\txt<str∊'[{')-+\txt<str∊']}'
      'Bad [{}] nesting'⎕SIGNAL 600 if level∨.<0
      split←1,(txt<str=',')∧level=0
      array←preserveShape toAPL¨1↓¨split⊂';',str
      array←(⊃⍣((∨/str∘≡¨'true' 'false')∨preserveShape∧∧/txt))array
      →preserveShape↓0
      array←shape⍴array
    ∇

    :endsection toAPL

    :section JavaScript

    ∇ r←toJQueryParameters arr;t;p;i
    ⍝ Format APL data in a manner consistent with most jQuery-style parameter
    ⍝ arr is one of:
    ⍝ - namespace reference
    ⍝ - character vector of formatted jQuery parameters
    ⍝ - nested vector of names/values
    ⍝ N.B. - be careful with scalar names and character values ('h' 'a')('b' (1 2 3)) >> {ha:{b:[1,2,3]}} because 'h' 'a' ≡ 'ha'

      :Access public shared
      :If isRef arr
          r←0 0 1 fromAPL arr
      :Else
⍝          arr←,arr
          :If isChar arr ⍝ simple charvec?
              →0⌿⍨'}{'≡2↑¯1⌽r←arr
          :AndIf isJSON r←'{',(strip arr),'}'
              →0 ⍝ treat it like a parameters vector
          :Else
              :If 1=≡arr   ⍝ only way this happens is with scalar name
                  arr←,⊂(,⊃arr)(1↓arr)
              :ElseIf (2=⍴arr)∧isChar⊃arr ⍝ id
                  arr←,⊂arr
              :EndIf
              r←'{'
              :For i :In ⍳⍴arr
                  p←i⊃arr
                  :If (isChar p)<isChar⊃p
                      r,←(1⊃p),':'
                      :Select |≡t←{(⊃⍣(1<≡⍵))⍵}1↓p
                      :CaseList 0 1
                          r,←fromAPL{(⊃⍣(isSingle ⍵))⍵}t
                      :Else
                          r,←toJQueryParameters⊃t
                      :EndSelect
                  :Else
                      r,←fromAPL p
                  :EndIf
                  r,←','
              :EndFor
              r←(¯1↓r),'}'
          :EndIf
      :EndIf
    ∇

    ∇ r←toAPLJAX nvp;verb;fmt;value;sel;x;d;strip
    ⍝ formats name/value pairs in a manner suitable for processing by the client side of APLJAX
    ⍝ essentially there are 4 verbs:
    ⍝ ('execute' javascript)
    ⍝ ('replace' selector)('data' html)
    ⍝ ('append' selector)('data' html)
    ⍝ ('prepend' selector)('data' html)
      :Access public shared
      nvp←,nvp
      :If 0∊⍴nvp ⋄ r←'[]' ⋄ :Return ⋄ :EndIf
      strip←{1↓¯1↓⍵}
      fmt←{(isChar ⍵)>(isJSON ⍵)∨t←'⍎'=1↑,⍵:'"',(JAchars ⍵),'"'
          ⋄ t:1↓⍕⍵
          ⋄ strip toAPLJAX ⍵}
      r←'['
      :Select |≡nvp
      :Case 1  ⍝ if depth 1, assume it's a JSON character string already
          r←⍕nvp ⋄ :Return
      :Case 2 ⍝ vector of vectors
          :While ~0∊⍴nvp
              :Select verb←⊃nvp
              :Case 'execute'
                  r,←'{"',verb,'":',(fmt⊃1↓2↑nvp),'},'
                  nvp↓⍨←2
              :CaseList 'replace' 'prepend' 'append'
                  x sel d value←4↑nvp
                  r,←'{"',verb,'":"',sel,'","',d,'":',(fmt value),'},'
                  nvp↓⍨←4
              :Else
              :EndSelect
          :EndWhile
      :Case 3  ⍝ could be (('execute' 'foo')('execute' 'goo')) OR (('replace' 'sel')('data' 'foo'))
          :Select verb←⊃⊃nvp
          :Case 'execute'
              r,←∊',',⍨¨strip¨toAPLJAX¨nvp
          :Else
              (x sel)(d value)←nvp
              r,←'{"',verb,'":"',sel,'","',d,'":',(fmt value),'},'
          :EndSelect
      :Case 4
          r,←∊',',⍨¨strip¨toAPLJAX¨nvp
      :EndSelect
⍝
⍝      :For p :In ,nvp
⍝          :Select |≡p
⍝          :Case 0
⍝              r,←(⍕p),']'
⍝          :Case 1
⍝              r,←(fromAPL p),']'
⍝          :Case 2
⍝              :If 2=⍴,p
⍝                  d←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ strip fromNVP ⍵}2⊃p
⍝                  r,←'{"',(1⊃p),'":',d,'},'
⍝              :Else
⍝                  r,←(fromAPL⊃p),']'
⍝              :EndIf
⍝          :Case 3
⍝              r,←'{'
⍝              :If (1=≡⊃p)∧2=⍴,p
⍝                  :If isChar⊃p
⍝                      r,←'"',(⊃p),'":',(strip toAPLJAX 2⊃p),','
⍝                  :Else
⍝                      r←fromAPL p
⍝                  :EndIf
⍝              :Else
⍝                  :For x :In p
⍝                      d←{1<⍴⍴⍵:∊(↓⍕⍵),¨⊂'<br/>' ⋄ ⍵}2⊃x
⍝                      d←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ ⍕⍵}d
⍝                      r,←'"',(1⊃x),'":',d,','
⍝                  :EndFor
⍝              :EndIf
⍝              r←(¯1↓r),'},'
⍝          :EndSelect
⍝      :EndFor
      r←(¯1↓r),']'
    ∇

    ∇ r←a formatData w
      :Access public shared
      r←a{0∊⍴z←⎕NS¨(⊃⍴⍵)⍴⊂'':z
          z⊣z(⍺{⍺.⍎'(',(⍕⍺⍺),')←⍵'})¨(↓⍣(2=⍬⍴⍴⍴⍵))⍵}w
    ∇

    ∇ r←aa Add(a w)
      :Access public shared
      r←a(aa{'{}'≡(1↑⍺⍺),¯1↑⍺⍺:(¯1↓⍺⍺),',',⍺,':',⍵,'}' ⋄ ⍺⍺,',',⍺,':',⍵})w
    ∇

    :EndSection

    :Section XML                                                 ⍝ DanB 2011/12

    ∇ xml←{name}toXML str;c1;end;b;tag;beg;item
     ⍝ Parse JSON string into XML
      :Access public shared
      :If 0=⎕NC'name' ⋄ name←'json' ⋄ :EndIf
      tag←''≢name
     ⍝ An empty name is an indication that we want the Value only w/o a complete Tag
      end←tag/'</',name,'>' ⋄ beg←tag/'<',name ⋄ item←tag/'<item'
      :If '{'=c1←1↑str←trim str~⎕UCS 8 9 10 13
          'Invalid JSON: expected }'⎕SIGNAL 600 if'}'≠¯1↑str
          xml←beg,' type="object">',(parseObj strip str),end
      :ElseIf '['=c1
          'Invalid JSON: expected ]'⎕SIGNAL 600 if']'≠¯1↑str
          xml←beg,' type="array">',(parseArr'[]'strip str),end
      :ElseIf '"'=c1
          xml←item,'>',(XJchars'""'strip str),tag/'</item>' ⍝ we could add  type="string"
      :ElseIf ∨/b←'null' 'true' 'false'∊⊂str
          xml←item,' type="',((b⍳1)⊃1 2/'null' 'boolean'),'">',(~1↑b)/str
          xml←xml,(tag/'</item>')
      :ElseIf (,1)≡⎕IO⊃b←⎕VFI fixNum str ⍝ allow nn+Emm
          xml←item,' type="number">',str ⍝ we could also use '17⍕b'
          xml←xml,(tag/'</item>')
      :Else
          'INVALID JSON'⎕SIGNAL 11
      :EndIf
    ∇

    ∇ str←{options}fromXML xml;head;Q;b;ot;n;type
     ⍝ Parse XML statement into JSON
      :Access public shared
      :If 0=⎕NC'options' ⋄ options←0 ⋄ :EndIf     ⍝ do we quote names?
      n←⍴head←xml↑⍨'>'⍳⍨xml←trim xml
      xml←{'>'≠¯1↑⍵:⍵ ⋄ ⍵↓⍨-'<'⍳⍨⌽⍵}n↓xml
      :If 'array'≡type←5↑(head⍳'"')↓head
          →0↓⍨⍴xml{⍺}str←'[]'
          str←'[',(1↓∊',',¨options∘fromXML¨cutItems xml),']'
      :ElseIf 'objec'≡type
          →0↓⍨⍴xml{⍺}str←'{}'
          str←'{',(1↓∊',',¨options∘getObject¨cutObjects xml),'}'
      :Else ⍝ may be boolean or null if empty
          :If ~'='∊head ⋄ str←Q,(JXchars xml),Q←'"'
          :ElseIf 0∊⍴xml ⋄ str←'null'
          :Else ⋄ str←xml ⍝ boolean?
          :EndIf
      :EndIf
    ∇

    ∇ str←XJchars str;set;sl;msk;bfnrt;u;b;x;⎕IO;Hex;i
     ⍝ Get XML from a JSON string
      →0↓⍨⍴,str ⋄ ⎕IO←0
      sl←(¯1⌽msk←isBslash str)∧str∊bfnrt←'bfnrtu'
      :If ∨/b←str∊set←'<>&"' ⍝ we could also change other specific chars here
          (b/str)←'<' '>' '&' '"'[set⍳b/str]
      :EndIf
      :If ∨/sl
          b←sl\~u←'u'=sl/str
          (b/str)←⎕UCS 8 12 10 13 9[bfnrt⍳b/str]
          :If ∨/b←sl\u ⍝ any \Uxxxx number?
              Hex←⎕D,'abcdef',⎕D,'ABCDEF'
              x←16⊥⍉16|Hex⍳str[i←(b/⍳⍴b)∘.+1+⍳4]
              (b/str)←⎕UCS x
              msk[i]←1 ⍝ mask out these positions
          :EndIf
      :EndIf
      str←⊃,/(~msk)/str
    ∇

    ∇ str←JXchars str;char;b;msk;i;rep;seq;fnrbt
     ⍝ Get JSON from an XML &..; sequences
      msk←1 ⋄ seq←';&#x'∘,¨'CAD89cad' ⋄ fnrbt←⎕UCS 12 10 13 8 9
      :For char rep :InEach ('<' '>' '"' '&',seq)('<>"&',8⍴fnrbt)
          i←b/⍳⍴b←char⍷str
          msk>←≠\(¯1⌽b)∨(-⍴b)↑(-⍴char)↓b
          str[i]←rep
      :EndFor
      str←msk/str
      str←JAchars str
    ∇

    ∇ slash←isBslash txt;t
     ⍝ Find where real backslashes are
      slash←'\'=txt           ⍝ need to check for multiple \
      t←slash>¯1↓0,slash      ⍝ start of each group of \
      slash←slash∧t us slash  ⍝ where the real \ are
    ∇

    ∇ mask←isText json;t;slash;quote
      quote←'"'=json          ⍝ find double quotes (they delimit strings)
      slash←isBslash json
      quote←quote>¯1↓0,slash  ⍝ where the real " are
      mask←quote∨≠\quote
    ∇

    ∇ list←parseArr s;txt;level;split
     ⍝ Surrounding '[]'s not present here
     ⍝ Elements are separated by ','
      →(s∧.=' ')⍴⍴list←''
     ⍝ Find the separating commas
      txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      split←1,(s=',')∧txt<level=0
      list←∊'item'∘toXML¨1↓¨split⊂';',s
    ∇

    ∇ obj←parseObj s;txt;level;split;n;pairs;x
     ⍝ Surrounding '{}'s not present here
     ⍝ Elements are separated by ','
      →(s∧.=' ')⍴⍴obj←''
     ⍝ Find the separating commas
      txt←isText s
      level←(+\txt<s∊'[{')-+\txt<s∊']}'
      n←+/split←1,(s∊',:')∧txt<level=0
      'Invalid JSON: unbalanced braces or brackets'⎕SIGNAL 600 if(2|n)∨0≠¯1↑level
      x←0,{0}¨pairs←trim¨(n÷2)2⍴1↓¨split⊂';',s
      x[;1]←n←{validName⊢n←deQuote ⍵:'<',n ⋄ 1⌽'"<SN name="',XJchars n}¨pairs[;1]
      x[;3]←{1⌽'></',1↓(¯1+⍵⍳' ')↑⍵}¨n ⍝ end tag
      x[;2]←''∘toXML¨pairs[;2]
      obj←⊃,/,x
    ∇

    ∇ vtv←cutObjects xml;b;n;ot;level
      b←'<'=xml ⋄ n←1↓0,⍨'/'=xml
      level←(+\ot←b>n)-+\b∧n
      vtv←(ot∧level=1)⊂xml
    ∇

    ∇ vtv←cutItems xml;level;start;mask
     ⍝ Cut XML into pieces based on the <item> tag
      mask←0≠level←(+\start←'<item'⍷xml)-+\'</item'⍷xml
      vtv←(mask/start∧level=1)⊂mask/xml
    ∇

    ∇ str←quote getObject xml;n;head;name;b;Q;data
     ⍝ Transform XML into JSON
      n←⍴head←xml↑⍨'>'⍳⍨xml←trim xml ⋄ data←trim{⍵↓⍨-'<'⍳⍨⌽⍵}n↓xml
      name←'<>'strip head
      :If ∨/b←'name='⍷head
          name←JXchars{⍵↑⍨¯1+⍵⍳'"'}(5+b⍳1)↓head
      :Else ⋄ b←' '=name ⍝ 2<+/name='"'
          name←(¯1+b⍳1)↑name
      :EndIf
      :If quote
      :OrIf ~validName name
          name←Q,name,Q←'"'
      :EndIf

     ⍝ If the type is boolean or number then nothing to do.
      :If ∨/b←'type='⍷head
          :Select 5↑(5+b⍳1)↓head
          :Case 'array'
              data←1⌽'][',1↓⊃,/',',¨quote∘fromXML¨cutItems xml
          :Case 'objec'
              data←1⌽'}{',1↓⊃,/',',¨quote∘getObject¨cutObjects data
        ⍝ If null then the result is 'null'
          :Case 'null"'
              data←'null'
          :EndSelect
      :Else ⍝ string
          data←Q,(JXchars data),Q←'"'
      :EndIf
      str←name,':',data
    ∇

    :endsection XML

    :section Utils

    ∇ r←{level}Tree ns;n;t;nms
 ⍝ Return indented name tree of APL namespace representation of JSON array
 ⍝ ns - reference to namespace created by JSON.toAPL
      :Access public shared
      r←''
      :If 0=⎕NC'level' ⋄ level←0 ⋄ :EndIf
      :If 2<≡nms←ns.⎕NL-2 9 ⋄ nms←⊃,/nms ⋄ :EndIf
      :For n :In nms
          r,←⊂((2×level)⍴' '),n
          t←ns⍎n
          :Select ⊃ns.⎕NC n
          :Case 2
              :If 326=⎕DR t
                  r,←(level+1)Tree⊃t
              :EndIf
          :Case 9
              r,←(level+1)Tree⊃t
          :EndSelect
      :EndFor
      :If level=0 ⋄ r←↑r ⋄ :EndIf
    ∇

    ∇ r←{level}TreeNames ns;n;t;nms;l
 ⍝ Return namelist of APL namespace representation of JSON array
 ⍝ ns - reference to namespace created by JSON.toAPL
      :Access public shared
      r←''
      :If 0=⎕NC'level' ⋄ level←'' ⋄ :EndIf
      :If 2<≡nms←ns.⎕NL-2 9 ⋄ nms←⊃,/nms ⋄ :EndIf
      :For n :In nms
          l←level,(0∊⍴level)↓'.',n
          t←ns⍎n
          :Select ⊃ns.⎕NC n
          :Case 2
              :If 326=⎕DR t
                  r,←l TreeNames⊃t
              :Else
                  r,←⊂l
              :EndIf
          :Case 9
              r,←l TreeNames⊃t
          :EndSelect
      :EndFor
    ∇
    :endsection

    :section test

    ∇ testAPL;apl;ns;ns2;js;t;bad;rl
      :Access public shared
      {}÷js≡fromAPL toAPL js←'[]'
      {}÷js≡fromAPL toAPL js←'[{}]'
      {}÷js≡fromAPL toAPL js←'[[]]'
      {}÷js≡fromAPL toAPL js←'[{"":12}]'
      {}÷js≡fromAPL toAPL js←'[{"2":null}]'
      {}÷js≡fromAPL toAPL js←'[1]'
      {}÷js≡fromAPL toAPL js←'[true]'
      {}÷js≡fromAPL toAPL js←'["true"]'
      {}÷js≡fromAPL toAPL js←'[false,{}]'
      {}÷js≡fromAPL toAPL js←'null'
      {}÷js≡fromAPL toAPL js←'[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3]]'
      {}÷js≡fromAPL toAPL js←'[null,[]]'
      {}÷js≡fromAPL toAPL js←'[[["J","zz0",["C",[32767,"C3",4.288882164521665],"0","O"]]]]'
      js←'[["42",[32767],-128,["CsaD",2.849477978087825],"2N"],"Q",["$,1"],[[127],["VI6B",false,"51"],"H",'
      js,←'"FSHMNY*",[null,"C","\u00A3",true,32768,"54"],"1"],["\u00A3","BGRKW",2.1447],"3",["MGOB","O",["*C",32'
      js,←'767,"N","K",2.84925],false,[42.59174222]]]'
      {}÷js≡t←fromAPL toAPL js
      js←'[[["M",["K",2.84,"Zz"],"6"],["&ZV"],[[null,"H8",32768,"\u00A394"],["G",false],["MJ",32767,"P"],["Y"]],'
      js,←'["J"],["9B$B0"],[["N",0.046117597181290375,-128]]]]'
      {}÷js≡t←fromAPL toAPL js
      {}÷js≡t←fromAPL toAPL js←'[[],[]]'
      {}÷js≡t←fromAPL toAPL js←'["2"]'
      bad←{600:: ⋄ ÷fromAPL toAPL ⍵}
      bad¨'[{[]}]' '[][]]' '{}{}' '[][]' '[[][]]' '{"\""}'
      {}÷js≡fromAPL toAPL js←'{}'
      {}÷js≡fromAPL toAPL js←'{";":[]}'
      {}÷js≡fromAPL toAPL js←'{"\"":21}'
      {}÷'{z1:"dsa"}'≡t←fromAPL toAPL js←'{"z1":"dsa"}'
      {}÷js≡t←1 fromAPL toAPL js←'{"z1":"dsa"}'
     ⍝ There are no "scalar strings", scalars chars MUST be ravelled
      {}÷apl≡0 toAPL 0 fromAPL apl←,⍳2 3
      {}÷apl≡t←0 toAPL 0 fromAPL apl←(54,⊂,'s')(⎕D'zzzz' 567)('asd'('zz'(⍳8)))
      {}÷apl≡t←1 toAPL 0 1 fromAPL apl←'asd' '',⊂2 1 1⍴99,⊂2 3⍴⎕NULL,(⊂,'s'),2 'asd'(⍪90)(1 2 3)
      {}÷apl≡t←1 toAPL 0 1 fromAPL apl←2 13⍴⎕NULL,(⊂,'s'),⍳8
      ns←⎕NS'' ⋄ ns.(a b c)←apl←2 'dsadsa'(0 23⍴5)
      ns2←1 toAPL 0 1 fromAPL ns
      {}÷9=⎕NC'ns2' ⋄ {}÷(⍪'abc')≡ns2.⎕NL 2 ⋄ {}÷apl≡ns2.(a b c)
      {}÷(↓apl)≡0 toAPL 0 fromAPL apl←⍳2 3
      :For t :In ⍳210
          rl←⎕RL ⋄ js←fromAPL ns←makeDict 3 ¯9 2 1
          {}÷js≡t←fromAPL toAPL js
      :EndFor
    ∇

    ∇ testXML;apl;js;q;noQ;chk
      :Access public shared
      noQ←{⍺:⍵ ⋄ '([{,])"(.*?)":'⎕R'\1\2:'⊢⍵}
      chk←{x←÷(q noQ ⍵)≡q fromXML toXML ⍵}
      :For q :In 0 1
          q chk apl←fromAPL 2 13⍴⎕NULL,'s',⍳8
          q chk apl←fromAPL apl(⍳3 4)
          q chk apl←fromAPL 2 2 2 2 2 3 3⍴⎕AV,⎕UCS⍳32
          q chk apl←fromAPL''
          q chk apl←fromAPL'''asd' '',⊂2 1 1⍴99,⊂2 3⍴⎕NULL,(⊂,'s'),2 'asd'(⍪90)(1 2 3)
          q chk js←'{"z1":"dsa"}'
          {}÷js≡q fromXML toXML js←'{"\"":21}'
          q chk js←'{"z1":"dsa","cxz":[1,2,[33,44]]}'
          q chk js←'{"z1":{"a":"bcder"}}'
      :EndFor
    ∇

    ∇ testjQuery;disp
      :Access public shared
      disp←{⍵⊣⍞←⍕⍵}
      {''}disp toJQueryParameters disp'hello' 'world'
      {''}disp toJQueryParameters disp'h' 'world'
      {''}disp toJQueryParameters disp('hello'('world' 12))
      {''}disp toJQueryParameters disp('h'(12 13 14))
      {''}disp toJQueryParameters disp(('h'(12 13 14))('b'(('cc'(13 'brian'))('cd' 23))))

    ∇

    ⎕RL←(2*30)|×/{⍵+0=2|⍵}⎕AI

    ∇ ns←makeDict arg;depth;Nentries;i;name;value;⎕IO;VC;nvc
     ⍝ Create a dictionnary. This is a list of name/value pairs encapsulated in a namespace.
     ⍝ The argument specifies the depth of the dictionnary, the number (<0→max) of entries
     ⍝ and other parameters in the make up of objects themselves.
     ⍝ Ex: makeDict 3 ¯9 2 1 will create a dictionnary 3 levels deep of max 9 names each depth 2 of vectors
      ns←⎕NS⍴⎕IO←0 ⋄ nvc←⍴VC←⎕AV~⎕UCS 0 8 9 10 13 4
      Nentries←{⍵≥0:⍵ ⋄ (×⍺)⌈?1+|⍵}/(depth Nentries)←2↑arg←arg,(⍴,arg)↓1 ¯10
      :For i :In ?⍨Nentries
          :While ('.'∊name)∨0≠ns.⎕NC name←makeName VC[?nvc⍴⍨{⍺⌊?3+⍵}⍣4⍨30] ⋄ :EndWhile
          :If (depth>1)∧(i=1)∨1=?2 ⍝ recurse dictionnaries?
              value←makeDict arg-(⍴arg)↑1
          :Else
              value←⍬ makeUpSomething⍨2↓arg
          :EndIf
          name ns.{⍎⍺,'←⍵'}value
      :EndFor
    ∇

      makeUpSomething←{ ⍝ build a structure at random from the argument
          ⎕IO←0         ⍝ ⍺ is depth, ⍴⍴, ⍴/axis, types to use (<0 means random)
         ⍝ Each leaf will be of one type, or mixed if ⍵ is ⍬
         ⍝ A depth ≤1 can generate strings
         ⍝ If ⍴⍴ or ⍴ are <0 then they constitude a maximum
          ne←¯8 ⋄ rk←-?16 ⋄ la←1 rk ne 31 0 ⋄ ⍺←la
          rk←noscalar⌈{⍵≥0:⍵ ⋄ ?1+|⍵}1⊃(de rk ne type noscalar)←la←⍺,(⍴,⍺)↓la
          type←⌽2 2 2 2 2 2 2⊤type ⍝ boolean, int, float, char, nulls, complex, DECF
          n←×/sh←ne genShape rk
          ne=0:sh⍴0
          data←,{~0∊⍴⍵:⍵ ⋄ ∊type/(false true)(127 ¯128 32767 ¯32769)R(⎕D,⎕A,'%&*£$')⎕NULL(+⌿1 ¯3.7J1.1∘.×R)({⎕FR←645 ⋄ ⍟|○⍵}R←¯6.04E¯23 5.5 ¯23.2(*1)(-÷3)1000000000000000000)}⍵
          de≤1:sh{⍺≢⍬:⍵ ⋄ ,⍣(isChar ⍵)+⍵}v←data[?sh⍴⍴data]
          v←sh⍴(?n)⌽n↑1  ⍝ at least one element must NOT be a simple scalar
          ∇{⍵ ⍺⍺ data}¨(4↑la-1↑⍨⍴la)∘,¨v

      }

      genShape←{⎕IO←0 ⋄ ⍺>0:⍵⍴⍺ ⍝ exact shape
          1⌈?⍵⍴|⍺               ⍝ generate a shape of rank ⍵
      }

    :endsection tests

:Endclass ⍝ JSONdb  $Revision: 22317 $


Positioning visual tutorial

Positioning visual tutorial

:Namespace MS3SiteUtils ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝
⍝ ┌─────────────────────────────────────────────────────────────────────────────────────────────┐ ⍝
⍝ │ This is the collection of utility functions used by MS3Server and the index page of the     │ ⍝
⍝ │ MiServer Sample Site, MS3, accessible at miserver.dyalog.com                                │ ⍝
⍝ ├─────────────────────────────────────────────────────────────────────────────────────────────┤ ⍝
⍝ │ The code is split up in six sections:                                                       │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ A_GENERAL has utilities that appropriate to APL or MiServer in general                │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ B_FILES has various tools to list, read, and cache files and their content            │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ C_STRINGS string and multi-string manipulation and extraction of information          │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ D_ELEMENTS aids to create elements for the HTML Document Object Model                 │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ E_TUTORIAL has subroutines for the Tutorial tab on the index page                     │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ F_CONSTANTS niladic functions that return unchanging values and cache                 │ ⍝
⍝ │                                                                                │ ⍝
⍝ └─────────────────────────────────────────────────────────────────────────────────────────────┘ ⍝
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION A_GENERAL ⍝ UTILITY FUNCTIONS THAT ARE NOT SPECIFIC TO THE "MS3" SITE

    ç←{⊂⍣(1=≡,⍵)⊢⍵} ⍝ enclose if simple     Mnemonic for the V16 glyph

    FwSl←'[\\/]+'⎕R'/' ⍝ Make all slash-block into single forward-slashes

    Q←'"'∘,,∘'"' ⍝ Surround with quotes

    FromCSV←↑{'"'~¨⍨1↓¨t⊂⍨(','=t)∧~≠\'"'=t←',',⍵}¨ ⍝ Convert CSV VTV to matrix (no escaped chars)

      Section←{ ⍝ Extract section ⍺:: from code ⍵
          regex←'^\s*⍝\s*',⍺,':(:.*?)$((\R^⍝(?!\s*\w+::).*?$)*)' ⍝ find '  ⍝  LeftArg:: some text'
          opts←('Mode' 'M')('DotAll' 1)('ML' 1)                  ⍝ '^'≡linestart  EOL∊'.'  1st-only
          res←regex ⎕S'\1\2'⍠opts⊢⍵                              ⍝ return parts 1 and 2
          #.Strings.deb'⍝'~⍨1↓⊃res                               ⍝ strip spaces and lamp
      }

      Controls←{ ⍝ Extract names of controls used in sample ⍵
          (Words'Control'Section Read ⍵)~'_',¨NSS
      }

    Of←{⍵/⍨⍺⍺¨⍵} ⍝ Those elements of ⍵ that satisfy ⍺⍺ element

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION B_FILES ⍝ FUNCTIONS THAT READ FILES

    Score←{(102-2×(50↑⊃⌽⍵)⍳⊂⍺)-∨/'Advanced'⍷⊃⍵} ⍝ Relevance score on index of control in list

      List←{ ⍝ Files in site folder
          ⍺←1↓FILEEXT                                      ⍝ default .ext
          mods←' -rec -raw -full=2 -ext=',⍺                ⍝ subdirs no-format rooted spec-ext
          list←(⎕SE.SALT.List #.Boot.AppRoot,⍵,mods)[;1 2] ⍝ begin at application root (MS3/)
          f←~d←list[;1]≡¨⊂'<DIR>'                          ⍝ find dirs
          list←FwSl list[;2]                               ⍝ normalize slashes for WWW
          (d/list),←'/'                                    ⍝ mark dirs with final slashes
          (f/list),←⊂'.',⍺                                 ⍝ add .ext to files
          list↓¨⍨¯1+1⍳⍨(FwSl ⍵)⍷⊃list                      ⍝ trim
      }

    ∇ r←Read page;i ⍝ Read a page via the #.CACHE.read (C)
      :Trap 0
          :If (≢C.read.keys)≥i←C.read.keys⍳⊂page ⍝ is it cached, and if so, save position
              r←i⊃C.read.data                     ⍝ extract
          :Else
              C.read.data,←⊂r←#.Files.GetVTV #.Boot.AppRoot,page,(~'.'∊page)/FILEEXT
              C.read.keys,←⊂page
          :EndIf
      :Else
          r←,⊂'[failed to read "',page,'"]'
      :EndTrap
    ∇

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION C_STRINGS ⍝ MANIPULATION OF CHARACTER VECTORS AND VECTORS OF CHARACTER VECTORS

    Slash←'/'∘=⊂⊢

    Name←{1↓⊃⌽(Slash ⍵)~⊂,'/'}  ⍝ '/aaa/bbb/ccc/ddd/' →         'ddd' (only in BuildTree)

    Words←{(1↓¨(∊∘' .'⊂⊢)' ',⍵)~⊂''} ⍝ Split at spaces and dots and remove empty pieces

    NoExt←{'.'∊⍵:⍵↓⍨-'.'⍳⍨⌽⍵⋄⍵} ⍝ 'aaa.bbb.ccc'  →  'aaa.bbb'

    NoNL←'\n' '\r'⎕R' ' ''⍠'Mode' 'D' ⍝ Replace newlines with spaces

    LastSeg←{⍺←⊢ ⋄ 1↓⍺⊃⌽Slash '/',⍵} ⍝ ⍺th (default 1st) /-separated segment from the end

    Levels←{(+/¨'/'=⍵)+~'/'=(⊃⌽)¨⍵} ⍝ Number of /s adjusted for categories' final /

    Shuffle←(?⍨∘≢⊃¨⊂)⊢⊂⍨⊢≡¨1↑⊢ ⍝ Shuffle the root elements of an XML snippet

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION D_ELEMENTS ⍝ FUNCTIONS THAT AUTOMATE THE CREATION OF DOM ELEMENTS AND HTML CODE

      Over←{
          ⊂'',⍺,'
',('/'⎕R'
'⊢⍵),''
      }

      External←{ ⍝ Icon off-site link
          ⍺←''
      ⍝    '.external' 'target=_blank' 'data-dyalog-tip="External link"'New _.A((⍺,'🔗')⍵)
          '',⍺,'🔗'
      }

      DescrEmbed←{ ⍝ Link to and iframed page
          l←('Description'Section Read ⍵),'
'
          l,←'Open this '
          l,←'simple sample' 'advanced sample' 'mini-app'⊃⍨1⍳⍨∨/¨'Simple' 'Advanced'⍷¨⊂⍵
          l,←' in a new tab'
          e←''
          l e
      }

      Link←{ ⍝ New-tab link with optional (⍺) "tooltip"
          ⍺←0
          ⍝(('data-dyalog-tip=',Q ⍺){⍺ ⍵}⍣(⍺≢0)⊢'target="_blank"')New _.A ⍵
          '',(⊃⍵),''
      }

      DocLink←{ ⍝ Link to WidgetDoc with appropriate parameters
          link←DocUrl ⍵
          ctor←'ctor'ForControl ⍵
          0=⍴ctor::Link ⍵ link ⍝ upon fail to retrieve info
          ('Constructor: ',ctor)Link ⍵ link
      }

      DocUrl←{
          '/Documentation/DyalogAPIs/WidgetDoc?namespace=_',('ns'ForControl ⍵),'&widget=',⍵
      }

      DocTreeLink←{ ⍝ Link to file in doc folder
          '/'=⊃⌽⍵:''
          ('/Documentation',⍵)'target="_blank"'
      }

      ReadingTree←{ ⍝ Create tree of documentation links
          l←'/',¨⍵~⊂''
          (Name∘NoExt¨l)(Levels l)(DocTreeLink¨l)
      }

    ∇ r←RelDocs w;list;item ⍝ Links to related samples
      list←'relevant'ForControl w
      r←''
      :For item :In list
          r,←'
',(Link('filedescr'ForFile item)item),'

'
      :EndFor
      r↓⍨←¯5
    ∇

      FormatList←{ ⍝ List of category-title pairs
          ⍺←1↓FILEEXT
          (⍺≡1↓FILEEXT)CatAndItem¨{'/'≠⊃⌽⍵}Of ⍺ List ⍵
      }

      CatAndItem←{ ⍝ (category) (filename/description)
          cat←2 LastSeg ⍵
          cat←'General' 'Mini App'cat['Documentation' 'Applications'⍳⊂cat]
          cat(Link((NoExt LastSeg)⍣(~⍺)('Description'Section Read)⍣⍺⊢⍵)⍵)
      }

      FilterTable←{
          dt←⍺ New _.DataTable ⍵
          dt.Options.mark←_true                ⍝ highlight search-terms
          dt.Options.columns←⎕NS¨4⍴⊂⍬          ⍝ options per column
          dt.Options.columns[4].visible←_false ⍝ hide column4
          dt.Options.dom←'l<"#fltcnt">ftpr'    ⍝ insert div with id "fltcnt" into table header
          dt.Plugins←'yadcf'
          dt.Options.yadcf←⎕NS ⍬
          dt.Options.yadcf.Filters←⎕NS ⍬
          dt.Options.yadcf.Filters.(column_number select_type filter_container_id)←3 'chosen' 'fltcnt'
          dt.Options.yadcf.Filters.(filter_type select_type_options filter_default_label)←'multi_select'(⊂'{width:"30em"}')'Filter by library'
          dt.Options.yadcf.Filters/⍨←1 ⍝ needs array of namespaces
          dt
      }

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION E_TUTORIAL ⍝ FUNCTIONS USED BY THE index PAGE'S Tutorial TAB

    ∇ t←Elements;tabs;r;sp;fs;ig;colors;rgbs;button;p;cbs;t2;g
      t←'#div'New _.div'This div is the main container of this tab. ' ⍝ #div
      p←'#p't.Add _.p'This is the beginning of a paragraph, ' ⍝ #p
      '#span'p.Add _.span'but this phrase is a separate piece of text inside the paragraph. ' ⍝ #span
      button←'#Button't.Add _.Button'Button' ⍝ #Button
      sp←'#StackPanel't.Add _.StackPanel ⍝ #StackPanel
      sp.Add'StackPanel'
      '#EditField'sp.Add _.EditField'EditField' 'EditField' ⍝ #EditField
      '#Select'sp.Add _.Select'Red' 'Green' 'Blue' ⍝ #Select
      '#Input1't.Add _.Input'number' 426 ' Number Input: ' ⍝ #Input1
      t.Add _.br
      fs←'#Fieldset1't.Add _.Fieldset'CheckBoxes' ⍝ #Fieldset1
      cbs←{'.CheckBox'New _.CheckBox ⍵}¨'checked' 'unchecked' ⍝ .CheckBox
      ig←'#InputGrid'fs.Add _.InputGrid('Checked' 'Unchecked')cbs ⍝ #InputGrid
      ig.Flip←1 ⍝ #InputGrid
      fs←'#Fieldset2't.Add _.Fieldset'RadioButtonGroup' ⍝ #Fieldset2
      '#RadioButtonGroup'fs.Add _.RadioButtonGroup('Selected' 'Unselected')1 'right' ⍝ #RadioButtonGroup
      '#h5't.Add _.h5'Slider' ⍝ #h52
      '#Input2't.Add _.Input'range' 1 ⍝ #Input2
      '#List't.Add _.List('Primaries' 'Cyan' 'Magenta' 'Yellow' 'Key' 'Black')(1 2 2 2 1 2) ⍝ #List
      colors←'aqua' 'black' 'blue' 'fuchsia' 'gray' 'green' 'lime' 'maroon' ⍝ #Table
      rgbs←'#00FFFF' '#000000' '#0000FF' '#FF00FF' '#808080' '#008000' '#00FF00' '#800000' ⍝ #Table
      colors,←'navy' 'olive' 'purple' 'red' 'silver' 'teal' 'white' 'yellow' ⍝ #Table
      rgbs,←'#000080' '#808000' '#800080' '#FF0000' '#C0C0C0' '#008080' '#FFFFFF' '#FFFF00' ⍝ #Table
      '#Table't.Add _.Table('Color' 'RGB'⍪colors,⍪rgbs)'' 1 ⍝ #Table
      t.Add _.style ScriptFollows
      ⍝ #div {padding: 10px; margin: 10px;}
      ⍝ #Button {vertical-align: top; margin: 5px;}
      ⍝ #StackPanel {display: inline-block; padding: 5px;}
      ⍝ #Fieldset1 {display: inline-block;}
      ⍝ #Fieldset2 {display: inline-block;}
      ⍝ #h5 {margin: 1em 0 0.5em 0;}
      ⍝ #Input1 {width: 4em;}
      ⍝ #Input2 {width: 100%;}
      ⍝ #List {display: inline-block; margin: 1em; padding: 5px 5px 5px 25px;}
      ⍝ #Table {display: inline-block; max-height: 7em; overflow-y: scroll; margin-top: 1em;}
      ⍝
      ⍝ /**/#span:hover, #p:hover, #div:hover, #Button:hover, #StackPanel:hover, #EditField:hover, #Select:hover, #Fieldset1:hover, #Fieldset2:hover, .CheckBox:hover, #RadioButtonGroup:hover, #Input1:hover, #Input2:hover, #h5:hover, #progress:hover, #List:hover, #Table:hover {
      ⍝     box-shadow: 0 0 5px 1px orange,0 0 5px orange inset;
      ⍝ }
      'ShowElement'∘AddHandler¨'#div' '#p' '#span' '#Button' '#EditField' '#StackPanel' '#Select' '#Fieldset1' '#Fieldset2' '.CheckBox' '#RadioButtonGroup' '#Input1' '#h5' '#Input2' '#progress' '#List' '#Table'
      t←'Common elements't
    ∇

    ∇ t←Formatting
      t←'#margrad'New _.div'This div has inner padding and gradient backround' ⍝ #margrad
      '#boldin't.Add _.p'Bold indented text which has to be extremely long in order to show that only the first line is being indented.' ⍝ #boldin
      '#huge't.Add _.span'Huge text with outer margin' ⍝ #huge
      '#expund't.Add _.span'Expanded and underlined' ⍝ #expund
      '#bluebox't.Add _.p'Blue box with shadow' ⍝ #bluebox
      '#centshad't.Add _.p'Centered text with shadow' ⍝ #centshad
      '#whimg't.Add _.p'White text on image background' ⍝ #whimg
      '#border't.Add _.p'Surrounded by borders and top-right corner is round' ⍝ #border
      '#img' 'src="Examples/Data/4lines.png"' 'alt="Image"' 'title="Four lines high"'t.Add _.img ⍝ #img
      '#narrow't.Add _.p'Inline paragraph with limited width and single line height.' ⍝ #narrow
      '#mono't.Add _.span'Monospace, ' ⍝ #mono
      '#sans't.Add _.span'Sans-Serif, ' ⍝ #sans
      '#serif't.Add _.span'and Serif.' ⍝ #serif
      t.Add _.style ScriptFollows
      ⍝ #margrad {padding: 2em; background: linear-gradient(White, SkyBlue);}
      ⍝ #boldin {font-weight: bold; text-indent: 2em;}
      ⍝ #huge {font-size: x-large; margin: 2em;}
      ⍝ #expund {text-decoration: underline; letter-spacing: 0.5ex;}
      ⍝ #bluebox {background-color: SkyBlue; box-shadow: 0.25em 0.5em 1em Gray;}
      ⍝ #centshad {text-align: center; text-shadow: 0.1em 0.3em 0.2em Blue;}
      ⍝ #whimg {color: white; background-image: url(Examples/Data/pic3.png);}
      ⍝ #serif {font-family: "Times New Roman", Times, serif; font-size: 150%;}
      ⍝ #sans {font-family: Arial, Helvetica, sans-serif; font-size: 150%;}
      ⍝ #mono {font-family: "Courier New", Courier, monospace; font-size: 150%;}
      ⍝ #border {border: 0.25em solid Blue; border-top-right-radius: 1.5em;}
      ⍝ #img {height: 4em; opacity: 0.5;}
      ⍝ #narrow {width: 20%; display: inline-block; line-height: 1;}
      ⍝
      ⍝ /**/#boldin:hover, #huge:hover, #expund:hover, #centshad:hover, #serif:hover, #sans:hover, #mono:hover, #narrow:hover {
      ⍝     box-shadow: 0 0 5px 1px orange,0 0 5px orange inset;
      ⍝ }
      ⍝ /**/#margrad:hover {box-shadow: 0 0 5px 2px Orange inset;}
      ⍝ /**/#whimg:hover {box-shadow: 0 0 5px 2px Orange;}
      ⍝ /**/#border:hover {box-shadow: 0 0 5px 2px Orange, 0 0 5px 2px Orange inset;}
      ⍝ /**/#img:hover {box-shadow: 0 0 5px 3px Orange,0 0 5px 3px Orange;}
      ⍝ /**/#bluebox:hover {box-shadow:0 0 5px 1px Orange, 0 0 5px 1px Orange inset, 0.25em 0.5em 1em Gray;}
      'ShowFormatting'∘AddHandler¨'#margrad' '#boldin' '#huge' '#expund' '#bluebox' '#centshad' '#whimg' '#serif' '#sans' '#mono' '#border' '#img' '#narrow'
      t←'Formatting't
    ∇

    ∇ t←Positioning
      Add _.style ScriptFollows
      ⍝ #parent {position: relative; height: 26em; margin: 1em;}
      ⍝ /**/#parent, #parent div {border: 1px solid black; margin-top: 1em; margin-bottom: 1em; padding: 1ex;}
      ⍝ /**/#parent div {width: 50%;}
      ⍝ #default {/* nothing to see here */}
      ⍝ #textcenter {text-align: center;}
      ⍝ #textright {text-align: right;}
      ⍝ #boxright {margin-left: auto; margin-right: 0;}
      ⍝ #boxcenter {margin-left: auto; margin-right: auto;}
      ⍝ #bottom {position: absolute; bottom: 0;}
      ⍝
      ⍝ /**/#parent, #parent div:hover {
      ⍝     box-shadow: 0 0 5px 1px orange,0 0 5px orange inset;
      ⍝ }
      t←'#parent'New _.div'Parent element with "relative" position so we can align vertically' ⍝ #parent
      '#default't.Add _.div'Default position and text alignment' ⍝ #default
      '#textcenter't.Add _.div'Centered text' ⍝ #textcenter
      '#textright't.Add _.div'Right-aligned text' ⍝ #textright
      '#boxcenter't.Add _.div'Centered element' ⍝ #boxcenter
      '#boxright't.Add _.div'Right-aligned element' ⍝ #boxright
      '#bottom't.Add _.div'Bottom-aligned element'
      'ShowPositioning'∘AddHandler¨'#parent' '#default' '#textcenter' '#textright' '#boxcenter' '#boxright' '#middle' '#bottom'
      t←'Positioning't
    ∇

    ∇ t←Embedding
      t←'#embed'New _.div'This div contains embedded items'
      t←'Embedding't
    ∇

    ∇ t←Interaction
      t←'#ui'New _.div'This div shows user interaction'
      t←'Interaction't
    ∇

    ∇ t←Windows
      t←'#win'New _.div'This div shows floating GUI elements'
      t←'Windows & Popups't
    ∇

    ∇ {ctrl}←callbackfn AddHandler sel
      ctrl←sel~'#.12'
      Add _.Handler sel'click'callbackfn'' 'event.stopPropagation()'
    ∇

    ∇ r←ShowElement;code;ctrl;info
      :Access Public
      ctrl←_selector~'#12'
      info←'
This element is called _.',ctrl,'
'
      info,←P'descr'ForControl ctrl
      info,←'
Constructor (what goes to the right of Add _.',ctrl,')
'
      info,←P Link('ctor'ForControl ctrl)(DocUrl ctrl)
      code←⊃_selector CodeFrom'Elements'
      info,←'
Put this in the Compose function
',P code
      r←'#info'Replace info
    ∇

    ∇ r←ShowFormatting;css;info;code
      :Access Public
      (code css)←_selector CodeFrom'Formatting'
      info←'
Put this in the Compose function
',P code
      info,←'
Put Add _.style''…'' in Compose or add  this to the stylesheet
',P css
      r←'#info'Replace info
    ∇

    ∇ r←ShowPositioning;css;info;code
      :Access Public
      (code css)←_selector CodeFrom'Positioning'
      info←'
Put this in the Compose function
',P code
      info,←'
Put Add _.style''…'' in Compose or add  this to the stylesheet
',P css
      r←'#info'Replace info
    ∇

      CodeFrom←{
          nr←⎕NR ⍵
          (css lines)←↓⍉↑('⍝ ',⍺)∘Prep¨nr/⍨('⍝ ',⍺)∘(∨/⍷)¨nr
          (lines/⍨~css)(css/lines)
      }

      Prep←{
          c←#.Strings.dlb ⍵
          ⍺≡c↑⍨-l←≢⍺:0('\w+\.Add'⎕R'Add'⊢c↓⍨¯1-l)
          1(2↓c)
      }

    P←{∊('
',,∘'
')¨ç⍵}

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION F_CONSTANTS ⍝ NILADIC FUNCTIONS THAT ACT LIKE :include'ABLE CONSTANTS

    ∇ r←NSS
      :Access public
      r←'DC' 'SF' 'JQ' 'JS' 'html'
    ∇

    ∇ r←GROUPS
      :Access public
      r←'Dyalog' 'Syncfusion' 'jQueryUI' 'JavaScript' 'Base HTML'
    ∇

    ∇ r←CACHE
      :Access public
      r←'#.CACHE'
    ∇

    ∇ r←FILEEXT
      :Access public
      r←#.Boot.ms.Config.DefaultExtension
    ∇

    ∇ C←C;scores;list;refs;srcs;control;i;info;ref;src;ctor;Read;Ø;demo
     ⍝ Return ref to cache (initialize cache if nonexistant)
      :Access public
      Read←#.Files.GetVTV #.Boot.AppRoot∘, ⍝ no-cache reading
      :Hold CACHE                          ⍝ prevent clashes
          :If 9≠⎕NC CACHE                  ⍝ if cache is empty:
              Ø←⊂''
              C←⍎CACHE ⎕NS ⍬       ⍝ create with shortcut
              C.read←⎕NS ⍬         ⍝ init cache for files
              C.read.(keys←data←⍬) ⍝ init keys and data

              C.controls←(#._.⎕NL ¯9)~⊂'Handler'                       ⍝ cache all controls
              C.controlsoi←C.controls∘⍳ç ⋄ C.eocontrols←∊∘C.controls ç ⍝ hash tables
              refs←#._⍎¨C.controls                                     ⍝ refs of all controls
              C.ns←3↓¨⍕¨refs.##                                        ⍝ ns of each control
              srcs←⎕SRC¨refs                                           ⍝ all sources

              C.files←⊃⍪/{List'Examples/',⍵}¨NSS,⊂'Applications' ⍝ sample filenames
              C.filesoi←C.files∘⍳ç                               ⍝ hash table
              C.filedescr←('Description'Section Read)¨C.files    ⍝ Description:: for all files
              C.demos←Controls¨C.files                           ⍝ controls demoed in each
              scores←C.controls∘.Score↓⍉↑C.files C.demos         ⍝ controls vs files
              C.rankings←(+/0<scores)↑¨↓⍒#.Utils.∆rank 1⊢scores  ⍝ cache all rankings

              C.(descr ctor notes relevant reldocs doclinks)←Ø
              info←FromCSV Read'IndexData/info.csv'
              :For control ref src :InEach C.controls refs srcs
                  i←info[;1]⍳⊂control
                  :If i≤≢info
                      C.descr,←info[i;2]
                      C.notes,←info[i;3]
                  :Else
                      C.descr,←⊂NoNL'Description'Section src
                      C.notes,←⊂NoNL'Notes'Section src
                  :EndIf

                  ctor←{⍵↑⍨¯1+⌊/⍵⍳⎕UCS 13 10}'Constructor'Section src
                  :If ''≡ctor
                      C.ctor,←'[content [attributes]]' '[attributes]'[1+(⎕NEW ref).NoEndTag]
                  :Else
                      C.ctor,←⊂ctor
                  :EndIf

                  :If C.eocontrols⊂control
                      C.relevant,←⊂C.files[C.rankings⊃⍨C.controlsoi⊂control]
                  :Else
                      C.relevant,←Ø
                  :EndIf

              :EndFor
              C.cats←GROUPS[NSS⍳3↓¨⍕¨('#._'∘⍎¨C.controls).##]

              C.reldocs←(RelDocs¨C.controls),Ø
              C.doclink←(DocLink¨C.controls),Ø
              C.used←{⊂2↓∊', '∘,¨C.doclink[C.controlsoi¨⍵]}¨C.demos

              C.tasks←{Link('Description'Section Read ⍵)⍵}¨C.files

              C.type←'simple' 'advanced' 'mini-app'[1⍳⍨¨↓⍉∨/¨'Simple' 'Advanced'∘.⍷C.files]

              ⍝ These cause an empty result if looked-up is not found
              C.(filedescr demos rankings descr ctor notes notes ns),←Ø

          :Else
              C←⍎CACHE ⍝ establish shortcut
          :EndIf
      :EndHold
    ∇

      ForControl←{ ⍝ e.g. 'notes'ForControl'DataTable'
          (C.controlsoi⊂,⍵)⊃C⍎⍺
      }
      ForFile←{ ⍝ e.g. 'filedescr'ForFile'DataTable'
          (C.filesoi⊂,⍵)⊃C⍎⍺
      }

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

:EndNamespace

:Namespace MS3SiteUtils ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝
⍝ ┌─────────────────────────────────────────────────────────────────────────────────────────────┐ ⍝
⍝ │ This is the collection of utility functions used by MS3Server and the index page of the     │ ⍝
⍝ │ MiServer Sample Site, MS3, accessible at miserver.dyalog.com                                │ ⍝
⍝ ├─────────────────────────────────────────────────────────────────────────────────────────────┤ ⍝
⍝ │ The code is split up in six sections:                                                       │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ A_GENERAL has utilities that appropriate to APL or MiServer in general                │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ B_FILES has various tools to list, read, and cache files and their content            │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ C_STRINGS string and multi-string manipulation and extraction of information          │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ D_ELEMENTS aids to create elements for the HTML Document Object Model                 │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ E_TUTORIAL has subroutines for the Tutorial tab on the index page                     │ ⍝
⍝ │                                                                                │ ⍝
⍝ │     ∘ F_CONSTANTS niladic functions that return unchanging values and cache                 │ ⍝
⍝ │                                                                                │ ⍝
⍝ └─────────────────────────────────────────────────────────────────────────────────────────────┘ ⍝
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION A_GENERAL ⍝ UTILITY FUNCTIONS THAT ARE NOT SPECIFIC TO THE "MS3" SITE

    ç←{⊂⍣(1=≡,⍵)⊢⍵} ⍝ enclose if simple     Mnemonic for the V16 glyph

    FwSl←'[\\/]+'⎕R'/' ⍝ Make all slash-block into single forward-slashes

    Q←'"'∘,,∘'"' ⍝ Surround with quotes

    FromCSV←↑{'"'~¨⍨1↓¨t⊂⍨(','=t)∧~≠\'"'=t←',',⍵}¨ ⍝ Convert CSV VTV to matrix (no escaped chars)

      Section←{ ⍝ Extract section ⍺:: from code ⍵
          regex←'^\s*⍝\s*',⍺,':(:.*?)$((\R^⍝(?!\s*\w+::).*?$)*)' ⍝ find '  ⍝  LeftArg:: some text'
          opts←('Mode' 'M')('DotAll' 1)('ML' 1)                  ⍝ '^'≡linestart  EOL∊'.'  1st-only
          res←regex ⎕S'\1\2'⍠opts⊢⍵                              ⍝ return parts 1 and 2
          #.Strings.deb'⍝'~⍨1↓⊃res                               ⍝ strip spaces and lamp
      }

      Controls←{ ⍝ Extract names of controls used in sample ⍵
          (Words'Control'Section Read ⍵)~'_',¨NSS
      }

    Of←{⍵/⍨⍺⍺¨⍵} ⍝ Those elements of ⍵ that satisfy ⍺⍺ element

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION B_FILES ⍝ FUNCTIONS THAT READ FILES

    Score←{(102-2×(50↑⊃⌽⍵)⍳⊂⍺)-∨/'Advanced'⍷⊃⍵} ⍝ Relevance score on index of control in list

      List←{ ⍝ Files in site folder
          ⍺←1↓FILEEXT                                      ⍝ default .ext
          mods←' -rec -raw -full=2 -ext=',⍺                ⍝ subdirs no-format rooted spec-ext
          list←(⎕SE.SALT.List #.Boot.AppRoot,⍵,mods)[;1 2] ⍝ begin at application root (MS3/)
          f←~d←list[;1]≡¨⊂'<DIR>'                          ⍝ find dirs
          list←FwSl list[;2]                               ⍝ normalize slashes for WWW
          (d/list),←'/'                                    ⍝ mark dirs with final slashes
          (f/list),←⊂'.',⍺                                 ⍝ add .ext to files
          list↓¨⍨¯1+1⍳⍨(FwSl ⍵)⍷⊃list                      ⍝ trim
      }

    ∇ r←Read page;i ⍝ Read a page via the #.CACHE.read (C)
      :Trap 0
          :If (≢C.read.keys)≥i←C.read.keys⍳⊂page ⍝ is it cached, and if so, save position
              r←i⊃C.read.data                     ⍝ extract
          :Else
              C.read.data,←⊂r←#.Files.GetVTV #.Boot.AppRoot,page,(~'.'∊page)/FILEEXT
              C.read.keys,←⊂page
          :EndIf
      :Else
          r←,⊂'[failed to read "',page,'"]'
      :EndTrap
    ∇

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION C_STRINGS ⍝ MANIPULATION OF CHARACTER VECTORS AND VECTORS OF CHARACTER VECTORS

    Slash←'/'∘=⊂⊢

    Name←{1↓⊃⌽(Slash ⍵)~⊂,'/'}  ⍝ '/aaa/bbb/ccc/ddd/' →         'ddd' (only in BuildTree)

    Words←{(1↓¨(∊∘' .'⊂⊢)' ',⍵)~⊂''} ⍝ Split at spaces and dots and remove empty pieces

    NoExt←{'.'∊⍵:⍵↓⍨-'.'⍳⍨⌽⍵⋄⍵} ⍝ 'aaa.bbb.ccc'  →  'aaa.bbb'

    NoNL←'\n' '\r'⎕R' ' ''⍠'Mode' 'D' ⍝ Replace newlines with spaces

    LastSeg←{⍺←⊢ ⋄ 1↓⍺⊃⌽Slash '/',⍵} ⍝ ⍺th (default 1st) /-separated segment from the end

    Levels←{(+/¨'/'=⍵)+~'/'=(⊃⌽)¨⍵} ⍝ Number of /s adjusted for categories' final /

    Shuffle←(?⍨∘≢⊃¨⊂)⊢⊂⍨⊢≡¨1↑⊢ ⍝ Shuffle the root elements of an XML snippet

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION D_ELEMENTS ⍝ FUNCTIONS THAT AUTOMATE THE CREATION OF DOM ELEMENTS AND HTML CODE

      Over←{
          ⊂'',⍺,'
',('/'⎕R'
'⊢⍵),''
      }

      External←{ ⍝ Icon off-site link
          ⍺←''
      ⍝    '.external' 'target=_blank' 'data-dyalog-tip="External link"'New _.A((⍺,'🔗')⍵)
          '',⍺,'🔗'
      }

      DescrEmbed←{ ⍝ Link to and iframed page
          l←('Description'Section Read ⍵),'
'
          l,←'Open this '
          l,←'simple sample' 'advanced sample' 'mini-app'⊃⍨1⍳⍨∨/¨'Simple' 'Advanced'⍷¨⊂⍵
          l,←' in a new tab'
          e←''
          l e
      }

      Link←{ ⍝ New-tab link with optional (⍺) "tooltip"
          ⍺←0
          ⍝(('data-dyalog-tip=',Q ⍺){⍺ ⍵}⍣(⍺≢0)⊢'target="_blank"')New _.A ⍵
          '',(⊃⍵),''
      }

      DocLink←{ ⍝ Link to WidgetDoc with appropriate parameters
          link←DocUrl ⍵
          ctor←'ctor'ForControl ⍵
          0=⍴ctor::Link ⍵ link ⍝ upon fail to retrieve info
          ('Constructor: ',ctor)Link ⍵ link
      }

      DocUrl←{
          '/Documentation/DyalogAPIs/WidgetDoc?namespace=_',('ns'ForControl ⍵),'&widget=',⍵
      }

      DocTreeLink←{ ⍝ Link to file in doc folder
          '/'=⊃⌽⍵:''
          ('/Documentation',⍵)'target="_blank"'
      }

      ReadingTree←{ ⍝ Create tree of documentation links
          l←'/',¨⍵~⊂''
          (Name∘NoExt¨l)(Levels l)(DocTreeLink¨l)
      }

    ∇ r←RelDocs w;list;item ⍝ Links to related samples
      list←'relevant'ForControl w
      r←''
      :For item :In list
          r,←'
',(Link('filedescr'ForFile item)item),'

'
      :EndFor
      r↓⍨←¯5
    ∇

      FormatList←{ ⍝ List of category-title pairs
          ⍺←1↓FILEEXT
          (⍺≡1↓FILEEXT)CatAndItem¨{'/'≠⊃⌽⍵}Of ⍺ List ⍵
      }

      CatAndItem←{ ⍝ (category) (filename/description)
          cat←2 LastSeg ⍵
          cat←'General' 'Mini App'cat['Documentation' 'Applications'⍳⊂cat]
          cat(Link((NoExt LastSeg)⍣(~⍺)('Description'Section Read)⍣⍺⊢⍵)⍵)
      }

      FilterTable←{
          dt←⍺ New _.DataTable ⍵
          dt.Options.mark←_true                ⍝ highlight search-terms
          dt.Options.columns←⎕NS¨4⍴⊂⍬          ⍝ options per column
          dt.Options.columns[4].visible←_false ⍝ hide column4
          dt.Options.dom←'l<"#fltcnt">ftpr'    ⍝ insert div with id "fltcnt" into table header
          dt.Plugins←'yadcf'
          dt.Options.yadcf←⎕NS ⍬
          dt.Options.yadcf.Filters←⎕NS ⍬
          dt.Options.yadcf.Filters.(column_number select_type filter_container_id)←3 'chosen' 'fltcnt'
          dt.Options.yadcf.Filters.(filter_type select_type_options filter_default_label)←'multi_select'(⊂'{width:"30em"}')'Filter by library'
          dt.Options.yadcf.Filters/⍨←1 ⍝ needs array of namespaces
          dt
      }

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION E_TUTORIAL ⍝ FUNCTIONS USED BY THE index PAGE'S Tutorial TAB

    ∇ t←Elements;tabs;r;sp;fs;ig;colors;rgbs;button;p;cbs;t2;g
      t←'#div'New _.div'This div is the main container of this tab. ' ⍝ #div
      p←'#p't.Add _.p'This is the beginning of a paragraph, ' ⍝ #p
      '#span'p.Add _.span'but this phrase is a separate piece of text inside the paragraph. ' ⍝ #span
      button←'#Button't.Add _.Button'Button' ⍝ #Button
      sp←'#StackPanel't.Add _.StackPanel ⍝ #StackPanel
      sp.Add'StackPanel'
      '#EditField'sp.Add _.EditField'EditField' 'EditField' ⍝ #EditField
      '#Select'sp.Add _.Select'Red' 'Green' 'Blue' ⍝ #Select
      '#Input1't.Add _.Input'number' 426 ' Number Input: ' ⍝ #Input1
      t.Add _.br
      fs←'#Fieldset1't.Add _.Fieldset'CheckBoxes' ⍝ #Fieldset1
      cbs←{'.CheckBox'New _.CheckBox ⍵}¨'checked' 'unchecked' ⍝ .CheckBox
      ig←'#InputGrid'fs.Add _.InputGrid('Checked' 'Unchecked')cbs ⍝ #InputGrid
      ig.Flip←1 ⍝ #InputGrid
      fs←'#Fieldset2't.Add _.Fieldset'RadioButtonGroup' ⍝ #Fieldset2
      '#RadioButtonGroup'fs.Add _.RadioButtonGroup('Selected' 'Unselected')1 'right' ⍝ #RadioButtonGroup
      '#h5't.Add _.h5'Slider' ⍝ #h52
      '#Input2't.Add _.Input'range' 1 ⍝ #Input2
      '#List't.Add _.List('Primaries' 'Cyan' 'Magenta' 'Yellow' 'Key' 'Black')(1 2 2 2 1 2) ⍝ #List
      colors←'aqua' 'black' 'blue' 'fuchsia' 'gray' 'green' 'lime' 'maroon' ⍝ #Table
      rgbs←'#00FFFF' '#000000' '#0000FF' '#FF00FF' '#808080' '#008000' '#00FF00' '#800000' ⍝ #Table
      colors,←'navy' 'olive' 'purple' 'red' 'silver' 'teal' 'white' 'yellow' ⍝ #Table
      rgbs,←'#000080' '#808000' '#800080' '#FF0000' '#C0C0C0' '#008080' '#FFFFFF' '#FFFF00' ⍝ #Table
      '#Table't.Add _.Table('Color' 'RGB'⍪colors,⍪rgbs)'' 1 ⍝ #Table
      t.Add _.style ScriptFollows
      ⍝ #div {padding: 10px; margin: 10px;}
      ⍝ #Button {vertical-align: top; margin: 5px;}
      ⍝ #StackPanel {display: inline-block; padding: 5px;}
      ⍝ #Fieldset1 {display: inline-block;}
      ⍝ #Fieldset2 {display: inline-block;}
      ⍝ #h5 {margin: 1em 0 0.5em 0;}
      ⍝ #Input1 {width: 4em;}
      ⍝ #Input2 {width: 100%;}
      ⍝ #List {display: inline-block; margin: 1em; padding: 5px 5px 5px 25px;}
      ⍝ #Table {display: inline-block; max-height: 7em; overflow-y: scroll; margin-top: 1em;}
      ⍝
      ⍝ /**/#span:hover, #p:hover, #div:hover, #Button:hover, #StackPanel:hover, #EditField:hover, #Select:hover, #Fieldset1:hover, #Fieldset2:hover, .CheckBox:hover, #RadioButtonGroup:hover, #Input1:hover, #Input2:hover, #h5:hover, #progress:hover, #List:hover, #Table:hover {
      ⍝     box-shadow: 0 0 5px 1px orange,0 0 5px orange inset;
      ⍝ }
      'ShowElement'∘AddHandler¨'#div' '#p' '#span' '#Button' '#EditField' '#StackPanel' '#Select' '#Fieldset1' '#Fieldset2' '.CheckBox' '#RadioButtonGroup' '#Input1' '#h5' '#Input2' '#progress' '#List' '#Table'
      t←'Common elements't
    ∇

    ∇ t←Formatting
      t←'#margrad'New _.div'This div has inner padding and gradient backround' ⍝ #margrad
      '#boldin't.Add _.p'Bold indented text which has to be extremely long in order to show that only the first line is being indented.' ⍝ #boldin
      '#huge't.Add _.span'Huge text with outer margin' ⍝ #huge
      '#expund't.Add _.span'Expanded and underlined' ⍝ #expund
      '#bluebox't.Add _.p'Blue box with shadow' ⍝ #bluebox
      '#centshad't.Add _.p'Centered text with shadow' ⍝ #centshad
      '#whimg't.Add _.p'White text on image background' ⍝ #whimg
      '#border't.Add _.p'Surrounded by borders and top-right corner is round' ⍝ #border
      '#img' 'src="Examples/Data/4lines.png"' 'alt="Image"' 'title="Four lines high"'t.Add _.img ⍝ #img
      '#narrow't.Add _.p'Inline paragraph with limited width and single line height.' ⍝ #narrow
      '#mono't.Add _.span'Monospace, ' ⍝ #mono
      '#sans't.Add _.span'Sans-Serif, ' ⍝ #sans
      '#serif't.Add _.span'and Serif.' ⍝ #serif
      t.Add _.style ScriptFollows
      ⍝ #margrad {padding: 2em; background: linear-gradient(White, SkyBlue);}
      ⍝ #boldin {font-weight: bold; text-indent: 2em;}
      ⍝ #huge {font-size: x-large; margin: 2em;}
      ⍝ #expund {text-decoration: underline; letter-spacing: 0.5ex;}
      ⍝ #bluebox {background-color: SkyBlue; box-shadow: 0.25em 0.5em 1em Gray;}
      ⍝ #centshad {text-align: center; text-shadow: 0.1em 0.3em 0.2em Blue;}
      ⍝ #whimg {color: white; background-image: url(Examples/Data/pic3.png);}
      ⍝ #serif {font-family: "Times New Roman", Times, serif; font-size: 150%;}
      ⍝ #sans {font-family: Arial, Helvetica, sans-serif; font-size: 150%;}
      ⍝ #mono {font-family: "Courier New", Courier, monospace; font-size: 150%;}
      ⍝ #border {border: 0.25em solid Blue; border-top-right-radius: 1.5em;}
      ⍝ #img {height: 4em; opacity: 0.5;}
      ⍝ #narrow {width: 20%; display: inline-block; line-height: 1;}
      ⍝
      ⍝ /**/#boldin:hover, #huge:hover, #expund:hover, #centshad:hover, #serif:hover, #sans:hover, #mono:hover, #narrow:hover {
      ⍝     box-shadow: 0 0 5px 1px orange,0 0 5px orange inset;
      ⍝ }
      ⍝ /**/#margrad:hover {box-shadow: 0 0 5px 2px Orange inset;}
      ⍝ /**/#whimg:hover {box-shadow: 0 0 5px 2px Orange;}
      ⍝ /**/#border:hover {box-shadow: 0 0 5px 2px Orange, 0 0 5px 2px Orange inset;}
      ⍝ /**/#img:hover {box-shadow: 0 0 5px 3px Orange,0 0 5px 3px Orange;}
      ⍝ /**/#bluebox:hover {box-shadow:0 0 5px 1px Orange, 0 0 5px 1px Orange inset, 0.25em 0.5em 1em Gray;}
      'ShowFormatting'∘AddHandler¨'#margrad' '#boldin' '#huge' '#expund' '#bluebox' '#centshad' '#whimg' '#serif' '#sans' '#mono' '#border' '#img' '#narrow'
      t←'Formatting't
    ∇

    ∇ t←Positioning
      t←'#position'New _.div'This div has its default positioning'
      t←'Positioning't
    ∇

    ∇ t←Embedding
      t←'#embed'New _.div'This div contains embedded items'
      t←'Embedding't
    ∇

    ∇ t←Interaction
      t←'#ui'New _.div'This div shows user interaction'
      t←'Interaction't
    ∇

    ∇ t←Windows
      t←'#win'New _.div'This div shows floating GUI elements'
      t←'Windows & Popups't
    ∇

    ∇ {ctrl}←callbackfn AddHandler sel
      ctrl←sel~'#.12'
      Add _.Handler sel'click'callbackfn'' 'event.stopPropagation()'
    ∇

    ∇ r←ShowElement;code;ctrl;info
      :Access Public
      ctrl←_selector~'#12'
      info←'
This element is called _.',ctrl,'
'
      info,←P'descr'ForControl ctrl
      info,←'
Constructor (what goes to the right of Add _.',ctrl,')
'
      info,←P Link('ctor'ForControl ctrl)(DocUrl ctrl)
      code←⊃_selector CodeFrom'Elements'
      info,←'
Put this in the Compose function
',P code
      r←'#info'Replace info
    ∇

    ∇ r←ShowFormatting;css;info;code
      :Access Public
      (code css)←_selector CodeFrom'Formatting'
      info←'
Put this in the Compose function
',P code
      info,←'
Put Add _.style''…'' in Compose or add  this to the stylesheet
',P css
      r←'#info'Replace info
    ∇

      CodeFrom←{
          nr←⎕NR ⍵
          (css lines)←↓⍉↑('⍝ ',⍺)∘Prep¨nr/⍨('⍝ ',⍺)∘(∨/⍷)¨nr
          (lines/⍨~css)(css/lines)
      }

      Prep←{
          c←#.Strings.dlb ⍵
          ⍺≡c↑⍨-l←≢⍺:0('\w+\.Add'⎕R'Add'⊢c↓⍨¯1-l)
          1(2↓c)
      }

    P←{∊('
',,∘'
')¨ç⍵}

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

    :SECTION F_CONSTANTS ⍝ NILADIC FUNCTIONS THAT ACT LIKE :include'ABLE CONSTANTS

    ∇ r←NSS
      :Access public
      r←'DC' 'SF' 'JQ' 'JS' 'html'
    ∇

    ∇ r←GROUPS
      :Access public
      r←'Dyalog' 'Syncfusion' 'jQueryUI' 'JavaScript' 'Base HTML'
    ∇

    ∇ r←CACHE
      :Access public
      r←'#.CACHE'
    ∇

    ∇ r←FILEEXT
      :Access public
      r←#.Boot.ms.Config.DefaultExtension
    ∇

    ∇ C←C;scores;list;refs;srcs;control;i;info;ref;src;ctor;Read;Ø;demo
     ⍝ Return ref to cache (initialize cache if nonexistant)
      :Access public
      Read←#.Files.GetVTV #.Boot.AppRoot∘, ⍝ no-cache reading
      :Hold CACHE                          ⍝ prevent clashes
          :If 9≠⎕NC CACHE                  ⍝ if cache is empty:
              Ø←⊂''
              C←⍎CACHE ⎕NS ⍬       ⍝ create with shortcut
              C.read←⎕NS ⍬         ⍝ init cache for files
              C.read.(keys←data←⍬) ⍝ init keys and data

              C.controls←(#._.⎕NL ¯9)~⊂'Handler'                       ⍝ cache all controls
              C.controlsoi←C.controls∘⍳ç ⋄ C.eocontrols←∊∘C.controls ç ⍝ hash tables
              refs←#._⍎¨C.controls                                     ⍝ refs of all controls
              C.ns←3↓¨⍕¨refs.##                                        ⍝ ns of each control
              srcs←⎕SRC¨refs                                           ⍝ all sources

              C.files←⊃⍪/{List'Examples/',⍵}¨NSS,⊂'Applications' ⍝ sample filenames
              C.filesoi←C.files∘⍳ç                               ⍝ hash table
              C.filedescr←('Description'Section Read)¨C.files    ⍝ Description:: for all files
              C.demos←Controls¨C.files                           ⍝ controls demoed in each
              scores←C.controls∘.Score↓⍉↑C.files C.demos         ⍝ controls vs files
              C.rankings←(+/0<scores)↑¨↓⍒#.Utils.∆rank 1⊢scores  ⍝ cache all rankings

              C.(descr ctor notes relevant reldocs doclinks)←Ø
              info←FromCSV Read'IndexData/info.csv'
              :For control ref src :InEach C.controls refs srcs
                  i←info[;1]⍳⊂control
                  :If i≤≢info
                      C.descr,←info[i;2]
                      C.notes,←info[i;3]
                  :Else
                      C.descr,←⊂NoNL'Description'Section src
                      C.notes,←⊂NoNL'Notes'Section src
                  :EndIf

                  ctor←{⍵↑⍨¯1+⌊/⍵⍳⎕UCS 13 10}'Constructor'Section src
                  :If ''≡ctor
                      C.ctor,←'[content [attributes]]' '[attributes]'[1+(⎕NEW ref).NoEndTag]
                  :Else
                      C.ctor,←⊂ctor
                  :EndIf

                  :If C.eocontrols⊂control
                      C.relevant,←⊂C.files[C.rankings⊃⍨C.controlsoi⊂control]
                  :Else
                      C.relevant,←Ø
                  :EndIf

              :EndFor
              C.cats←GROUPS[NSS⍳3↓¨⍕¨('#._'∘⍎¨C.controls).##]

              C.reldocs←(RelDocs¨C.controls),Ø
              C.doclink←(DocLink¨C.controls),Ø
              C.used←{⊂2↓∊', '∘,¨C.doclink[C.controlsoi¨⍵]}¨C.demos

              C.tasks←{Link('Description'Section Read ⍵)⍵}¨C.files

              C.type←'simple' 'advanced' 'mini-app'[1⍳⍨¨↓⍉∨/¨'Simple' 'Advanced'∘.⍷C.files]

              ⍝ These cause an empty result if looked-up is not found
              C.(filedescr demos rankings descr ctor notes notes ns),←Ø

          :Else
              C←⍎CACHE ⍝ establish shortcut
          :EndIf
      :EndHold
    ∇

      ForControl←{ ⍝ e.g. 'notes'ForControl'DataTable'
          (C.controlsoi⊂,⍵)⊃C⍎⍺
      }
      ForFile←{ ⍝ e.g. 'filedescr'ForFile'DataTable'
          (C.filesoi⊂,⍵)⊃C⍎⍺
      }

    :ENDSECTION ⍝ ─────────────────────────────────────────────────────────────────────────────────
⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝ ⍝

:EndNamespace


MiPageSample now shows page name in title

:Class MiPageSample : #.MiPage
   ⍝ This is a template that "wraps" the page content by
   ⍝ - adding a header and footer
   ⍝ - adding a handler that will toggle the display of the web page and its APL source code

    ∇ {r}←Wrap;lang;server;src;c
      :Access Public

      :If 0∊⍴Get'nowrapper'
          server←_Request.Server

        ⍝ we need jQuery to toggle content/source, other resources will be loaded if needed
          Use'JQuery' ⍝ this is a resource defined in Config/Resources.xml

        ⍝ set the title display in the browser to the name of the page or application
          Add _.title('Advanced' 'Simple' 'index' '_'⎕R'' ''server.Config.Name' '((-'.'⍳⍨⌽)↓⊢↑⍨1-'/'⍳⍨⌽)_Request.Page)

        ⍝ add a link to our CSS stylesheet
          _CssReset←'/Styles/cssreset.css'
          _CssOverride←'/Styles/sampleStyles.css'

        ⍝ set a meta tag to make it explicitly UTF-8
        ⍝  (Add _.meta).Set'http-equiv="content-type" content="text/html;charset=UTF-8"'

        ⍝ wrap the content of the  element in a div
          'contentblock'Body.Push _.div

        ⍝ add a hidden division to the body containing the APL source code
          (Add _.div(#.HTMLInput.APLToHTMLColour src←⎕SRC⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

        ⍝ extract the content and re-write it in parallel to the controls info div
          c←Body.Content
          Body.Content←''
          Body.Add c

        ⍝ create a division with info about the controls used
          Body.Add CtrlsDiv src

        ⍝ wrap the content of the  element in a div
          '.bodyblock'Body.Push _.div

        ⍝ add the footer to the bottom of the page
          ⍝Add #.Files.GetText server.Config.Root,'Styles\footer.txt'

        ⍝ add the header to the top of the page and wrap the body in a div with id="wrapper"
          Body.Push #.Files.GetText server.Config.Root,'Styles\banner.txt'

          'wrapper'Body.Push _.div

        ⍝ add a JQuery event handler to toggle the web page/APL source code
          Add _.Script ScriptFollows
          ⍝ $(function(){
          ⍝   $("#tocode").click(function(){
          ⍝     $("#contentblock").hide();
          ⍝     $("#codeblock,#widgethelp").show();
          ⍝     $("#topage").removeClass("activetab");
          ⍝     $("#tocode").addClass("activetab");
          ⍝   });
          ⍝   $("#topage").click(function(){
          ⍝     $("#contentblock").show();
          ⍝     $("#codeblock,#widgethelp").hide();
          ⍝     $("#topage").addClass("activetab");
          ⍝     $("#tocode").removeClass("activetab");
          ⍝   });
          ⍝ });

        ⍝ set the language for the page
          lang←server.Config.Lang ⍝ use the language specified in Server.xml
          Set'lang="',lang,'" xml:lang="',lang,'" xmlns="http://www.w3.org/1999/xhtml"'
      :Else
          Head.Add _.StyleSheet'/Styles/sampleStyles.css'
          Body.class←'bodyblock'
      :EndIf
     ⍝ call the base class Wrap function

      r←⎕BASE.Wrap
    ∇

    ∇ r←CtrlsDiv source;control;controls;ns
     ⍝ Creates a div with info on the controls used in source

     ⍝ First we extract proper lists of controls
      controls←5/⊂''
      source←(⍳∘'⍝'↑⊢)¨source      ⍝ remove comments
      source←{⍵/⍨~≠\''''=⍵}¨source ⍝ remove strings but leaves one ' as separator
      :For control :In 'Handler' 'Position'~⍨∪('_(DC|SF|JQ|JS|html|)\.(\w+)'⎕S'\2')source ⍝ find controls
          :Trap 6 ⍝ unknown
              ns←(#.MS3SiteUtils.NSS(∨/⍷)¨⊂⍕⍎'#._.',control)/⍳⍴#.MS3SiteUtils.NSS ⍝ add to right list
          :Else
              ns←⍬
          :EndTrap
          controls[ns],←⊂⊂control
      :EndFor
      controls←{⍵[⍋↑⍵]}¨controls   ⍝ sort the lists

     ⍝ Now we create and populate the info div
      r←'
Controls used on this page:'
      :For ns :In (×≢¨controls)/⍳⍴#.MS3SiteUtils.NSS ⍝ do not process if empty
          r,←' ',(ns⊃#.MS3SiteUtils.GROUPS),': '
          :For control :In ns⊃controls
              r,←'',control,', '
          :EndFor
          r↓⍨←¯7
      :EndFor
      r,←'
'
    ∇

    ∇ r←Walk content;e
      r←⍬
      :For e :In content
          :If (isClass e)∨isInstance e
              r←r,⊃⎕CLASS e
              :Trap 6
                  r,←Walk e.Content
              :EndTrap
          :EndIf
      :EndFor
    ∇

:EndClass

:Class MiPageSample : #.MiPage
   ⍝ This is a template that "wraps" the page content by
   ⍝ - adding a header and footer
   ⍝ - adding a handler that will toggle the display of the web page and its APL source code

    ∇ {r}←Wrap;lang;server;src;c
      :Access Public

      :If 0∊⍴Get'nowrapper'
          server←_Request.Server

        ⍝ we need jQuery to toggle content/source, other resources will be loaded if needed
          Use'JQuery' ⍝ this is a resource defined in Config/Resources.xml

        ⍝ set the title display in the browser to the name of the application defined in Config/Server.xml
          Add _.title server.Config.Name

        ⍝ add a link to our CSS stylesheet
          _CssReset←'/Styles/cssreset.css'
          _CssOverride←'/Styles/sampleStyles.css'

        ⍝ set a meta tag to make it explicitly UTF-8
        ⍝  (Add _.meta).Set'http-equiv="content-type" content="text/html;charset=UTF-8"'

        ⍝ wrap the content of the  element in a div
          'contentblock'Body.Push _.div

        ⍝ add a hidden division to the body containing the APL source code
          (Add _.div(#.HTMLInput.APLToHTMLColour src←⎕SRC⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

        ⍝ extract the content and re-write it in parallel to the controls info div
          c←Body.Content
          Body.Content←''
          Body.Add c

        ⍝ create a division with info about the controls used
           Body.Add CtrlsDiv src

        ⍝ wrap the content of the  element in a div
          '.bodyblock'Body.Push _.div

        ⍝ add the footer to the bottom of the page
          ⍝Add #.Files.GetText server.Config.Root,'Styles\footer.txt'

        ⍝ add the header to the top of the page and wrap the body in a div with id="wrapper"
          Body.Push #.Files.GetText server.Config.Root,'Styles\banner.txt'

          'wrapper'Body.Push _.div

        ⍝ add a JQuery event handler to toggle the web page/APL source code
          Add _.Script ScriptFollows
          ⍝ $(function(){
          ⍝   $("#tocode").click(function(){
          ⍝     $("#contentblock").hide();
          ⍝     $("#codeblock,#widgethelp").show();
          ⍝     $("#topage").removeClass("activetab");
          ⍝     $("#tocode").addClass("activetab");
          ⍝   });
          ⍝   $("#topage").click(function(){
          ⍝     $("#contentblock").show();
          ⍝     $("#codeblock,#widgethelp").hide();
          ⍝     $("#topage").addClass("activetab");
          ⍝     $("#tocode").removeClass("activetab");
          ⍝   });
          ⍝ });

        ⍝ set the language for the page
          lang←server.Config.Lang ⍝ use the language specified in Server.xml
          Set'lang="',lang,'" xml:lang="',lang,'" xmlns="http://www.w3.org/1999/xhtml"'
      :Else
          Head.Add _.StyleSheet'/Styles/sampleStyles.css'
          Body.class←'bodyblock'
      :EndIf
     ⍝ call the base class Wrap function

      r←⎕BASE.Wrap
    ∇

    ∇ r←CtrlsDiv source;control;controls;ns
     ⍝ Creates a div with info on the controls used in source

     ⍝ First we extract proper lists of controls
      controls←5/⊂''
      source←(⍳∘'⍝'↑⊢)¨source      ⍝ remove comments
      source←{⍵/⍨~≠\''''=⍵}¨source ⍝ remove strings but leaves one ' as separator
      :For control :In 'Handler' 'Position'~⍨∪('_(DC|SF|JQ|JS|html|)\.(\w+)'⎕S'\2')source ⍝ find controls
          :Trap 6 ⍝ unknown
              ns←(#.MS3SiteUtils.NSS(∨/⍷)¨⊂⍕⍎'#._.',control)/⍳⍴#.MS3SiteUtils.NSS ⍝ add to right list
          :Else
              ns←⍬
          :EndTrap
          controls[ns],←⊂⊂control
      :EndFor
      controls←{⍵[⍋↑⍵]}¨controls   ⍝ sort the lists

     ⍝ Now we create and populate the info div
      r←'
Controls used on this page:'
      :For ns :In (×≢¨controls)/⍳⍴#.MS3SiteUtils.NSS ⍝ do not process if empty
          r,←' ',(ns⊃#.MS3SiteUtils.GROUPS),': '
          :For control :In ns⊃controls
              r,←'',control,', '
          :EndFor
          r↓⍨←¯7
      :EndFor
      r,←'
'
    ∇

    ∇ r←Walk content;e
      r←⍬
      :For e :In content
          :If (isClass e)∨isInstance e
              r←r,⊃⎕CLASS e
              :Trap 6
                  r,←Walk e.Content
              :EndTrap
          :EndIf
      :EndFor
    ∇

:EndClass