Update Boot.dyalog

Update Boot.dyalog

Removed protected load for classes from CODE-Directory

:Namespace Boot

    (⎕ML ⎕IO)←1

    :section Startup/Shutdown

    ∇ Run root

      AppRoot←folderize root  ⍝ application (website) root
      AppRoot Load 1 ⍝ load essential objects
      #.Utils.SetupCompatibility
      ms←Init ConfigureServer AppRoot ⍝ read configuration and create server instance
      ConfigureDatasources ms
      ConfigureVirtual ms
      ConfigureResources ms
      ConfigureContentTypes ms
      ConfigureLogger ms

      ms.Run
    ∇

    ∇ {AppRoot}Load yes;files;f;classes;class;utils;t;core;HTML;extensions;HTMLsubdirs
      ⍝ Load required objects for MiServer
      ⍝ Note: DRC namespace is not SALTed
      ⍝ yes - 1 to perform load, 0 to clean up

      classes←''
      :If 0≠⎕NC'AppRoot'
          classes←(⎕SE.SALT.List AppRoot,'Code -raw')[;1 2] ⍝ Classes in application folder
          classes←(empty¨classes[;1])/classes[;2] ⍝ remove directory entries (have <DIR> in [;1])
      :EndIf
      utils←(⎕SE.SALT.List MSRoot,'Utils -raw')[;2]   ⍝ find utility libraries
      core←(⊂'Boot')~⍨(⎕SE.SALT.List MSRoot,'Core -raw')[;2]
      extensions←(⎕SE.SALT.List MSRoot,'Extensions -raw')[;2]
      HTML←(⎕SE.SALT.List MSRoot,'HTML -raw')[;2] ⍝ force to be loaded first
      HTMLsubdirs←HTML∩,⎕SE.SALT.List MSRoot,'HTML -folder'
      :If yes

          files←'Core/'∘,¨core
          files,←'Utils/'∘,¨utils
          files,←'Extensions/'∘,¨extensions

          :For f :In files
              disperror ⎕SE.SALT.Load MSRoot,f,' -target=#' ⍝ do not reload already loaded spaces
          :EndFor

          #.SupportedHtml5Elements.Build_html_namespace

          :For f :In HTML
              disperror ⎕SE.SALT.Load MSRoot,'HTML/',f,' -target=#'
              :If (⊂f)∊HTMLsubdirs
                  disperror¨⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
              :EndIf
          :EndFor

