Implement FSW Event Queue Handler

StartupSession/Link/Notify.aplf

@@ -80,11 +80,18 @@
              :EndIf
          :EndIf
 
+         :If deleted
+            linkedpaths←⊃¨5176⌶0
+            children←((⊃¨⎕NPARTS linkedpaths)∊⊂path,'/')/linkedpaths
+         :AndIf 0<≢children
+            Notify¨{'deleted'⍵}¨children
+         :EndIf
+
          :If dir⍱link U.HasExtn path  ⍝ must be directory or have correct extension
              →END⊣msg,←⊂'file extension not managed by link'
          :ElseIf 0=≢nsref ⋄ warn←1 ⋄ msg,←⊂'unable to find corresponding namespace'
              →(type≢'deleted')×END ⍝ Exit if event was "deleted", else report error
-         :ElseIf nc=¯1 ⋄ warn←1 ⋄ →END⊣msg,←'invalid name defined by file: 'path
+         :ElseIf (~link.flatten∧dir)∧(nc=¯1) ⋄ warn←1 ⋄ →END⊣msg,←'invalid name defined by file: 'path
          :ElseIf (deleted∨~link.fastLoad)∧(nc=0)  ⍝ cannot trust nc returned by DetermineAplName when opts.fastLoad
              warn←~deleted  ⍝ link issue #235 : the delete callback provoked by ⎕SE.Link.Expunge cannot see the expunged name
              →END⊣msg,←⊂(1+deleted)⊃'invalid file contents' 'could not determine which object was linked to it'
@@ -109,6 +116,15 @@
              :ElseIf ~curnc∊0 ¯1    ⍝ file already tied to another name
                  (⍎curnsname)U.Untie curactname
                  msg,←'creating 'affected' - unlinking previously linked 'curname
+             :ElseIf dir
+                 :Trap 0 ⋄ children←⊃⎕NINFO⍠1⊢path,'/*'
+                 :Else ⋄ children←0⍴⊂''
+                 :EndTrap
+                 children←(link U.HasExtn children)/children
+                 :If 0<≢children
+                     Notify¨{'created'⍵}¨children
+                 :EndIf
+                 :If link.flatten ⋄ →END⊣msg,←⊂'ignoring created directory' ⋄ :EndIf
              :Else
                  msg,←'creating 'affected
              :EndIf
