Merge pull request #11 from cryogenian/emulate-finalizer

removed Quit, made emulateFinalizer

Author: cryogenian

bower.json

@@ -27,6 +27,7 @@
     "purescript-refs": "^0.2.0",
     "purescript-datetime": "^0.9.1",
     "purescript-random": "^0.2.3",
-    "purescript-ace": "~0.11.0"
+    "purescript-ace": "~0.11.0",
+    "purescript-sets": "^0.5.7"
   }
 }

src/Ace/Halogen/Component.js

@@ -6,6 +6,8 @@ exports.initialized = {value: false};
 
 exports.focused = {value: ""};
 
+exports.keys = {value: []};
+
 exports.dataset = function(node) {
     return function() {
         return node.dataset;

src/Ace/Halogen/Component.purs

@@ -11,24 +11,39 @@ module Ace.Halogen.Component
 
 import Prelude
 
+import Control.Coroutine (($$), consumer, Producer(), Consumer(), runProcess)
+import Control.Coroutine.Aff (produce)
 import Control.Monad (when)
-import Control.Monad.Aff (Aff(), runAff)
+import Control.Monad.Aff (Aff(), runAff, later', forkAff)
 import Control.Monad.Aff.AVar (AVAR())
 import Control.Monad.Eff (Eff())
+import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Random (random, RANDOM())
 import Control.Monad.Eff.Ref (Ref(), REF(), readRef, writeRef, modifyRef)
+import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
 
+import Data.Array as Arr
+import Data.Either (Either(..))
 import Data.Date (nowEpochMilliseconds, Now())
-import Data.Foldable (traverse_)
+import Data.Foldable as F
 import Data.Maybe (Maybe(..), maybe)
+import Data.Nullable (toMaybe)
+import Data.Set as Set
 import Data.StrMap (StrMap())
 import Data.StrMap as Sm
 import Data.Time (Milliseconds(..))
 
 import DOM (DOM())
-import DOM.HTML.Types (HTMLElement())
+import DOM.HTML (window)
+import DOM.HTML.Types (HTMLElement(), htmlDocumentToParentNode)
+import DOM.HTML.Window (document)
+import DOM.Node.ParentNode (querySelectorAll)
+import DOM.Node.Types (NodeList(), Node())
+import DOM.Node.NodeList as Nl
 
-import Halogen
+import Halogen hiding (Prop())
+import Halogen.HTML.Core (Prop(..), attrName)
+import Halogen.HTML.Properties.Indexed (IProp())
 import Halogen.HTML.Indexed as H
 import Halogen.HTML.Properties.Indexed as P
 
@@ -38,6 +53,14 @@ import Ace.Ext.LanguageTools as LanguageTools
 import Ace.Ext.LanguageTools.Completer as Completer
 import Ace.Types
 
+import Unsafe.Coerce (unsafeCoerce)
+
+dataAceKey :: forall i r. String -> IProp r i
+dataAceKey = unsafeCoerce nonIndexed
+  where
+  nonIndexed :: String -> Prop i
+  nonIndexed = Attr Nothing (attrName "data-acekey")
+
 -- | Effectful knot of autocomplete functions. It's needed because
 -- | `languageTools.addCompleter` is global and adds completer to
 -- | all editors
@@ -50,9 +73,13 @@ foreign import initialized :: Ref Boolean
 -- | autocomplete function
 foreign import focused :: Ref String
 
+-- | Stores `data-acekey` of last checked components
+foreign import keys :: Ref (Array String)
+
 -- | Get `dataset` property of element
 foreign import dataset
-  :: forall eff. HTMLElement -> Eff (dom :: DOM | eff) (StrMap String)
+  :: forall eff. Node -> Eff (dom :: DOM | eff) (StrMap String)
+
 
 
 -- | Take completion function for currently selected component
@@ -79,19 +106,77 @@ setAutocompleteResume (Just Live) editor = do
   Editor.setEnableBasicAutocompletion true editor
 
 -- | Language tools and autocomplete initializer. Runs once.
-enableAutocomplete :: forall eff. Eff (AceEffects eff) Unit
-enableAutocomplete = do
-  languageToolsInitialized <- readRef initialized
-  when (not languageToolsInitialized) do
-    completer <- Completer.mkCompleter globalCompleteFn
-    tools <- LanguageTools.languageTools
-    LanguageTools.addCompleter completer tools
+globalInitialization :: forall eff. Eff (AceEffects eff) Unit
+globalInitialization = do
+  alreadyInited <- readRef initialized
+  when (not alreadyInited) do
+    initLanguageTools
+    -- This should be removed and altered with finalizer prop
+    -- after slamdata/purescript-halogen#272 is resolved
+    emulateFinalizer
     writeRef initialized true
+
+initLanguageTools :: forall eff. Eff (AceEffects eff) Unit
+initLanguageTools = do
+  completer <- Completer.mkCompleter globalCompleteFn
+  tools <- LanguageTools.languageTools
+  LanguageTools.addCompleter completer tools
+
+emulateFinalizer :: forall eff. Eff (AceEffects eff) Unit
+emulateFinalizer = do
+  runAff (const $ pure unit) pure $ runProcess (tickProducer $$ tickConsumer)
   where
-  globalCompleteFn editor session position prefix cb = do
-    fn <- completeFnFocused
-    runAff (const $ cb Nothing) (cb <<< Just)
-      $ fn editor session position prefix
+  tickProducer :: Producer Unit (Aff (AceEffects eff)) Unit
+  tickProducer =
+    produce (runAff (const $ pure unit) pure <<< void <<< forkAff <<< tick)
+
+  tick emit = do
+    liftEff $ emit $ Left unit
+    forkAff $ later' 60000 $ tick emit
+
+  tickConsumer :: Consumer Unit (Aff (AceEffects eff)) Unit
+  tickConsumer = consumer \_ -> liftEff do
+    storedKeys <- map Set.fromFoldable $ readRef keys
+    activeKeysArr <- window
+                     >>= document
+                     >>= querySelectorAll "[data-acekey]"
+                     <<< htmlDocumentToParentNode
+                     >>= extractKeys [ ] 0
+    F.for_ (F.foldl (flip Set.delete) storedKeys activeKeysArr) \key ->
+      modifyRef completeFns $ Sm.delete key
+    writeRef keys activeKeysArr
+    pure Nothing
+
+globalCompleteFn
+  :: forall eff
+   . Editor
+  -> EditSession
+  -> Position
+  -> String
+  -> Completer.CompleterCallback (AceEffects eff)
+  -> Eff (AceEffects eff) Unit
+globalCompleteFn editor session position prefix cb = do
+  fn <- completeFnFocused
+  runAff (const $ cb Nothing) (cb <<< Just)
+    $ fn editor session position prefix
+
+extractKeys
+  :: forall eff
+   . Array String
+  -> Int
+  -> NodeList
+  -> Eff (AceEffects eff) (Array String)
+extractKeys acc ix nl = do
+  count <- Nl.length nl
+  if ix >= count
+    then pure acc
+    else do
+    mbKey <- runMaybeT do
+      el <- MaybeT $ map toMaybe $ Nl.item ix nl
+      ds <- liftEff $ dataset el
+      MaybeT $ pure $ Sm.lookup "acekey" ds
+    extractKeys (maybe acc (Arr.snoc acc) mbKey) (ix + one) nl
+
 
 -- | Generate unique key for component
 genKey :: forall eff. Eff (now :: Now, random :: RANDOM | eff) String
@@ -115,7 +200,6 @@ type AceEffects eff =
 
 -- | Ace query algebra
 -- | - `Init` - used internally to handle initialization of component
--- | - `Quit` - used internally to handle finalizing of component.
 -- | - `GetText` - gets the current text value
 -- | - `SetText` - alters the current text value
 -- | - `SetAutocomplete` - sets autocomplete resume:
@@ -129,7 +213,6 @@ type AceEffects eff =
 -- |   via the `peek` mechanism.
 data AceQuery a
   = Init HTMLElement a
-  | Quit a
   | GetText (String -> a)
   | SetText String a
   | SetAutocomplete (Maybe Autocomplete) a
@@ -173,18 +256,18 @@ aceComponent setup resume = component render eval
   render :: AceState -> ComponentHTML AceQuery
   render state =
     H.div
-      [ P.initializer \el -> action (Init el)
-      , P.finalizer \el -> action Quit
-      ]
+      ([ P.initializer \el -> action (Init el) ]
+       <> maybe [] (Arr.singleton <<< dataAceKey) state.key)
       []
 
   eval :: Natural AceQuery (ComponentDSL AceState AceQuery (Aff (AceEffects eff)))
   eval (Init el next) = do
     key <- gets _.key >>= maybe (liftEff' genKey) pure
+    liftEff' $  modifyRef keys $ Arr.cons key
     editor <- liftEff' $ Ace.editNode el Ace.ace
     modify $ const $ { key: Just key, editor: Just editor }
     liftEff' do
-      enableAutocomplete
+      globalInitialization
       setAutocompleteResume resume editor
       Editor.onFocus editor $ writeRef focused key
     session <- liftEff' $ Editor.getSession editor
@@ -193,12 +276,6 @@ aceComponent setup resume = component render eval
     liftH $ setup editor
     pure next
 
-  eval (Quit next) = do
-    gets _.key
-      >>= traverse_ \key ->
-      liftEff' $ modifyRef completeFns $ Sm.delete key
-    pure next
-
   eval (GetEditor k) =
     map k $ gets _.editor
 
@@ -209,20 +286,20 @@ aceComponent setup resume = component render eval
 
   eval (SetText text next) = do
     gets _.editor
-      >>= traverse_ \editor -> do
+      >>= F.traverse_ \editor -> do
         current <- liftEff' $ Editor.getValue editor
         when (text /= current) $ void
           $ liftEff' (Editor.setValue text Nothing editor)
     pure next
 
   eval (SetAutocomplete mbAc next) = do
     gets _.editor
-      >>= traverse_ (liftEff' <<< setAutocompleteResume mbAc)
+      >>= F.traverse_ (liftEff' <<< setAutocompleteResume mbAc)
     pure next
 
   eval (SetCompleteFn fn next) = do
     gets _.key
-      >>= traverse_ \key ->
+      >>= F.traverse_ \key ->
       liftEff' $ modifyRef completeFns $ Sm.insert key fn
     pure next