From fbe06f8e1be2d09d74cdd6ffb0e1cc2e85c28aa3 Mon Sep 17 00:00:00 2001 From: Maxim Zimaliev Date: Thu, 28 Jan 2016 19:15:03 +0300 Subject: [PATCH] emulate finalizer --- bower.json | 3 +- src/Ace/Halogen/Component.js | 2 + src/Ace/Halogen/Component.purs | 139 +++++++++++++++++++++++++-------- 3 files changed, 112 insertions(+), 32 deletions(-) diff --git a/bower.json b/bower.json index 43e72c2..e53860e 100644 --- a/bower.json +++ b/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" } } diff --git a/src/Ace/Halogen/Component.js b/src/Ace/Halogen/Component.js index 85b067c..04b5563 100644 --- a/src/Ace/Halogen/Component.js +++ b/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; diff --git a/src/Ace/Halogen/Component.purs b/src/Ace/Halogen/Component.purs index ba9f319..d47186d 100644 --- a/src/Ace/Halogen/Component.purs +++ b/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,7 +286,7 @@ 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) @@ -217,12 +294,12 @@ aceComponent setup resume = component render eval 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