@@ -135,7 +151,7 @@
                  msg,←,'updating previously linked 'affected
              :ElseIf 0≠⎕NC affected  ⍝ redefining existing name
              :AndIf curfile≢oldpath  ⍝ name not bound to old file (TODO won't work for arrays)
-                 warn←1 ⋄ name←'' ⋄ →END⊣msg,←'ignoring attempt to redefine 'affected,(0<≢curfile)/' which is linked to 'curfile
+                 warn←~dir∧link.flatten ⋄ name←'' ⋄ →END⊣msg,←'ignoring attempt to redefine 'affected,(0<≢curfile)/' which is linked to 'curfile
              :EndIf
              :If NOTIFY
                  U.Notify oldpath,' renamed as ',path
@@ -156,9 +172,15 @@
                      :Else ⋄ children←0⍴⊂''
                      :EndTrap
                      msg,←'namespace rename 'oldname' → 'affected
-                     Notify¨{'changed'⍵}¨children
-                 :Else ⋄ warn←1                                    ⍝ no old ns
-                     msg,←'namespace 'oldname' not found. Loading 'affected' from 'path
+                     children←(link U.HasExtn children)/children
+                     :If 0<≢children
+                         Notify¨{'changed'⍵}¨children
+                     :EndIf
+                 :Else
+                     :If ~link.flatten
+                         warn←1                                    ⍝ no old ns
+                         msg,←'namespace 'oldname' not found. Loading 'affected' from 'path
+                     :EndIf
                      :If 0<≢inFail←2⊃link U.FixFiles nsref path 1  ⍝ always overwrite
                          msg,←' - failed to load: '(U.FmtLines inFail)
                      :EndIf

StartupSession/Link/Utils.apln

@@ -2,7 +2,8 @@
     ⎕IO ⎕ML←1 1
 
     :Section Constants
-        SRC_BEST←62 ⍝ ⎕ATX fact
+        SRC_NORMALIZED←61 ⍝ ⎕ATX fact
+        SRC_BEST←      62 ⍝ ⎕ATX fact
         ISWIN←'Win'≡3↑⊃# ⎕WG'APLVersion'
         DYALOGVERSION←1 .1+.×2↑⊃(//)'.'⎕VFI 2⊃'.'⎕WG'AplVersion'
         IS180←18.0≤DYALOGVERSION
@@ -17,6 +18,9 @@
           :EndIf
         ∇
         ##.NOTIFY←'1'∊2 ⎕NQ '.' 'GetEnvironment' 'LINK\NOTIFY'
+        ##.ALWAYSREFORMAT←'1'∊2 ⎕NQ '.' 'GetEnvironment' 'LINK\ALWAYSREFORMAT'
+        ##.FSWDELAY←{⍵+200×⍵=0}⊃2⊃⎕VFI 2 ⎕NQ '.' 'GetEnvironment' 'LINK\FSWDELAY'
+
         LASTFIX←⍬  ⍝ remember last onFix event
     :EndSection
 
@@ -660,7 +664,7 @@
                   :EndTrap
               :CaseList 3.1 3.2 4.1 4.2 ⍝ tradfn/dfn/tradop/dop - v18.0 cannot get source of functions "as typed"
                   src←⎕NULL
-                  :If IS181 ⋄ :Trap 11 ⋄ src←SRC_BEST ns.⎕ATX name ⋄ :EndTrap ⋄ :EndIf ⍝ ⎕ATX returns ⎕NULL if source not available - ⎕ATX errors if name doesn't exist
+                  :If IS181 ⋄ :Trap 11 ⋄ src←(SRC_BEST SRC_NORMALIZED)[1+##.ALWAYSREFORMAT] ns.⎕ATX name ⋄ :EndTrap ⋄ :EndIf ⍝ ⎕ATX returns ⎕NULL if source not available - ⎕ATX errors if name doesn't exist
                   :If src≡⎕NULL ⋄ src←ns.⎕NR name ⋄ :EndIf  ⍝ de-tokenised source - not "as typed" - ⎕NR never errors
               :CaseList 9.1 9.4 9.5 ⋄ src←GetRefSource ns⍎name ⍝ ns/class/interface
               :Else ⋄ src←'Cannot get source of ',(⍕ns),'.',name,': Invalid name class (',(⍕nc),')'
@@ -700,9 +704,9 @@
           ⍝ Link             0|1     (default 1)   ⍝ maintain the link to the file - link issue #155
               FIX←where.⎕FIX⍠('Quiet' 1)('AllowLateBinding' 1)('FixWithErrors'force)('Link'(~0∊⍴file))
           :EndIf
-      ⍝:If (⌊|where.⎕NC⊂name)∊3 4 ⋄ (stops trace monitor)←(where.⎕STOP name)(where.⎕TRACE name)(⊣/where.⎕MONITOR name)  ⍝ link issue #148 and #129
-      ⍝:Else ⋄ stops←trace←monitor←⍬
-      ⍝:EndIf
+          :If (⌊|where.⎕NC⊂name)∊3 4 ⋄ (stops trace monitor)←(where.⎕STOP name)(where.⎕TRACE name)(⊣/where.⎕MONITOR name)  ⍝ link issue #148 and #129
+          :Else ⋄ stops←trace←monitor←⍬
+          :EndIf
       ⍝ attempt to fix as named script because this is the most commly expected format
           :Trap 0 ⋄ names←(2 FIX src)  ⍝ fn/op/script - can work from file
           :Else ⋄ names←0⍴⊂''
@@ -711,9 +715,9 @@
               :If 1=≢names ⋄ name←⊃names ⋄ nc←where.⎕NC⊂name
               :Else ⋄ name←'' ⋄ nc←0  ⍝ multiple names in single file not supported
               :EndIf
-          ⍝:If ((⌊|nc)∊3 4)∧(0∨.<⊃∘⍴¨stops trace monitor)  ⍝ restore stops, traces and monitor - monitor timing information will be lost
-          ⍝    stops where.⎕STOP name ⋄ trace where.⎕TRACE name ⋄ monitor where.⎕MONITOR name
-          ⍝:EndIf
+              :If ((⌊|nc)∊3 4)∧(0∨.<⊃∘⍴¨stops trace monitor)  ⍝ restore stops, traces and monitor - monitor timing information will be lost
+                  stops where.⎕STOP name ⋄ trace where.⎕TRACE name ⋄ monitor where.⎕MONITOR name
+              :EndIf
               :Return  ⍝ named script fixed
           :EndIf
       ⍝required←11 116≡⎕DMX.(EN ENX)  ⍝ 2 ⎕FIX failed because cannot read :Required file

StartupSession/Link/Watcher.apln

@@ -5,7 +5,7 @@
     DYALOGVERSION←1 .1+.×2↑⊃(//)'.'⎕VFI 2⊃'.'⎕WG'AplVersion'  ⍝ required at ⎕FIX time - can't rely on ##.U
     IS180←18≤DYALOGVERSION
     IS181←18.1≤DYALOGVERSION
-
+    BUFFER←⍬                                ⍝ event buffer for throttling FSW events
     CRAWLER←0                               ⍝ allow using crawler
 
 
@@ -57,7 +57,6 @@
       canwatch←CRAWLER∨DOTNET   ⍝ must be evaluated at runtime to allow ⎕SE.Link.Test to change them
     ∇
 
-
     ∇ RequeuedEvent(obj event args)
      ⍝ Process events redirected via the timer
       :Select event
@@ -72,14 +71,57 @@
     ∇ WatchEvent(obj args);ct;nargs;timers
      ⍝ Callback for System.IO.FileSystemWatcher instance
      ⍝ Passes info on to ⎕SE.Link.Notify for processing
-      {}2501⌶0 ⍝ Reap the thread on exit - triggers mantis 17628
-      ⍝{}2502⌶0  ⍝ Discard parked thread - workaround mantis 17628
       nargs←⊂0 ##.U.CaseText⍕args.ChangeType
       nargs,←⊂args.FullPath
       :If 0≠⎕NC⊂'args.OldFullPath'
           nargs,←⊂args.OldFullPath
       :EndIf
-      obj ##.Notify&nargs
+      BUFFER,←⊂obj nargs  ⍝ Add event to the queue
+      THROTTLE.FireOnce←1 ⍝ Restart the timer
+    ∇
+
+    ∇ HandleEventQueue args;evts;types;targets;exist;actions;m;todo;slash;tgts;order;ops;exists;renames;nex;fsw
+     ⍝ Throttle calls to Notify and filter/re-order events
+      {}2502⌶0 ⍝ Discard the parked thread that was presumably created by the incoming event
+
+      BUFFER←(≢evts←BUFFER)↓BUFFER
+      :If ##.DEBUG
+          ⎕←' '
+          ⎕←'EventQueue original:'
+          ⎕←((⍳≢evts),0 1↓↑evts)
+      :EndIf
+      fsw←⊃⊃evts ⍝ Actually there might be more than one but it probably doesn't matter
+      (actions targets)←2↑↓⍉↑2⊃¨evts
+
+      ⍝ Eliminate "internal" git folder notifications
+      slash←⊃⌽(1⊃targets)∩'/\' ⍝ slash at tail end of FSW messages are "native"
+      :If ∨/m←∨/¨(slash,'.git',slash)∘⍷¨targets
+          (actions targets evts)←(~m)∘/¨actions targets evts
+      :EndIf
+
+      ⍝ Separate logic for renames
+      ⍝ We think Git operations are never renames
+      :If 0≠≢renames←(m←actions∊⊂'renamed')/evts
+          targets←(~m)/targets
+          :If ~∧/m ⍝ Worried that combining renames with other logic may go badly
+              ##.U.Warn'Rename batched with other operations'
+          :EndIf
+      :EndIf
+
+      exists←⎕NEXISTS tgts←∪targets          ⍝ deletions first - matters if flatten=1
+      order←⍋exists,⍪(¯1*nex←~exists)×≢¨tgts ⍝ delete folders after contents, create folders before contents
+      ops←((+/nex),(+/exists))/'deleted' 'changed'
+      ⍝ renames, then deletes, then changed (Link does not distinguish between create and change)
+      todo←renames,fsw,∘⊂¨↓ops,⍪tgts[order]
+
+      :If ##.DEBUG
+          ⎕←'==> "todo" :'
+          ⎕←((⍳≢todo),0 1↓↑todo)
+      :EndIf
+
+      :If 0≠≢todo
+          {##.Notify/↑⍵}&todo
+      :EndIf
     ∇
 
     ∇ WatchError(obj args);link;msg
@@ -109,31 +151,56 @@
       :EndDisposable
     ∇
 
-    ∇ watcher←MakeWatcher args;⎕USING
-     ⍝ Return a FileSystemWatcher object
+    ∇ r←MakeWatcher args;filter;filters;path;watcher;⎕USING
+     ⍝ Return vector of FileSystemWatcher objects
      ⍝ Try .Net Core rather than Framework if non-Windows or DYALOG_NETCORE explicitly set
+     ⍝ Creates a vector of watchers on .Net Framework to watch specific extensions.
+     ⍝ dotnet supports collection of filters on single watcher.
       ⎕USING←',System',(~DOTNETCORE)/'.dll'
+      path filters←args
       watcher←⎕NEW System.IO.FileSystemWatcher
-      watcher.(Path Filter)←args
-      watcher.(onChanged onCreated onDeleted onRenamed)←⊂'WatchEvent'
-      watcher.onError←'WatchError'
-      watcher.IncludeSubdirectories←1
+      watcher.Filter←,'*'
+      watcher.NotifyFilter←System.IO.NotifyFilters.DirectoryName
+      r←,watcher
+      :If DOTNETCORE
+          watcher←⎕NEW System.IO.FileSystemWatcher
+          watcher.Filters.Add¨⊂¨⊆filters
+          watcher.NotifyFilter←System.IO.NotifyFilters.(FileName+LastWrite)
+          r,←watcher
+      :Else
+          :For filter :In ⊆filters
+              watcher←⎕NEW System.IO.FileSystemWatcher
+              watcher.Filter←filter
+              watcher.NotifyFilter←System.IO.NotifyFilters.(FileName+LastWrite)
+              r,←watcher
+          :EndFor
+      :EndIf
+      r.Path←⊂path
+      r.(onChanged onCreated onDeleted onRenamed)←⊂⊂'WatchEvent'
+      r.onError←⊂'WatchError'
+      r.IncludeSubdirectories←1
+      r.InternalBufferSize←65536 ⍝ Max size is 64KB
+      :If 0=⎕NC'THROTTLE'
+          THROTTLE←⎕NEW⊂'Timer'
+          THROTTLE.FireOnce←2
+          THROTTLE.Interval←##.FSWDELAY
+          THROTTLE.onTimer←'HandleEventQueue'
+      :EndIf
     ∇
 
 
 
-
    ⍝⍝⍝⍝⍝ MAIN API ⍝⍝⍝⍝⍝⍝⍝⍝
 
-    ∇ Watch link;args;end;q;r;tid;z
+    ∇ Watch link;filters;end;q;r;tid;z
     ⍝ Set up a file system watcher, return object that will be stored as "fsw" in ⎕SE.Link.Links[i]
       link.fsw←⎕NULL
       :If ~'dir' 'both'∊⍨⊂link.watch
           :Return
       :EndIf
       :If DOTNET
-          args←link.dir(,'*')
-          r←MakeWatcher args
+          filters←(⊂'*.'),¨∪link.(codeExtensions,customExtensions)
+          r←MakeWatcher link.dir filters
           r.EnableRaisingEvents←1
           link.fsw←r
       :ElseIf CRAWLER