Hinzufügen Funktionalität.

Hinzufügen Funktionalität.

module Event.Stream.Input where

import Rx.JQuery
import Rx.Observable

import Data.Either
import Data.Foreign
import Data.Foreign.Class
import Data.Tuple

import Control.Monad.Eff
import Control.Monad.ST
import qualified Control.Monad.JQuery as J
import Debug.Trace
import DOM

import Render.Types
import Render.Main

foreign import readTopic
"""
function readTopic (){
  return { description : $('#topicInput').val(), typ: $('#typInput').val() };
}
""" :: forall eff. Eff( dom :: DOM | eff ) Foreign

foreign import readSlot
"""
function readSlot (){
  return { room: $('#roomInput').val(), time: parseFloat($('#timeInput').val(), 10) };
}
""" :: forall eff. Eff( dom :: DOM | eff ) Foreign

parseTopic :: Foreign -> Either ForeignError Topic
parseTopic ft = do
  t <- read ft :: F Topic
  return t

parseSlot :: Foreign -> Either ForeignError Slot
parseSlot fs = do
  s <- read fs :: F Slot
  return s

parseTimeslot :: Foreign -> Foreign -> Either ForeignError Timeslot
parseTimeslot fs ft = do
  s <- parseSlot fs
  t <- parseTopic ft
  return $ Tuple s t

postTopic :: forall eff. Topic -> Eff(trace :: Trace | eff) Unit
postTopic (Topic t) = print $ "Beschreibung: " ++ t.description ++ " Typ: " ++ t.typ

postSlot :: forall eff. Slot -> Eff(trace :: Trace | eff) Unit
postSlot (Slot s) = print $ "Raum: " ++ s.room ++ " Typ: " ++ (show s.time)

type Stream a h eff = Eff( dom :: DOM, trace :: Trace, st :: ST h | eff ) Unit

streams :: forall eff h. Stream AppState h eff
streams = do

  appSt <- newSTRef myState1
  renderApp <$> readSTRef appSt

  submit <- J.select "#submitBtn"
  submitClick <- "click" `onAsObservable` submit

  subscribe submitClick (\_-> do
    t <- readTopic
    s <- readSlot
    case parseTimeslot s t of
      Right ts -> void $ modifySTRef appSt $ addTimeslot ts
      Left e -> trace $ show e
    renderApp <$> readSTRef appSt
    )

main = runST streams

module Event.Stream.Input where

import Control.Monad.Eff

import Rx.JQuery
import Rx.Observable

import Control.Monad.JQuery
import Debug.Trace

streams = do
  room   <- select "#roomInput"
  time   <- select "#timeInput"
  topic  <- select "#topicInput"
  typ    <- select "#typInput"
  submit <- select "#submitBtn"
  output <- select "#output"

  roomInput   <- "input" `onAsObservable` room
  timeInput   <- "input" `onAsObservable` time
  topicInput  <- "input" `onAsObservable` topic
  typInput    <- "input" `onAsObservable` typ
  submitClick <- "click" `onAsObservable` submit

  let roomTime = merge roomInput timeInput
  subscribe roomTime (\e -> trace e)


Warn on duplicate slots during render

Warn on duplicate slots during render

module Halogen.Aff.Driver
  ( RenderSpec
  , runUI
  , module Halogen
  , module Halogen.Aff.Effects
  ) where

import Prelude

import Control.Coroutine as CR
import Control.Monad.Aff (Aff, forkAff, forkAll, runAff)
import Control.Monad.Aff.AVar as AV
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (warn)
import Control.Monad.Eff.Exception (error, throw, throwException)
import Control.Monad.Eff.Ref (Ref, modifyRef, writeRef, readRef, newRef)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Rec.Class (Step(..), tailRecM)

import Data.List ((:))
import Data.List as L
import Data.Either (Either(..))
import Data.Map as M
import Data.Maybe (Maybe(..), maybe, isNothing)
import Data.Traversable (for_, traverse_, sequence_)
import Data.Tuple (Tuple(..))

import Halogen (HalogenIO)
import Halogen.Aff.Driver.Eval (eval, handleLifecycle, queuingHandler, parSequenceAff_)
import Halogen.Aff.Driver.State (LifecycleHandlers, DriverState(..), DriverStateX, RenderStateX, initDriverState, renderStateX, renderStateX_, unDriverStateX)
import Halogen.Aff.Effects (HalogenEffects)
import Halogen.Component (Component, ComponentSlot, unComponent, unComponentSlot)
import Halogen.Data.OrdBox (OrdBox)
import Halogen.Query.InputF (InputF(..))

type RenderSpec h r eff =
  { render
      :: forall s f g p o
       . (forall x. InputF x (f x) -> Eff (HalogenEffects eff) Unit)
      -> (ComponentSlot h g (Aff (HalogenEffects eff)) p (f Unit) -> Eff (HalogenEffects eff) (RenderStateX r eff))
      -> h (ComponentSlot h g (Aff (HalogenEffects eff)) p (f Unit)) (f Unit)
      -> Maybe (r s f g p o eff)
      -> Eff (HalogenEffects eff) (r s f g p o eff)
  , renderChild :: forall s f g p o. r s f g p o eff -> r s f g p o eff
  , removeChild :: forall s f g p o. r s f g p o eff -> Eff (HalogenEffects eff) Unit
  }

newLifecycleHandlers :: forall eff. Eff (HalogenEffects eff) (Ref (LifecycleHandlers eff))
newLifecycleHandlers = newRef { initializers: L.Nil, finalizers: L.Nil }

runUI
  :: forall h r f i o eff
   . RenderSpec h r eff
  -> Component h f i o (Aff (HalogenEffects eff))
  -> i
  -> Aff (HalogenEffects eff) (HalogenIO f o (Aff (HalogenEffects eff)))
