Merge pull request #23 from garyb/halogen-bump

Update for Halogen 1.0.0

Author: natefaubion

bower.json

@@ -28,7 +28,7 @@
   ],
   "dependencies": {
     "purescript-ace": "^3.0.0",
-    "purescript-halogen": "^0.12.0",
+    "purescript-halogen": "^1.0.0-rc.2",
     "purescript-now": "^2.0.0",
     "purescript-random": "^2.0.0",
     "purescript-refs": "^2.0.0"

example/package.json

@@ -4,9 +4,6 @@
     "clean": "rimraf output && rimraf .pulp-cache",
     "build": "pulp browserify --optimise --to example.js"
   },
-  "dependencies": {
-    "virtual-dom": "^2.1.1"
-  },
   "devDependencies": {
     "pulp": "^9.0.1",
     "purescript": "^0.10.1",

example/src/Main.purs

@@ -6,23 +6,23 @@ import Control.Monad.Aff (Aff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Random (RANDOM)
-import Control.Monad.Eff.Ref (REF)
 import Control.Monad.Eff.Now (NOW)
 
-import Data.Functor.Coproduct (Coproduct)
-import Data.Maybe (Maybe (..), fromMaybe)
+import Data.Maybe (Maybe(..))
 
 import Halogen as H
-import Halogen.HTML.Indexed as HH
-import Halogen.Util (runHalogenAff, awaitBody)
+import Halogen.Aff as HA
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.VDom.Driver (runUI)
 
 import Ace.Editor as Editor
 import Ace.EditSession as Session
-import Ace.Halogen.Component (AceState, AceQuery (TextChanged, GetText), aceConstructor)
+import Ace.Halogen.Component (AceQuery, AceMessage(..), aceComponent)
 import Ace.Types (ACE, Editor)
 
 data Query a
-  = UpdateText a
+  = HandleMessage AceMessage a
 
 type State =
   { text ∷ String
@@ -35,24 +35,32 @@ initialState =
 
 type AceSlot = Unit
 
-type StateP g = H.ParentState State AceState Query AceQuery g AceSlot
-type QueryP = Coproduct Query (H.ChildF AceSlot AceQuery)
-type MainHtml g = H.ParentHTML AceState Query AceQuery g AceSlot
-type MainEffects = H.HalogenEffects (random ∷ RANDOM, now ∷ NOW, ref ∷ REF, ace ∷ ACE)
+type MainEffects = HA.HalogenEffects (random ∷ RANDOM, now ∷ NOW, ace ∷ ACE)
 type MainAff = Aff MainEffects
-type MainDSL = H.ParentDSL State AceState Query AceQuery MainAff AceSlot
 
-ui ∷ H.Component (StateP MainAff) QueryP MainAff
-ui = H.parentComponent { render, eval, peek: Just (peek <<< H.runChildF) }
+type MainHtml = H.ParentHTML Query AceQuery AceSlot MainAff
+type MainDSL = H.ParentDSL State Query AceQuery AceSlot Void MainAff
+
+ui ∷ H.Component HH.HTML Query Unit Void MainAff
+ui =
+  H.parentComponent
+    { initialState: const initialState
+    , render
+    , eval
+    , receiver: const Nothing
+    }
   where
 
-  render ∷ State → MainHtml MainAff
+  render ∷ State → MainHtml
   render state =
     HH.div_
-      [ HH.Slot $ aceConstructor unit (initEditor state) Nothing
+      [ HH.slot unit (component state) unit (HE.input HandleMessage)
       , HH.div_ [ HH.text state.text ]
       ]
 
+  component :: State → H.Component HH.HTML AceQuery Unit AceMessage MainAff
+  component state = aceComponent (initEditor state) Nothing
+
   initEditor ∷ State → Editor → MainAff Unit
   initEditor state editor = liftEff $ do
     session ← Editor.getSession editor
@@ -61,15 +69,10 @@ ui = H.parentComponent { render, eval, peek: Just (peek <<< H.runChildF) }
     pure unit
 
   eval ∷ Query ~> MainDSL
-  eval (UpdateText next) =
-    pure next
-
-  peek ∷ forall x. AceQuery x → MainDSL Unit
-  peek (TextChanged _) = do
-    text ← H.query unit $ H.request GetText
-    H.modify (_ { text = fromMaybe "" text })
-  peek _ =
-    pure unit
+  eval = case _ of
+    HandleMessage (TextChanged text) next → do
+      H.modify (_ { text = text })
+      pure next
 
 main ∷ Eff MainEffects Unit
-main = runHalogenAff $ H.runUI ui (H.parentState initialState) =<< awaitBody
+main = HA.runHalogenAff (runUI ui unit =<< HA.awaitBody)

package.json

@@ -2,15 +2,15 @@
   "private": true,
   "scripts": {
     "clean": "rimraf output && rimraf .pulp-cache",
-    "build": "jshint src && jscs src && pulp build --censor-lib --strict",
+    "build": "jshint src && jscs src && pulp build -- --censor-lib --strict",
     "example": "bower link && cd example && bower link purescript-ace-halogen && npm i --production && npm run -s build"
   },
   "devDependencies": {
     "jscs": "^3.0.7",
     "jshint": "^2.9.4",
-    "pulp": "^9.0.1",
-    "purescript": "^0.10.1",
-    "purescript-psa": "^0.3.9",
+    "pulp": "^10.0.0",
+    "purescript": "^0.10.5",
+    "purescript-psa": "^0.4.0",
     "rimraf": "^2.5.4"
   }
 }

src/Ace/Halogen/Component.purs

@@ -1,9 +1,7 @@
 module Ace.Halogen.Component
   ( aceComponent
-  , aceConstructor
   , AceQuery(..)
-  , AceState(..)
-  , initialAceState
+  , AceMessage(..)
   , AceEffects
   , Autocomplete(..)
   , CompleteFn
@@ -13,14 +11,14 @@ import Prelude
 
 import Control.Monad.Aff (Aff, runAff)
 import Control.Monad.Aff.AVar (AVAR)
-import Control.Monad.Aff.Free (class Affable)
 import Control.Monad.Eff (Eff)
+import Control.Monad.Aff.Class (class MonadAff)
 import Control.Monad.Eff.Now (NOW, now)
 import Control.Monad.Eff.Random (random, RANDOM)
 import Control.Monad.Eff.Ref (Ref, REF, readRef, writeRef, modifyRef)
 
 import Data.DateTime.Instant (unInstant)
-import Data.Foldable (traverse_, for_)
+import Data.Foldable (traverse_)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (unwrap)
 import Data.StrMap (StrMap)
@@ -37,8 +35,8 @@ import DOM (DOM)
 import DOM.HTML.Types (HTMLElement)
 
 import Halogen as H
-import Halogen.HTML.Indexed as HH
-import Halogen.HTML.Properties.Indexed as HP
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
 
 -- | Effectful knot of autocomplete functions. It's needed because
 -- | `languageTools.addCompleter` is global and adds completer to
@@ -129,19 +127,19 @@ type AceEffects eff =
 -- |   - `Just Live` - enables live autocomplete
 -- | - `SetCompleteFn` - sets function providing autocomplete variants.
 -- | - `GetEditor` - returns ace editor instance handled by this component.
--- | - `TextChanged` - raised internally when the value in the editor is
--- |   changed. Allows for parent component to observe when the value changes
--- |   via the `peek` mechanism.
 data AceQuery a
-  = SetElement (Maybe HTMLElement) a
-  | Init a
+  = Init a
   | Quit a
   | GetText (String → a)
   | SetText String a
   | SetAutocomplete (Maybe Autocomplete) a
   | SetCompleteFn (∀ eff. CompleteFn eff) a
   | GetEditor (Maybe Editor → a)
-  | TextChanged a
+  | HandleChange (H.SubscribeStatus -> a)
+
+-- | Ace output messages
+-- | - `AceValueChanged` - raised when the value in the editor is changed.
+data AceMessage = TextChanged String
 
 -- | The type for autocomplete function s. Takes editor, session, text position,
 -- | prefix, and returns array of possible completions in the `Aff` monad.
@@ -158,108 +156,96 @@ type CompleteFn eff
 type AceState =
   { key ∷ Maybe String
   , editor ∷ Maybe Editor
-  , element ∷ Maybe HTMLElement
   }
 
+type DSL m = H.ComponentDSL AceState AceQuery AceMessage m
+
 -- | An initial empty state value.
-initialAceState ∷ AceState
-initialAceState =
+initialState ∷ AceState
+initialState =
   { key: Nothing
   , editor: Nothing
-  , element: Nothing
   }
 
 -- | The Ace component.
 aceComponent
-  ∷ ∀ eff g
-  . (Monad g, Affable (AceEffects eff) g)
-  ⇒ (Editor → g Unit)
+  ∷ ∀ eff m
+  . MonadAff (AceEffects eff) m
+  ⇒ (Editor → m Unit)
   → Maybe Autocomplete
-  → H.Component AceState AceQuery g
-aceComponent setup resume = H.lifecycleComponent
-    { render
+  → H.Component HH.HTML AceQuery Unit AceMessage m
+aceComponent setup resume =
+  H.lifecycleComponent
+    { initialState: const initialState
+    , render
     , eval: eval setup resume
     , initializer: Just (H.action Init)
     , finalizer: Just (H.action Quit)
+    , receiver: const Nothing
     }
 
 render ∷ AceState → H.ComponentHTML AceQuery
-render = const $ HH.div [ HP.ref (H.action <<< SetElement) ] []
+render = const $ HH.div [ HP.ref (H.RefLabel "container") ] []
 
-eval ∷ ∀ eff g
- . (Monad g, Affable (AceEffects eff) g)
- ⇒ (Editor → g Unit)
+eval ∷ ∀ eff m
+ . MonadAff (AceEffects eff) m
+ ⇒ (Editor → m Unit)
  → Maybe Autocomplete
  → AceQuery
- ~> H.ComponentDSL AceState AceQuery g
+ ~> DSL m
 eval setup resume = case _ of
-  SetElement el next → do
-    state ← H.get
-    for_ state.editor $ H.fromEff <<< Editor.destroy
-    H.modify _{ element = el, editor = Nothing }
-    pure next
 
   Init next → do
-    el ← H.gets _.element
-    for_ el \el' → do
-      key ← H.gets _.key >>= maybe (H.fromEff genKey) pure
-      editor ← H.fromEff $ Ace.editNode el' Ace.ace
-      H.set { key: Just key, editor: Just editor, element: Just el' }
-      H.fromEff do
+    H.getHTMLElementRef (H.RefLabel "container") >>= traverse_ \el → do
+      key ← H.gets _.key >>= maybe (H.liftEff genKey) pure
+      editor ← H.liftEff $ Ace.editNode el Ace.ace
+      H.put { key: Just key, editor: Just editor }
+      H.liftEff do
         enableAutocomplete
         setAutocompleteResume resume editor
         Editor.onFocus editor $ writeRef focused key
-      session ← H.fromEff $ Editor.getSession editor
-      H.subscribe $ H.eventSource_ (Session.onChange session) do
-        pure $ H.action TextChanged
-      H.liftH $ setup editor
+      session ← H.liftEff $ Editor.getSession editor
+      H.subscribe $ H.eventSource_ (Session.onChange session) (H.request HandleChange)
+      H.lift $ setup editor
     pure next
 
   Quit next → do
     H.gets _.key
       >>= traverse_ \key →
-      H.fromEff $ modifyRef completeFns $ Sm.delete key
+      H.liftEff $ modifyRef completeFns $ Sm.delete key
     pure next
 
   GetEditor k →
     map k $ H.gets _.editor
 
   GetText k →
-    H.gets _.editor
-      >>= maybe (pure "") (H.fromEff <<< Editor.getValue)
-      >>= k >>> pure
+    pure <<< k =<< getText
 
   SetText text next → do
     H.gets _.editor
       >>= traverse_ \editor → do
-        current ← H.fromEff $ Editor.getValue editor
+        current ← H.liftEff $ Editor.getValue editor
         when (text /= current) $ void
-          $ H.fromEff (Editor.setValue text Nothing editor)
+          $ H.liftEff (Editor.setValue text Nothing editor)
     pure next
 
   SetAutocomplete mbAc next → do
     H.gets _.editor
-      >>= traverse_ (H.fromEff <<< setAutocompleteResume mbAc)
+      >>= traverse_ (H.liftEff <<< setAutocompleteResume mbAc)
     pure next
 
   SetCompleteFn fn next → do
     H.gets _.key
       >>= traverse_ \key →
-      H.fromEff $ modifyRef completeFns $ Sm.insert key fn
+      H.liftEff $ modifyRef completeFns $ Sm.insert key fn
     pure next
 
-  TextChanged next → pure next
+  HandleChange k → do
+    H.raise <<< TextChanged =<< getText
+    pure $ k H.Listening
 
--- | A convenience function for creating a `SlotConstructor` for an Ace
--- | component.
-aceConstructor
-  ∷ ∀ p eff
-  . p
-  → (Editor → Aff (AceEffects eff) Unit)
-  → Maybe Autocomplete
-  → H.SlotConstructor AceState AceQuery (Aff (AceEffects eff)) p
-aceConstructor p setup mbAc =
-  H.SlotConstructor p \_ →
-    { component: aceComponent setup mbAc
-    , initialState: initialAceState
-    }
+  where
+
+  getText :: DSL m String
+  getText =
+    maybe (pure "") (H.liftEff <<< Editor.getValue) =<< H.gets _.editor