⍝          :For f :In HTML∩,⎕SE.SALT.List MSRoot,'HTML -folder'
⍝              ⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
⍝          :EndFor

          :If 0≠⍴classes
              :For class :In classes
                  disperror ⎕SE.SALT.Load AppRoot,'Code/',class,' -target=#'
              :EndFor
          :EndIf

          'Pages'#.⎕NS'' ⍝ Container Space for loaded classes
          #.Pages.(MiPage MildPage RESTful)←#.(MiPage MildPage RESTful)
          BuildEAWC ⍝ build the Easy As ⎕WC namespace
          :If #.Files.DirExists AppRoot,'/Code/Templates/'
              disperror ⎕SE.SALT.Load AppRoot,'/Code/Templates/* -target=#.Pages'
          :EndIf

      :Else ⍝ Cleanup
          #.⎕EX¨classes
          #.⎕EX¨utils
          #.⎕EX'Pages'
          #.⎕EX¨'MiServer' 'HTTPRequest'
      :EndIf
    ∇

    ∇ LoadHTML f
    ⍝ Utility to reload an HTML content-generating namespace
      disperror ⎕SE.SALT.Load MSRoot,'HTML/',f,' -target=#'
      disperror¨⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
    ∇

    ∇ ms←Init Config;path;class;classes;e;res;mask
     ⍝ Create instances of MiServer, Session and Authentication Handlers

      ms←⎕NEW(#⍎Config.ClassName)Config
      path←MSRoot,'Extensions/'

      :If 0≠⍴Config.SessionHandler
          class←⎕SE.SALT.Load path,Config.SessionHandler
          ms.SessionHandler←⎕NEW class ms
      :EndIf

      :If 0≠⍴Config.Authentication
          class←⎕SE.SALT.Load path,Config.Authentication
          ms.Authentication←⎕NEW class ms
      :EndIf

      :If 0≠⍴Config.SupportedEncodings
          {}⎕SE.SALT.Load path,'ContentEncoder'
          :For e :In Config.SupportedEncodings
              class←⎕SE.SALT.Load path,e
              ms.Encoders,←⎕NEW class
          :EndFor
          :If ∨/mask←0≠1⊃¨res←ms.Encoders.Init
              2 ms.Log'Content Encoding Initialization failed for:',∊' ',¨mask/ms.Encoders.Encoding
              ms.Encoders←(~mask)/ms.Encoders
          :EndIf
      :EndIf
      Config.UseContentEncoding∧←0≠⍴ms.Encoders

      :If 0≠⍴Config.Logger
          class←⎕SE.SALT.Load path,Config.Logger
          ms.Logger←⎕NEW class ms
      :EndIf
    ∇

    ∇ End;classes;z;m
      ⍝ Clean up the workspace

      :If 9=⎕NC'ms'
          :Trap 0
              ms.End
          :EndTrap
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.SessionHandler'
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.Authentication'
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.Logger'
          {}try'⎕EX⍕¨∪enlist ⎕CLASS¨ms.Encoders'
          ⎕EX⍕⊃⊃⎕CLASS ms
          ⎕EX'ms'
      :EndIf

      :If 9=⎕NC'SQA'
          {}try'SQA.Close''.'''
      :EndIf

      :If 0≠⍴classes←↓#.⎕NL 9.4
      :AndIf 0≠⍴classes←(m←2=⊃∘⍴¨z←⎕CLASS¨#⍎¨classes)/classes
      :AndIf 0≠⎕NC'#.MiPage'
          classes←(#.MiPage≡¨2 1∘⊃¨m/z)/classes
          #.⎕EX↑⍕¨classes ⍝ Erase loaded classes
      :EndIf

      Load 0
      ⎕EX'#.MiPage'
      ⎕EX'AppRoot'
      {}try'#.DRC.Close ''.'''
    ∇

    ∇ BuildEAWC;src;sources;fields;source;list;mask;refs;target
     ⍝ Build the Easy As ⎕WC namespace from core classes and its own source
     ⍝ Also build the #._ namespace with shortcuts
      sources←#._html #._SF #._JQ #._DC #._JS
⍝      fields←''
      '_'#.⎕NS''
      :For source :In sources
          list←source.⎕NL ¯9.4
          list←list/⍨'_'≠⊃¨list
          :If ∨/mask←0≠refs←source{6::0 ⋄ (⍕⍺){('.'∊1↓s↓r)<⍺≡(s←⍴⍺)↑r←⍕⍵}t←⍺⍎⍵:t ⋄ 0}¨list
              #._⍎∊(mask/list){'⋄',⍺,'←',⍕⍵}¨mask/refs
          :EndIf
      :EndFor
    ∇

    :endsection

    :section Configuration

    ∇ r←ns Setting pars;name;num;default;mask
    ⍝ returns setting from a config style namespace or provides a default if it doesn't exist
    ⍝ pars - name [num] [default]
    ⍝ ns - namespace reference
    ⍝ name - name of the setting
    ⍝ num - 1 if setting is numeric scalar, (,1) if numeric vector is allowed, 0 otherwise
    ⍝ default - default value if not found
      pars←eis pars
      (name num)←2↑pars,(⍴pars)↓'' 0 ''
      :If 2<⍴pars ⋄ default←3⊃pars
      :Else ⋄ default←(1+num)⊃''⍬
      :EndIf
      r←(⍴ns)⍴⊂default
      :If ∨/mask←0≠⊃¨ns.⎕NC⊂name
          (mask/r)←(((⍴⍴num)∘tonum)⍣(⊃num))¨(mask/ns).⍎⊂name
      :EndIf
      :If 0=⍴⍴r ⋄ r←⊃r ⋄ :EndIf
    ∇

    ∇ config←{element}ReadConfiguration type;serverconfig;file;siteconfig;thing;ind;mask
    ⍝ Attempt to read configuration file
    ⍝ 1) from server root MSRoot
    ⍝ 2) from site root AppRoot
    ⍝ merging the two if they both exist - site settings overrule server settings
      config←''
      :If #.Files.Exists file←MSRoot,'Config/',type,'.xml'
          config←serverconfig←(#.XML.ToNS #.Files.GetText file)⍎type
      :EndIf
      :If #.Files.Exists file←AppRoot,'Config/',type,'.xml'
          siteconfig←(#.XML.ToNS #.Files.GetText file)⍎type
          :If 0∊⍴config
              config←siteconfig
          :ElseIf 0=⎕NC'element'
              {}{try'serverconfig.',⍵,'←siteconfig.',⍵}¨siteconfig.⎕NL ¯2
          :Else ⍝ element specifies the element(s) to search on
              :For thing :In siteconfig
                  :If 0≠thing.⎕NC element
                      :If ∨/mask←0≠∊serverconfig.⎕NC⊂element
                          :If (+/mask)<ind←((mask/serverconfig)⍎¨⊂element)⍳⊂thing⍎element
                              serverconfig,←thing
                          :Else
                              serverconfig[(mask/⍳⍴mask)[ind]]←thing
                          :EndIf
                      :Else
                          serverconfig,←thing
                      :EndIf
                  :EndIf
              :EndFor
              config←serverconfig
          :EndIf
      :EndIf
    ∇

    ∇ Config←ConfigureServer AppRoot;file
    ⍝ configure server level settings, setting defaults for needed ones that are not supplied
      Config←ReadConfiguration'Server'

      Config.AllowedHttpCommands←{⎕ML←3 ⋄ ⍵⊂⍨~⍵∊' ,'}#.Strings.lc Config Setting'AllowedHttpCommands' 0 'get,post'
      Config.AppRoot←AppRoot
      Config.Authentication←Config Setting'Authentication' 0 'SimpleAuth'
      Config.CertFile←Config Setting'CertFile' 0 ''
      Config.ClassName←Config Setting'ClassName' 0 'MiServer'
      Config.Debug←Config Setting'Debug' 1 0
      Config.DefaultExtension←Config Setting'DefaultExtension' 0 '.mipage'
      Config.DefaultPage←Config Setting'DefaultPage' 0 'index.mipage'
      Config.FormatHtml←Config Setting'FormatHtml' 1 0
      Config.Host←Config Setting'Host' 0 'localhost'
      Config.HttpCacheTime←Config Setting'HttpCacheTime' 1 0 ⍝ default to off (0)
      Config.IPVersion←Config Setting'IPVersion' 0 'IPV4'
      Config.IdleTimeOut←Config Setting'IdleTimeOut' 1 0 ⍝ default to none (0)
      Config.KeyFile←Config Setting'KeyFile' 0 ''
      Config.Lang←Config Setting'Lang' 0 'en'
      Config.LogMessageLevel←Config Setting'LogMessageLevel' 1 1 ⍝ default to error messages only
      Config.Logger←Config Setting'Logger' 0 ''
      Config.MSRoot←MSRoot
      Config.Name←Config Setting'Name' 0 'MiServer'
      Config.Port←Config Setting'Port' 1 8080
      Config.Ports←Config Setting'Ports'(,1)⍬
      Config.Production←Config Setting'Production' 1 0 ⍝ production mode?  (0/1 = development debug framework en/disabled)
      Config.RESTful←Config Setting'RESTful' 1 0 ⍝ RESTful web service?
      Config.RootCertDir←Config Setting'RootCertDir' 0 ''
      Config.Root←AppRoot ⍝ folderize MSRoot{((isRelPath ⍵)/⍺),⍵}AppRoot
      Config.SSLFlags←Config Setting'SSLFlags' 1(32+64)  ⍝ Accept Without Validating, RequestClientCertificate
      Config.Secure←Config Setting'Secure' 1 0
      Config.Server←Config Setting'Server' 0 ''
      Config.SessionHandler←Config Setting'SessionHandler' 0 'SimpleSessions'
      Config.SessionTimeOut←Config Setting'SessionTimeOut' 1 30 ⍝ 30 minute timeout
      Config.SupportedEncodings←{(⊂'')~⍨1↓¨(⍵=⊃⍵)⊂⍵}',',Config Setting'SupportedEncodings' 0
      Config.TempFolder←folderize Config.Root{0∊⍴⍵:⍵ ⋄ ((isRelPath ⍵)/⍺),⍵}Config Setting'TempFolder' 0
      Config.TrapErrors←Config Setting'TrapErrors' 1 0
      Config.UseContentEncoding←Config Setting'UseContentEncoding' 1 0 ⍝ aka HTTP Compression default off (0)

      :If 0≠⎕NC'#.DrA' ⍝ Transfer DrA config options
          {}#.DrA.SetDefaults
          #.DrA.AppName←Config.Name
          #.DrA.MailMethod←Config Setting'MailMethod' 0 'NONE'
          #.DrA.MailRecipient←Config Setting'MailRecipient' 0
          #.DrA.Mode←Config.Debug
          #.DrA.NoUser←Config Setting'NoUser' 1 1 ⍝ run without user interaction
          #.DrA.Path←AppRoot ⍝ Where to put log files
          #.DrA.SMTP_Gateway←Config Setting'SMTP_Gateway' 0
          #.DrA.UseHTTP←Config Setting'UseHTTP' 1 0
      :EndIf
    ∇

    ∇ ConfigureDatasources ms;file;ds;name;tmp;orig;dyalog
      ⍝ load any datasource definitions
      :If ~0∊⍴ms.Datasources←'Name'ReadConfiguration'Datasources'
          :For ds :In ms.Datasources
              :For name :In ds.⎕NL ¯2
                  orig←tmp←ds.⍎name
                  tmp←SubstPath tmp
                  :If orig≢tmp
                      ⍎'ds.',name,'←tmp'
                  :EndIf
              :EndFor
          :EndFor

          :Trap 0
              :If 0=#.⎕NC'SQA'
                  dyalog←2 ⎕NQ'.' 'GetEnvironment' 'DYALOG'
                  'SQA'#.⎕CY dyalog,'ws/sqapl' ⍝ copy in SQA
              :EndIf
              :If 0≠1⊃#.SQA.Init'' ⍝ and initialize
                  1 ms.Log'SQA failed to initialize'
              :EndIf
          :Else
              1 ms.Log'SQA failed to initialize'
          :EndTrap
      :EndIf
    ∇

    ∇ ConfigureVirtual ms;file;virtual;mask;inds;v
      ⍝ load virtual (alias) definitions if any
      ms.Config.Virtual←''
      :If ~0∊⍴virtual←'alias'ReadConfiguration'Virtual'
          :If 0∊mask←{⍵=⍳⍴⍵}inds←{⍵⍳⍵}virtual.alias ⍝ check for duplicate aliases, keep first
              1 ms.Log'Duplicate virtual aliases defined (first occurrence will be used): ',1↓enlist',',¨(~mask)/virtual.alias
              virtual←mask/virtual
          :EndIf
          ⍝ substitute server and site root if found
          virtual.path←SubstPath¨virtual.path
          :For v :In virtual
              :If ~#.Files.DirExists v.path ⍝ check if mapped path exists
                  1 ms.Log'Virtual path not found: ',v.path
                  virtual~←v
              :Else
                  :If #.Files.DirExists AppRoot,v.alias ⍝ check if alias conflicts with local path
                      1 ms.Log'Virtual alias "',v.alias,'" overrides site path of same name.'
                  :EndIf
              :EndIf
          :EndFor
          ms.Config.Virtual←virtual
      :EndIf
    ∇

    ∇ ConfigureResources ms;file;mask;inds;names;uses;map;n;res;f;missing;order
      ⍝ load resource definitions if any
      ms.Config.Resources←0 3⍴⊂''
      :If ~0∊⍴res←'name'ReadConfiguration'Resources'
          :If 0∊mask←{⍵=⍳⍴⍵}inds←{⍵⍳⍵}names←res.name ⍝ check for duplicate aliases, keep first
              1 ms.Log'Duplicate resources defined (first occurence will be used): ',1↓enlist',',¨(~mask)/res.name
              res←mask/res
          :EndIf
          ⍝ build the dependency map
          uses←{(eis⍣(⊃0<⍴⍵))⍵}¨res Setting'uses'
          inds←res.name∘⍳¨uses
          n←⊃⍴res
          :If ∨/mask←∨/¨missing←n<inds
              1 ms.Log'Invalid resource dependency found for:',enlist' ',¨mask/res.name
              inds←(~missing)/¨inds
          :EndIf
          order←OrderResources inds
          inds←(order∘⍳¨inds)[order]
          res←res[order]
          map←,(2⍴n)⍴(1+n)↑1 ⍝ identity matrix
          map[enlist(n×¯1+⍳n)+¨inds]←1
          map←(2⍴n)⍴map
          map←↓{({⍺∨⍺∨.∧⍵}⍣≡)⍨⍵}map
          ⍝ ms.Config.Resources[;1] resource name, [;2] scripts used [;3] styles used
          f←{SubstPath¨{⍵~⊂''}∘∪¨⊃¨,/¨map/¨⊂eis¨⍵}
          ms.Config.Resources←res.name,(f res Setting'script'),[1.1]f res Setting'style'
      :EndIf
    ∇

    ∇ r←OrderResources inds;n;mask
      n←⍳⍴inds
      r←n/⍨mask←0∘∊∘⍴¨inds ⍝ roots with no dependencies
      inds/⍨←~mask
      n/⍨←~mask
      :While ~0∊⍴inds
          mask←∧/¨inds∊¨⊂r
          r,←mask/n
          inds/⍨←~mask
          n/⍨←~mask
      :EndWhile
    ∇

    ∇ ConfigureContentTypes ms;file;ct;inds;exts;types;mask;exp;n
      ⍝ load supported content types
      ms.Config.ContentTypes←0 2⍴⊂''
      :If ~0∊⍴ct←ReadConfiguration'ContentTypes'
          exts←#.Strings.lc¨ct Setting'ext'
          types←ct Setting'type'
          :If ~0∊⍴inds←{⍵/⍳⍴⍵}enlist','∊¨exts
              mask←(⍴exts)⍴1
              exp←{⎕ML←3 ⋄ (⍵≠',')⊂⍵}¨exts[inds]
              mask[inds]←n←⍬∘⍴∘⍴¨exp
              (exts types)←mask∘/¨exts types
              exts[(n/inds)++\~enlist n↑¨1]←⊃,/exp
          :EndIf
          ms.Config.ContentTypes←exts,[1.1]types
      :Else
          1 ms.Log'No content types defined?'
      :EndIf
    ∇

    ∇ ConfigureLogger ms;file;log
      ⍝ load logger information
      ms.Config.Logger←⎕NS''
      ms.Config.Logger.active←0
      :If ~0∊⍴log←ReadConfiguration'Logger'
          ms.Config.Logger.active←log Setting'active' 1 0
          ms.Config.Logger.directory←SubstPath log Setting'directory' 0 ''
          ms.Config.Logger.frequency←log Setting'frequency' 0 ''
          ms.Config.Logger.sizelimit←log Setting'sizelimit' 1 0
      :EndIf
    ∇

    :endsection

    :section Utilities
    disperror←{}∘{326=⎕DR ⍵:'' ⋄ '***'≡3↑⍵:⎕←⍵ ⋄ ''}
    isWin←('.' ⎕WG 'APLVersion')[3]≡⊂,'W'
    fileSep←'/\'[1+isWin]
    MSRoot←{(1-⌊/'/\'⍳⍨⌽⍵)↓⍵}⎕WSID
    isRelPath←{{~'/\'∊⍨(⎕IO+2×isWin∧':'∊⍵)⊃⍵}3↑⍵}
    enlist←{⎕ML←1⋄∊⍵}
      tonum←{⍺←0
          1∊⍺:tonumvec ⍵
          w←⍵ ⋄ ((w='-')/w)←'¯'
          ⊃⊃{~∧/⍺:⎕SIGNAL 11 ⋄ ⍵}/⎕VFI w}
    try←{0::'' ⋄⍎⍵}
    empty←{0∊⍴⍵}
    notEmpty←~∘empty
    eis←{(,∘⊂)⍣((326∊⎕DR ⍵)<2>|≡⍵),⍵} ⍝ Enclose if simple
    isRef←{(0∊⍴⍴⍵)∧326=⎕DR ⍵}
    folderize←{¯1↑⍵∊'/\':⍵ ⋄ ⍵,fileSep}
    makeSitePath←{⍺{((isRelPath ⍵)/⍺),⍵},folderize ⍵}
    Log←{⎕←⍵}

    ∇ r←tonumvec v;to;minus;digits;c;mask
    ⍝ tonum vector version
    ⍝ allows for specific of ranges and comma or space delimited numbers
    ⍝ tonumvec '8080-8090'  or '5,7-9,11-15'
      r←⍬
      ⎕SIGNAL 11/⍨~∧/v∊⎕D,'., -¯'
      to←{⍺←⍵ ⋄ ⍺,⍺+(¯1*⍺>⍵)×⍳|⍺-⍵}
      v←('^\s*|\s*$'⎕R'')('\s+'⎕R' ')('\s*-\s*'⎕R'-')v
      minus←'-'=v
      digits←v∊⎕D,'.'
      ((minus>(minus∨{1↓⍵,0}digits)∧{¯1↓0,⍵}digits)/v)←⊂'¯'
      ((' '=v)/v)←','
      (('-'=v)/v)←⊂' to '
      :Trap 0
          :For c :In {⎕ML←3 ⋄ ⍵⊂⍨⍵≠','}∊v
              r,←⍎∊c
          :EndFor
      :Else
          ⎕SIGNAL 11
      :EndTrap
    ∇

    ∇ r←SubstPath r
      r←(#.Strings.subst∘('%ServerRoot%'(¯1↓MSRoot)))r
      r←(#.Strings.subst∘('%SiteRoot%'(¯1↓AppRoot)))r
    ∇

    ∇ r←isRunning
      :Trap r←0
          r←ms.TID∊⎕TNUMS
      :EndTrap
    ∇

    ∇ r←Oops;dmx;ends;xsi
    ⍝ debugging framework to bubble up to user's code when rendering fails
      r←'⎕SIGNAL 811'
      ends←{(,⍺)≡(-⍴,⍺)↑⍵}
      :If {0::0 ⋄ #.HtmlPage∊∊⎕CLASS ⍵}⊃⊃⎕RSI
          r←'⎕TRAP←(800 ''C'' ''→FAIL'')(811 ''E'' ''⎕SIGNAL 801'')(813 ''E'' ''⎕SIGNAL 803'')(812 ''S'')(85 ''N'')(0 ''S'')'
          ⎕←''
          ⎕←'*** MiServer Debug ***'
          ⎕←↑⎕DMX.DM
          ⎕←''
          ⎕←'      ⎕SIGNAL 800 ⍝ to ignore this error and carry on'
          ⎕←'      or Press Ctrl-Enter to invoke debugger'
      :Else
          :Select ⎕DMX.EN
          :Case 801
              xsi←⎕XSI
              :If '.HandleMSP'ends 2⊃xsi
                  r←'→FAIL'
              :ElseIf '.HandleMSP'ends 4⊃xsi
                  :If '.Render'ends 3⊃xsi
                      r←'⎕SIGNAL 813'
                  :EndIf
              :ElseIf '.HandleMSP'ends 3⊃xsi
                  :If '.Wrap'ends 2⊃xsi
                      r←'⎕SIGNAL 813'
                  :EndIf
              :Else
                  r←'⎕SIGNAL 811'
              :EndIf
          :Case 803
              r←'⎕SIGNAL 812'
              ⎕←'Press Ctrl-Enter to invoke debugger'
          :Else
              :Trap 0
                  dmx←⎕DMX
                  ⎕←'*** MiServer Debug ***'
                  ⎕←'' 'occurred at:',⍪dmx.(EM(2⊃DM))
                  ⎕←'' 'SI Stack is ',(⍕¯1+⍴⎕XSI),' levels deep'
                  ⎕←''
              :EndTrap
              ⎕←'      ⎕SIGNAL 800 ⍝ to ignore this error and carry on'
              ⎕←'      ⎕SIGNAL 801 ⍝ to cut back and debug'
              r←''
          :EndSelect
      :EndIf
    ∇
    :endsection

:EndNamespace

:Namespace Boot

    (⎕ML ⎕IO)←1

    :section Startup/Shutdown

    ∇ Run root

      AppRoot←folderize root  ⍝ application (website) root
      AppRoot Load 1 ⍝ load essential objects
      #.Utils.SetupCompatibility
      ms←Init ConfigureServer AppRoot ⍝ read configuration and create server instance
      ConfigureDatasources ms
      ConfigureVirtual ms
      ConfigureResources ms
      ConfigureContentTypes ms
      ConfigureLogger ms

      ms.Run
    ∇

    ∇ {AppRoot}Load yes;files;f;classes;class;utils;t;core;HTML;extensions;HTMLsubdirs
      ⍝ Load required objects for MiServer
      ⍝ Note: DRC namespace is not SALTed
      ⍝ yes - 1 to perform load, 0 to clean up

      classes←''
      :If 0≠⎕NC'AppRoot'
          classes←(⎕SE.SALT.List AppRoot,'Code -raw')[;1 2] ⍝ Classes in application folder
          classes←(empty¨classes[;1])/classes[;2] ⍝ remove directory entries (have <DIR> in [;1])
      :EndIf
      utils←(⎕SE.SALT.List MSRoot,'Utils -raw')[;2]   ⍝ find utility libraries
      core←(⊂'Boot')~⍨(⎕SE.SALT.List MSRoot,'Core -raw')[;2]
      extensions←(⎕SE.SALT.List MSRoot,'Extensions -raw')[;2]
      HTML←(⎕SE.SALT.List MSRoot,'HTML -raw')[;2] ⍝ force to be loaded first
      HTMLsubdirs←HTML∩,⎕SE.SALT.List MSRoot,'HTML -folder'
      :If yes

          files←'Core/'∘,¨core
          files,←'Utils/'∘,¨utils
          files,←'Extensions/'∘,¨extensions

          :For f :In files
              disperror ⎕SE.SALT.Load MSRoot,f,' -target=#' ⍝ do not reload already loaded spaces
          :EndFor

          #.SupportedHtml5Elements.Build_html_namespace

          :For f :In HTML
              disperror ⎕SE.SALT.Load MSRoot,'HTML/',f,' -target=#'
              :If (⊂f)∊HTMLsubdirs
                  disperror¨⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
              :EndIf
          :EndFor

⍝          :For f :In HTML∩,⎕SE.SALT.List MSRoot,'HTML -folder'
⍝              ⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
⍝          :EndFor

          :If 0≠⍴classes
              :For class :In classes
                  disperror 1 ⎕SE.SALT.Load AppRoot,'Code/',class,' -target=#'
              :EndFor
          :EndIf

          'Pages'#.⎕NS'' ⍝ Container Space for loaded classes
          #.Pages.(MiPage MildPage RESTful)←#.(MiPage MildPage RESTful)
          BuildEAWC ⍝ build the Easy As ⎕WC namespace
          :If #.Files.DirExists AppRoot,'/Code/Templates/'
              disperror ⎕SE.SALT.Load AppRoot,'/Code/Templates/* -target=#.Pages'
          :EndIf

      :Else ⍝ Cleanup
          #.⎕EX¨classes
          #.⎕EX¨utils
          #.⎕EX'Pages'
          #.⎕EX¨'MiServer' 'HTTPRequest'
      :EndIf
    ∇

    ∇ LoadHTML f
    ⍝ Utility to reload an HTML content-generating namespace
      disperror ⎕SE.SALT.Load MSRoot,'HTML/',f,' -target=#'
      disperror¨⎕SE.SALT.Load MSRoot,'HTML/',f,'/* -target=#.',f
    ∇

    ∇ ms←Init Config;path;class;classes;e;res;mask
     ⍝ Create instances of MiServer, Session and Authentication Handlers

      ms←⎕NEW(#⍎Config.ClassName)Config
      path←MSRoot,'Extensions/'

      :If 0≠⍴Config.SessionHandler
          class←⎕SE.SALT.Load path,Config.SessionHandler
          ms.SessionHandler←⎕NEW class ms
      :EndIf

      :If 0≠⍴Config.Authentication
          class←⎕SE.SALT.Load path,Config.Authentication
          ms.Authentication←⎕NEW class ms
      :EndIf

      :If 0≠⍴Config.SupportedEncodings
          {}⎕SE.SALT.Load path,'ContentEncoder'
          :For e :In Config.SupportedEncodings
              class←⎕SE.SALT.Load path,e
              ms.Encoders,←⎕NEW class
          :EndFor
          :If ∨/mask←0≠1⊃¨res←ms.Encoders.Init
              2 ms.Log'Content Encoding Initialization failed for:',∊' ',¨mask/ms.Encoders.Encoding
              ms.Encoders←(~mask)/ms.Encoders
          :EndIf
      :EndIf
      Config.UseContentEncoding∧←0≠⍴ms.Encoders

      :If 0≠⍴Config.Logger
          class←⎕SE.SALT.Load path,Config.Logger
          ms.Logger←⎕NEW class ms
      :EndIf
    ∇

    ∇ End;classes;z;m
      ⍝ Clean up the workspace

      :If 9=⎕NC'ms'
          :Trap 0
              ms.End
          :EndTrap
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.SessionHandler'
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.Authentication'
          {}try'⎕EX⍕⊃⊃⎕CLASS ms.Logger'
          {}try'⎕EX⍕¨∪enlist ⎕CLASS¨ms.Encoders'
          ⎕EX⍕⊃⊃⎕CLASS ms
          ⎕EX'ms'
      :EndIf

      :If 9=⎕NC'SQA'
          {}try'SQA.Close''.'''
      :EndIf

      :If 0≠⍴classes←↓#.⎕NL 9.4
      :AndIf 0≠⍴classes←(m←2=⊃∘⍴¨z←⎕CLASS¨#⍎¨classes)/classes
      :AndIf 0≠⎕NC'#.MiPage'
          classes←(#.MiPage≡¨2 1∘⊃¨m/z)/classes
          #.⎕EX↑⍕¨classes ⍝ Erase loaded classes
      :EndIf

      Load 0
      ⎕EX'#.MiPage'
      ⎕EX'AppRoot'
      {}try'#.DRC.Close ''.'''
    ∇

    ∇ BuildEAWC;src;sources;fields;source;list;mask;refs;target
     ⍝ Build the Easy As ⎕WC namespace from core classes and its own source
     ⍝ Also build the #._ namespace with shortcuts
      sources←#._html #._SF #._JQ #._DC #._JS
⍝      fields←''
      '_'#.⎕NS''
      :For source :In sources
          list←source.⎕NL ¯9.4
          list←list/⍨'_'≠⊃¨list
          :If ∨/mask←0≠refs←source{6::0 ⋄ (⍕⍺){('.'∊1↓s↓r)<⍺≡(s←⍴⍺)↑r←⍕⍵}t←⍺⍎⍵:t ⋄ 0}¨list
              #._⍎∊(mask/list){'⋄',⍺,'←',⍕⍵}¨mask/refs
          :EndIf
      :EndFor
    ∇

    :endsection

    :section Configuration

    ∇ r←ns Setting pars;name;num;default;mask
    ⍝ returns setting from a config style namespace or provides a default if it doesn't exist
    ⍝ pars - name [num] [default]
    ⍝ ns - namespace reference
    ⍝ name - name of the setting
    ⍝ num - 1 if setting is numeric scalar, (,1) if numeric vector is allowed, 0 otherwise
    ⍝ default - default value if not found
      pars←eis pars
      (name num)←2↑pars,(⍴pars)↓'' 0 ''
      :If 2<⍴pars ⋄ default←3⊃pars
      :Else ⋄ default←(1+num)⊃''⍬
      :EndIf
      r←(⍴ns)⍴⊂default
      :If ∨/mask←0≠⊃¨ns.⎕NC⊂name
          (mask/r)←(((⍴⍴num)∘tonum)⍣(⊃num))¨(mask/ns).⍎⊂name
      :EndIf
      :If 0=⍴⍴r ⋄ r←⊃r ⋄ :EndIf
    ∇

    ∇ config←{element}ReadConfiguration type;serverconfig;file;siteconfig;thing;ind;mask
    ⍝ Attempt to read configuration file
    ⍝ 1) from server root MSRoot
    ⍝ 2) from site root AppRoot
    ⍝ merging the two if they both exist - site settings overrule server settings
      config←''
      :If #.Files.Exists file←MSRoot,'Config/',type,'.xml'
          config←serverconfig←(#.XML.ToNS #.Files.GetText file)⍎type
      :EndIf
      :If #.Files.Exists file←AppRoot,'Config/',type,'.xml'
          siteconfig←(#.XML.ToNS #.Files.GetText file)⍎type
          :If 0∊⍴config
              config←siteconfig
          :ElseIf 0=⎕NC'element'
              {}{try'serverconfig.',⍵,'←siteconfig.',⍵}¨siteconfig.⎕NL ¯2
          :Else ⍝ element specifies the element(s) to search on
              :For thing :In siteconfig
                  :If 0≠thing.⎕NC element
                      :If ∨/mask←0≠∊serverconfig.⎕NC⊂element
                          :If (+/mask)<ind←((mask/serverconfig)⍎¨⊂element)⍳⊂thing⍎element
                              serverconfig,←thing
                          :Else
                              serverconfig[(mask/⍳⍴mask)[ind]]←thing
                          :EndIf
                      :Else
                          serverconfig,←thing
                      :EndIf
                  :EndIf
              :EndFor
              config←serverconfig
          :EndIf
      :EndIf
    ∇

    ∇ Config←ConfigureServer AppRoot;file
    ⍝ configure server level settings, setting defaults for needed ones that are not supplied
      Config←ReadConfiguration'Server'

      Config.AllowedHttpCommands←{⎕ML←3 ⋄ ⍵⊂⍨~⍵∊' ,'}#.Strings.lc Config Setting'AllowedHttpCommands' 0 'get,post'
      Config.AppRoot←AppRoot
      Config.Authentication←Config Setting'Authentication' 0 'SimpleAuth'
      Config.CertFile←Config Setting'CertFile' 0 ''
      Config.ClassName←Config Setting'ClassName' 0 'MiServer'
      Config.Debug←Config Setting'Debug' 1 0
      Config.DefaultExtension←Config Setting'DefaultExtension' 0 '.mipage'
      Config.DefaultPage←Config Setting'DefaultPage' 0 'index.mipage'
      Config.FormatHtml←Config Setting'FormatHtml' 1 0
      Config.Host←Config Setting'Host' 0 'localhost'
      Config.HttpCacheTime←Config Setting'HttpCacheTime' 1 0 ⍝ default to off (0)
      Config.IPVersion←Config Setting'IPVersion' 0 'IPV4'
      Config.IdleTimeOut←Config Setting'IdleTimeOut' 1 0 ⍝ default to none (0)
      Config.KeyFile←Config Setting'KeyFile' 0 ''
      Config.Lang←Config Setting'Lang' 0 'en'
      Config.LogMessageLevel←Config Setting'LogMessageLevel' 1 1 ⍝ default to error messages only
      Config.Logger←Config Setting'Logger' 0 ''
      Config.MSRoot←MSRoot
      Config.Name←Config Setting'Name' 0 'MiServer'
      Config.Port←Config Setting'Port' 1 8080
      Config.Ports←Config Setting'Ports'(,1)⍬
      Config.Production←Config Setting'Production' 1 0 ⍝ production mode?  (0/1 = development debug framework en/disabled)
      Config.RESTful←Config Setting'RESTful' 1 0 ⍝ RESTful web service?
      Config.RootCertDir←Config Setting'RootCertDir' 0 ''
      Config.Root←AppRoot ⍝ folderize MSRoot{((isRelPath ⍵)/⍺),⍵}AppRoot
      Config.SSLFlags←Config Setting'SSLFlags' 1(32+64)  ⍝ Accept Without Validating, RequestClientCertificate
      Config.Secure←Config Setting'Secure' 1 0
      Config.Server←Config Setting'Server' 0 ''
      Config.SessionHandler←Config Setting'SessionHandler' 0 'SimpleSessions'
      Config.SessionTimeOut←Config Setting'SessionTimeOut' 1 30 ⍝ 30 minute timeout
      Config.SupportedEncodings←{(⊂'')~⍨1↓¨(⍵=⊃⍵)⊂⍵}',',Config Setting'SupportedEncodings' 0
      Config.TempFolder←folderize Config.Root{0∊⍴⍵:⍵ ⋄ ((isRelPath ⍵)/⍺),⍵}Config Setting'TempFolder' 0
      Config.TrapErrors←Config Setting'TrapErrors' 1 0
      Config.UseContentEncoding←Config Setting'UseContentEncoding' 1 0 ⍝ aka HTTP Compression default off (0)

      :If 0≠⎕NC'#.DrA' ⍝ Transfer DrA config options
          {}#.DrA.SetDefaults
          #.DrA.AppName←Config.Name
          #.DrA.MailMethod←Config Setting'MailMethod' 0 'NONE'
          #.DrA.MailRecipient←Config Setting'MailRecipient' 0
          #.DrA.Mode←Config.Debug
          #.DrA.NoUser←Config Setting'NoUser' 1 1 ⍝ run without user interaction
          #.DrA.Path←AppRoot ⍝ Where to put log files
          #.DrA.SMTP_Gateway←Config Setting'SMTP_Gateway' 0
          #.DrA.UseHTTP←Config Setting'UseHTTP' 1 0
      :EndIf
    ∇

    ∇ ConfigureDatasources ms;file;ds;name;tmp;orig;dyalog
      ⍝ load any datasource definitions
      :If ~0∊⍴ms.Datasources←'Name'ReadConfiguration'Datasources'
          :For ds :In ms.Datasources
              :For name :In ds.⎕NL ¯2
                  orig←tmp←ds.⍎name
                  tmp←SubstPath tmp
                  :If orig≢tmp
                      ⍎'ds.',name,'←tmp'
                  :EndIf
              :EndFor
          :EndFor

          :Trap 0
              :If 0=#.⎕NC'SQA'
                  dyalog←2 ⎕NQ'.' 'GetEnvironment' 'DYALOG'
                  'SQA'#.⎕CY dyalog,'ws/sqapl' ⍝ copy in SQA
              :EndIf
              :If 0≠1⊃#.SQA.Init'' ⍝ and initialize
                  1 ms.Log'SQA failed to initialize'
              :EndIf
          :Else
              1 ms.Log'SQA failed to initialize'
          :EndTrap
      :EndIf
    ∇

    ∇ ConfigureVirtual ms;file;virtual;mask;inds;v
      ⍝ load virtual (alias) definitions if any
      ms.Config.Virtual←''
      :If ~0∊⍴virtual←'alias'ReadConfiguration'Virtual'
          :If 0∊mask←{⍵=⍳⍴⍵}inds←{⍵⍳⍵}virtual.alias ⍝ check for duplicate aliases, keep first
              1 ms.Log'Duplicate virtual aliases defined (first occurrence will be used): ',1↓enlist',',¨(~mask)/virtual.alias
              virtual←mask/virtual
          :EndIf
          ⍝ substitute server and site root if found
          virtual.path←SubstPath¨virtual.path
          :For v :In virtual
              :If ~#.Files.DirExists v.path ⍝ check if mapped path exists
                  1 ms.Log'Virtual path not found: ',v.path
                  virtual~←v
              :Else
                  :If #.Files.DirExists AppRoot,v.alias ⍝ check if alias conflicts with local path
                      1 ms.Log'Virtual alias "',v.alias,'" overrides site path of same name.'
                  :EndIf
              :EndIf
          :EndFor
          ms.Config.Virtual←virtual
      :EndIf
    ∇

    ∇ ConfigureResources ms;file;mask;inds;names;uses;map;n;res;f;missing;order
      ⍝ load resource definitions if any
      ms.Config.Resources←0 3⍴⊂''
      :If ~0∊⍴res←'name'ReadConfiguration'Resources'
          :If 0∊mask←{⍵=⍳⍴⍵}inds←{⍵⍳⍵}names←res.name ⍝ check for duplicate aliases, keep first
              1 ms.Log'Duplicate resources defined (first occurence will be used): ',1↓enlist',',¨(~mask)/res.name
              res←mask/res
          :EndIf
          ⍝ build the dependency map
          uses←{(eis⍣(⊃0<⍴⍵))⍵}¨res Setting'uses'
          inds←res.name∘⍳¨uses
          n←⊃⍴res
          :If ∨/mask←∨/¨missing←n<inds
              1 ms.Log'Invalid resource dependency found for:',enlist' ',¨mask/res.name
              inds←(~missing)/¨inds
          :EndIf
          order←OrderResources inds
          inds←(order∘⍳¨inds)[order]
          res←res[order]
          map←,(2⍴n)⍴(1+n)↑1 ⍝ identity matrix
          map[enlist(n×¯1+⍳n)+¨inds]←1
          map←(2⍴n)⍴map
          map←↓{({⍺∨⍺∨.∧⍵}⍣≡)⍨⍵}map
          ⍝ ms.Config.Resources[;1] resource name, [;2] scripts used [;3] styles used
          f←{SubstPath¨{⍵~⊂''}∘∪¨⊃¨,/¨map/¨⊂eis¨⍵}
          ms.Config.Resources←res.name,(f res Setting'script'),[1.1]f res Setting'style'
      :EndIf
    ∇

    ∇ r←OrderResources inds;n;mask
      n←⍳⍴inds
      r←n/⍨mask←0∘∊∘⍴¨inds ⍝ roots with no dependencies
      inds/⍨←~mask
      n/⍨←~mask
      :While ~0∊⍴inds
          mask←∧/¨inds∊¨⊂r
          r,←mask/n
          inds/⍨←~mask
          n/⍨←~mask
      :EndWhile
    ∇

    ∇ ConfigureContentTypes ms;file;ct;inds;exts;types;mask;exp;n
      ⍝ load supported content types
      ms.Config.ContentTypes←0 2⍴⊂''
      :If ~0∊⍴ct←ReadConfiguration'ContentTypes'
          exts←#.Strings.lc¨ct Setting'ext'
          types←ct Setting'type'
          :If ~0∊⍴inds←{⍵/⍳⍴⍵}enlist','∊¨exts
              mask←(⍴exts)⍴1
              exp←{⎕ML←3 ⋄ (⍵≠',')⊂⍵}¨exts[inds]
              mask[inds]←n←⍬∘⍴∘⍴¨exp
              (exts types)←mask∘/¨exts types
              exts[(n/inds)++\~enlist n↑¨1]←⊃,/exp
          :EndIf
          ms.Config.ContentTypes←exts,[1.1]types
      :Else
          1 ms.Log'No content types defined?'
      :EndIf
    ∇

    ∇ ConfigureLogger ms;file;log
      ⍝ load logger information
      ms.Config.Logger←⎕NS''
      ms.Config.Logger.active←0
      :If ~0∊⍴log←ReadConfiguration'Logger'
          ms.Config.Logger.active←log Setting'active' 1 0
          ms.Config.Logger.directory←SubstPath log Setting'directory' 0 ''
          ms.Config.Logger.frequency←log Setting'frequency' 0 ''
          ms.Config.Logger.sizelimit←log Setting'sizelimit' 1 0
      :EndIf
    ∇

    :endsection

    :section Utilities
    disperror←{}∘{326=⎕DR ⍵:'' ⋄ '***'≡3↑⍵:⎕←⍵ ⋄ ''}
    isWin←('.' ⎕WG 'APLVersion')[3]≡⊂,'W'
    fileSep←'/\'[1+isWin]
    MSRoot←{(1-⌊/'/\'⍳⍨⌽⍵)↓⍵}⎕WSID
    isRelPath←{{~'/\'∊⍨(⎕IO+2×isWin∧':'∊⍵)⊃⍵}3↑⍵}
    enlist←{⎕ML←1⋄∊⍵}
      tonum←{⍺←0
          1∊⍺:tonumvec ⍵
          w←⍵ ⋄ ((w='-')/w)←'¯'
          ⊃⊃{~∧/⍺:⎕SIGNAL 11 ⋄ ⍵}/⎕VFI w}
    try←{0::'' ⋄⍎⍵}
    empty←{0∊⍴⍵}
    notEmpty←~∘empty
    eis←{(,∘⊂)⍣((326∊⎕DR ⍵)<2>|≡⍵),⍵} ⍝ Enclose if simple
    isRef←{(0∊⍴⍴⍵)∧326=⎕DR ⍵}
    folderize←{¯1↑⍵∊'/\':⍵ ⋄ ⍵,fileSep}
    makeSitePath←{⍺{((isRelPath ⍵)/⍺),⍵},folderize ⍵}
    Log←{⎕←⍵}

    ∇ r←tonumvec v;to;minus;digits;c;mask
    ⍝ tonum vector version
    ⍝ allows for specific of ranges and comma or space delimited numbers
    ⍝ tonumvec '8080-8090'  or '5,7-9,11-15'
      r←⍬
      ⎕SIGNAL 11/⍨~∧/v∊⎕D,'., -¯'
      to←{⍺←⍵ ⋄ ⍺,⍺+(¯1*⍺>⍵)×⍳|⍺-⍵}
      v←('^\s*|\s*$'⎕R'')('\s+'⎕R' ')('\s*-\s*'⎕R'-')v
      minus←'-'=v
      digits←v∊⎕D,'.'
      ((minus>(minus∨{1↓⍵,0}digits)∧{¯1↓0,⍵}digits)/v)←⊂'¯'
      ((' '=v)/v)←','
      (('-'=v)/v)←⊂' to '
      :Trap 0
          :For c :In {⎕ML←3 ⋄ ⍵⊂⍨⍵≠','}∊v
              r,←⍎∊c
          :EndFor
      :Else
          ⎕SIGNAL 11
      :EndTrap
    ∇

    ∇ r←SubstPath r
      r←(#.Strings.subst∘('%ServerRoot%'(¯1↓MSRoot)))r
      r←(#.Strings.subst∘('%SiteRoot%'(¯1↓AppRoot)))r
    ∇

    ∇ r←isRunning
      :Trap r←0
          r←ms.TID∊⎕TNUMS
      :EndTrap
    ∇

    ∇ r←Oops;dmx;ends;xsi
    ⍝ debugging framework to bubble up to user's code when rendering fails
      r←'⎕SIGNAL 811'
      ends←{(,⍺)≡(-⍴,⍺)↑⍵}
      :If {0::0 ⋄ #.HtmlPage∊∊⎕CLASS ⍵}⊃⊃⎕RSI
          r←'⎕TRAP←(800 ''C'' ''→FAIL'')(811 ''E'' ''⎕SIGNAL 801'')(813 ''E'' ''⎕SIGNAL 803'')(812 ''S'')(85 ''N'')(0 ''S'')'
          ⎕←''
          ⎕←'*** MiServer Debug ***'
          ⎕←↑⎕DMX.DM
          ⎕←''
          ⎕←'      ⎕SIGNAL 800 ⍝ to ignore this error and carry on'
          ⎕←'      or Press Ctrl-Enter to invoke debugger'
      :Else
          :Select ⎕DMX.EN
          :Case 801
              xsi←⎕XSI
              :If '.HandleMSP'ends 2⊃xsi
                  r←'→FAIL'
              :ElseIf '.HandleMSP'ends 4⊃xsi
                  :If '.Render'ends 3⊃xsi
                      r←'⎕SIGNAL 813'
                  :EndIf
              :ElseIf '.HandleMSP'ends 3⊃xsi
                  :If '.Wrap'ends 2⊃xsi
                      r←'⎕SIGNAL 813'
                  :EndIf
              :Else
                  r←'⎕SIGNAL 811'
              :EndIf
          :Case 803
              r←'⎕SIGNAL 812'
              ⎕←'Press Ctrl-Enter to invoke debugger'
          :Else
              :Trap 0
                  dmx←⎕DMX
                  ⎕←'*** MiServer Debug ***'
                  ⎕←'' 'occurred at:',⍪dmx.(EM(2⊃DM))
                  ⎕←'' 'SI Stack is ',(⍕¯1+⍴⎕XSI),' levels deep'
                  ⎕←''
              :EndTrap
              ⎕←'      ⎕SIGNAL 800 ⍝ to ignore this error and carry on'
              ⎕←'      ⎕SIGNAL 801 ⍝ to cut back and debug'
              r←''
          :EndSelect
      :EndIf
    ∇
    :endsection

:EndNamespace


ejToggleButtonSimple QA fix

ejToggleButtonSimple QA fix

 msg←Test dummy;button

 button←'CssSelector'Find'.e-btn'

 ⍝ Check if button toggles on
 Click button
 :If 0=⍴msg←button WaitFor'That was a BOLD move!' 'First toggle did not happen'

 ⍝ Check if button toggles off
     Click button
     msg←button WaitFor'Toggle me if you dare...' 'Second toggle did not happen'
 :EndIf

 msg←Test dummy;label
 label←'CssSelector'Find'label'
 'Click'MoveToElement'btn1' 10 10
 msg←label WaitFor'That was a BOLD move!' 'First toggle did not happen'
 →(0≠⍴msg)⍴0
 'Click'MoveToElement'btn1' 10 10
 msg←label WaitFor'Toggle me if you dare...' 'Second toggle did not happen'


JQuery strings are not surrounded by quotes

: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
    ⍝ 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∧'function'≡8↑array~' '
              r←array
          :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←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/'"'
    ∇

⍝   ---------------------------------------------------------------------
    :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
      :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?
          'Invalid JSON: expected }'⎕SIGNAL 600 if'}'≠¯1↑str
          obj←options parseNS strip str
      :ElseIf '['=c1                           ⍝ an array maybe?
          'Invalid JSON: expected ]'⎕SIGNAL 600 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;ns;d;p;x
    ⍝ 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
      :If 0∊⍴nvp ⋄ r←'[]' ⋄ :Return ⋄ :EndIf
      r←'['
      :Select |≡nvp
      :Case 1
          nvp←⊂(,¨⍣(isChar nvp))nvp
      :Case 2
          nvp←⊂,¨¨nvp
      :Case 3
          nvp←⊂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←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ ⍕⍵}2⊃x
                      r,←'"',(1⊃x),'":',d,','
                  :EndFor
              :EndIf
              r←(¯1↓r),'},'
          :EndSelect
      :EndFor
      r←(¯1↓r),']'
    ∇

    ∇ r←a formatData w
      :Access public shared
      r←a{z←⎕NS¨(≢⍵)⍴⊂'' ⋄ 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 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))))

    ∇

⍝  ∇ r←true
⍝    :Access public shared
⍝    r←⎕NS''
⍝    r.⎕DF'true'
⍝  ∇
⍝
⍝  ∇ r←false
⍝    :Access public shared
⍝    r←⎕NS''
⍝    r.⎕DF'false'
⍝  ∇

    ⎕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
    ⍝ 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∧'function'≡8↑array~' '
        r←array
      :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←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/'"'
  ∇

⍝   ---------------------------------------------------------------------
  :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
    :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?
      'Invalid JSON: expected }'⎕SIGNAL 600 if'}'≠¯1↑str
      obj←options parseNS strip str
    :ElseIf '['=c1                           ⍝ an array maybe?
      'Invalid JSON: expected ]'⎕SIGNAL 600 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;ns;d;p;x
    ⍝ 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
    :If 0∊⍴nvp ⋄ r←'[]' ⋄ :Return ⋄ :EndIf
    r←'['
    :Select |≡nvp
    :Case 1
      nvp←⊂(,¨⍣(isChar nvp))nvp
    :Case 2
      nvp←⊂,¨¨nvp
    :Case 3
      nvp←⊂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←{(isChar ⍵)>isJSON ⍵:'"',(JAchars ⍵),'"' ⋄ ⍕⍵}2⊃x
            r,←'"',(1⊃x),'":',d,','
          :EndFor
        :EndIf
        r←(¯1↓r),'},'
      :EndSelect
    :EndFor
    r←(¯1↓r),']'
  ∇

  ∇ r←a formatData w
    :Access public shared
    r←a{z←⎕NS¨(≢⍵)⍴⊂'' ⋄ 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 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))))

  ∇

⍝  ∇ r←true
⍝    :Access public shared
⍝    r←⎕NS''
⍝    r.⎕DF'true'
⍝  ∇
⍝
⍝  ∇ r←false
⍝    :Access public shared
⍝    r←⎕NS''
⍝    r.⎕DF'false'
⍝  ∇

  ⎕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 $


Revert "Added _JSS.RemoveClass"

Revert "Added _JSS.RemoveClass"

This reverts commit d3e328a8550be6fa274a8778708866417d79d28e.

:Namespace _JSS ⍝ Javascript Snippets

    (⎕ML ⎕IO)←1
⍝ this list will grow over time as usage patterns are discovered
    eis←{(,∘⊂)⍣((326∊⎕DR ⍵)<2>|≡⍵),⍵} ⍝ Enclose if simple
    quote←{0∊⍴⍵: '' ⋄ '"',(('"' ⎕R '\\\0')⍕⍵),'"'}
    ine←{0∊⍴⍺:'' ⋄ ⍵} ⍝ if not empty
    fmtSelector←{{'this'≡⍵:⍵ ⋄quote ⍵}¯2↓∊{⍵,', '}¨eis ⍵}
    fmtData←#.JSON.fromAPL ⍝ {{(326=⍵)<0=2|⍵}⎕DR ⍵:quote ⍵ ⋄ ⍕⍵}
    JAchars←#.JSON.JAchars

    ∇ r←Alert txt
    ⍝ popup alert text
      r←'alert(',(quote txt),');'
    ∇

    ∇ r←CloseWindow
    ⍝ close the browser window
      r←'var w=window.open(window.location,''_self''); w.close();'
    ∇

    ∇ r←sel Css args ⍝ JQuery css cover
      r←(sel JQuery'css')args
    ∇

    ∇ r←sel Val args ⍝ JQuery val cover
      r←(sel JQuery'val')args
    ∇

    ∇ r←sel Prop args ⍝ JQuery prop cover
      r←(sel JQuery'prop')args
    ∇

    ∇ r←sel Attr args ⍝ JQuery attr cover
      r←(sel JQuery'attr')args
    ∇

    ∇ r←sel RemoveAttr args
      r←(sel JQuery'removeAttr')args
    ∇

    ∇ r←sel Html args ⍝ JQuery html cover
      r←(sel JQuery'html')args
    ∇

    ∇ r←sel Show args
      r←(sel JQuery'show')args
    ∇

    ∇ r←sel Hide args
      r←(sel JQuery'hide')args
    ∇

    ∇ r←sel Toggle args
      r←(sel JQuery'toggle')args
    ∇

    ∇ r←sel Trigger args
      r←(sel JQuery'trigger')args
    ∇

    ∇ r←Submit sel
      r←(sel JQuery'submit')''
    ∇

    ∇ r←sel Position args;Position;inds;parameters;q;mask
      parameters←'my' 'at' 'of' 'collision' 'within'
      q←{1⌽'''''',{⍵/⍨1+''''=⍵}⍕⍵}
      Position←⎕NS ⍬
      :If 2=⍴⍴args ⍝ matrix
          args←,args
      :ElseIf 3=≡args
          args←⊃,/args
      :EndIf
      args←eis args
      inds←parameters⍳args
      :If ∨/mask←inds≤⍴parameters
          :If mask≡(2×+/mask)⍴1 0
              parameters←mask/args
              args←(1⌽mask)/args
          :EndIf
      :Else
          parameters←(⍴args)↑parameters
      :EndIf
      mask←⍬∘≢¨args
      args←mask/args
      parameters←mask/parameters
      parameters({⍎'Position.',⍺,'←',q ⍵})¨args
      :If ~0∊⍴Position.⎕NL-2
          r←0 #.JQ.JQueryfn'position'sel Position
      :EndIf
    ∇

    ∇ r←{eval}JSDate date
    ⍝ snippet to create a JS date (JavaScript months are 0-11!!!)
    ⍝ date is in 6↑⎕TS form
    ⍝ eval is optional Boolean to indicate whether to prepend '⍎' to the snippet (default is 0=do not prepend)
    ⍝         prepending ⍎ tells MiServer that this is an executable phrase and not simply a string

      :If 0=⎕NC'eval' ⋄ eval←0 ⋄ :EndIf
      :If 0 2∊⍨10|⎕DR date  ⍝ char?
          date←'"',date,'"'
      :Else
          date←1↓∊','∘,∘⍕¨0 ¯1 0 0 0 0+6↑date
      :EndIf
⍝      r←(~eval)↓'⍎new Date(',date,')'
⍝ ⍝ 180221, MBaas: ⍎ no longer supported
      :If eval
          r←⊂'new Date(',date,')'
      :Else
          r←'new Date(',date,')'
      :EndIf
    ∇

    ∇ r←{varname}JSData data
    ⍝ return var definition to build a JavaScript object based on data
    ⍝ varname is the name of the variable
    ⍝ data is either a matrix of [1;] column names, (1↓) data
    ⍝      or a vector of namespaces
      :If 0=⎕NC'varname' ⋄ varname←'' ⋄ :EndIf
      :If 2=⍴⍴data
          data←#.JSON.fromTable data
      :EndIf
      r←(((~0∊⍴varname)/'var ',varname,' = '),0 0 1 #.JSON.fromAPL data),';'
    ∇

    ∇ r←{val}(sel JQuery fn)args;opt
    ⍝ construct JavaScript to call a jQuery function - eg val(), html(), css(), prop(), or attr()
    ⍝ optionally setting a value for
    ⍝ Get a jQuery parameter:
    ⍝    ('"#id"' JQuery 'attr') '"data-role"'
    ⍝ Set a jQuery parameter:
    ⍝    '"blue"' ('#id' JQuery 'css') 'background-color'
    ⍝
      args←eis args
      :If 0=⎕NC'val'
          (opt val)←2↑args,(⍴args)↓''⎕NULL
      :Else
          opt←⊃args
      :EndIf
      :If val≡⎕NULL
          r←'$(',(fmtSelector sel),').',fn,'(',(quote opt),');'
      :Else
          r←'$(',(fmtSelector sel),').',fn,'(',(quote opt),',',(fmtData val),');'
      :EndIf
    ∇

    ∇ r←{val}(fn JQueryOpt sel)opt
      :If 0=⎕NC'val'
          r←'$(',(fmtSelector sel),').',fn,'("option",',(quote opt),');'
      :Else
          r←'$(',(fmtSelector sel),').',fn,'("option",',(quote opt),',',(fmtData val),');'
      :EndIf
    ∇

    :Class StorageObject
    ⍝ !!!Prototype!!!

        ∇ r←{what}Set(type value);name;w;v
          :Access public shared
        ⍝ value may be
          :Access public shared
          r←''
          :If 9.1=⎕NC⊂'value' ⍝ namespace?
              :For name :In value.⎕NL-2
                  r,←formatSet(type name(value⍎name))
              :EndFor
          :Else
              value←eis value
              :If 2=⎕NC'what' ⍝ value is list of name value pairs
                  what←eis what
              :Else
                  (what value)←↓[1]((⌊0.5×⍴value),2)⍴value
              :EndIf
              :For (w v) :InEach (what value)
                  r,←formatSet(type w v)
              :EndFor
          :EndIf
        ∇

        ∇ r←formatSet(type what value)
          :Access public shared
          r←type,'.setItem("',what,'",JSON.stringify(',(#.JSON.fromAPL value),');'
        ∇

        ∇ r←type Remove what;w;ww
          :Access public shared
          what←eis what
          r←''
          :For w :In what
              :If ' '∊w←#.Strings.deb w
                  :For ww :In ' '#.Utils.penclose w
                      r,←type,'.removeItem("',w,'");'
                  :EndFor
              :Else
                  r,←type,'.removeItem("',w,'");'
              :EndIf
          :EndFor
        ∇

        ∇ r←type Get what
          :Access public shared
          r←''
          r,←'<input type="hidden" name="',w,'" value="',JSON
        ∇
    :endclass

    :class localStorage : StorageObject

        ∇ r←{what}Set value
          :If 0=⎕NC'what'
              r←⎕BASE.Set('localStorage'value)
          :Else
              r←what ⎕BASE.Set('localStorage'value)
          :EndIf
        ∇

        ∇ r←Remove what
          :Access public shared
          r←
        ∇

        ∇ r←{name}Get what
          :Access public shared
        ∇

    :EndClass

    :Class sessionStorage
        ∇ r←{what}Set value
          :Access public shared
        ∇
    :endclass

    :class sessionStorage
    :endclass

:EndNamespace

:Namespace _JSS ⍝ Javascript Snippets

    (⎕ML ⎕IO)←1
⍝ this list will grow over time as usage patterns are discovered
    eis←{(,∘⊂)⍣((326∊⎕DR ⍵)<2>|≡⍵),⍵} ⍝ Enclose if simple
    quote←{0∊⍴⍵: '' ⋄ '"',(('"' ⎕R '\\\0')⍕⍵),'"'}
    ine←{0∊⍴⍺:'' ⋄ ⍵} ⍝ if not empty
    fmtSelector←{{'this'≡⍵:⍵ ⋄quote ⍵}¯2↓∊{⍵,', '}¨eis ⍵}
    fmtData←#.JSON.fromAPL ⍝ {{(326=⍵)<0=2|⍵}⎕DR ⍵:quote ⍵ ⋄ ⍕⍵}
    JAchars←#.JSON.JAchars

    ∇ r←Alert txt
    ⍝ popup alert text
      r←'alert(',(quote txt),');'
    ∇

    ∇ r←CloseWindow
    ⍝ close the browser window
      r←'var w=window.open(window.location,''_self''); w.close();'
    ∇

    ∇ r←sel Css args ⍝ JQuery css cover
      r←(sel JQuery'css')args
    ∇

    ∇ r←sel Val args ⍝ JQuery val cover
      r←(sel JQuery'val')args
    ∇

    ∇ r←sel Prop args ⍝ JQuery prop cover
      r←(sel JQuery'prop')args
    ∇

    ∇ r←sel Attr args ⍝ JQuery attr cover
      r←(sel JQuery'attr')args
    ∇

    ∇ r←sel RemoveClass args
      r←(sel JQuery'removeClass')args
    ∇

    ∇ r←sel RemoveAttr args
      r←(sel JQuery'removeAttr')args
    ∇

    ∇ r←sel Html args ⍝ JQuery html cover
      r←(sel JQuery'html')args
    ∇

    ∇ r←sel Show args
      r←(sel JQuery'show')args
    ∇

    ∇ r←sel Hide args
      r←(sel JQuery'hide')args
    ∇

    ∇ r←sel Toggle args
      r←(sel JQuery'toggle')args
    ∇

    ∇ r←sel Trigger args
      r←(sel JQuery'trigger')args
    ∇

    ∇ r←Submit sel
      r←(sel JQuery'submit')''
    ∇

    ∇ r←sel Position args;Position;inds;parameters;q;mask
      parameters←'my' 'at' 'of' 'collision' 'within'
      q←{1⌽'''''',{⍵/⍨1+''''=⍵}⍕⍵}
      Position←⎕NS ⍬
      :If 2=⍴⍴args ⍝ matrix
          args←,args
      :ElseIf 3=≡args
          args←⊃,/args
      :EndIf
      args←eis args
      inds←parameters⍳args
      :If ∨/mask←inds≤⍴parameters
          :If mask≡(2×+/mask)⍴1 0
              parameters←mask/args
              args←(1⌽mask)/args
          :EndIf
      :Else
          parameters←(⍴args)↑parameters
      :EndIf
      mask←⍬∘≢¨args
      args←mask/args
      parameters←mask/parameters
      parameters({⍎'Position.',⍺,'←',q ⍵})¨args
      :If ~0∊⍴Position.⎕NL-2
          r←0 #.JQ.JQueryfn'position'sel Position
      :EndIf
    ∇

    ∇ r←{eval}JSDate date
    ⍝ snippet to create a JS date (JavaScript months are 0-11!!!)
    ⍝ date is in 6↑⎕TS form
    ⍝ eval is optional Boolean to indicate whether to prepend '⍎' to the snippet (default is 0=do not prepend)
    ⍝         prepending ⍎ tells MiServer that this is an executable phrase and not simply a string

      :If 0=⎕NC'eval' ⋄ eval←0 ⋄ :EndIf
      :If 0 2∊⍨10|⎕DR date  ⍝ char?
          date←'"',date,'"'
      :Else
          date←1↓∊','∘,∘⍕¨0 ¯1 0 0 0 0+6↑date
      :EndIf
⍝      r←(~eval)↓'⍎new Date(',date,')'
⍝ ⍝ 180221, MBaas: ⍎ no longer supported
      :If eval
          r←⊂'new Date(',date,')'
      :Else
          r←'new Date(',date,')'
      :EndIf
    ∇

    ∇ r←{varname}JSData data
    ⍝ return var definition to build a JavaScript object based on data
    ⍝ varname is the name of the variable
    ⍝ data is either a matrix of [1;] column names, (1↓) data
    ⍝      or a vector of namespaces
      :If 0=⎕NC'varname' ⋄ varname←'' ⋄ :EndIf
      :If 2=⍴⍴data
          data←#.JSON.fromTable data
      :EndIf
      r←(((~0∊⍴varname)/'var ',varname,' = '),0 0 1 #.JSON.fromAPL data),';'
    ∇

    ∇ r←{val}(sel JQuery fn)args;opt
    ⍝ construct JavaScript to call a jQuery function - eg val(), html(), css(), prop(), or attr()
    ⍝ optionally setting a value for
    ⍝ Get a jQuery parameter:
    ⍝    ('"#id"' JQuery 'attr') '"data-role"'
    ⍝ Set a jQuery parameter:
    ⍝    '"blue"' ('#id' JQuery 'css') 'background-color'
    ⍝
      args←eis args
      :If 0=⎕NC'val'
          (opt val)←2↑args,(⍴args)↓''⎕NULL
      :Else
          opt←⊃args
      :EndIf
      :If val≡⎕NULL
          r←'$(',(fmtSelector sel),').',fn,'(',(quote opt),');'
      :Else
          r←'$(',(fmtSelector sel),').',fn,'(',(quote opt),',',(fmtData val),');'
      :EndIf
    ∇

    ∇ r←{val}(fn JQueryOpt sel)opt
      :If 0=⎕NC'val'
          r←'$(',(fmtSelector sel),').',fn,'("option",',(quote opt),');'
      :Else
          r←'$(',(fmtSelector sel),').',fn,'("option",',(quote opt),',',(fmtData val),');'
      :EndIf
    ∇

    :Class StorageObject
    ⍝ !!!Prototype!!!

        ∇ r←{what}Set(type value);name;w;v
          :Access public shared
        ⍝ value may be
          :Access public shared
          r←''
          :If 9.1=⎕NC⊂'value' ⍝ namespace?
              :For name :In value.⎕NL-2
                  r,←formatSet(type name(value⍎name))
              :EndFor
          :Else
              value←eis value
              :If 2=⎕NC'what' ⍝ value is list of name value pairs
                  what←eis what
              :Else
                  (what value)←↓[1]((⌊0.5×⍴value),2)⍴value
              :EndIf
              :For (w v) :InEach (what value)
                  r,←formatSet(type w v)
              :EndFor
          :EndIf
        ∇

        ∇ r←formatSet(type what value)
          :Access public shared
          r←type,'.setItem("',what,'",JSON.stringify(',(#.JSON.fromAPL value),');'
        ∇

        ∇ r←type Remove what;w;ww
          :Access public shared
          what←eis what
          r←''
          :For w :In what
              :If ' '∊w←#.Strings.deb w
                  :For ww :In ' '#.Utils.penclose w
                      r,←type,'.removeItem("',w,'");'
                  :EndFor
              :Else
                  r,←type,'.removeItem("',w,'");'
              :EndIf
          :EndFor
        ∇

        ∇ r←type Get what
          :Access public shared
          r←''
          r,←'<input type="hidden" name="',w,'" value="',JSON
        ∇
    :endclass

    :class localStorage : StorageObject

        ∇ r←{what}Set value
          :If 0=⎕NC'what'
              r←⎕BASE.Set('localStorage'value)
          :Else
              r←what ⎕BASE.Set('localStorage'value)
          :EndIf
        ∇

        ∇ r←Remove what
          :Access public shared
          r←
        ∇

        ∇ r←{name}Get what
          :Access public shared
        ∇

    :EndClass

    :Class sessionStorage
        ∇ r←{what}Set value
          :Access public shared
        ∇
    :endclass

    :class sessionStorage
    :endclass

:EndNamespace


reset _.Icon Content, Spec, and class after Render

:class Icon : #._html.span
⍝ Description:: Dyalog Icon widget
⍝ Constructor:: [spec]
⍝ spec - either a single or pair of string which specify the icon(s) to use
⍝        each consists of a vendor-prefix, dash, icon-name, and optionally space-separated modifiers
⍝        when two strings are used, it represents a "stacked" icon, with second icon overlayed on the first
⍝        "stacked" icons are a feature of FontAwesome icons - using other icons may or may not have the desired visual effect
⍝
⍝ Public Fields::
⍝ Spec  - either a single or pair of string which specify the icon(s) to use
⍝         each consists of a vendor-prefix, dash, icon-name, and optionally space-separated modifiers
⍝         when two strings are used, it represents a "stacked" icon, with second icon overlayed on the first
⍝         "stacked" icons are a feature of FontAwesome icons - using other icons may or may not have the desired visual effect
⍝
⍝ Examples::
⍝ Add _.Icon 'fa-cloud-upload'    ⍝ FontAwesome: http://fontawesome.io/icons/
⍝ Add _.Icon 'md-fingerprint'     ⍝ Google Material Design: https://design.google.com/icons/
⍝ Add _.Icon 'e-delete-column_01' ⍝ Syncfusion Essential JavaScript: http://js.syncfusion.com/demos/web/#!/azure/icon/EJIcons
⍝ '.fa-spin' Add _.Icon 'md-track_changes' ⍝ FontAwesome effects (works on non-FA icons too)
⍝ 'style="color: red;"' Add _.Icon 'e-stop' ⍝ Applying own styling
⍝ Add _.Icon 'fa-square fa-2x' 'fa-terminal fa-inverse' ⍝ Stacking inverse small on large
⍝ Add _.Icon 'fa-camera' 'fa-ban fa-2x'  ⍝ Stacking large on small

    :field public shared readonly ApiLevel←3
    :Field public Spec←⍬
    :field public shared readonly DocBase←'http://fontawesome.io/examples/'

    ∇ Make
      :Access public
      :Implements constructor
    ∇

    ∇ Make1 args;last
      :Access public
      :Implements constructor
      :If 2|⎕DR last←⊃¯1↑Spec←args
          Order←last ⋄ Spec←¯1↓args
      :EndIf
    ∇

    ∇ r←Render;prefix;spec;icon;classes;n;origContent;origSpec;origClass
      :Access public
      (origSpec origContent origClass)←Spec Content class
      Spec←eis Spec
      Spec,←eis Content
      Content←⍬
      :If 1=⍴Spec ⍝ Simple icon
          Spec←{⊃⍣(1<≡⍵)⊢⍵}Spec ⍝ Disclose if nested (eis⍣¯1)
          :If isInstance Spec
              Spec←Spec.Spec
          :EndIf
          (prefix spec)←Spec SplitOn1st'-'
          :Select ¯1↓prefix
          :Case 'fa' ⍝ FontAwesome
              Use'faIcons'
              AddClass'fa ',Spec

          :Case 'md' ⍝ Google
              Use'mdIcons'
              (icon classes)←(spec,' ')SplitOn1st' '
              AddClass'material-icons ',classes
              Content←¯1↓icon

          :CaseList (,'e')'ej' ⍝ Syncfusion
              Use'ejIcons'
              AddClass'e-icon e-',spec
              AddStyle'display: inline-block'  ⍝ add this because default Syncfusion is "block"
          :Else
              Content←Spec

          :EndSelect

      :Else
          Use'faIcons'
          AddClass'fa-stack'
          :For spec :In Spec
              :If isInstance spec
                  spec.AddClass'fa-stack-1x'
                  Add spec
              :Else
                  (Add _.Icon spec).AddClass'fa-stack-1x'
              :EndIf
          :EndFor
      :EndIf
      SetUse
      r←⎕BASE.Render
      (Spec Content class)←origSpec origContent((1+origClass≡UNDEF)⊃origClass'') ⍝ cannot just "unset" class
    ∇

    SplitOn1st←{(l↑⍺)((l←⍺⍳⍵)↓⍺)}
:endclass

:class Icon : #._html.span
⍝ Description:: Dyalog Icon widget
⍝ Constructor:: [spec]
⍝ spec - either a single or pair of string which specify the icon(s) to use
⍝        each consists of a vendor-prefix, dash, icon-name, and optionally space-separated modifiers
⍝        when two strings are used, it represents a "stacked" icon, with second icon overlayed on the first
⍝        "stacked" icons are a feature of FontAwesome icons - using other icons may or may not have the desired visual effect
⍝
⍝ Public Fields::
⍝ Spec  - either a single or pair of string which specify the icon(s) to use
⍝         each consists of a vendor-prefix, dash, icon-name, and optionally space-separated modifiers
⍝         when two strings are used, it represents a "stacked" icon, with second icon overlayed on the first
⍝         "stacked" icons are a feature of FontAwesome icons - using other icons may or may not have the desired visual effect
⍝
⍝ Examples::
⍝ Add _.Icon 'fa-cloud-upload'    ⍝ FontAwesome: http://fontawesome.io/icons/
⍝ Add _.Icon 'md-fingerprint'     ⍝ Google Material Design: https://design.google.com/icons/
⍝ Add _.Icon 'e-delete-column_01' ⍝ Syncfusion Essential JavaScript: http://js.syncfusion.com/demos/web/#!/azure/icon/EJIcons
⍝ '.fa-spin' Add _.Icon 'md-track_changes' ⍝ FontAwesome effects (works on non-FA icons too)
⍝ 'style="color: red;"' Add _.Icon 'e-stop' ⍝ Applying own styling
⍝ Add _.Icon 'fa-square fa-2x' 'fa-terminal fa-inverse' ⍝ Stacking inverse small on large
⍝ Add _.Icon 'fa-camera' 'fa-ban fa-2x'  ⍝ Stacking large on small

    :field public shared readonly ApiLevel←3
    :Field public Spec←⍬
    :field public shared readonly DocBase←'http://fontawesome.io/examples/'

    ∇ Make
      :Access public
      :Implements constructor
    ∇

    ∇ Make1 args;last
      :Access public
      :Implements constructor
      :If 2|⎕DR last←⊃¯1↑Spec←args
          Order←last ⋄ Spec←¯1↓args
      :EndIf
    ∇

    ∇ r←Render;prefix;spec;icon;classes;n
      :Access public
      Spec←eis Spec
      Spec,←eis Content
      Content←⍬
      :If 1=⍴Spec ⍝ Simple icon
          Spec←{⊃⍣(1<≡⍵)⊢⍵}Spec ⍝ Disclose if nested (eis⍣¯1)
          :If isInstance Spec
              Spec←Spec.Spec
          :EndIf
          (prefix spec)←Spec SplitOn1st'-'
          :Select ¯1↓prefix
          :Case 'fa' ⍝ FontAwesome
              Use'faIcons'
              AddClass'fa ',Spec

          :Case 'md' ⍝ Google
              Use'mdIcons'
              (icon classes)←(spec,' ')SplitOn1st' '
              AddClass'material-icons ',classes
              Content←¯1↓icon

          :CaseList (,'e')'ej' ⍝ Syncfusion
              Use'ejIcons'
              AddClass'e-icon e-',spec
              AddStyle'display: inline-block'  ⍝ add this because default Syncfusion is "block"
          :Else
              Content←Spec

          :EndSelect

      :Else
          Use'faIcons'
          AddClass'fa-stack'
          :For spec :In Spec
              :If isInstance spec
                  spec.AddClass'fa-stack-1x'
                  Add spec
              :Else
                  (Add _.Icon spec).AddClass'fa-stack-1x'
              :EndIf
          :EndFor
      :EndIf
      SetUse
      r←⎕BASE.Render
    ∇

    SplitOn1st←{(l↑⍺)((l←⍺⍳⍵)↓⍺)}
:endclass