runUI renderSpec component i = do
  lchs <- liftEff newLifecycleHandlers
  fresh <- liftEff $ newRef 0
  handleLifecycle lchs do
    listeners <- newRef M.empty
    runComponent lchs (rootHandler listeners) i Just component
      >>= readRef
      >>= unDriverStateX \st ->
        pure
          { query: evalDriver st.selfRef st.prjQuery
          , subscribe: subscribe fresh listeners
          }

  where

  evalDriver
    :: forall s f' z' g p i' o'
     . Ref (DriverState h r s f' z' g p i' o' eff)
    -> (forall x. f' x -> Maybe (z' x))
    -> f'
    ~> Aff (HalogenEffects eff)
  evalDriver ref prjQuery q =
    case prjQuery q of
      Just q' -> evalF ref (Query q')
      Nothing -> liftEff $ throwException (error "Halogen internal error: query projection failed in runUI'")

  evalF
    :: forall s f' z' g p i' o' a
     . Ref (DriverState h r s f' z' g p i' o' eff)
    -> InputF a (z' a)
    -> Aff (HalogenEffects eff) a
  evalF ref = eval render ref

  rootHandler
    :: Ref (M.Map Int (AV.AVar o))
    -> o
    -> Aff (HalogenEffects eff) Unit
  rootHandler ref message = do
    listeners <- liftEff $ readRef ref
    void $ forkAll $ map (\var -> AV.putVar var message) listeners

  subscribe
    :: Ref Int
    -> Ref (M.Map Int (AV.AVar o))
    -> CR.Consumer o (Aff (HalogenEffects eff)) Unit
    -> Aff (HalogenEffects eff) Unit
  subscribe fresh ref consumer = do
    inputVar <- AV.makeVar
    listenerId <- liftEff do
      listenerId <- readRef fresh
      modifyRef fresh (_ + 1)
      modifyRef ref (M.insert listenerId inputVar)
      pure listenerId
    let producer = CR.producer (Left <$> AV.takeVar inputVar)
    void $ forkAff do
      CR.runProcess (CR.connect producer consumer)
      liftEff $ modifyRef ref (M.delete listenerId)
      AV.killVar inputVar (error "ended")

  runComponent
    :: forall z f' i' o'
     . Ref (LifecycleHandlers eff)
    -> (o' -> Aff (HalogenEffects eff) Unit)
    -> i'
    -> (forall x. f' x -> Maybe (z x))
    -> Component h z i' o' (Aff (HalogenEffects eff))
    -> Eff (HalogenEffects eff) (Ref (DriverStateX h r f' eff))
  runComponent lchs handler j prjQuery = unComponent \c -> do
    lchs' <- newLifecycleHandlers
    var <- initDriverState c j handler prjQuery lchs'
    pre <- readRef lchs
    writeRef lchs { initializers: L.Nil, finalizers: pre.finalizers }
    unDriverStateX (render lchs <<< _.selfRef) =<< readRef var
    squashChildInitializers lchs pre.initializers =<< readRef var
    pure var

  render
    :: forall s f' z' g p i' o'
     . Ref (LifecycleHandlers eff)
    -> Ref (DriverState h r s f' z' g p i' o' eff)
    -> Eff (HalogenEffects eff) Unit
  render lchs var = readRef var >>= \(DriverState ds) -> do
    shouldProcessHandlers <- isNothing <$> readRef ds.pendingHandlers
    when shouldProcessHandlers $ writeRef ds.pendingHandlers (Just L.Nil)
    writeRef ds.childrenOut M.empty
    writeRef ds.childrenIn ds.children
    let
      handler :: forall x. InputF x (z' x) -> Aff (HalogenEffects eff) Unit
      handler = queuingHandler (void <<< evalF ds.selfRef) ds.pendingHandlers
      childHandler :: forall x. z' x -> Aff (HalogenEffects eff) Unit
      childHandler = queuingHandler (handler <<< Query) ds.pendingQueries
    rendering <-
      renderSpec.render
        (handleAff <<< handler)
        (renderChild lchs childHandler ds.component.mkOrdBox ds.childrenIn ds.childrenOut)
        (ds.component.render ds.state)
        ds.rendering
    children <- readRef ds.childrenOut
    readRef ds.childrenIn >>= traverse_ \childVar -> do
      childDS <- readRef childVar
      renderStateX_ renderSpec.removeChild childDS
      cleanupSubscriptions childDS
      addFinalizer lchs childDS
    modifyRef ds.selfRef \(DriverState ds') ->
      DriverState
        { rendering: Just rendering
        , children
        , component: ds'.component
        , state: ds'.state
        , refs: ds'.refs
        , childrenIn: ds'.childrenIn
        , childrenOut: ds'.childrenOut
        , selfRef: ds'.selfRef
        , handler: ds'.handler
        , pendingQueries: ds'.pendingQueries
        , pendingOuts: ds'.pendingOuts
        , pendingHandlers: ds'.pendingHandlers
        , prjQuery: ds'.prjQuery
        , fresh: ds'.fresh
        , subscriptions: ds'.subscriptions
        , lifecycleHandlers: ds'.lifecycleHandlers
        }
    when shouldProcessHandlers do
      flip tailRecM unit \_ -> do
        handlers <- readRef ds.pendingHandlers
        writeRef ds.pendingHandlers (Just L.Nil)
        traverse_ (handleAff <<< forkAll <<< L.reverse) handlers
        mmore <- readRef ds.pendingHandlers
        if maybe false L.null mmore
          then writeRef ds.pendingHandlers Nothing $> Done unit
          else pure $ Loop unit

  renderChild
    :: forall f' g p
     . Ref (LifecycleHandlers eff)
    -> (forall x. f' x -> Aff (HalogenEffects eff) Unit)
    -> (p -> OrdBox p)
    -> Ref (M.Map (OrdBox p) (Ref (DriverStateX h r g eff)))
    -> Ref (M.Map (OrdBox p) (Ref (DriverStateX h r g eff)))
    -> ComponentSlot h g (Aff (HalogenEffects eff)) p (f' Unit)
    -> Eff (HalogenEffects eff) (RenderStateX r eff)
  renderChild lchs handler mkOrdBox childrenInRef childrenOutRef =
    unComponentSlot \p ctor input inputQuery outputQuery prjQuery -> do
      let ordP = mkOrdBox p
      childrenIn <- readRef childrenInRef
      var <- case M.pop ordP childrenIn of
        Just (Tuple existing childrenIn') -> do
          writeRef childrenInRef childrenIn'
          for_ (inputQuery input) \q -> do
            dsx <- readRef existing
            unDriverStateX (\st -> for_ (st.prjQuery q) (handleAff <<< evalF st.selfRef <<< Query)) dsx
          pure existing
        Nothing ->
          runComponent lchs (maybe (pure unit) handler <<< outputQuery) input prjQuery ctor
      isDuplicate <- M.member ordP <$> readRef childrenOutRef
      when isDuplicate
        $ unsafeCoerceEff
        $ warn "Halogen: Duplicate slot address was detected during rendering, unexpected results may occur"
      modifyRef childrenOutRef (M.insert ordP var)
      readRef var >>= renderStateX case _ of
        Nothing -> throw "Halogen internal error: child was not initialized in renderChild"
        Just r -> pure (renderSpec.renderChild r)

  squashChildInitializers
    :: forall f'
     . Ref (LifecycleHandlers eff)
    -> L.List (Aff (HalogenEffects eff) Unit)
    -> DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  squashChildInitializers lchs preInits =
    unDriverStateX \st -> do
      let parentInitializer = evalF st.selfRef <<< Query <$> st.component.initializer
      modifyRef lchs \handlers ->
        { initializers: (do
            parSequenceAff_ (L.reverse handlers.initializers)
            sequence_ parentInitializer
            liftEff do
              handlePending st.pendingQueries
              handlePending st.pendingOuts) : preInits
        , finalizers: handlers.finalizers
        }

  handlePending
    :: Ref (Maybe (L.List (Aff (HalogenEffects eff) Unit)))
    -> Eff (HalogenEffects eff) Unit
  handlePending ref = do
    queue <- readRef ref
    writeRef ref Nothing
    for_ queue (handleAff <<< forkAll <<< L.reverse)

  cleanupSubscriptions
    :: forall f'
     . DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  cleanupSubscriptions = unDriverStateX \ds -> do
    traverse_ (handleAff <<< forkAll) =<< readRef ds.subscriptions
    writeRef ds.subscriptions Nothing

  addFinalizer
    :: forall f'
     . Ref (LifecycleHandlers eff)
    -> DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  addFinalizer lchs =
    unDriverStateX \st -> do
      for_ (evalF st.selfRef <<< Query <$> st.component.finalizer) \f ->
        modifyRef lchs (\handlers ->
          { initializers: handlers.initializers
          , finalizers: f : handlers.finalizers
          })
      for_ st.children (addFinalizer lchs <=< readRef)

-- | TODO: we could do something more intelligent now this isn't baked into the
-- | virtual-dom rendering. Perhaps write to an avar when an error occurs...
-- | something other than a runtime exception anyway.
handleAff
  :: forall eff a
   . Aff (HalogenEffects eff) a
  -> Eff (HalogenEffects eff) Unit
handleAff = void <<< runAff throwException (const (pure unit))

module Halogen.Aff.Driver
  ( RenderSpec
  , runUI
  , module Halogen
  , module Halogen.Aff.Effects
  ) where

import Prelude

import Control.Coroutine as CR
import Control.Monad.Aff (Aff, forkAff, forkAll, runAff)
import Control.Monad.Aff.AVar as AV
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (error, throw, throwException)
import Control.Monad.Eff.Ref (Ref, modifyRef, writeRef, readRef, newRef)
import Control.Monad.Rec.Class (Step(..), tailRecM)

import Data.List ((:))
import Data.List as L
import Data.Either (Either(..))
import Data.Map as M
import Data.Maybe (Maybe(..), maybe, isNothing)
import Data.Traversable (for_, traverse_, sequence_)
import Data.Tuple (Tuple(..))

import Halogen (HalogenIO)
import Halogen.Aff.Driver.Eval (eval, handleLifecycle, queuingHandler, parSequenceAff_)
import Halogen.Aff.Driver.State (LifecycleHandlers, DriverState(..), DriverStateX, RenderStateX, initDriverState, renderStateX, renderStateX_, unDriverStateX)
import Halogen.Aff.Effects (HalogenEffects)
import Halogen.Component (Component, ComponentSlot, unComponent, unComponentSlot)
import Halogen.Data.OrdBox (OrdBox)
import Halogen.Query.InputF (InputF(..))

type RenderSpec h r eff =
  { render
      :: forall s f g p o
       . (forall x. InputF x (f x) -> Eff (HalogenEffects eff) Unit)
      -> (ComponentSlot h g (Aff (HalogenEffects eff)) p (f Unit) -> Eff (HalogenEffects eff) (RenderStateX r eff))
      -> h (ComponentSlot h g (Aff (HalogenEffects eff)) p (f Unit)) (f Unit)
      -> Maybe (r s f g p o eff)
      -> Eff (HalogenEffects eff) (r s f g p o eff)
  , renderChild :: forall s f g p o. r s f g p o eff -> r s f g p o eff
  , removeChild :: forall s f g p o. r s f g p o eff -> Eff (HalogenEffects eff) Unit
  }

newLifecycleHandlers :: forall eff. Eff (HalogenEffects eff) (Ref (LifecycleHandlers eff))
newLifecycleHandlers = newRef { initializers: L.Nil, finalizers: L.Nil }

runUI
  :: forall h r f i o eff
   . RenderSpec h r eff
  -> Component h f i o (Aff (HalogenEffects eff))
  -> i
  -> Aff (HalogenEffects eff) (HalogenIO f o (Aff (HalogenEffects eff)))
runUI renderSpec component i = do
  lchs <- liftEff newLifecycleHandlers
  fresh <- liftEff $ newRef 0
  handleLifecycle lchs do
    listeners <- newRef M.empty
    runComponent lchs (rootHandler listeners) i Just component
      >>= readRef
      >>= unDriverStateX \st ->
        pure
          { query: evalDriver st.selfRef st.prjQuery
          , subscribe: subscribe fresh listeners
          }

  where

  evalDriver
    :: forall s f' z' g p i' o'
     . Ref (DriverState h r s f' z' g p i' o' eff)
    -> (forall x. f' x -> Maybe (z' x))
    -> f'
    ~> Aff (HalogenEffects eff)
  evalDriver ref prjQuery q =
    case prjQuery q of
      Just q' -> evalF ref (Query q')
      Nothing -> liftEff $ throwException (error "Halogen internal error: query projection failed in runUI'")

  evalF
    :: forall s f' z' g p i' o' a
     . Ref (DriverState h r s f' z' g p i' o' eff)
    -> InputF a (z' a)
    -> Aff (HalogenEffects eff) a
  evalF ref = eval render ref

  rootHandler
    :: Ref (M.Map Int (AV.AVar o))
    -> o
    -> Aff (HalogenEffects eff) Unit
  rootHandler ref message = do
    listeners <- liftEff $ readRef ref
    void $ forkAll $ map (\var -> AV.putVar var message) listeners

  subscribe
    :: Ref Int
    -> Ref (M.Map Int (AV.AVar o))
    -> CR.Consumer o (Aff (HalogenEffects eff)) Unit
    -> Aff (HalogenEffects eff) Unit
  subscribe fresh ref consumer = do
    inputVar <- AV.makeVar
    listenerId <- liftEff do
      listenerId <- readRef fresh
      modifyRef fresh (_ + 1)
      modifyRef ref (M.insert listenerId inputVar)
      pure listenerId
    let producer = CR.producer (Left <$> AV.takeVar inputVar)
    void $ forkAff do
      CR.runProcess (CR.connect producer consumer)
      liftEff $ modifyRef ref (M.delete listenerId)
      AV.killVar inputVar (error "ended")

  runComponent
    :: forall z f' i' o'
     . Ref (LifecycleHandlers eff)
    -> (o' -> Aff (HalogenEffects eff) Unit)
    -> i'
    -> (forall x. f' x -> Maybe (z x))
    -> Component h z i' o' (Aff (HalogenEffects eff))
    -> Eff (HalogenEffects eff) (Ref (DriverStateX h r f' eff))
  runComponent lchs handler j prjQuery = unComponent \c -> do
    lchs' <- newLifecycleHandlers
    var <- initDriverState c j handler prjQuery lchs'
    pre <- readRef lchs
    writeRef lchs { initializers: L.Nil, finalizers: pre.finalizers }
    unDriverStateX (render lchs <<< _.selfRef) =<< readRef var
    squashChildInitializers lchs pre.initializers =<< readRef var
    pure var

  render
    :: forall s f' z' g p i' o'
     . Ref (LifecycleHandlers eff)
    -> Ref (DriverState h r s f' z' g p i' o' eff)
    -> Eff (HalogenEffects eff) Unit
  render lchs var = readRef var >>= \(DriverState ds) -> do
    shouldProcessHandlers <- isNothing <$> readRef ds.pendingHandlers
    when shouldProcessHandlers $ writeRef ds.pendingHandlers (Just L.Nil)
    writeRef ds.childrenOut M.empty
    writeRef ds.childrenIn ds.children
    let
      handler :: forall x. InputF x (z' x) -> Aff (HalogenEffects eff) Unit
      handler = queuingHandler (void <<< evalF ds.selfRef) ds.pendingHandlers
      childHandler :: forall x. z' x -> Aff (HalogenEffects eff) Unit
      childHandler = queuingHandler (handler <<< Query) ds.pendingQueries
    rendering <-
      renderSpec.render
        (handleAff <<< handler)
        (renderChild lchs childHandler ds.component.mkOrdBox ds.childrenIn ds.childrenOut)
        (ds.component.render ds.state)
        ds.rendering
    children <- readRef ds.childrenOut
    readRef ds.childrenIn >>= traverse_ \childVar -> do
      childDS <- readRef childVar
      renderStateX_ renderSpec.removeChild childDS
      cleanupSubscriptions childDS
      addFinalizer lchs childDS
    modifyRef ds.selfRef \(DriverState ds') ->
      DriverState
        { rendering: Just rendering
        , children
        , component: ds'.component
        , state: ds'.state
        , refs: ds'.refs
        , childrenIn: ds'.childrenIn
        , childrenOut: ds'.childrenOut
        , selfRef: ds'.selfRef
        , handler: ds'.handler
        , pendingQueries: ds'.pendingQueries
        , pendingOuts: ds'.pendingOuts
        , pendingHandlers: ds'.pendingHandlers
        , prjQuery: ds'.prjQuery
        , fresh: ds'.fresh
        , subscriptions: ds'.subscriptions
        , lifecycleHandlers: ds'.lifecycleHandlers
        }
    when shouldProcessHandlers do
      flip tailRecM unit \_ -> do
        handlers <- readRef ds.pendingHandlers
        writeRef ds.pendingHandlers (Just L.Nil)
        traverse_ (handleAff <<< forkAll <<< L.reverse) handlers
        mmore <- readRef ds.pendingHandlers
        if maybe false L.null mmore
          then writeRef ds.pendingHandlers Nothing $> Done unit
          else pure $ Loop unit

  renderChild
    :: forall f' g p
     . Ref (LifecycleHandlers eff)
    -> (forall x. f' x -> Aff (HalogenEffects eff) Unit)
    -> (p -> OrdBox p)
    -> Ref (M.Map (OrdBox p) (Ref (DriverStateX h r g eff)))
    -> Ref (M.Map (OrdBox p) (Ref (DriverStateX h r g eff)))
    -> ComponentSlot h g (Aff (HalogenEffects eff)) p (f' Unit)
    -> Eff (HalogenEffects eff) (RenderStateX r eff)
  renderChild lchs handler mkOrdBox childrenInRef childrenOutRef =
    unComponentSlot \p ctor input inputQuery outputQuery prjQuery -> do
      childrenIn <- readRef childrenInRef
      var <- case M.pop (mkOrdBox p) childrenIn of
        Just (Tuple existing childrenIn') -> do
          writeRef childrenInRef childrenIn'
          for_ (inputQuery input) \q -> do
            dsx <- readRef existing
            unDriverStateX (\st -> for_ (st.prjQuery q) (handleAff <<< evalF st.selfRef <<< Query)) dsx
          pure existing
        Nothing ->
          runComponent lchs (maybe (pure unit) handler <<< outputQuery) input prjQuery ctor
      modifyRef childrenOutRef (M.insert (mkOrdBox p) var)
      readRef var >>= renderStateX case _ of
        Nothing -> throw "Halogen internal error: child was not initialized in renderChild"
        Just r -> pure (renderSpec.renderChild r)

  squashChildInitializers
    :: forall f'
     . Ref (LifecycleHandlers eff)
    -> L.List (Aff (HalogenEffects eff) Unit)
    -> DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  squashChildInitializers lchs preInits =
    unDriverStateX \st -> do
      let parentInitializer = evalF st.selfRef <<< Query <$> st.component.initializer
      modifyRef lchs \handlers ->
        { initializers: (do
            parSequenceAff_ (L.reverse handlers.initializers)
            sequence_ parentInitializer
            liftEff do
              handlePending st.pendingQueries
              handlePending st.pendingOuts) : preInits
        , finalizers: handlers.finalizers
        }

  handlePending
    :: Ref (Maybe (L.List (Aff (HalogenEffects eff) Unit)))
    -> Eff (HalogenEffects eff) Unit
  handlePending ref = do
    queue <- readRef ref
    writeRef ref Nothing
    for_ queue (handleAff <<< forkAll <<< L.reverse)

  cleanupSubscriptions
    :: forall f'
     . DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  cleanupSubscriptions = unDriverStateX \ds -> do
    traverse_ (handleAff <<< forkAll) =<< readRef ds.subscriptions
    writeRef ds.subscriptions Nothing

  addFinalizer
    :: forall f'
     . Ref (LifecycleHandlers eff)
    -> DriverStateX h r f' eff
    -> Eff (HalogenEffects eff) Unit
  addFinalizer lchs =
    unDriverStateX \st -> do
      for_ (evalF st.selfRef <<< Query <$> st.component.finalizer) \f ->
        modifyRef lchs (\handlers ->
          { initializers: handlers.initializers
          , finalizers: f : handlers.finalizers
          })
      for_ st.children (addFinalizer lchs <=< readRef)

-- | TODO: we could do something more intelligent now this isn't baked into the
-- | virtual-dom rendering. Perhaps write to an avar when an error occurs...
-- | something other than a runtime exception anyway.
handleAff
  :: forall eff a
   . Aff (HalogenEffects eff) a
  -> Eff (HalogenEffects eff) Unit
handleAff = void <<< runAff throwException (const (pure unit))


remove unused parameters

remove unused parameters

module Test.Data.String.CodePoints (testStringCodePoints) where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)

import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.String.CodePoints

import Test.Assert (ASSERT, assert)

str :: String
str = "a\xDC00\xD800\xD800\x16805\x16A06\&z"

testStringCodePoints :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
testStringCodePoints = do
  log "codePointAt"
  assert $ codePointAt (-1) str == Nothing
  assert $ codePointAt 0 str == (codePointFromInt 0x61)
  assert $ codePointAt 1 str == (codePointFromInt 0xDC00)
  assert $ codePointAt 2 str == (codePointFromInt 0xD800)
  assert $ codePointAt 3 str == (codePointFromInt 0xD800)
  assert $ codePointAt 4 str == (codePointFromInt 0x16805)
  assert $ codePointAt 5 str == (codePointFromInt 0x16A06)
  assert $ codePointAt 6 str == (codePointFromInt 0x7A)
  assert $ codePointAt 7 str == Nothing

  log "count"
  assert $ count (\_ -> true) "" == 0
  assert $ count (\_ -> false) str == 0
  assert $ count (\_ -> true) str == 7
  assert $ count (\x -> codePointToInt x < 0xFFFF) str == 4
  assert $ count (\x -> codePointToInt x < 0xDC00) str == 1

  log "drop"
  assert $ drop (-1) str == str
  assert $ drop 0 str == str
  assert $ drop 1 str == "\xDC00\xD800\xD800\x16805\x16A06\&z"
  assert $ drop 2 str == "\xD800\xD800\x16805\x16A06\&z"
  assert $ drop 3 str == "\xD800\x16805\x16A06\&z"
  assert $ drop 4 str == "\x16805\x16A06\&z"
  assert $ drop 5 str == "\x16A06\&z"
  assert $ drop 6 str == "z"
  assert $ drop 7 str == ""
  assert $ drop 8 str == ""

  log "dropWhile"
  assert $ dropWhile (\_ -> true) str == ""
  assert $ dropWhile (\_ -> false) str == str
  assert $ dropWhile (\c -> codePointToInt c < 0xFFFF) str == "\x16805\x16A06\&z"
  assert $ dropWhile (\c -> codePointToInt c < 0xDC00) str == "\xDC00\xD800\xD800\x16805\x16A06\&z"

  log "indexOf"
  assert $ indexOf (Pattern "") "" == Just 0
  assert $ indexOf (Pattern "") str == Just 0
  assert $ indexOf (Pattern str) str == Just 0
  assert $ indexOf (Pattern "a") str == Just 0
  assert $ indexOf (Pattern "\xDC00\xD800\xD800") str == Just 1
  assert $ indexOf (Pattern "\xD800") str == Just 2
  assert $ indexOf (Pattern "\xD800\xD800") str == Just 2
  assert $ indexOf (Pattern "\xD800\xD81A") str == Just 3
  assert $ indexOf (Pattern "\xD800\x16805") str == Just 3
  assert $ indexOf (Pattern "\x16805") str == Just 4
  assert $ indexOf (Pattern "\x16A06") str == Just 5
  assert $ indexOf (Pattern "z") str == Just 6
  assert $ indexOf (Pattern "\0") str == Nothing
  assert $ indexOf (Pattern "\xD81A") str == Just 4

  log "indexOf'"
  assert $ indexOf' (Pattern "") 0 "" == Just 0
  assert $ indexOf' (Pattern str) 0 str == Just 0
  assert $ indexOf' (Pattern str) 1 str == Nothing
  assert $ indexOf' (Pattern "a") 0 str == Just 0
  assert $ indexOf' (Pattern "a") 1 str == Nothing
  assert $ indexOf' (Pattern "z") 0 str == Just 6
  assert $ indexOf' (Pattern "z") 1 str == Just 6
  assert $ indexOf' (Pattern "z") 2 str == Just 6
  assert $ indexOf' (Pattern "z") 3 str == Just 6
  assert $ indexOf' (Pattern "z") 4 str == Just 6
  assert $ indexOf' (Pattern "z") 5 str == Just 6
  assert $ indexOf' (Pattern "z") 6 str == Just 6
  assert $ indexOf' (Pattern "z") 7 str == Nothing

  log "lastIndexOf"
  assert $ lastIndexOf (Pattern "") "" == Just 0
  assert $ lastIndexOf (Pattern "") str == Just 7
  assert $ lastIndexOf (Pattern str) str == Just 0
  assert $ lastIndexOf (Pattern "a") str == Just 0
  assert $ lastIndexOf (Pattern "\xDC00\xD800\xD800") str == Just 1
  assert $ lastIndexOf (Pattern "\xD800") str == Just 3
  assert $ lastIndexOf (Pattern "\xD800\xD800") str == Just 2
  assert $ lastIndexOf (Pattern "\xD800\xD81A") str == Just 3
  assert $ lastIndexOf (Pattern "\xD800\x16805") str == Just 3
  assert $ lastIndexOf (Pattern "\x16805") str == Just 4
  assert $ lastIndexOf (Pattern "\x16A06") str == Just 5
  assert $ lastIndexOf (Pattern "z") str == Just 6
  assert $ lastIndexOf (Pattern "\0") str == Nothing
  assert $ lastIndexOf (Pattern "\xD81A") str == Just 5

  log "lastIndexOf'"
  assert $ lastIndexOf' (Pattern "") 0 "" == Just 0
  assert $ lastIndexOf' (Pattern str) 0 str == Just 0
  assert $ lastIndexOf' (Pattern str) 1 str == Nothing
  assert $ lastIndexOf' (Pattern "a") 0 str == Just 0
  assert $ lastIndexOf' (Pattern "a") 1 str == Nothing
  assert $ lastIndexOf' (Pattern "z") 0 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 1 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 2 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 3 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 4 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 5 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 6 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 7 str == Nothing

  log "length"
  assert $ length "" == 0
  assert $ length "a" == 1
  assert $ length "ab" == 2
  assert $ length str == 7

  log "singleton"
  assert $ (singleton <$> codePointFromInt 0x30) == Just "0"
  assert $ (singleton <$> codePointFromInt 0x16805) == Just "\x16805"

  log "splitAt"
  let testSplitAt i s res =
        assert $ case splitAt i s of
          Nothing ->
            isNothing res
          Just { before, after } ->
            maybe false (\r ->
              r.before == before && r.after == after) res

  testSplitAt 0 "" $ Just {before: "", after: ""}
  testSplitAt 1 "" Nothing
  testSplitAt 0 "a" $ Just {before: "", after: "a"}
  testSplitAt 1 "ab" $ Just {before: "a", after: "b"}
  testSplitAt 3 "aabcc" $ Just {before: "aab", after: "cc"}
  testSplitAt (-1) "abc" $ Nothing
  testSplitAt 0 str $ Just {before: "", after: str}
  testSplitAt 1 str $ Just {before: "a", after: "\xDC00\xD800\xD800\x16805\x16A06\&z"}
  testSplitAt 2 str $ Just {before: "a\xDC00", after: "\xD800\xD800\x16805\x16A06\&z"}
  testSplitAt 3 str $ Just {before: "a\xDC00\xD800", after: "\xD800\x16805\x16A06\&z"}
  testSplitAt 4 str $ Just {before: "a\xDC00\xD800\xD800", after: "\x16805\x16A06\&z"}
  testSplitAt 5 str $ Just {before: "a\xDC00\xD800\xD800\x16805", after: "\x16A06\&z"}
  testSplitAt 6 str $ Just {before: "a\xDC00\xD800\xD800\x16805\x16A06", after: "z"}
  testSplitAt 7 str $ Just {before: str, after: ""}
  testSplitAt 8 str $ Nothing

  log "take"
  assert $ take (-1) str == ""
  assert $ take 0 str == ""
  assert $ take 1 str == "a"
  assert $ take 2 str == "a\xDC00"
  assert $ take 3 str == "a\xDC00\xD800"
  assert $ take 4 str == "a\xDC00\xD800\xD800"
  assert $ take 5 str == "a\xDC00\xD800\xD800\x16805"
  assert $ take 6 str == "a\xDC00\xD800\xD800\x16805\x16A06"
  assert $ take 7 str == str
  assert $ take 8 str == str

  log "takeWhile"
  assert $ takeWhile (\_ -> true) str == str
  assert $ takeWhile (\_ -> false) str == ""
  assert $ takeWhile (\c -> codePointToInt c < 0xFFFF) str == "a\xDC00\xD800\xD800"
  assert $ takeWhile (\c -> codePointToInt c < 0xDC00) str == "a"

  log "uncons"
  let testUncons s res =
        assert $ case uncons s of
          Nothing ->
            isNothing res
          Just { head, tail } ->
            maybe false (\r ->
              r.head == codePointToInt head && r.tail == tail) res

  testUncons str $ Just {head: 0x61, tail:  "\xDC00\xD800\xD800\x16805\x16A06\&z"}
  testUncons (drop 1 str) $ Just {head: 0xDC00, tail: "\xD800\xD800\x16805\x16A06\&z"}
  testUncons (drop 2 str) $ Just {head: 0xD800, tail: "\xD800\x16805\x16A06\&z"}
  testUncons (drop 3 str) $ Just {head: 0xD800, tail: "\x16805\x16A06\&z"}
  testUncons (drop 4 str) $ Just {head: 0x16805, tail: "\x16A06\&z"}
  testUncons (drop 5 str) $ Just {head: 0x16A06, tail: "z"}
  testUncons (drop 6 str) $ Just {head: 0x7A, tail: ""}
  testUncons "" Nothing

module Test.Data.String.CodePoints (testStringCodePoints) where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)

import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.String.CodePoints

import Test.Assert (ASSERT, assert)

str :: String
str = "a\xDC00\xD800\xD800\x16805\x16A06\&z"

testStringCodePoints :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
testStringCodePoints = do
  log "codePointAt"
  assert $ codePointAt (-1) str == Nothing
  assert $ codePointAt 0 str == (codePointFromInt 0x61)
  assert $ codePointAt 1 str == (codePointFromInt 0xDC00)
  assert $ codePointAt 2 str == (codePointFromInt 0xD800)
  assert $ codePointAt 3 str == (codePointFromInt 0xD800)
  assert $ codePointAt 4 str == (codePointFromInt 0x16805)
  assert $ codePointAt 5 str == (codePointFromInt 0x16A06)
  assert $ codePointAt 6 str == (codePointFromInt 0x7A)
  assert $ codePointAt 7 str == Nothing

  log "count"
  assert $ count (\_ -> true) "" == 0
  assert $ count (\_ -> false) str == 0
  assert $ count (\_ -> true) str == 7
  assert $ count (\x -> codePointToInt x < 0xFFFF) str == 4
  assert $ count (\x -> codePointToInt x < 0xDC00) str == 1

  log "drop"
  assert $ drop (-1) str == str
  assert $ drop 0 str == str
  assert $ drop 1 str == "\xDC00\xD800\xD800\x16805\x16A06\&z"
  assert $ drop 2 str == "\xD800\xD800\x16805\x16A06\&z"
  assert $ drop 3 str == "\xD800\x16805\x16A06\&z"
  assert $ drop 4 str == "\x16805\x16A06\&z"
  assert $ drop 5 str == "\x16A06\&z"
  assert $ drop 6 str == "z"
  assert $ drop 7 str == ""
  assert $ drop 8 str == ""

  log "dropWhile"
  assert $ dropWhile (\c -> true) str == ""
  assert $ dropWhile (\c -> false) str == str
  assert $ dropWhile (\c -> codePointToInt c < 0xFFFF) str == "\x16805\x16A06\&z"
  assert $ dropWhile (\c -> codePointToInt c < 0xDC00) str == "\xDC00\xD800\xD800\x16805\x16A06\&z"

  log "indexOf"
  assert $ indexOf (Pattern "") "" == Just 0
  assert $ indexOf (Pattern "") str == Just 0
  assert $ indexOf (Pattern str) str == Just 0
  assert $ indexOf (Pattern "a") str == Just 0
  assert $ indexOf (Pattern "\xDC00\xD800\xD800") str == Just 1
  assert $ indexOf (Pattern "\xD800") str == Just 2
  assert $ indexOf (Pattern "\xD800\xD800") str == Just 2
  assert $ indexOf (Pattern "\xD800\xD81A") str == Just 3
  assert $ indexOf (Pattern "\xD800\x16805") str == Just 3
  assert $ indexOf (Pattern "\x16805") str == Just 4
  assert $ indexOf (Pattern "\x16A06") str == Just 5
  assert $ indexOf (Pattern "z") str == Just 6
  assert $ indexOf (Pattern "\0") str == Nothing
  assert $ indexOf (Pattern "\xD81A") str == Just 4

  log "indexOf'"
  assert $ indexOf' (Pattern "") 0 "" == Just 0
  assert $ indexOf' (Pattern str) 0 str == Just 0
  assert $ indexOf' (Pattern str) 1 str == Nothing
  assert $ indexOf' (Pattern "a") 0 str == Just 0
  assert $ indexOf' (Pattern "a") 1 str == Nothing
  assert $ indexOf' (Pattern "z") 0 str == Just 6
  assert $ indexOf' (Pattern "z") 1 str == Just 6
  assert $ indexOf' (Pattern "z") 2 str == Just 6
  assert $ indexOf' (Pattern "z") 3 str == Just 6
  assert $ indexOf' (Pattern "z") 4 str == Just 6
  assert $ indexOf' (Pattern "z") 5 str == Just 6
  assert $ indexOf' (Pattern "z") 6 str == Just 6
  assert $ indexOf' (Pattern "z") 7 str == Nothing

  log "lastIndexOf"
  assert $ lastIndexOf (Pattern "") "" == Just 0
  assert $ lastIndexOf (Pattern "") str == Just 7
  assert $ lastIndexOf (Pattern str) str == Just 0
  assert $ lastIndexOf (Pattern "a") str == Just 0
  assert $ lastIndexOf (Pattern "\xDC00\xD800\xD800") str == Just 1
  assert $ lastIndexOf (Pattern "\xD800") str == Just 3
  assert $ lastIndexOf (Pattern "\xD800\xD800") str == Just 2
  assert $ lastIndexOf (Pattern "\xD800\xD81A") str == Just 3
  assert $ lastIndexOf (Pattern "\xD800\x16805") str == Just 3
  assert $ lastIndexOf (Pattern "\x16805") str == Just 4
  assert $ lastIndexOf (Pattern "\x16A06") str == Just 5
  assert $ lastIndexOf (Pattern "z") str == Just 6
  assert $ lastIndexOf (Pattern "\0") str == Nothing
  assert $ lastIndexOf (Pattern "\xD81A") str == Just 5

  log "lastIndexOf'"
  assert $ lastIndexOf' (Pattern "") 0 "" == Just 0
  assert $ lastIndexOf' (Pattern str) 0 str == Just 0
  assert $ lastIndexOf' (Pattern str) 1 str == Nothing
  assert $ lastIndexOf' (Pattern "a") 0 str == Just 0
  assert $ lastIndexOf' (Pattern "a") 1 str == Nothing
  assert $ lastIndexOf' (Pattern "z") 0 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 1 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 2 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 3 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 4 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 5 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 6 str == Just 6
  assert $ lastIndexOf' (Pattern "z") 7 str == Nothing

  log "length"
  assert $ length "" == 0
  assert $ length "a" == 1
  assert $ length "ab" == 2
  assert $ length str == 7

  log "singleton"
  assert $ (singleton <$> codePointFromInt 0x30) == Just "0"
  assert $ (singleton <$> codePointFromInt 0x16805) == Just "\x16805"

  log "splitAt"
  let testSplitAt i s res =
        assert $ case splitAt i s of
          Nothing ->
            isNothing res
          Just { before, after } ->
            maybe false (\r ->
              r.before == before && r.after == after) res

  testSplitAt 0 "" $ Just {before: "", after: ""}
  testSplitAt 1 "" Nothing
  testSplitAt 0 "a" $ Just {before: "", after: "a"}
  testSplitAt 1 "ab" $ Just {before: "a", after: "b"}
  testSplitAt 3 "aabcc" $ Just {before: "aab", after: "cc"}
  testSplitAt (-1) "abc" $ Nothing
  testSplitAt 0 str $ Just {before: "", after: str}
  testSplitAt 1 str $ Just {before: "a", after: "\xDC00\xD800\xD800\x16805\x16A06\&z"}
  testSplitAt 2 str $ Just {before: "a\xDC00", after: "\xD800\xD800\x16805\x16A06\&z"}
  testSplitAt 3 str $ Just {before: "a\xDC00\xD800", after: "\xD800\x16805\x16A06\&z"}
  testSplitAt 4 str $ Just {before: "a\xDC00\xD800\xD800", after: "\x16805\x16A06\&z"}
  testSplitAt 5 str $ Just {before: "a\xDC00\xD800\xD800\x16805", after: "\x16A06\&z"}
  testSplitAt 6 str $ Just {before: "a\xDC00\xD800\xD800\x16805\x16A06", after: "z"}
  testSplitAt 7 str $ Just {before: str, after: ""}
  testSplitAt 8 str $ Nothing

  log "take"
  assert $ take (-1) str == ""
  assert $ take 0 str == ""
  assert $ take 1 str == "a"
  assert $ take 2 str == "a\xDC00"
  assert $ take 3 str == "a\xDC00\xD800"
  assert $ take 4 str == "a\xDC00\xD800\xD800"
  assert $ take 5 str == "a\xDC00\xD800\xD800\x16805"
  assert $ take 6 str == "a\xDC00\xD800\xD800\x16805\x16A06"
  assert $ take 7 str == str
  assert $ take 8 str == str

  log "takeWhile"
  assert $ takeWhile (\c -> true) str == str
  assert $ takeWhile (\c -> false) str == ""
  assert $ takeWhile (\c -> codePointToInt c < 0xFFFF) str == "a\xDC00\xD800\xD800"
  assert $ takeWhile (\c -> codePointToInt c < 0xDC00) str == "a"

  log "uncons"
  let testUncons s res =
        assert $ case uncons s of
          Nothing ->
            isNothing res
          Just { head, tail } ->
            maybe false (\r ->
              r.head == codePointToInt head && r.tail == tail) res

  testUncons str $ Just {head: 0x61, tail:  "\xDC00\xD800\xD800\x16805\x16A06\&z"}
  testUncons (drop 1 str) $ Just {head: 0xDC00, tail: "\xD800\xD800\x16805\x16A06\&z"}
  testUncons (drop 2 str) $ Just {head: 0xD800, tail: "\xD800\x16805\x16A06\&z"}
  testUncons (drop 3 str) $ Just {head: 0xD800, tail: "\x16805\x16A06\&z"}
  testUncons (drop 4 str) $ Just {head: 0x16805, tail: "\x16A06\&z"}
  testUncons (drop 5 str) $ Just {head: 0x16A06, tail: "z"}
  testUncons (drop 6 str) $ Just {head: 0x7A, tail: ""}
  testUncons "" Nothing