├── .github ├── FUNDING.yml └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE ├── dist ├── Storybook.css └── index.html ├── example ├── spago.yaml └── src │ ├── Example │ └── Component │ │ ├── Child.purs │ │ └── Parent.purs │ └── Main.purs ├── packages.dhall ├── readme.md ├── spago.dhall ├── spago.example.dhall ├── spago.example.yaml ├── spago.yaml ├── src └── Halogen │ └── Portal.purs └── test └── Main.purs /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [thomashoneyman] 4 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | - uses: thomashoneyman/setup-purescript@main 16 | 17 | - name: Build the project 18 | run: spago build 19 | 20 | - name: Build the examples 21 | run: spago build --path 'example/**/*.purs' --config spago.example.dhall 22 | 23 | - name: Run tests 24 | run: spago test 25 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.lock 2 | 3 | bower_components 4 | node_modules 5 | output 6 | generated-docs 7 | 8 | .pulp-cache 9 | .psc-package 10 | .psc* 11 | .purs* 12 | .psa* 13 | .spago 14 | 15 | dist/* 16 | !dist/*.html 17 | !dist/*.css 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Thomas Honeyman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /dist/Storybook.css: -------------------------------------------------------------------------------- 1 | body { 2 | margin: 0; 3 | font-family: sans-serif; 4 | } 5 | 6 | .Storybook { 7 | height: 100vh; 8 | display: grid; 9 | grid-template-areas: 10 | "logo main" 11 | "nav main"; 12 | grid-template-columns: 20rem 1fr; 13 | grid-template-rows: 4rem 1fr; 14 | } 15 | 16 | .Storybook-logo { 17 | grid-area: logo; 18 | display: flex; 19 | align-items: center; 20 | padding-left: 2rem; 21 | text-decoration: none; 22 | background-color: #fafafa; 23 | color: #282828; 24 | border-right: 1px solid rgba(0, 0, 0, 0.08); 25 | border-bottom: 1px solid rgba(0, 0, 0, 0.08); 26 | } 27 | 28 | .Storybook-nav { 29 | grid-area: nav; 30 | overflow-y: auto; 31 | font-size: 0.875rem; 32 | background-color: #fafafa; 33 | border-right: 1px solid rgba(0, 0, 0, 0.08); 34 | } 35 | 36 | .Storybook-nav-list { 37 | list-style: none; 38 | margin: 0; 39 | padding: 0; 40 | } 41 | 42 | .Storybook-nav-section { 43 | margin: 1rem 0; 44 | } 45 | 46 | .Storybook-nav-section-title { 47 | color: #3a3a3a; 48 | text-transform: uppercase; 49 | font-weight: bold; 50 | padding: 0.625rem 2rem; 51 | } 52 | 53 | .Storybook-link { 54 | display: block; 55 | text-decoration: none; 56 | padding: 0.625rem 2rem; 57 | word-wrap: break-word; 58 | color: #282828; 59 | } 60 | 61 | .Storybook-link:hover, 62 | .Storybook-link.is-active { 63 | color: #008cff; 64 | } 65 | 66 | .Storybook-main { 67 | grid-area: main; 68 | padding: 2rem; 69 | overflow: auto; 70 | } 71 | -------------------------------------------------------------------------------- /dist/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Halogen Portal 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /example/spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | dependencies: 3 | - aff 4 | - avar 5 | - console 6 | - effect 7 | - foldable-traversable 8 | - free 9 | - halogen 10 | - halogen-store 11 | - halogen-storybook 12 | - halogen-subscriptions 13 | - maybe 14 | - prelude 15 | - tailrec 16 | - transformers 17 | - typelevel-prelude 18 | - web-html 19 | name: halogen-portal 20 | workspace: 21 | extra_packages: {} 22 | package_set: 23 | url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.14-20240113/packages.json 24 | -------------------------------------------------------------------------------- /example/src/Example/Component/Child.purs: -------------------------------------------------------------------------------- 1 | module Example.Component.Child where 2 | 3 | import Prelude 4 | import Data.Maybe (Maybe(..)) 5 | import Halogen as H 6 | import Halogen.HTML as HH 7 | import Halogen.HTML.Events as HE 8 | 9 | data Action 10 | = HandleClick 11 | 12 | data Query a 13 | = GetCount (Int -> a) 14 | 15 | data Output 16 | = Clicked 17 | 18 | type State 19 | = Int 20 | 21 | component :: forall m. H.Component Query Unit Output m 22 | component = 23 | H.mkComponent 24 | { initialState: const 0 25 | , render: 26 | \_ -> 27 | HH.div_ 28 | [ HH.button 29 | [ HE.onClick \_ -> HandleClick ] 30 | [ HH.text "I'm the child." ] 31 | , HH.text "I'm rendered within the parent in the component tree, but elsewhere in the DOM." 32 | ] 33 | , eval: 34 | H.mkEval 35 | $ H.defaultEval 36 | { handleAction = handleAction 37 | , handleQuery = handleQuery 38 | } 39 | } 40 | where 41 | handleAction = case _ of 42 | HandleClick -> do 43 | H.modify_ (_ + 1) 44 | H.raise Clicked 45 | 46 | handleQuery :: forall a. Query a -> H.HalogenM _ _ _ _ _ (Maybe a) 47 | handleQuery = case _ of 48 | GetCount reply -> do 49 | int <- H.get 50 | pure $ Just $ reply int 51 | -------------------------------------------------------------------------------- /example/src/Example/Component/Parent.purs: -------------------------------------------------------------------------------- 1 | module Example.Component.Parent where 2 | 3 | import Prelude 4 | import Data.Const (Const) 5 | import Data.Foldable (traverse_) 6 | import Data.Maybe (Maybe(..)) 7 | import Effect.Aff.Class (class MonadAff) 8 | import Effect.Class.Console as Console 9 | import Example.Component.Child as Child 10 | import Halogen as H 11 | import Halogen.HTML as HH 12 | import Halogen.Portal as Portal 13 | import Type.Proxy (Proxy(..)) 14 | 15 | data Action 16 | = HandleChild Child.Output 17 | 18 | type ChildSlots 19 | = ( child :: H.Slot Child.Query Child.Output Unit 20 | ) 21 | 22 | _child :: Proxy "child" 23 | _child = Proxy 24 | 25 | component :: forall m. MonadAff m => H.Component (Const Void) Unit Void m 26 | component = 27 | H.mkComponent 28 | { initialState: identity 29 | , render: 30 | \_ -> 31 | HH.div 32 | [] 33 | [ HH.text "I'm the parent" 34 | -- This is almost identical to using the `slot` function, but this component 35 | -- will _not_ be rendered within the parent component
in the DOM. 36 | , Portal.portalAff _child unit Child.component unit Nothing (HandleChild) 37 | ] 38 | , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } 39 | } 40 | where 41 | handleAction = case _ of 42 | HandleChild output -> case output of 43 | -- We can receive messages directly from the child, as usual 44 | Child.Clicked -> do 45 | Console.log "clicked" 46 | -- and we can also query the child directly, as usual 47 | traverse_ Console.logShow =<< H.request _child unit Child.GetCount 48 | -------------------------------------------------------------------------------- /example/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | import Data.Maybe (Maybe(..)) 5 | import Data.Tuple (Tuple(..)) 6 | import Effect (Effect) 7 | import Effect.Aff.Class (class MonadAff) 8 | import Example.Component.Parent as Parent 9 | import Foreign.Object as Object 10 | import Halogen.Aff as HA 11 | import Halogen.Storybook (Stories, proxy, runStorybook) 12 | 13 | stories :: forall m. MonadAff m => Stories m 14 | stories = 15 | Object.fromFoldable 16 | [ Tuple "basic" $ proxy Parent.component ] 17 | 18 | main :: Effect Unit 19 | main = 20 | HA.runHalogenAff do 21 | runStorybook { stories, logo: Nothing } =<< HA.awaitBody 22 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.14-20240113/packages.dhall 3 | sha256:5ff283a7f415485e231034ac754b09b206f22b790e4a4728367c1ea9c0f5ef5b 4 | 5 | in upstream 6 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Halogen Portal 2 | 3 | When you render an element or component in Halogen, it's inserted within the nearest parent node. Sometimes it's useful to insert a child into a different location in the DOM, especially for: 4 | 5 | - modals 6 | - dialogs 7 | - tooltips 8 | - loading bars 9 | - breaking elements out of parents with `overflow: hidden` or `z-index` set 10 | 11 | This component allows you to take any child component and mount it at a target node in the DOM instead of directly within its parent. All you need to do is use the `portal` function instead of the traditional `slot` function: 12 | 13 | ```purs 14 | -- old: 15 | HH.slot _modal unit Modal.component modalInput HandleModal 16 | 17 | -- new: this mounts to the `` node instead 18 | portalAff _modal unit Modal.component modalInput Nothing HandleModal 19 | ``` 20 | 21 | The component within the portal can be used exactly as if it were just a regular child component -- you can send queries, subscribe to outputs, and use the component types as before. 22 | 23 | ### Testing locally 24 | 25 | Build the example app: 26 | 27 | ```sh 28 | spago bundle-app --path 'example/**/*.purs' --to dist/app.js --config spago.example.dhall 29 | ``` 30 | 31 | Open `dist/index.html` in your browser to explore the examples. 32 | 33 | ### Limitations 34 | 35 | Due to the use of `runUI`, only components which can be easily interpreted into `Aff` can be used. This includes `Aff` and `ReaderT r Aff`, and that's about it. More specifically, you can provide a function `m (n ~> Aff)` that can pull in the monadic context of the parent to interpret the child component into `Aff`, but effects from the child component will not bubble up to the parent component at all. 36 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "halogen-portal" 2 | , dependencies = 3 | [ "aff" 4 | , "console" 5 | , "effect" 6 | , "foldable-traversable" 7 | , "free" 8 | , "halogen" 9 | , "halogen-store" 10 | , "maybe" 11 | , "prelude" 12 | , "transformers" 13 | , "typelevel-prelude" 14 | , "web-html" 15 | ] 16 | , packages = ./packages.dhall 17 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 18 | } 19 | -------------------------------------------------------------------------------- /spago.example.dhall: -------------------------------------------------------------------------------- 1 | { name = "halogen-portal" 2 | , dependencies = 3 | [ "aff" 4 | , "avar" 5 | , "console" 6 | , "effect" 7 | , "foldable-traversable" 8 | , "free" 9 | , "halogen" 10 | , "halogen-store" 11 | , "halogen-storybook" 12 | , "halogen-subscriptions" 13 | , "maybe" 14 | , "prelude" 15 | , "tailrec" 16 | , "transformers" 17 | , "typelevel-prelude" 18 | , "web-html" 19 | ] 20 | , packages = ./packages.dhall 21 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 22 | } 23 | -------------------------------------------------------------------------------- /spago.example.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | dependencies: 3 | - aff 4 | - avar 5 | - console 6 | - effect 7 | - foldable-traversable 8 | - free 9 | - halogen 10 | - halogen-store 11 | - halogen-storybook 12 | - halogen-subscriptions 13 | - maybe 14 | - prelude 15 | - tailrec 16 | - transformers 17 | - typelevel-prelude 18 | - web-html 19 | name: halogen-portal 20 | workspace: 21 | extra_packages: {} 22 | package_set: 23 | url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.7-20230207/packages.json 24 | -------------------------------------------------------------------------------- /spago.yaml: -------------------------------------------------------------------------------- 1 | package: 2 | dependencies: 3 | - aff 4 | - console 5 | - effect 6 | - foldable-traversable 7 | - free 8 | - halogen 9 | - halogen-store 10 | - maybe 11 | - prelude 12 | - transformers 13 | - typelevel-prelude 14 | - web-html 15 | name: halogen-portal 16 | workspace: 17 | extra_packages: {} 18 | package_set: 19 | url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.14-20240113/packages.json 20 | -------------------------------------------------------------------------------- /src/Halogen/Portal.purs: -------------------------------------------------------------------------------- 1 | -- | A container component which renders a sub-tree to a DOM node not in the 2 | -- | tree. This is useful for when a child component needs to 'break out' of a 3 | -- | parent, like dialogs, modals, and tooltips, especially if the parent has 4 | -- | z-indexing or overflow: hidden set. 5 | module Halogen.Portal where 6 | 7 | import Prelude 8 | 9 | import Control.Apply (lift2) 10 | import Control.Monad.Reader (ReaderT, asks, lift, runReaderT) 11 | import Data.Coyoneda (hoistCoyoneda, unCoyoneda) 12 | import Data.Foldable (for_) 13 | import Data.Maybe (Maybe(..), maybe, maybe') 14 | import Data.Symbol (class IsSymbol) 15 | import Effect.Aff (Aff) 16 | import Effect.Aff.Class (class MonadAff) 17 | import Halogen as H 18 | import Halogen.Aff (awaitBody) 19 | import Halogen.HTML as HH 20 | import Halogen.HTML.Properties as HP 21 | import Halogen.Store.Monad (StoreT(..)) 22 | import Halogen.VDom.Driver as VDom 23 | import Type.Prelude (Proxy(..)) 24 | import Type.Proxy (Proxy) 25 | import Type.Row as Row 26 | import Web.HTML (HTMLElement) 27 | 28 | type InputFields query input output n = 29 | ( input :: input 30 | , child :: H.Component query input output n 31 | , targetElement :: Maybe HTMLElement 32 | ) 33 | 34 | type Input query input output n = { | InputFields query input output n } 35 | 36 | type State query input output n = 37 | { io :: Maybe (H.HalogenIO (Query input query) output Aff) 38 | | InputFields query input output n 39 | } 40 | 41 | -- This wraps natural transformations into a type that is easier to use 42 | -- with type inference. 43 | -- 44 | -- A couple default handlers are provided below. If you have a custom monad, 45 | -- you can make your own, or compose it with an existing handler: 46 | -- 47 | -- ```purescript 48 | -- newtype AppM a = AppM (ReaderT Env Aff a) 49 | -- 50 | -- ntAppM :: AppM (NT AppM Aff) 51 | -- ntAppM = AppM (ntReaderT <#> ntCompose (NT \(AppM ma) -> ma)) 52 | -- ``` 53 | -- 54 | -- Another option is to use `H.hoist` to lift your component into `ReaderT`. 55 | newtype NT :: (Type -> Type) -> (Type -> Type) -> Type 56 | newtype NT m n = NT (forall a. m a -> n a) 57 | 58 | ntCompose :: forall h m n. NT h m -> NT m n -> NT h n 59 | ntCompose (NT hm) (NT mn) = NT (hm >>> mn) 60 | 61 | ntIdentity :: forall m. NT m m 62 | ntIdentity = NT identity 63 | 64 | ntAff :: forall m. MonadAff m => NT Aff m 65 | ntAff = NT H.liftAff 66 | 67 | ntReaderT :: forall r m n. Monad n => ReaderT r n (NT (ReaderT r m) m) 68 | ntReaderT = asks \r -> NT \ma -> runReaderT ma r 69 | 70 | class (Monad m) <= PortalM m where 71 | toPortalAff :: m (NT m Aff) 72 | 73 | instance PortalM Aff where 74 | toPortalAff = pure ntIdentity 75 | 76 | instance (PortalM m) => PortalM (ReaderT r m) where 77 | toPortalAff :: ReaderT r m (NT (ReaderT r m) Aff) 78 | toPortalAff = lift2 ntCompose unReader toAff 79 | where 80 | unReader :: ReaderT r m (NT (ReaderT r m) m) 81 | unReader = 82 | asks \r -> do 83 | NT \ma -> do 84 | runReaderT ma r 85 | 86 | toAff = lift toPortalAff 87 | 88 | instance (PortalM m) => PortalM (StoreT act r m) where 89 | toPortalAff :: _ (NT (StoreT act r m) Aff) 90 | toPortalAff = lift2 ntCompose unStore toAff 91 | where 92 | unStore :: _ (NT (StoreT act r m) m) 93 | unStore = StoreT $ 94 | asks \r -> do 95 | NT \(StoreT ma) -> do 96 | runReaderT ma r 97 | 98 | toAff = lift toPortalAff 99 | 100 | -- | `portal` but using the `PortalM` typeclass to allow for custom monads without a contextualize function. 101 | portalM 102 | :: forall query action input output slots label slot _1 m 103 | . Row.Cons label (H.Slot query output slot) _1 slots 104 | => IsSymbol label 105 | => Ord slot 106 | => MonadAff m 107 | => PortalM m 108 | => Proxy label 109 | -> slot 110 | -> H.Component query input output m 111 | -> input 112 | -> Maybe HTMLElement 113 | -> (output -> action) 114 | -> H.ComponentHTML action slots m 115 | portalM = portal toPortalAff 116 | 117 | -- | An alternative to `slot` which mounts the child component to a specific 118 | -- | HTMLElement in the DOM instead of within the parent component. Use this 119 | -- | in place of `slot` -- it shares the same arguments, with an additional, 120 | -- | optional `HTMLElement`. Your component will be mounted to the target element 121 | -- | if provided, or the `` tag otherwise. 122 | -- | 123 | -- | ```purs 124 | -- | -- if `Nothing` is provided as the target HTMLElement, then the `` 125 | -- | -- tag will be used 126 | -- | HH.div_ 127 | -- | [ portal ntIdentity _modal unit Modal.component modalInput (Just element) handler ] 128 | -- | 129 | -- | -- for comparison, this is how you would mount the component _not_ via 130 | -- | -- a portal 131 | -- | HH.div_ 132 | -- | [ HH.slot _modal unit Modal.component modalInput handler ] 133 | -- | ``` 134 | portal 135 | :: forall query action input output slots label slot _1 m n 136 | . Row.Cons label (H.Slot query output slot) _1 slots 137 | => IsSymbol label 138 | => Ord slot 139 | => MonadAff m 140 | => MonadAff n 141 | => m (NT n Aff) 142 | -> Proxy label 143 | -> slot 144 | -> H.Component query input output n 145 | -> input 146 | -> Maybe HTMLElement 147 | -> (output -> action) 148 | -> H.ComponentHTML action slots m 149 | portal contextualize label slot childComponent childInput htmlElement handler = 150 | handler 151 | # HH.slot label slot (component contextualize) 152 | { child: childComponent 153 | , input: childInput 154 | , targetElement: htmlElement 155 | } 156 | 157 | -- | Run a portal component that is already in `Aff`. 158 | portalAff 159 | :: forall m query action input output slots label slot _1 160 | . Row.Cons label (H.Slot query output slot) _1 slots 161 | => IsSymbol label 162 | => Ord slot 163 | => MonadAff m 164 | => Proxy label 165 | -> slot 166 | -> H.Component query input output Aff 167 | -> input 168 | -> Maybe HTMLElement 169 | -> (output -> action) 170 | -> H.ComponentHTML action slots m 171 | portalAff = portal (pure ntIdentity) 172 | 173 | -- | Run a portal component that is in `ReaderT r Aff` (for some context `r`). 174 | portalReaderT 175 | :: forall m r query action input output slots label slot _1 176 | . Row.Cons label (H.Slot query output slot) _1 slots 177 | => IsSymbol label 178 | => Ord slot 179 | => MonadAff m 180 | => Proxy label 181 | -> slot 182 | -> H.Component query input output (ReaderT r Aff) 183 | -> input 184 | -> Maybe HTMLElement 185 | -> (output -> action) 186 | -> H.ComponentHTML action slots (ReaderT r m) 187 | portalReaderT = portal ntReaderT 188 | 189 | data Query input query a = SetInput input a | ChildQuery (query a) 190 | 191 | _content :: Proxy "content" 192 | _content = Proxy @"content" 193 | 194 | -- wraps the portalled component and provides a SetInput query 195 | -- that can be used by the Portal component to update the child's 196 | -- input when it receives new values from the parent 197 | wrapper 198 | :: forall query input output m 199 | . MonadAff m 200 | => H.Component (Query input query) (State query input output m) output m 201 | wrapper = H.mkComponent 202 | { initialState: identity 203 | , render 204 | , eval: H.mkEval $ H.defaultEval 205 | { handleQuery = handleQuery 206 | , handleAction = H.raise 207 | } 208 | } 209 | 210 | where 211 | 212 | render { input, child } = HH.div 213 | [ HP.style "display: contents" ] 214 | [ HH.slot _content unit child input identity ] 215 | 216 | handleQuery :: forall action a. Query input query a -> H.HalogenM _ action _ output m (Maybe a) 217 | handleQuery = case _ of 218 | SetInput input a -> do 219 | H.modify_ _ { input = input } 220 | pure $ Just a 221 | ChildQuery query -> do 222 | res <- H.query _content unit query 223 | pure res 224 | 225 | component 226 | :: forall query input output m n 227 | . MonadAff m 228 | => MonadAff n 229 | => m (NT n Aff) 230 | -> H.Component query (Input query input output n) output m 231 | component contextualize = 232 | H.mkComponent 233 | { initialState 234 | , render 235 | , eval 236 | } 237 | where 238 | initialState :: Input query input output n -> State query input output n 239 | initialState { input, child, targetElement } = 240 | { input 241 | , child 242 | , targetElement 243 | , io: Nothing 244 | } 245 | 246 | eval 247 | :: H.HalogenQ query output (Input query input output n) 248 | ~> H.HalogenM (State query input output n) output () output m 249 | eval = case _ of 250 | H.Initialize a -> do 251 | NT context <- H.lift contextualize 252 | state <- H.get 253 | -- The target element can either be the one supplied by the user, or the 254 | -- document body. Either way, we'll run the sub-tree at the target and 255 | -- save the resulting interface. 256 | target <- maybe (H.liftAff awaitBody) pure state.targetElement 257 | io <- H.liftAff $ VDom.runUI (H.hoist context wrapper) state target 258 | -- Subscribe to the child component's messages 259 | _ <- H.subscribe io.messages 260 | H.modify_ _ { io = Just io } 261 | pure a 262 | H.Finalize a -> do 263 | state <- H.get 264 | for_ state.io (H.liftAff <<< _.dispose) 265 | pure a 266 | H.Receive { input } a -> H.gets _.io 267 | >>= case _ of 268 | Nothing -> pure a 269 | Just io -> do 270 | void $ H.liftAff $ (ioq io) (SetInput input a) 271 | pure a 272 | H.Action output a -> do 273 | H.raise output 274 | pure a 275 | H.Query query fail -> 276 | H.gets _.io 277 | >>= case _ of 278 | Nothing -> pure $ fail unit 279 | Just io -> H.liftAff $ unCoyoneda (\k q -> maybe' fail k <$> ioq io q) (hoistCoyoneda ChildQuery query) 280 | 281 | -- We don't need to render anything; this component is explicitly meant to be 282 | -- passed through. 283 | render :: State query input output n -> H.ComponentHTML output () m 284 | render _ = HH.text "" 285 | 286 | -- This is needed for a hint to the typechecker. Without it there's an 287 | -- impredicativity issue with `a` when `HalogenIO` is taken from `State`. 288 | ioq :: forall a. H.HalogenIO (Query input query) output Aff -> (Query input query) a -> Aff (Maybe a) 289 | ioq = _.query 290 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Effect.Console (log) 6 | 7 | main :: Effect Unit 8 | main = do 9 | log "You should add some tests." 10 | --------------------------------------------------------------------------------