/
Widget.purs
82 lines (66 loc) · 2.96 KB
/
Widget.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
module Specular.Dom.Widget (
Widget
, RWidget
, runWidgetInNode
, runWidgetInBody
, runMainWidgetInNode
, runMainWidgetInBody
, spawnWidgetInNode
, spawnWidgetInBody
, class MonadWidget
, liftWidget
, emptyWidget
) where
import Prelude
import Data.Tuple (Tuple(..), fst)
import Effect (Effect)
import Effect.Class (liftEffect, class MonadEffect)
import Effect.Uncurried (mkEffectFn1, runEffectFn1)
import Specular.Dom.Browser (Node)
import Specular.Dom.Builder (Builder, runBuilder, unBuilder)
import Specular.Dom.Builder.Class (class MonadDomBuilder, liftBuilder)
import Specular.FRP (class MonadFRP)
import Specular.Internal.RIO (RIO(..))
import Control.Monad.Replace (class MonadReplace, newSlot, replaceSlot, destroySlot)
import Control.Monad.Cleanup (class MonadCleanup, onCleanup)
type Widget = RWidget Unit
type RWidget = Builder
-- | Runs a widget in the specified parent element. Returns the result and cleanup action.
runWidgetInNode :: forall a. Node -> Widget a -> Effect (Tuple a (Effect Unit))
runWidgetInNode parent widget = runBuilder parent do
slot <- newSlot
onCleanup (destroySlot slot)
liftEffect $ replaceSlot slot widget
-- | Runs a widget `document.body`. Returns the result and cleanup action.
runWidgetInBody :: forall a. Widget a -> Effect (Tuple a (Effect Unit))
runWidgetInBody widget = do
body <- documentBody
runWidgetInNode body widget
-- | Runs a widget in the specified parent element and discards cleanup action.
runMainWidgetInNode :: forall a. Node -> Widget a -> Effect a
runMainWidgetInNode parent widget = fst <$> runWidgetInNode parent widget
-- | Runs a widget in `document.body` and discards cleanup action.
runMainWidgetInBody :: forall a. Widget a -> Effect a
runMainWidgetInBody widget = do
body <- documentBody
runMainWidgetInNode body widget
-- | Runs a widget in the specified parent element. The widget is destroyed and removed from DOM on cleanup.
spawnWidgetInNode :: forall m a. MonadEffect m => MonadCleanup m => Node -> Widget a -> m a
spawnWidgetInNode node widget = do
Tuple result cleanup <- liftEffect $ runWidgetInNode node widget
onCleanup cleanup
pure result
-- | Runs a widget in `document.body`. The widget is destroyed and removed from DOM on cleanup.
spawnWidgetInBody :: forall m a. MonadEffect m => MonadCleanup m => Widget a -> m a
spawnWidgetInBody widget = do
body <- liftEffect documentBody
spawnWidgetInNode body widget
foreign import documentBody :: Effect Node
-- A handy alias for all the constraints you'll need
class (MonadDomBuilder m, MonadFRP m, MonadReplace m, Monoid (m Unit)) <= MonadWidget m
instance monadWidget :: (MonadDomBuilder m, MonadFRP m, MonadReplace m, Monoid (m Unit)) => MonadWidget m
-- | Lift a `Widget` into any `MonadWidget` monad.
liftWidget :: forall m a. MonadDomBuilder m => Widget a -> m a
liftWidget w = let RIO f = unBuilder w in liftBuilder (mkEffectFn1 \env -> runEffectFn1 f (env { userEnv = unit }))
emptyWidget :: Widget Unit
emptyWidget = pure unit