diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 8b79337..a4bf203 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -8,15 +8,15 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: actions/setup-node@v2 + - uses: actions/setup-node@v4 with: - node-version: '15' + node-version: '22' cache: 'npm' - uses: purescript-contrib/setup-purescript@main - name: Cache PureScript dependencies - uses: actions/cache@v2 + uses: actions/cache@v4 # This cache uses the .dhall files to know when it should reinstall # and rebuild packages. It caches both the installed packages from # the `.spago` directory and compilation artifacts from the `output` diff --git a/benchmarks/js-framework-benchmark/keyed/src/Main.purs b/benchmarks/js-framework-benchmark/keyed/src/Main.purs index dafdaf4..3d677a2 100644 --- a/benchmarks/js-framework-benchmark/keyed/src/Main.purs +++ b/benchmarks/js-framework-benchmark/keyed/src/Main.purs @@ -5,17 +5,18 @@ import Prelude import Data.Array ((!!)) import Data.Array as DA import Data.Maybe (Maybe(..)) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame (Html, ListUpdate, QuerySelector(..), (:>)) +import Flame (Html, Update) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE - -import Flame.Types(NodeData) +import Flame.Types (NodeData) +import Web.DOM.ParentNode (QuerySelector(..)) data Message = Create Int | @@ -52,7 +53,7 @@ createRandomNRows n lastID = liftEffect (EU.runEffectFn2 createRandomNRows_ n la main :: Effect Unit main = F.mount_ (QuerySelector "body") { - init: model :> [], + model: model, subscribe: [], view, update @@ -133,15 +134,15 @@ spacer = HE.td' [ HA.class' "col-md-6" ] footer :: Html Message footer = HE.span' [ HA.class' "preloadicon glyphicon glyphicon-remove", HA.createAttribute "aria-hidden" "true" ] -update :: ListUpdate Model Message +update :: Update Model Message update model = case _ of - Create amount -> model :> [map (\rows -> Just (DisplayCreated rows)) (createRandomNRows amount model.lastID)] + Create amount -> model /\ [map (\rows -> Just (DisplayCreated rows)) (createRandomNRows amount model.lastID)] DisplayCreated rows -> F.noMessages (model { lastID = model.lastID + DA.length rows, rows = rows }) AppendOneThousand -> let amount = 1000 - in model :> [map (\rows -> Just (DisplayAppended rows)) (createRandomNRows amount model.lastID)] + in model /\ [map (\rows -> Just (DisplayAppended rows)) (createRandomNRows amount model.lastID)] DisplayAppended newRows -> F.noMessages (model { lastID = model.lastID + DA.length newRows, rows = model.rows <> newRows }) UpdateEveryTenth -> F.noMessages model { rows = DA.mapWithIndex updateLabel model.rows } diff --git a/benchmarks/js-framework-benchmark/non-keyed/src/Main.purs b/benchmarks/js-framework-benchmark/non-keyed/src/Main.purs index ac86b14..7d39ec7 100644 --- a/benchmarks/js-framework-benchmark/non-keyed/src/Main.purs +++ b/benchmarks/js-framework-benchmark/non-keyed/src/Main.purs @@ -1,7 +1,5 @@ module Main where -import Prelude (Unit, bind, map, mod, pure, show, (+), (/=), (<>), (==), otherwise) - import Data.Array ((!!)) import Data.Array as DA import Data.Maybe (Maybe(..)) @@ -10,12 +8,13 @@ import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame.Application.EffectList (ListUpdate) -import Flame.Types((:>), Html, NodeData) -import Web.DOM.ParentNode(QuerySelector(..)) +import Flame as F import Flame.Application.EffectList as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Flame.Types ((/\), Html, NodeData) +import Prelude (Unit, bind, map, mod, pure, show, (+), (/=), (<>), (==), otherwise) +import Web.DOM.ParentNode (QuerySelector(..)) data Message = Create Int | @@ -52,7 +51,7 @@ createRandomNRows n lastID = liftEffect (EU.runEffectFn2 createRandomNRows_ n la main :: Effect Unit main = F.mount_ (QuerySelector "main") { - init: model :> [], + model: model, view, subscribe: [], update @@ -133,15 +132,15 @@ spacer = HE.td' [ HA.class' "col-md-6" ] footer :: Html Message footer = HE.span' [ HA.class' "preloadicon glyphicon glyphicon-remove", HA.createAttribute "aria-hidden" "true" ] -update :: ListUpdate Model Message +update :: Update Model Message update model = case _ of - Create amount -> model :> [map (\rows -> Just (DisplayCreated rows)) (createRandomNRows amount model.lastID)] + Create amount -> model /\ [map (\rows -> Just (DisplayCreated rows)) (createRandomNRows amount model.lastID)] DisplayCreated rows -> F.noMessages (model { lastID = model.lastID + DA.length rows, rows = rows }) AppendOneThousand -> let amount = 1000 - in model :> [map (\rows -> Just (DisplayAppended rows)) (createRandomNRows amount model.lastID)] + in model /\ [map (\rows -> Just (DisplayAppended rows)) (createRandomNRows amount model.lastID)] DisplayAppended newRows -> F.noMessages (model { lastID = model.lastID + DA.length newRows, rows = model.rows <> newRows}) UpdateEveryTenth -> F.noMessages model { rows = DA.mapWithIndex updateLabel model.rows } diff --git a/docs/concepts.md b/docs/concepts.md index 6f73825..e2d1473 100644 --- a/docs/concepts.md +++ b/docs/concepts.md @@ -10,9 +10,9 @@ A Flame application consists of the following record ```haskell type Application model message = { - init :: model, + model :: model, view :: model -> Html message, - update :: model -> message -> model, + update :: Update model message, subscribe :: Array (Subscription message) } ``` @@ -31,11 +31,11 @@ that is, the state of our application is a single integer. In a real world appli With our model type declared, we can define the initial state of the application ```haskell -init :: Model -init = 0 +model :: Model +model = 0 ``` -The first time the application is rendered, Flame calls the view function with `init`. +The first time the application is rendered, Flame calls the view function with `model`. ### Application markup @@ -67,13 +67,13 @@ data Message = Increment | Decrement and thus our update function looks like ```haskell -update :: Model -> Message -> Model +update :: Update Model Message update model = case _ of - Increment -> model + 1 - Decrement -> model - 1 + Increment -> model + 1 /\ [] + Decrement -> model - 1 /\ [] ``` -See [Handling events](events) for an in depth look at update strategies. +See [Handling events](events) for an in depth look at updates. ### Subscriptions @@ -84,10 +84,9 @@ In the counter example no external events are handled, so the subscription list ```haskell subscribe :: Array (Subscription Message) subscribe = [] -} ``` -See [Handling external events](events#handling-external-events) for an in depth look at subscriptions. +See [Subscriptions](events#subscriptions) for an in depth look at subscriptions. ### Rendering @@ -95,8 +94,8 @@ Having all pieces put together, we can either render the application to the DOM, ```haskell main :: Effect Unit -main = FAN.mount_ (QuerySelector "body") { - init, +main = F.mount_ (QuerySelector "body") { + model, view, update, subscribe diff --git a/docs/events.md b/docs/events.md index 1fc5928..874cc8d 100644 --- a/docs/events.md +++ b/docs/events.md @@ -10,54 +10,27 @@ Perhaps the most important field in the application record ```haskell type Application model message = { - init :: model, + model :: model view :: model -> Html message, - update :: model -> message -> model, + update :: Update model message, subscribe :: Array (Subscription message) } ``` -is the `update` function. This is where we define our business logic by matching event `message`s and returning an updated model. For simplicity, we have only considered side effects free updating so far, however Flame offers three different ways to define your `update` function. - -Each module under `Flame.Application` export a `mount` (or `mount_`) function which asks for an application record with different `init` and `update` types - -```haskell -import Flame.Application.NoEffects (mount) -- side effects free updating -import Flame (mount) -- Elm style updating, using a list of effects -import Flame.Application.Effectful (mount) -- Aff based updating -``` - -Let's discuss each of them in detail. - -### No effects updating - -The application record is the same as we have seen so far +is the `update` function. So far we have been using the `Update` type alias. Let's expand it: ```haskell type Application model message = { - init :: model, - view :: model -> Html message, - update :: model -> message -> model, - subscribe :: Array (Subscription message) -} -``` - -This is enough for toy examples or small modules, but probably not sufficient to build an user facing application. If we want to do any sort of effectul computation we need to look into the next `update` types. - -### Effect list updating - -This is the default way to run a Flame application. The record here has `init` and `update` return an array of effects to be performed - -```haskell -type Application model message = { - init :: Tuple model (Array (Aff (Maybe message))), + model :: model, view :: model -> Html message, update :: model -> message -> Tuple model (Array (Aff (Maybe message))), subscribe :: Array (Subscription message) } ``` -For every entry in the array, the effect is run and `update` is called again with the resulting `message`. Consider an application to roll dices +That means that `update` returns an updated model but also an array of side effects to perform. Each entry in the array may optionally raise another `message`, which is in turn handled by `update` as well. + +Consider an application to roll dices ```haskell type Model = Maybe Int @@ -66,10 +39,11 @@ data Message = Roll | Update Int update :: Model -> Message -> Tuple Model (Array (Aff (Maybe Message))) update model = case _ of - Roll -> model :> [ - Just <<< Update <$> liftEffect (ER.randomInt 1 6) - ] - Update int -> Just int :> [] + Roll -> model /\ [ rollDice ] + Update int -> Just int /\ [] + where rollDice = do + n <- EC.liftEffect $ ER.randomInt 1 6 + pure <<< Just $ Update n view :: Model -> Html Message view model = HE.main "main" [ @@ -78,9 +52,9 @@ view model = HE.main "main" [ ] ``` -Whenever `update` receives the `Roll` message, a `Tuple` (using the infix operator `:>`) of the model and effect list is returned. Performing the effect in the list raises the `Update` message, which carries the generated random number that will be the new model. +`Roll` returns the model as it is. However, generating random numbers is a side effect so we return it on our array. Flame will run this effect and raise `Update`, which then updates the model with the die number. -Likewise, we could define a loading screen to appear before AJAX requests +Likewise, we could perform some network requests with a loading screen ```haskell type Model = { @@ -89,13 +63,13 @@ type Model = { } data Message = - Loading | + Perform | Response String | DifferentResponse String | Finish String -performAJAX :: String -> Aff String -performAJAX url = ... +fetch :: String -> Aff String +fetch url = ... useResponse :: Model -> String -> Aff Model useResponse = ... @@ -103,143 +77,32 @@ useResponse = ... useDifferentResponse :: Model -> String -> Aff Model useDifferentResponse = ... -update :: ListUpdate Model Message -- type synonym to reduce clutter +update :: Model -> Message -> Tuple Model (Array (Aff (Maybe Message))) update model = case _ of - Loading -> model { isLoading = true } :> [ - Just <<< Response <$> performAJAX "url", - Just <<< DifferentResponse <$> performAJAX "url2", - Just <<< Response <$> performAJAX "url3", - Just <<< DifferentResponse <$> performAJAX "url4", - pure <<< Just $ Finish "Performed all" - ] - Response contents -> F.noMessages $ useResponse model contents -- noMessages is the same as _ :> [] - Finish contents -> F.noMessages $ model { isLoading = false, response = model.response <> contents } + Perform -> model { isLoading = true } /\ requests + Response contents -> F.noMessages $ useResponse model contents -- noMessages is the same as _ /\ [] + Finish contents -> F.noMessages model { isLoading = false, response = model.response <> contents } + where requests = [ + Just <<< Response <$> fetch "url", + Just <<< DifferentResponse <$> fetch "url2", + Just <<< Response <$> fetch "url3", + Just <<< DifferentResponse <$> fetch "url4", + pure <<< Just $ Finish "Performed all" + ] view :: Model -> Html Message view model = HE.main "main" [ - HE.button [HA.disabled model.isLoading, HA.onClick Loading] "Perform requests", + HE.button [HA.disabled model.isLoading, HA.onClick Perform] "Perform requests", if model.isLoading then - HE.div [HA.className "overlay"] "Loading..." + HE.div [HA.class' "overlay"] "Loading..." else ... ] ``` -In the same way, here every call to `performAJAX` also causes `update` to be called again with a new `Response` or `DifferentResponse` until we get a `Finish` message. - -Notice that the type of `init` is also defined as `Tuple model (Array (Aff (Maybe message)))`. This enables us to run effects at the startup of the application. Suppose in the previous example we also wanted to perform some AJAX requests before any other user interaction. We could have defined `init` as follows - -```haskell -init :: Tuple Model (Array (Aff (Maybe Message))) -init = model :> [ - Just <<< Response <$> performAJAX "url", - Just <<< DifferentResponse <$> performAJAX "url2", - Just <<< Response <$> performAJAX "url3", - Just <<< DifferentResponse <$> performAJAX "url4", - pure <<< Just $ Finish "Performed all" -] -``` - -which has the same expected behavior of calling `update` with the resulting message of every entry in the array. - -### Effectful updating - -Returning an array of effects is great for testability and isolating input/output, but certain program flows became somewhat awkward to write. For most messages, we essentially have to create a different data constructor for each step in the computation. For that reason, Flame provides an alternative way to perform effects in the `update` function. - -The effectful updating defines `Application` as - -```haskell -type Application model message = { - init :: Tuple model (Maybe message), - view :: model -> Html message, - update :: Environment model message -> Aff (model -> model), - subscribe :: Array (Subscription message) -} -``` - -Here instead of returning a list of effects, we perform them directly in the `Aff` monad. Because the `update` function is now fully asynchronous, its type is a little different. Instead of the model, we return a function to modify it -- this ensures slower computations don't overwrite unrelated updates that might happen in the meanwhile. `Environment` is defined as follows - -```haskell -type Environment model message = { - model :: model, - message :: message, - display :: (model -> model) -> Aff Unit -} -``` - -`model` and `message` are now grouped in a record. `display` is a function to arbitrarily re-render the view. - -Let's rewrite the dice application using the effectful updates - -```haskell -type Model = Maybe Int - -data Message = Roll - -update :: Environment Model Message -> Aff (Model -> Model) -update _ = map (const <<< Just) $ liftEffect $ ER.randomInt 1 6 -``` - -Since we are always generating a new model, and don't need an intermediate message to update it, we can ignore the environment and perform the update in a single go. - -Let's see how we can use `display` to rewrite the AJAX example from above as well - -```haskell -type Model = { - response :: String, - isLoading :: boolean -} - -data Message = Loading - -update :: AffUpdate Model Message -- type synonym to reduce clutter -update { display } = do - display _ { isLoading = true } - traverse (\rs -> display _ { response = rs }) [ - performAJAX "url", - performAJAX "url2", - performAJAX "url3", - performAJAX "url4", - ] - pure $ _ { isLoading = false } - -init :: Tuple Model (Maybe Message) -init = model :> Just Loading -``` - -`display` renders the view with the modified model without leaving the `update` function, which is again a little more straightforward. - -But juggling model update functions can quickly turn messy, specially if we are using records. For that reason, helper functions are provided to modify only given fields - -```haskell -diff' :: forall changed model. Diff changed model => changed -> (model -> model) -diff :: forall changed model. Diff changed model => changed -> Aff (model -> model) -``` - -the `Diff` type class guarantees that `changed` only includes fields present in `model` so instead of `pure _ { field = value }` we can write `diff { field: value }`. Let's see an example: - -```haskell -newtype MyModel = MyModel { - url :: String, - result :: Result, - ... -} -derive instance myModelNewtype :: Newtype MyModel _ - -update :: AffUpdate MyModel Message -update { display, model: MyModel model, message } = - case message of - UpdateUrl url -> FAE.diff { url, result: NotFetched } - Fetch -> do - display $ FAE.diff' { result: Fetching } - response <- A.get AR.string model.url - FAE.diff <<< { result: _ } $ case response.body of - Left error -> Error $ A.printResponseFormatError error - Right ok -> Ok ok - ... -> ... -``` +Here for `Perform`, we return an array of network calls and a final `Finish` message. The effects are run in order, and once we have a response their events are raised for `update` as well. -Here, no matter how many fields `MyModel` has, we update only what's required in each case expression. Notice that `diff` always takes a record as first parameter. The model, however, can be either a record or newtype (given a `Newtype` instance)/plain functor that holds a record to be updated. +You may be wondering: why separate model updating and side effects? The reason is that in this way we are "forced" to keep most of our business logic in pure functions, which are easier to reason and test. Effects become interchangeable, decoupled from what we do with their results. ## [Subscriptions](#subscriptions) @@ -250,7 +113,7 @@ More often than not, a real world application needs to handle events that don't When mounting the application, `subscribe` can be used to specify `message`s as a list of subscriptions. The modules under `Flame.Subscription` define `on` event handlers similar to those used in views ```haskell -FAN.mount_ (QuerySelector "body") { +F.mount_ (QuerySelector "body") { ... subscribe: [ FSW.onLoad Message, -- `window` event from `Flame.Subscription.Window` @@ -272,7 +135,7 @@ Once a subscription has been defined, the raised `message` will be handled by th * Arbitrary message passing -Sometimes, we need to talk to an application from external events handlers or other points in code far away from the mount point. Consider an app that uses web sockets, or a singe page application that uses multiple mount points for lazy loading. For these and other use cases, Flame provides a `mount` function that takes an application id, as well a `send` function to raise messages for application ids +Sometimes, we need to talk to an application from external events handlers or other points in the code away from the mount point. Consider an app that uses web sockets, or a singe page application that uses multiple mount points for lazy loading, or just some initialization events. For these and other use cases, Flame provides a `mount` (no trailing underscore) function that takes an application id, as well a `send` function to raise messages for application ids ```haskell mount :: forall id model message. Show id => QuerySelector -> AppId id message -> Application model message -> Effect Unit @@ -336,7 +199,7 @@ Flame also provides a way to "broadcast" `CustomEvent`s for all listeners. `Flam broadcast :: forall arg. SerializeState arg => EventType -> arg -> Effect Unit ``` -whose events can be handled with `onCustomEven` on your `subscribe` list. Broadcasting events is considered unsafe, as it is user code responsibility to make sure all listeners expect the same `message` payload. +whose events can be handled with `onCustomEvent` on your `subscribe` list. Broadcasting events is considered unsafe as it is user code responsibility to make sure all listeners expect the same `message` payload. See the [API reference](https://pursuit.purescript.org/packages/purescript-flame) for a complete list of built-in external events. See this [test application](https://github.com/easafe/purescript-flame/tree/master/examples/Subscriptions) for a full example of subscriptions. diff --git a/docs/index.md b/docs/index.md index 98444cc..14d4a72 100644 --- a/docs/index.md +++ b/docs/index.md @@ -33,9 +33,9 @@ module Counter.Main where import Prelude import Effect (Effect) -import Flame (Html, QuerySelector(..), Subscription) --- Side effects free updating; see docs for other examples -import Flame.Application.NoEffects as FAN +import Web.DOM.ParentNode (QuerySelector(..)) +import Flame (Html, Update, Subscription) +import Flame as F import Flame.Html.Element as HE import Flame.Html.Attribute as HA @@ -46,14 +46,14 @@ type Model = Int data Message = Increment | Decrement -- | Initial state of the app -init :: Model -init = 0 +model :: Model +model = 0 -- | `update` is called to handle events -update :: Model -> Message -> Model +update :: Update Model Message update model = case _ of - Increment -> model + 1 - Decrement -> model - 1 + Increment -> model + 1 /\ [] + Decrement -> model - 1 /\ [] -- | `view` is called whenever the model is updated view :: Model -> Html Message @@ -69,8 +69,8 @@ subscribe = [] -- | Mount the application on the given selector main :: Effect Unit -main = FAN.mount_ (QuerySelector "body") { - init, +main = F.mount_ (QuerySelector "body") { + model, view, update, subscribe diff --git a/docs/rendering.md b/docs/rendering.md index 0acec49..1c5950a 100644 --- a/docs/rendering.md +++ b/docs/rendering.md @@ -10,9 +10,9 @@ With all pieces in place ```haskell type Application model message = { - init :: model, + model :: model view :: model -> Html message, - update :: model -> message -> model, + update :: Update model message, subscribe :: Array (Subscription message) } ``` @@ -29,7 +29,7 @@ mount_ :: forall model message. QuerySelector -> Application model message -> Ef mount :: forall id model message. Show id => QuerySelector -> AppId id message -> Application model message -> Effect Unit ``` -The first parameter is a CSS selector used as mount point. The application markup is added as children nodes to the mount point, otherwise it is left untouched. Several applications can live in the same `document` provided they are mounted on different selectors. +The first parameter is a CSS selector used as mount point. The application markup is added as children nodes to the mount point. Several applications can live in the same `document` provided they are mounted on different selectors. ### Server side rendering @@ -51,7 +51,7 @@ The module `Flame` provides ```haskell type PreApplication model message = { - init :: model, + model :: model view :: model -> Html message } @@ -62,18 +62,17 @@ which can used to render server-side the initial state of an application. On cli ```haskell type ResumedApplication model message = { - init :: Array (Aff (Maybe message)), -- only the (optional) initial message to be raised view :: model -> Html message, update :: model -> message -> Tuple model (Array (Aff (Maybe message))), -- update is only available client side subscribe :: Array (Subscription message) -- subscriptions are only available client side } -resumeMount_ :: forall model message. UnserializeState model => QuerySelector -> ResumedApplication model message -> Effect Unit +resumeMount_ :: forall model message. UnserializeState model => QuerySelector -> ResumedApplication model message -> Effect model --or -resumeMount :: forall id model message. UnserializeState model => Show id => QuerySelector -> AppId id message -> ResumedApplication model message -> Effect Unit +resumeMount :: forall id model message. UnserializeState model => Show id => QuerySelector -> AppId id message -> ResumedApplication model message -> Effect model ``` -to install event handlers in the pre rendered markup. The `SerializeState`/`UnserializeState` type class automatically parses the initial state as JSON in case of records or `Generic` instances. The `QuerySelector` passed to `preMount` and `resumeMount` must match -- otherwise the application will crash with an exception. To avoid diffing issues, the same `view` function should be used on the server and client side as well. +to install event handlers in the pre rendered markup. The `SerializeState`/`UnserializeState` type class automatically parses the initial state as JSON in case of records or `Generic` instances. The `QuerySelector` passed to `preMount` and `resumeMount` must match -- otherwise the application will crash with an exception. To avoid diffing issues, the same `view` function should be used on the server and client side as well. To make initialization logic easier, `resumeMount` returns the initial parsed model. See the [Dice application](https://github.com/easafe/purescript-flame/tree/master/examples/ServerSideRendering) for an example of how to pre render an application on server-side. diff --git a/docs/views.md b/docs/views.md index 20329b6..2976753 100644 --- a/docs/views.md +++ b/docs/views.md @@ -10,9 +10,9 @@ In the application record ```haskell type Application model message = { - init :: model, + model :: model view :: model -> Html message, - update :: model -> message -> model, + update :: Update model message, subscribe :: Array (Subscription message) } ``` diff --git a/examples/Affjax/Affjax.purs b/examples/Affjax/Affjax.purs index 740036a..d8fe83f 100755 --- a/examples/Affjax/Affjax.purs +++ b/examples/Affjax/Affjax.purs @@ -2,15 +2,17 @@ module Examples.EffectList.Affjax.Main where import Prelude -import Affjax.Web as A import Affjax.ResponseFormat as AR +import Affjax.Web as A import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) +import Data.Tuple.Nested ((/\)) import Effect (Effect) -import Flame (QuerySelector(..), Html, (:>), ListUpdate) +import Flame (Html, Update) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) type Model = { url ∷ String @@ -29,11 +31,11 @@ init = , result: NotFetched } -update ∷ ListUpdate Model Message +update ∷ Update Model Message update model = case _ of UpdateUrl url → F.noMessages $ model { url = url, result = NotFetched } - Fetch → model { result = Fetching } :> + Fetch → model { result = Fetching } /\ [ do response ← A.get AR.string model.url pure <<< Just <<< Fetched $ case response of @@ -59,7 +61,7 @@ view { url, result } = HE.main "main" main ∷ Effect Unit main = F.mount_ (QuerySelector "body") - { init: F.noMessages init + { model: init , subscribe: [] , update , view diff --git a/examples/Counter/Counter.purs b/examples/Counter/Counter.purs index 9e25e78..a330a45 100755 --- a/examples/Counter/Counter.purs +++ b/examples/Counter/Counter.purs @@ -4,10 +4,11 @@ module Examples.NoEffects.Counter.Main where import Prelude import Effect (Effect) -import Flame (QuerySelector(..), Html) -import Flame.Application.NoEffects as FAN -import Flame.Html.Element as HE +import Flame (Html, Update) +import Flame as F import Flame.Html.Attribute as HA +import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) -- | The model represents the state of the app type Model = Int @@ -20,8 +21,8 @@ init ∷ Model init = 0 -- | `update` is called to handle events -update ∷ Model → Message → Model -update model = case _ of +update ∷ Update Model Message +update model = F.noMessages <<< case _ of Increment → model + 1 Decrement → model - 1 @@ -35,8 +36,8 @@ view model = HE.main "main" -- | Mount the application on the given selector main ∷ Effect Unit -main = FAN.mount_ (QuerySelector "body") - { init +main = F.mount_ (QuerySelector "body") + { model: init , subscribe: [] , update , view diff --git a/examples/Counters/Counters.purs b/examples/Counters/Counters.purs index 76b2624..8bc3858 100755 --- a/examples/Counters/Counters.purs +++ b/examples/Counters/Counters.purs @@ -6,12 +6,14 @@ import Data.Array ((!!)) import Data.Array as DA import Data.Maybe (Maybe(..)) import Data.Maybe as DM +import Data.Tuple as DT import Effect (Effect) import Examples.NoEffects.Counter.Main as ECM -import Flame (QuerySelector(..), Html) -import Flame.Application.NoEffects as FAN +import Flame (Html, Update) +import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) type Model = Array ECM.Model @@ -20,14 +22,14 @@ data Message = Add | Remove Int | CounterMessage Int ECM.Message init ∷ Model init = [] -update ∷ Model → Message → Model -update model = case _ of +update ∷ Update Model Message +update model = F.noMessages <<< case _ of Add → DA.snoc model ECM.init Remove index → DM.fromMaybe model $ DA.deleteAt index model CounterMessage index message → case model !! index of Nothing → model - Just model' → DM.fromMaybe model $ DA.updateAt index (ECM.update model' message) model + Just model' → DM.fromMaybe model $ DA.updateAt index (DT.fst $ ECM.update model' message) model view ∷ Model → Html Message view model = HE.main "main" @@ -41,8 +43,8 @@ view model = HE.main "main" ] main ∷ Effect Unit -main = FAN.mount_ (QuerySelector "body") - { init +main = F.mount_ (QuerySelector "body") + { model: init , subscribe: [] , update , view diff --git a/examples/Dice/Dice.purs b/examples/Dice/Dice.purs index b8a8d9e..defae9d 100755 --- a/examples/Dice/Dice.purs +++ b/examples/Dice/Dice.purs @@ -3,15 +3,17 @@ module Examples.EffectList.Dice.Main where import Prelude import Data.Maybe (Maybe(..)) +import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Random as ER -import Flame (QuerySelector(..), Html, (:>)) +import Flame (Html) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE -import Data.Tuple (Tuple) +import Web.DOM.ParentNode (QuerySelector(..)) type Model = Maybe Int @@ -22,10 +24,10 @@ data Message = Roll | Update Int update ∷ Model → Message → Tuple Model (Array (Aff (Maybe Message))) update model = case _ of - Roll → model :> + Roll → model /\ [ Just <<< Update <$> liftEffect (ER.randomInt 1 6) ] - Update int → Just int :> [] + Update int → Just int /\ [] view ∷ Model → Html Message view model = HE.main "main" @@ -35,7 +37,7 @@ view model = HE.main "main" main ∷ Effect Unit main = F.mount_ (QuerySelector "body") - { init: init :> [] + { model: init , subscribe: [] , update , view diff --git a/examples/EffectfulAffjax/Affjax.purs b/examples/EffectfulAffjax/Affjax.purs deleted file mode 100755 index 4c79125..0000000 --- a/examples/EffectfulAffjax/Affjax.purs +++ /dev/null @@ -1,65 +0,0 @@ -module Examples.Effectful.Affjax.Main where - -import Prelude - -import Affjax.Web as A -import Affjax.ResponseFormat as AR -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA -import Flame.Html.Element as HE - -type Model = - { url ∷ String - , result ∷ Result - } - -data Message = UpdateUrl String | Fetch - -data Result = NotFetched | Fetching | Ok String | Error String - -derive instance eqResult ∷ Eq Result - -init ∷ Model -init = - { url: "https://httpbin.org/get" - , result: NotFetched - } - -update ∷ AffUpdate Model Message -update { display, model, message } = - case message of - UpdateUrl url → FAE.diff { url, result: NotFetched } - Fetch → do - display $ FAE.diff' { result: Fetching } - response ← A.get AR.string model.url - FAE.diff <<< { result: _ } $ case response of - Left error → Error $ A.printError error - Right payload → Ok payload.body - -view ∷ Model → Html Message -view { url, result } = HE.main "main" - [ HE.input [ HA.onInput UpdateUrl, HA.value url, HA.type' "text" ] - , HE.button [ HA.onClick Fetch, HA.disabled $ result == Fetching ] "Fetch" - , case result of - NotFetched → - HE.div_ "Not Fetched..." - Fetching → - HE.div_ "Fetching..." - Ok ok → - HE.pre_ <<< HE.code_ $ "Ok: " <> ok - Error error → - HE.div_ $ "Error: " <> error - ] - -main ∷ Effect Unit -main = FAE.mount_ (QuerySelector "body") - { init: init :> Nothing - , subscribe: [] - , update - , view - } diff --git a/examples/EffectfulAffjax/README.md b/examples/EffectfulAffjax/README.md deleted file mode 100644 index eea8568..0000000 --- a/examples/EffectfulAffjax/README.md +++ /dev/null @@ -1,7 +0,0 @@ -# Flame - -## AJAX example - -An example of how to perform AJAX requests using `affjax` and effectful update. - -Build it with `npm run example-affjax` and open affjax.html on your favorite browser. \ No newline at end of file diff --git a/examples/EffectfulAffjax/affjax.html b/examples/EffectfulAffjax/affjax.html deleted file mode 100755 index fe1d1cd..0000000 --- a/examples/EffectfulAffjax/affjax.html +++ /dev/null @@ -1,13 +0,0 @@ - - - - - Affjax Example - - -
- -
- - - \ No newline at end of file diff --git a/examples/EffectfulAffjax/affjax.js b/examples/EffectfulAffjax/affjax.js deleted file mode 100644 index 94d9be3..0000000 --- a/examples/EffectfulAffjax/affjax.js +++ /dev/null @@ -1,2 +0,0 @@ -import { main } from '../../output/Examples.Effectful.Affjax.Main'; -main(); \ No newline at end of file diff --git a/examples/EffectfulDice/Dice.purs b/examples/EffectfulDice/Dice.purs deleted file mode 100755 index 4c1036b..0000000 --- a/examples/EffectfulDice/Dice.purs +++ /dev/null @@ -1,37 +0,0 @@ -module Examples.Effectful.Dice.Main where - -import Prelude - -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Effect.Class (liftEffect) -import Effect.Random as ER -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA -import Flame.Html.Element as HE - -type Model = Maybe Int - -init ∷ Model -init = Nothing - -data Message = Roll - -update ∷ AffUpdate Model Message -update { model } = map (const <<< Just) $ liftEffect $ ER.randomInt 1 6 - -view ∷ Model → Html Message -view model = HE.main "main" - [ HE.text (show model) - , HE.button [ HA.onClick Roll ] "Roll" - ] - -main ∷ Effect Unit -main = FAE.mount_ (QuerySelector "body") - { init: init :> Nothing - , subscribe: [] - , update - , view - } diff --git a/examples/EffectfulDice/README.md b/examples/EffectfulDice/README.md deleted file mode 100644 index a86a16d..0000000 --- a/examples/EffectfulDice/README.md +++ /dev/null @@ -1,7 +0,0 @@ -# Flame - -## Dice example - -A dice rolling app built using effectful updating. - -Build it with `npm run example-dice-aff` and open dice.html on your favorite browser. \ No newline at end of file diff --git a/examples/EffectfulDice/dice.html b/examples/EffectfulDice/dice.html deleted file mode 100755 index 2b94ce5..0000000 --- a/examples/EffectfulDice/dice.html +++ /dev/null @@ -1,13 +0,0 @@ - - - - - Dice Example - - -
- -
- - - \ No newline at end of file diff --git a/examples/EffectfulDice/dice.js b/examples/EffectfulDice/dice.js deleted file mode 100644 index b873d89..0000000 --- a/examples/EffectfulDice/dice.js +++ /dev/null @@ -1,2 +0,0 @@ -import { main } from '../../output/Examples.Effectful.Dice.Main'; -main(); \ No newline at end of file diff --git a/examples/ServerSideRendering/Client/ServerSideRendering.purs b/examples/ServerSideRendering/Client/ServerSideRendering.purs index a6f3fe9..666528d 100755 --- a/examples/ServerSideRendering/Client/ServerSideRendering.purs +++ b/examples/ServerSideRendering/Client/ServerSideRendering.purs @@ -4,27 +4,27 @@ module Examples.EffectList.ServerSideRendering.Client.Main where import Prelude import Data.Maybe (Maybe(..)) +import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Random as ER -import Flame (QuerySelector(..), (:>)) -import Flame as F -import Data.Tuple (Tuple) import Examples.EffectList.ServerSideRendering.Shared (Model(..), Message(..)) import Examples.EffectList.ServerSideRendering.Shared as EESS +import Flame as F +import Web.DOM.ParentNode (QuerySelector(..)) update ∷ Model → Message → Tuple Model (Array (Aff (Maybe Message))) -update m@(Model model) = case _ of - Roll → m :> +update model = case _ of + Roll → model /\ [ Just <<< Update <$> liftEffect (ER.randomInt 1 6) ] - Update int → Model (Just int) :> [] + Update int → Model (Just int) /\ [] main ∷ Effect Unit -main = F.resumeMount_ (QuerySelector "#main") - { init: [] - , subscribe: [] +main = void $ F.resumeMount_ (QuerySelector "#main") + { subscribe: [] , update , view: EESS.view } diff --git a/examples/ServerSideRendering/Server/ServerSideRendering.purs b/examples/ServerSideRendering/Server/ServerSideRendering.purs index 36ca717..f53ccc0 100755 --- a/examples/ServerSideRendering/Server/ServerSideRendering.purs +++ b/examples/ServerSideRendering/Server/ServerSideRendering.purs @@ -8,13 +8,14 @@ import Effect.Class (liftEffect) import Effect.Console as EC import Examples.EffectList.ServerSideRendering.Shared (Model(..), Message) import Examples.EffectList.ServerSideRendering.Shared as EESS -import Flame (QuerySelector(..), Html) +import Flame (Html) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE import HTTPure (ResponseM, ServerM, Request) import HTTPure as H import Node.FS.Aff as FSA +import Web.DOM.ParentNode (QuerySelector(..)) -- | Boot up the server main ∷ ServerM @@ -34,7 +35,7 @@ serveJavaScript = do serveHTML ∷ ResponseM serveHTML = do - stringContents ← liftEffect $ F.preMount (QuerySelector "#main") { init: Model Nothing, view: markup } + stringContents ← liftEffect $ F.preMount (QuerySelector "#main") { model: Model Nothing, view: markup } H.ok' htmlContentType stringContents where htmlContentType = H.header "Content-Type" "text/html" diff --git a/examples/SpecialElements/Special.purs b/examples/SpecialElements/Special.purs index 9dfdba5..8dfa87b 100755 --- a/examples/SpecialElements/Special.purs +++ b/examples/SpecialElements/Special.purs @@ -5,14 +5,16 @@ import Prelude import Data.Array ((:)) import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Random as ER -import Flame (QuerySelector(..), Html, (:>)) +import Flame (Html) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) type Model = { current ∷ Maybe Int @@ -29,14 +31,14 @@ data Message = Roll | Update Int update ∷ Model → Message → Tuple Model (Array (Aff (Maybe Message))) update model@{ history } = case _ of - Roll → model :> + Roll → model /\ [ Just <<< Update <$> liftEffect (ER.randomInt 1 6) ] Update roll → model { current = Just roll , history = roll : history - } :> [] + } /\ [] view ∷ Model → Html Message view model@{ current, history } = HE.fragment @@ -56,7 +58,7 @@ lazyEntry roll = HE.lazy Nothing toEntry roll -- lazy node will only be recomput main ∷ Effect Unit main = F.mount_ (QuerySelector "body") - { init: init :> [] + { model: init , subscribe: [] , update , view diff --git a/examples/Subscriptions/Subscriptions.purs b/examples/Subscriptions/Subscriptions.purs index a041a6a..fabe5c5 100755 --- a/examples/Subscriptions/Subscriptions.purs +++ b/examples/Subscriptions/Subscriptions.purs @@ -4,16 +4,18 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Random as ER import Effect.Timer as ET -import Flame (AppId(..), Html, QuerySelector(..), Subscription, (:>)) +import Flame (AppId(..), Html, Subscription) import Flame as F import Flame.Html.Element as HE import Flame.Subscription as FS import Flame.Subscription.Document as FSD +import Web.DOM.ParentNode (QuerySelector(..)) type Model = { roll ∷ Maybe Int @@ -33,12 +35,12 @@ data Message update ∷ Model → Message → Tuple Model (Array (Aff (Maybe Message))) update model = case _ of - IntervalRoll → model :> next "interval" - ClickRoll → model :> next "click" + IntervalRoll → model /\ next "interval" + ClickRoll → model /\ next "click" Update from int → { roll: Just int , from - } :> [] + } /\ [] where next from = [ Just <<< Update from <$> liftEffect (ER.randomInt 1 6) ] @@ -56,7 +58,7 @@ main ∷ Effect Unit main = do let id = AppId "dice-rolling" F.mount (QuerySelector "body") id - { init: init :> [] + { model: init , subscribe , update , view diff --git a/examples/Todo/Todo.purs b/examples/Todo/Todo.purs index 3e7a76e..73d14c6 100644 --- a/examples/Todo/Todo.purs +++ b/examples/Todo/Todo.purs @@ -8,13 +8,15 @@ import Data.Array as DA import Data.Maybe (Maybe(..)) import Data.Maybe as DM import Data.Tuple (Tuple(..)) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) -import Flame (QuerySelector(..), Html, Key, (:>)) +import Flame (Html, Key) import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) import Web.HTML as WH import Web.HTML.Window as WHW import Web.Storage.Storage as WSS @@ -51,7 +53,7 @@ update model message = Remove index → model { todos = DM.fromMaybe model.todos $ DA.deleteAt index model.todos } message' → saveOnEnter model message' in - newModel :> [ liftEffect $ serialize newModel ] + newModel /\ [ liftEffect $ serialize newModel ] where saveOnEnter updatedModel (Add (Tuple "Enter" todo)) = updatedModel @@ -89,7 +91,7 @@ view model = HE.main "main" main ∷ Effect Unit main = F.mount_ (QuerySelector "body") - { init: init :> [] + { model: init , subscribe: [] , update , view diff --git a/package.json b/package.json index 2c08418..2b8f4ff 100644 --- a/package.json +++ b/package.json @@ -10,21 +10,18 @@ ], "type": "module", "scripts": { - "example-dice-aff": "parcel build examples/EffectfulDice/dice.js --dist-dir examples/EffectfulDice/dist/", "example-server-side-rendering-client": "parcel build examples/ServerSideRendering/Client/server-side-rendering-client.js --dist-dir examples/ServerSideRendering/dist", "example-server-side-rendering": "npm run example-server-side-rendering-client", - "example-affjax": "parcel build examples/EffectfulAffjax/affjax.js --dist-dir examples/EffectfulAffjax/dist", "example-affjax-list": "parcel build examples/Affjax/affjax.js --dist-dir examples/Affjax/dist", "example-counter": "parcel build examples/Counter/counter.js --dist-dir examples/Counter/dist", "example-counters": "parcel build examples/Counters/counters.js --dist-dir examples/Counters/dist", "example-dice": "parcel build examples/Dice/dice.js --dist-dir examples/Dice/dist", - "example-effectful-dice": "parcel build examples/EffectfulDice/dice.js --dist-dir examples/EffectfulDice/dist", "example-special": "parcel build examples/SpecialElements/special.js --dist-dir examples/SpecialElements/dist", "example-subscriptions": "parcel build examples/Subscriptions/subscriptions.js --dist-dir examples/Subscriptions/dist", "example-todo": "parcel build examples/Todo/todo.js --dist-dir examples/Todo/dist", "scratchpad": "parcel watch test/scratchpadloader.js --dist-dir test/dist", "server-side-rendering": "npm run example-server-side-rendering && node examples/ServerSideRendering/Server/server-side-rendering-server.js", - "build-examples": "npm run example-affjax-list && npm run example-affjax && npm run example-counter && npm run example-counters && npm run example-dice && npm run example-todo && npm run example-special && npm run example-subscriptions && npm run example-effectful-dice", + "build-examples": "npm run example-affjax-list && npm run example-counter && npm run example-counters && npm run example-dice && npm run example-todo && npm run example-special && npm run example-subscriptions", "test": "spago -x examples.dhall test && npm run build-examples" }, "devDependencies": { diff --git a/src/Flame.purs b/src/Flame.purs index d7c0b4d..ff329b3 100755 --- a/src/Flame.purs +++ b/src/Flame.purs @@ -1,7 +1,6 @@ -- | Entry module for a default Flame application module Flame (module Exported) where -import Flame.Application.EffectList (Application, noMessages, ResumedApplication, ListUpdate, mount, mount_, resumeMount, resumeMount_) as Exported +import Flame.Application (Application, noMessages, ResumedApplication, Update, mount, mount_, resumeMount, resumeMount_) as Exported import Flame.Application.Internal.PreMount (preMount) as Exported -import Flame.Types (Html, (:>), Key, PreApplication, AppId(..), Subscription) as Exported -import Web.DOM.ParentNode (QuerySelector(..)) as Exported +import Flame.Types (Html, Key, PreApplication, AppId(..), Subscription) as Exported diff --git a/src/Flame/Application/EffectList.purs b/src/Flame/Application/Application.purs similarity index 71% rename from src/Flame/Application/EffectList.purs rename to src/Flame/Application/Application.purs index 4802f89..570a5af 100755 --- a/src/Flame/Application/EffectList.purs +++ b/src/Flame/Application/Application.purs @@ -1,8 +1,7 @@ --- | The Elm like way to run a Flame application --- | --- | The update function returns an array of side effects -module Flame.Application.EffectList - ( ListUpdate +-- | Run TEA like applications +module Flame.Application + ( Update + , App , Application , noMessages , mount @@ -16,6 +15,7 @@ import Data.Either (Either(..)) import Data.Foldable as DF import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Aff as EA @@ -28,36 +28,40 @@ import Flame.Internal.Equality as FIE import Flame.Renderer.Internal.Dom as FRD import Flame.Serialization (class UnserializeState) import Flame.Subscription.Internal.Listener as FSIL -import Flame.Types (App, AppId(..), ApplicationId, DomNode, DomRenderingState, (:>)) +import Flame.Types (AppId(..), ApplicationId, DomNode, DomRenderingState, Html, Subscription) import Prelude (class Show, Unit, bind, discard, map, pure, show, unit, when, ($), (<>)) - import Unsafe.Coerce as UC import Web.DOM.ParentNode (QuerySelector(..)) -type ListUpdate model message = model → message → Tuple model (Array (Aff (Maybe message))) +type Update model message = model → message → Tuple model (Array (Aff (Maybe message))) + +-- | Abstracts over common fields of an `Application` +type App model message extension = + { view ∷ model → Html message + , subscribe ∷ Array (Subscription message) + | extension + } -- | `Application` contains --- | * `init` – the initial model and a list of messages to invoke `update` with +-- | * `model` – starting model -- | * `view` – a function to update your markup -- | * `update` – a function to update your model -- | * `subscribe` – list of external events type Application model message = App model message - ( init ∷ Tuple model (Array (Aff (Maybe message))) - , update ∷ ListUpdate model message + ( model ∷ model + , update ∷ Update model message ) -- | `ResumedApplication` contains --- | * `init` – initial list of messages to invoke `update` with -- | * `view` – a function to update your markup -- | * `update` – a function to update your model -- | * `subscribe` – list of external events type ResumedApplication model message = App model message - ( init ∷ Array (Aff (Maybe message)) - , update ∷ ListUpdate model message + ( update ∷ Update model message ) noMessages ∷ ∀ model message. model → Tuple model (Array (Aff (Maybe message))) -noMessages model = model :> [] +noMessages model = model /\ [] noAppId ∷ ∀ message. Maybe (AppId Unit message) noAppId = Nothing @@ -66,25 +70,27 @@ showId ∷ ∀ id message. Show id ⇒ (AppId id message) → String showId (AppId id) = show id -- | Mount a Flame application on the given selector which was rendered server-side -resumeMount_ ∷ ∀ model message. UnserializeState model ⇒ QuerySelector → ResumedApplication model message → Effect Unit +resumeMount_ ∷ ∀ model message. UnserializeState model ⇒ QuerySelector → ResumedApplication model message → Effect model resumeMount_ selector = resumeMountWith selector noAppId -- | Mount on the given selector a Flame application which was rendered server-side and can be fed arbitrary external messages -resumeMount ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → AppId id message → ResumedApplication model message → Effect Unit +resumeMount ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → AppId id message → ResumedApplication model message → Effect model resumeMount selector appId = resumeMountWith selector (Just appId) -- | Mount on the given selector a Flame application which was rendered server-side and can be fed arbitrary external messages -resumeMountWith ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → Maybe (AppId id message) → ResumedApplication model message → Effect Unit -resumeMountWith (QuerySelector selector) appId { update, view, init, subscribe } = do - initialModel ← FAP.serializedState selector +resumeMountWith ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → Maybe (AppId id message) → ResumedApplication model message → Effect model +resumeMountWith (QuerySelector selector) appId resumed = do + model ← FAP.serializedState selector maybeElement ← FAD.querySelector selector case maybeElement of - Just parent → run parent true (map showId appId) - { init: initialModel :> init - , view - , update - , subscribe + Just parent → do + run parent true (map showId appId) + { model + , view : resumed.view + , update : resumed.update + , subscribe : resumed.subscribe } + pure model Nothing → EE.throw $ "Error resuming application mount: no element matching selector " <> selector <> " found!" -- | Mount a Flame application on the given selector @@ -104,42 +110,37 @@ mountWith (QuerySelector selector) appId application = do -- | Keeps the state in a `Ref` and call `Flame.Renderer.render` for every update run ∷ ∀ model message. DomNode → Boolean → Maybe ApplicationId → Application model message → Effect Unit -run parent isResumed appId { update, view, init: Tuple initialModel initialAffs, subscribe } = do - modelState ← ER.new initialModel +run parent isResumed appId application = do + modelState ← ER.new application.model renderingState ← ER.new (UC.unsafeCoerce 21 ∷ DomRenderingState) let --the function which actually run events runUpdate message = do currentModel ← ER.read modelState - let Tuple model affs = update currentModel message + let Tuple model affs = application.update currentModel message when (FIE.modelHasChanged currentModel model) $ render model - runMessages affs - - runMessages affs = DF.for_ affs $ EA.runAff_ ( case _ of Left error → EC.log $ EE.message error - Right (Just message) → runUpdate message + Right (Just msg) → runUpdate msg _ → pure unit ) --the function which renders to the dom render model = do rendering ← ER.read renderingState - FRD.resume rendering $ view model + FRD.resume rendering $ application.view model ER.write model modelState rendering ← if isResumed then - FRD.startFrom parent runUpdate $ view initialModel + FRD.startFrom parent runUpdate $ application.view application.model else - FRD.start parent runUpdate $ view initialModel + FRD.start parent runUpdate $ application.view application.model ER.write rendering renderingState - runMessages initialAffs - --subscriptions are used for external events case appId of Nothing → pure unit Just id → FSIL.createMessageListener id runUpdate - DF.traverse_ (FSIL.createSubscription runUpdate) subscribe \ No newline at end of file + DF.traverse_ (FSIL.createSubscription runUpdate) application.subscribe \ No newline at end of file diff --git a/src/Flame/Application/Effectful.js b/src/Flame/Application/Effectful.js deleted file mode 100644 index 499c7b7..0000000 --- a/src/Flame/Application/Effectful.js +++ /dev/null @@ -1,15 +0,0 @@ -export function unsafeMergeFields(model) { - return function (subset) { - let copy = {}; - - for (let key of Object.keys(model)) { - copy[key] = model[key]; - } - - for (let key of Object.keys(subset)) { - copy[key] = subset[key]; - } - - return copy; - } -} \ No newline at end of file diff --git a/src/Flame/Application/Effectful.purs b/src/Flame/Application/Effectful.purs deleted file mode 100755 index d93efde..0000000 --- a/src/Flame/Application/Effectful.purs +++ /dev/null @@ -1,175 +0,0 @@ --- | Run a flame application with unbounded side effects --- | --- | The update function carries context information and runs on `Aff` -module Flame.Application.Effectful - ( Application - , mount - , mount_ - , AffUpdate - , Environment - , ResumedApplication - , resumeMount - , resumeMount_ - , noChanges - , class Diff - , diff' - , diff - ) where - -import Data.Either as DET -import Data.Foldable as DF -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Newtype as DN -import Data.Tuple (Tuple(..)) -import Effect (Effect) -import Effect.Aff (Aff) -import Effect.Aff as EA -import Effect.Class (liftEffect) -import Effect.Console as EC -import Effect.Exception as EE -import Effect.Ref as ER -import Flame.Application.Internal.Dom as FAD -import Flame.Application.Internal.PreMount as FAP -import Flame.Renderer.Internal.Dom as FRD -import Flame.Serialization (class UnserializeState) -import Flame.Subscription.Internal.Listener as FSIL -import Flame.Types (App, AppId(..), ApplicationId, DomNode, DomRenderingState, (:>)) -import Prelude (class Functor, class Show, Unit, bind, discard, flip, identity, map, pure, show, unit, ($), (<<<), (<>)) -import Prim.Row (class Union, class Nub) -import Unsafe.Coerce as UC -import Web.DOM.ParentNode (QuerySelector(..)) - -foreign import unsafeMergeFields ∷ ∀ model subset. Record model → Record subset → Record model - -type AffUpdate model message = Environment model message → Aff (model → model) - --- | `Application` contains --- | * `init` – the initial model and an optional message to invoke `update` with --- | * `view` – a function to update your markup --- | * `update` – a function to update your model --- | * `subscribe` – list of external events -type Application model message = App model message - ( init ∷ Tuple model (Maybe message) - , update ∷ AffUpdate model message - ) - --- | `ResumedApplication` contains --- | * `init` – initial list of messages to invoke `update` with --- | * `view` – a function to update your markup --- | * `update` – a function to update your model --- | * `subscribe` – list of external events -type ResumedApplication model message = App model message - ( init ∷ Maybe message - , update ∷ AffUpdate model message - ) - --- | `Environment` contains context information for `Application.update` --- | * `model` – the current model --- | * `message` – the current message --- | * `view` – forcefully update view with given model changes -type Environment model message = - { model ∷ model - , message ∷ message - , display ∷ (model → model) → Aff Unit - } - --- | Convenience type class to update only the given fields of a model -class Diff changed model where - diff' ∷ changed → (model → model) - -instance recordDiff ∷ (Union changed t model, Nub changed c) ⇒ Diff (Record changed) (Record model) where - diff' changed = \model → unsafeMergeFields model changed -else instance functorRecordDiff ∷ (Functor f, Union changed t model, Nub changed c) ⇒ Diff (Record changed) (f (Record model)) where - diff' changed = map (flip unsafeMergeFields changed) -else instance newtypeRecordDiff ∷ (Newtype newtypeModel (Record model), Union changed t model, Nub changed c) ⇒ Diff (Record changed) newtypeModel where - diff' changed = \model → DN.wrap $ unsafeMergeFields (DN.unwrap model) changed - --- | Wraps diff' in Aff -diff ∷ ∀ changed model. Diff changed model ⇒ changed → Aff (model → model) -diff = pure <<< diff' - -noChanges ∷ ∀ model. Aff (model → model) -noChanges = pure identity - -noAppId ∷ ∀ message. Maybe (AppId Unit message) -noAppId = Nothing - -showId ∷ ∀ id message. Show id ⇒ (AppId id message) → String -showId (AppId id) = show id - --- | Mount a Flame application on the given selector which was rendered server-side -resumeMount_ ∷ ∀ model message. UnserializeState model ⇒ QuerySelector → ResumedApplication model message → Effect Unit -resumeMount_ selector = resumeMountWith selector noAppId - --- | Mount on the given selector a Flame application which was rendered server-side and can be fed arbitrary external messages -resumeMount ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → AppId id message → ResumedApplication model message → Effect Unit -resumeMount selector appId = resumeMountWith selector (Just appId) - --- | Mount on the given selector a Flame application which was rendered server-side and can be fed arbitrary external messages -resumeMountWith ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → Maybe (AppId id message) → ResumedApplication model message → Effect Unit -resumeMountWith (QuerySelector selector) appId { update, view, init, subscribe } = do - initialModel ← FAP.serializedState selector - maybeElement ← FAD.querySelector selector - case maybeElement of - Just parent → run parent true (map showId appId) - { init: initialModel :> init - , view - , update - , subscribe - } - Nothing → EE.throw $ "Error resuming application mount: no element matching selector " <> selector <> " found!" - --- | Mount a Flame application on the given selector -mount_ ∷ ∀ model message. QuerySelector → Application model message → Effect Unit -mount_ selector = mountWith selector noAppId - --- | Mount a Flame application that can be fed arbitrary external messages -mount ∷ ∀ id model message. Show id ⇒ QuerySelector → AppId id message → Application model message → Effect Unit -mount selector appId = mountWith selector (Just appId) - -mountWith ∷ ∀ id model message. Show id ⇒ QuerySelector → Maybe (AppId id message) → Application model message → Effect Unit -mountWith (QuerySelector selector) appId application = do - maybeElement ← FAD.querySelector selector - case maybeElement of - Just parent → run parent false (map showId appId) application - Nothing → EE.throw $ "Error mounting application" - --- | `run` keeps the state in a `Ref` and call `Flame.Renderer.Internal.Dom.render` for every update -run ∷ ∀ model message. DomNode → Boolean → Maybe ApplicationId → Application model message → Effect Unit -run parent isResumed appId { init: Tuple initialModel initialMessage, update, view, subscribe } = do - modelState ← ER.new initialModel - renderingState ← ER.new (UC.unsafeCoerce 21 ∷ DomRenderingState) - - let --the function which actually run events - runUpdate message = do - model ← ER.read modelState - EA.runAff_ (DET.either (EC.log <<< EE.message) render) $ update { display: renderFromUpdate, model, message } - - --the function which renders to the dom - render recordUpdate = do - model ← ER.read modelState - rendering ← ER.read renderingState - let updatedModel = recordUpdate model - FRD.resume rendering $ view updatedModel - ER.write updatedModel modelState - - --the function used to arbitraly render the view from inside Environment.update - renderFromUpdate recordUpdate = liftEffect $ render recordUpdate - - rendering ← - if isResumed then - FRD.startFrom parent runUpdate $ view initialModel - else - FRD.start parent runUpdate $ view initialModel - ER.write rendering renderingState - - case initialMessage of - Nothing → pure unit - Just message → runUpdate message - - --subscriptions are used for external events - case appId of - Nothing → pure unit - Just id → FSIL.createMessageListener id runUpdate - DF.traverse_ (FSIL.createSubscription runUpdate) subscribe \ No newline at end of file diff --git a/src/Flame/Application/Internal/PreMount.purs b/src/Flame/Application/Internal/PreMount.purs index 05de4d3..816b175 100644 --- a/src/Flame/Application/Internal/PreMount.purs +++ b/src/Flame/Application/Internal/PreMount.purs @@ -51,7 +51,7 @@ serializedState selector = do preMount ∷ ∀ model message. SerializeState model ⇒ QuerySelector → PreApplication model message → Effect String preMount (QuerySelector selector) application = do - let html = injectState state $ application.view application.init + let html = injectState state $ application.view application.model FRS.render html where sanitizedSelector = onlyLetters selector @@ -60,4 +60,4 @@ preMount (QuerySelector selector) application = do [ HA.style { display: "none" } , HA.id $ idSerializedState sanitizedSelector , HA.createAttribute (attributeSerializedState sanitizedSelector) sanitizedSelector - ] $ FS.serialize application.init \ No newline at end of file + ] $ FS.serialize application.model \ No newline at end of file diff --git a/src/Flame/Application/NoEffects.purs b/src/Flame/Application/NoEffects.purs deleted file mode 100755 index 30c174d..0000000 --- a/src/Flame/Application/NoEffects.purs +++ /dev/null @@ -1,67 +0,0 @@ --- | Run a Flame application without side effects --- | --- | The update function is a pure function from model and message raised -module Flame.Application.NoEffects - ( Application - , mount - , mount_ - , ResumedApplication - , resumeMount - , resumeMount_ - ) where - -import Effect (Effect) -import Flame.Application.EffectList as FAE -import Flame.Serialization (class UnserializeState) -import Flame.Types (App, AppId, (:>)) -import Prelude (class Show, Unit, ($), (<<<)) - -import Web.DOM.ParentNode (QuerySelector) - --- | `Application` contains --- | * `init` – the initial model --- | * `view` – a function to update your markup --- | * `update` – a function to update your model --- | * `subscribe` – list of external events -type Application model message = App model message - ( init ∷ model - , update ∷ model → message → model - ) - --- | `ResumedApplication` contains --- | * `view` – a function to update your markup --- | * `update` – a function to update your model --- | * `subscribe` – list of external events -type ResumedApplication model message = App model message - ( update ∷ model → message → model - ) - --- | Mount a Flame application on the given selector which was rendered server-side -resumeMount_ ∷ ∀ model message. UnserializeState model ⇒ QuerySelector → ResumedApplication model message → Effect Unit -resumeMount_ selector = FAE.resumeMount_ selector <<< toResumedApplication - --- | Mount on the given selector a Flame application which was rendered server-side and can be fed arbitrary external messages -resumeMount ∷ ∀ id model message. UnserializeState model ⇒ Show id ⇒ QuerySelector → AppId id message → ResumedApplication model message → Effect Unit -resumeMount selector appId = FAE.resumeMount selector appId <<< toResumedApplication - -toResumedApplication ∷ ∀ model message. ResumedApplication model message → FAE.ResumedApplication model message -toResumedApplication { update, view, subscribe } = - { init: [] - , update: \model message → update model message :> [] - , view - , subscribe - } - --- | Mount a Flame application that can be fed arbitrary external messages -mount ∷ ∀ id model message. Show id ⇒ QuerySelector → AppId id message → Application model message → Effect Unit -mount selector appId application = FAE.mount selector appId $ application - { init = application.init :> [] - , update = \model message → application.update model message :> [] - } - --- | Mount a Flame application on the given selector, discarding the message Channel -mount_ ∷ ∀ model message. QuerySelector → Application model message → Effect Unit -mount_ selector application = FAE.mount_ selector $ application - { init = application.init :> [] - , update = \model message → application.update model message :> [] - } \ No newline at end of file diff --git a/src/Flame/Types.purs b/src/Flame/Types.purs index 6110612..35929ec 100755 --- a/src/Flame/Types.purs +++ b/src/Flame/Types.purs @@ -1,8 +1,6 @@ -- | Types common to Flame modules module Flame.Types ( PreApplication - , App - , (:>) , ToNodeData , Tag , Key @@ -18,16 +16,15 @@ module Flame.Types ) where import Data.Maybe (Maybe) -import Data.Tuple (Tuple(..)) import Data.Tuple.Nested (Tuple3) import Foreign (Foreign) import Prelude (class Functor, class Show, map) -- | `PreApplication` contains --- | * `init` – the initial model +-- | * `model` – the initial model -- | * `view` – a function to update your markup type PreApplication model message = - { init ∷ model + { model ∷ model , view ∷ model → Html message } @@ -43,16 +40,6 @@ data Source = Window | Document | Custom -- | Subscriptions are events from outside the view, e.g. `window`, `document` or `CustomEvent` type Subscription message = Tuple3 Source EventName (Foreign → message) --- | Abstracts over common fields of an `Application` -type App model message extension = - { view ∷ model → Html message - , subscribe ∷ Array (Subscription message) - | extension - } - --- | Infix tuple constructor -infixr 6 Tuple as :> - type ToNodeData value = ∀ message. value → NodeData message type Tag = String diff --git a/test/Basic/EffectList.purs b/test/Basic/Application.purs similarity index 82% rename from test/Basic/EffectList.purs rename to test/Basic/Application.purs index 45652c6..2f305b9 100755 --- a/test/Basic/EffectList.purs +++ b/test/Basic/Application.purs @@ -1,4 +1,4 @@ -module Test.Basic.EffectList (mount) where +module Test.Basic.Application (mount) where import Prelude @@ -7,15 +7,18 @@ import Data.Maybe as DM import Data.String as DS import Data.String.CodeUnits as DSC import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Random as ER -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.EffectList as FAE +import Flame (Html) +import Flame as F +import Flame.Application as FA import Flame.Html.Attribute as HA import Flame.Html.Element as HE import Partial.Unsafe as UP +import Web.DOM.ParentNode (QuerySelector(..)) import Web.Event.Event as WEE import Web.UIEvent.KeyboardEvent as WUK @@ -25,11 +28,11 @@ data Message = Current String | Cut | Submit update ∷ Model → Message → Tuple Model (Array (Aff (Maybe Message))) update model = case _ of - Cut → model :> + Cut → model /\ [ Just <<< Current <$> cut model ] - Submit → "thanks" :> [] - Current text → text :> [] + Submit → "thanks" /\ [] + Current text → text /\ [] where cut text = do amount ← liftEffect <<< ER.randomInt 1 $ DSC.length text @@ -53,8 +56,8 @@ view model = HE.main_ _ → pure Nothing mount ∷ Effect Unit -mount = FAE.mount_ (QuerySelector "#mount-point") - { init: "" :> [] +mount = F.mount_ (QuerySelector "#mount-point") + { model: "" , subscribe: [] , update , view diff --git a/test/Basic/Effectful.purs b/test/Basic/Effectful.purs deleted file mode 100644 index 16b67ac..0000000 --- a/test/Basic/Effectful.purs +++ /dev/null @@ -1,51 +0,0 @@ -module Test.Basic.Effectful (mount) where - -import Prelude - -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Effect.Aff (Aff) -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.Effectful (Environment) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA -import Flame.Html.Element as HE - -type Model = - { increments ∷ Int - , decrements ∷ Int - , luckyNumber ∷ Int - } - -data Message = Increment | Decrement | Bogus - -init ∷ Model -init = { increments: 0, decrements: 0, luckyNumber: 0 } - -update ∷ Environment Model Message → Aff (Model → Model) -update { display, model, message } = case message of - Increment → do - display (const $ model { luckyNumber = model.increments - 2 }) - pure <<< const $ model { increments = model.increments + 1 } - Decrement → pure (_ { luckyNumber = model.increments + 2, decrements = model.decrements - 1 }) - Bogus → FAE.noChanges - -view ∷ Model → Html Message -view model = HE.main_ - [ HE.span "text-output-increment" $ show model.increments - , HE.span "text-output-decrement" $ show model.decrements - , HE.span "text-output-lucky-number" $ show model.luckyNumber - , HE.br - , - --we add extra events for each button to test if the correct message is used - HE.button [ HA.id "decrement-button", HA.onClick Decrement, HA.onFocus Increment, HA.onDrag Increment ] "-" - , HE.button [ HA.id "increment-button", HA.onClick Increment, HA.onFocus Decrement, HA.onDrag Bogus ] "+" - ] - -mount ∷ Effect Unit -mount = FAE.mount_ (QuerySelector "#mount-point") - { init: init :> Just Decrement - , subscribe: [] - , update - , view - } diff --git a/test/Basic/NoEffects.purs b/test/Basic/NoEffects.purs deleted file mode 100755 index c0ee746..0000000 --- a/test/Basic/NoEffects.purs +++ /dev/null @@ -1,36 +0,0 @@ -module Test.Basic.NoEffects (mount) where - -import Prelude - -import Effect (Effect) -import Flame (QuerySelector(..), Html) -import Flame.Application.NoEffects as FAN -import Flame.Html.Element as HE -import Flame.Html.Attribute as HA - -type Model = Int - -data Message = Increment | Decrement - -init ∷ Model -init = 0 - -update ∷ Model → Message → Model -update model = case _ of - Increment → model + 1 - Decrement → model - 1 - -view ∷ Model → Html Message -view model = HE.main_ - [ HE.button [ HA.id "decrement-button", HA.onClick Decrement ] "-" - , HE.span "text-output" $ show model - , HE.button [ HA.id "increment-button", HA.onClick Increment ] "+" - ] - -mount ∷ Effect Unit -mount = FAN.mount_ (QuerySelector "#mount-point") - { init - , subscribe: [] - , update - , view - } diff --git a/test/Effectful/SlowEffects.purs b/test/Effectful/SlowEffects.purs deleted file mode 100644 index 5a2fb8a..0000000 --- a/test/Effectful/SlowEffects.purs +++ /dev/null @@ -1,48 +0,0 @@ -module Test.Effectful.SlowEffects (mount) where - -import Prelude - -import Data.Array as DA -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Effect.Aff (Aff, Milliseconds(..)) -import Effect.Aff as EA -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.Effectful (Environment) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA -import Flame.Html.Element as HE - -type Model = - { current ∷ Int - , numbers ∷ Array Int - } - -data Message = Bump | BumpAndSnoc - -init ∷ Model -init = { current: 0, numbers: [] } - -update ∷ Environment Model Message → Aff (Model → Model) -update { message } = case message of - Bump → pure $ \m@{ current } → m { current = current + 1 } - BumpAndSnoc → do - EA.delay $ Milliseconds 500.0 - pure $ \m@{ current, numbers } → m { current = current + 1, numbers = DA.snoc numbers 0 } - -view ∷ Model → Html Message -view { current, numbers } = HE.main_ - [ HE.span "text-output-current" $ show current - , HE.span "text-output-numbers" $ show numbers - , HE.br - , HE.button [ HA.id "bump-button", HA.onClick Bump ] "-" - , HE.button [ HA.id "snoc-button", HA.onClick BumpAndSnoc ] "+" - ] - -mount ∷ Effect Unit -mount = FAE.mount_ (QuerySelector "#mount-point") - { init: init :> Nothing - , subscribe: [] - , update - , view - } diff --git a/test/Functor/Basic.purs b/test/Functor/Basic.purs index 273ee1f..521dbc5 100644 --- a/test/Functor/Basic.purs +++ b/test/Functor/Basic.purs @@ -7,10 +7,11 @@ import Data.Array as DA import Data.Maybe (Maybe(..)) import Data.Maybe as DM import Effect (Effect) -import Flame (QuerySelector(..), Html) -import Flame.Application.NoEffects as FAN +import Flame (Html, Update) +import Flame as F import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) type Model = Array NestedModel @@ -19,8 +20,8 @@ data Message = Add | Remove Int | CounterMessage Int NestedMessage init ∷ Model init = [] -update ∷ Model → Message → Model -update model = case _ of +update ∷ Update Model Message +update model = F.noMessages <<< case _ of Add → DA.snoc model nestedInit Remove index → DM.fromMaybe model $ DA.deleteAt index model CounterMessage index message → @@ -62,8 +63,8 @@ nestedView index model = HE.main ("main-" <> show index) ] mount ∷ Effect Unit -mount = FAN.mount_ (QuerySelector "#mount-point") - { init +mount = F.mount_ (QuerySelector "#mount-point") + { model: init , subscribe: [] , update , view diff --git a/test/Functor/Lazy.purs b/test/Functor/Lazy.purs index 7cc22b8..da24f3f 100644 --- a/test/Functor/Lazy.purs +++ b/test/Functor/Lazy.purs @@ -1,13 +1,16 @@ module Test.Functor.Lazy where -import Prelude +import Data.Maybe import Effect import Flame import Flame.Html.Element -import Data.Maybe -import Flame.Html.Element as H +import Prelude + +import Data.Tuple.Nested ((/\)) import Flame.Html.Attribute as HA +import Flame.Html.Element as H import Flame.Html.Event as E +import Web.DOM.ParentNode (QuerySelector(..)) data CounterMsg = Increment Int @@ -33,9 +36,11 @@ data PageMsg = CounterMsg CounterMsg type Model = { counter ∷ CounterModel } -init = { counter: initCounter } :> [] +init ∷ { counter ∷ { count :: Int } } +init = { counter: initCounter } -update model (PageMsg (CounterMsg msg)) = model { counter = updateCounter model.counter msg } :> [] +update :: Update Model Msg +update model (PageMsg (CounterMsg msg)) = model { counter = updateCounter model.counter msg } /\ [] view ∷ Model → Html Msg view model = H.div_ [ PageMsg <$> CounterMsg <$> counterView model.counter ] @@ -43,7 +48,7 @@ view model = H.div_ [ PageMsg <$> CounterMsg <$> counterView model.counter ] mount ∷ Effect Unit mount = mount_ (QuerySelector "#mount-point") { subscribe: [] - , init + , model:init , update , view } diff --git a/test/Main.purs b/test/Main.purs index 273f718..de25aee 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -18,7 +18,6 @@ import Effect.Class (liftEffect) import Effect.Exception.Unsafe as EEU import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame.Application.Effectful as FAE import Flame.Application.Internal.Dom as FAD import Flame.Html.Attribute as HA import Flame.Html.Element as HE @@ -27,20 +26,15 @@ import Flame.Renderer.String as FRS import Flame.Subscription as FS import Flame.Subscription.Unsafe.CustomEvent as FSUC import Partial.Unsafe (unsafePartial) -import Test.Basic.EffectList as TBEL -import Test.Basic.Effectful as TBE +import Test.Basic.Application as TBEL import Test.Functor.Basic as TBF import Test.Functor.Lazy as TFL -import Test.Basic.NoEffects as TBN -import Test.Effectful.SlowEffects as TES -import Test.ServerSideRendering.Effectful as TSE +import Test.ServerSideRendering.Application as TSE import Test.ServerSideRendering.FragmentNode as TSF import Test.ServerSideRendering.ManagedNode as TSM import Test.Subscription.Broadcast as TSB import Test.Subscription.EffectList (TEELMessage(..)) import Test.Subscription.EffectList as TEEL -import Test.Subscription.Effectful as TEE -import Test.Subscription.NoEffects as TEN import Unsafe.Coerce as UC import Web.DOM.Element (Element) import Web.DOM.Element as WDE @@ -673,53 +667,8 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do childrenIdsSwapped ← childNodeIds "#test-div" TSA.shouldEqual [ "1", "2", "3" ] childrenIdsSwapped - -- TS.it "remove nodes" do - -- TS.it "remove all nodes" do - -- TS.it "move nodes" do - -- TS.it "move and remove nodes" do - -- TS.it "move and add nodes" do - - TS.describe "diff" do - TS.it "updates record fields" do - TSA.shouldEqual { a: 23, b: "hello", c: true } $ FAE.diff' { c: true } { a: 23, b: "hello", c: false } - TSA.shouldEqual { a: 23, b: "hello", c: false } $ FAE.diff' {} { a: 23, b: "hello", c: false } - - TS.it "updates record fields with newtype" do - TSA.shouldEqual (TestNewtype { a: 23, b: "hello", c: true }) <<< FAE.diff' { c: true } $ TestNewtype { a: 23, b: "hello", c: false } - TSA.shouldEqual (TestNewtype { a: 23, b: "hello", c: false }) <<< FAE.diff' {} $ TestNewtype { a: 23, b: "hello", c: false } - - TS.it "updates record fields with functor" do - TSA.shouldEqual (Just { a: 23, b: "hello", c: true }) <<< FAE.diff' { c: true } $ Just { a: 23, b: "hello", c: false } - TSA.shouldEqual (Just { a: 23, b: "hello", c: false }) <<< FAE.diff' {} $ Just { a: 23, b: "hello", c: false } - - TS.it "new copy is returned" do - --since diff uses unsafe javascript, make sure the reference is not being written to - let model = { a: 1, b: 2 } - TSA.shouldEqual { a: 1, b: 3 } $ FAE.diff' { b: 3 } model - TSA.shouldEqual { a: 12, b: 2 } $ FAE.diff' { a: 12 } model - TS.describe "Basic applications" do - TS.it "noeffects" do - liftEffect do - unsafeCreateEnviroment - TBN.mount - childrenLength ← childrenNodeLength - --button, span, button - TSA.shouldEqual 3 childrenLength - - initial ← textContent "#text-output" - TSA.shouldEqual "0" initial - - dispatchEvent clickEvent "#decrement-button" - current ← textContent "#text-output" - TSA.shouldEqual "-1" current - - dispatchEvent clickEvent "#increment-button" - dispatchEvent clickEvent "#increment-button" - current2 ← textContent "#text-output" - TSA.shouldEqual "1" current2 - - TS.it "effectlist" do + TS.it "application" do liftEffect do unsafeCreateEnviroment TBEL.mount @@ -750,38 +699,6 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do submitted ← textContent "#text-output" TSA.shouldEqual "thanks" submitted - TS.it "effectful" do - liftEffect do - unsafeCreateEnviroment - TBE.mount - childrenLength ← childrenNodeLength - --span, span, span, br, button, button - TSA.shouldEqual 6 childrenLength - - currentIncrement ← textContent "#text-output-increment" - currentDecrement ← textContent "#text-output-decrement" - currentLuckyNumber ← textContent "#text-output-lucky-number" - TSA.shouldEqual "-1" currentDecrement - TSA.shouldEqual "0" currentIncrement - TSA.shouldEqual "2" currentLuckyNumber - - dispatchEvent clickEvent "#decrement-button" - currentIncrement2 ← textContent "#text-output-increment" - currentDecrement2 ← textContent "#text-output-decrement" - currentLuckyNumber2 ← textContent "#text-output-lucky-number" - TSA.shouldEqual "-2" currentDecrement2 - TSA.shouldEqual "0" currentIncrement2 - TSA.shouldEqual "2" currentLuckyNumber2 - - dispatchEvent clickEvent "#increment-button" - dispatchEvent clickEvent "#increment-button" - currentIncrement3 ← textContent "#text-output-increment" - currentDecrement3 ← textContent "#text-output-decrement" - currentLuckyNumber3 ← textContent "#text-output-lucky-number" - TSA.shouldEqual "2" currentIncrement3 - TSA.shouldEqual "-2" currentDecrement3 - TSA.shouldEqual "2" currentLuckyNumber3 - TS.describe "functor" do TS.it "basic" do liftEffect do @@ -822,49 +739,9 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do current2 ← textContent "#add-button" TSA.shouldEqual "Current Value: 3001" current2 - TS.describe "Effectful specific" do - TS.it "slower effects" do - liftEffect do - unsafeCreateEnviroment - TES.mount - outputCurrent ← textContent "#text-output-current" - outputNumbers ← textContent "#text-output-numbers" - TSA.shouldEqual "0" outputCurrent - TSA.shouldEqual "[]" outputNumbers - - --the event for snoc has a delay, make sure it doesnt overwrite unrelated fields when updating - dispatchEvent clickEvent "#snoc-button" - dispatchEvent clickEvent "#bump-button" - outputCurrent2 ← textContent "#text-output-current" - outputNumbers2 ← textContent "#text-output-numbers" - TSA.shouldEqual "1" outputCurrent2 - TSA.shouldEqual "[]" outputNumbers2 - - AF.delay $ Milliseconds 1000.0 - outputCurrent3 ← textContent "#text-output-current" - outputNumbers3 ← textContent "#text-output-numbers" - TSA.shouldEqual "2" outputCurrent3 - TSA.shouldEqual "[0]" outputNumbers3 TS.describe "Subscription applications" do - TS.it "noeffects" do - liftEffect do - unsafeCreateEnviroment - TEN.mount - output ← textContent "#text-output" - TSA.shouldEqual "0" output - - dispatchDocumentEvent clickEvent - output2 ← textContent "#text-output" - TSA.shouldEqual "-1" output2 - - dispatchDocumentEvent keydownEvent - dispatchDocumentEvent keydownEvent - dispatchDocumentEvent keydownEvent - output3 ← textContent "#text-output" - TSA.shouldEqual "2" output3 - - TS.it "effectlist" do + TS.it "application" do id ← liftEffect do unsafeCreateEnviroment TEEL.mount @@ -879,23 +756,6 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do output3 ← textContent "#text-output" TSA.shouldEqual "0" output3 - TS.it "effectful" do - liftEffect do - unsafeCreateEnviroment - TEE.mount - output ← textContent "#text-output" - TSA.shouldEqual "5" output - - dispatchWindowEvent errorEvent - dispatchWindowEvent errorEvent - dispatchWindowEvent errorEvent - output2 ← textContent "#text-output" - TSA.shouldEqual "2" output2 - - dispatchWindowEvent offlineEvent - output3 ← textContent "#text-output" - TSA.shouldEqual "3" output3 - TS.it "broadcast" do id ← liftEffect do unsafeCreateEnviroment @@ -912,7 +772,7 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do TSA.shouldEqual "-33" output3 TS.describe "Server side rendering" do - TS.it "effectful" do + TS.it "application" do liftEffect do unsafeCreateEnviroment TSE.preMount @@ -1045,17 +905,6 @@ main = AF.launchAff_ $ TSR.runSpec [ consoleReporter ] do event ← eventFunction WEE.dispatchEvent event $ WDE.toEventTarget element - dispatchDocumentEvent eventFunction = liftEffect $ void do - window ← WH.window - document ← WHW.document window - event ← eventFunction - WEE.dispatchEvent event $ WDD.toEventTarget document - - dispatchWindowEvent eventFunction = liftEffect $ void do - window ← WH.window - event ← eventFunction - WEE.dispatchEvent event $ WHW.toEventTarget window - childNodeIds selector = liftEffect do children ← childrenNode selector liftEffect $ DT.traverse WDE.id children diff --git a/test/ServerSideRendering/Effectful.js b/test/ServerSideRendering/Application.js similarity index 100% rename from test/ServerSideRendering/Effectful.js rename to test/ServerSideRendering/Application.js diff --git a/test/ServerSideRendering/Effectful.purs b/test/ServerSideRendering/Application.purs similarity index 68% rename from test/ServerSideRendering/Effectful.purs rename to test/ServerSideRendering/Application.purs index 0e0ab3a..73a6ed9 100644 --- a/test/ServerSideRendering/Effectful.purs +++ b/test/ServerSideRendering/Application.purs @@ -1,4 +1,4 @@ -module Test.ServerSideRendering.Effectful (preMount, mount) where +module Test.ServerSideRendering.Application (preMount, mount) where import Prelude @@ -7,12 +7,11 @@ import Data.Maybe (Maybe(..)) import Effect (Effect) import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame (QuerySelector(..), Html) -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA +import Flame (Html, Update) import Flame as F +import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) import Web.Event.Internal.Types (Event) foreign import setInnerHTML ∷ EffectFn2 String String Unit @@ -26,13 +25,12 @@ derive instance genericModel ∷ Generic Model _ data Message = Increment | Decrement Event -- | `update` is called to handle events -update ∷ AffUpdate Model Message -update { model: Model m, message } = - pure $ const - ( Model $ case message of - Increment → m + 1 - Decrement _ → m - 1 - ) +update ∷ Update Model Message +update (Model m) message = + F.noMessages <<< + Model $ case message of + Increment → m + 1 + Decrement _ → m - 1 -- | `view` is called whenever the model is updated view ∷ Model → Html Message @@ -50,14 +48,13 @@ children (Model model) = preMount ∷ Effect Unit preMount = do - contents ← F.preMount (QuerySelector "#my-id") { init: Model 2, view: preView } + contents ← F.preMount (QuerySelector "#my-id") { model: Model 2, view: preView } EU.runEffectFn2 setInnerHTML "#mount-point" contents -- | Mount the application on the given selector mount ∷ Effect Unit -mount = FAE.resumeMount_ (QuerySelector "#my-id") - { init: Nothing - , subscribe: [] +mount = void $ F.resumeMount_ (QuerySelector "#my-id") + { subscribe: [] , update , view } \ No newline at end of file diff --git a/test/ServerSideRendering/FragmentNode.purs b/test/ServerSideRendering/FragmentNode.purs index ca560fa..3208f19 100644 --- a/test/ServerSideRendering/FragmentNode.purs +++ b/test/ServerSideRendering/FragmentNode.purs @@ -7,12 +7,11 @@ import Data.Maybe (Maybe(..)) import Effect (Effect) import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame (QuerySelector(..), Html) -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA +import Flame (Html, Update) import Flame as F +import Flame.Html.Attribute as HA import Flame.Html.Element as HE +import Web.DOM.ParentNode (QuerySelector(..)) import Web.Event.Internal.Types (Event) foreign import setInnerHTML ∷ EffectFn2 String String Unit @@ -26,13 +25,11 @@ derive instance genericModel ∷ Generic Model _ data Message = Increment | Decrement Event -- | `update` is called to handle events -update ∷ AffUpdate Model Message -update { model: Model m, message } = - pure $ const - ( Model $ case message of +update ∷ Update Model Message +update (Model m) message = + F.noMessages <<< Model $ case message of Increment → m + 1 Decrement _ → m - 1 - ) -- | `view` is called whenever the model is updated view ∷ Model → Html Message @@ -52,14 +49,13 @@ children (Model model) = preMount ∷ Effect Unit preMount = do - contents ← F.preMount (QuerySelector "#my-id") { init: Model 2, view: preView } + contents ← F.preMount (QuerySelector "#my-id") { model: Model 2, view: preView } EU.runEffectFn2 setInnerHTML "#mount-point" contents -- | Mount the application on the given selector mount ∷ Effect Unit -mount = FAE.resumeMount_ (QuerySelector "#my-id") - { init: Nothing - , subscribe: [] +mount = void $ F.resumeMount_ (QuerySelector "#my-id") + { subscribe: [] , update , view } \ No newline at end of file diff --git a/test/ServerSideRendering/ManagedNode.purs b/test/ServerSideRendering/ManagedNode.purs index 638de4d..2452cd3 100644 --- a/test/ServerSideRendering/ManagedNode.purs +++ b/test/ServerSideRendering/ManagedNode.purs @@ -7,10 +7,8 @@ import Data.Maybe (Maybe(..), fromJust) import Effect (Effect) import Effect.Uncurried (EffectFn2) import Effect.Uncurried as EU -import Flame (QuerySelector(..), Html) +import Flame (Html, Update) import Flame as F -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE import Flame.Html.Attribute as HA import Flame.Html.Element (NodeRenderer) import Flame.Html.Element as HE @@ -18,6 +16,7 @@ import Partial.Unsafe as PU import Web.DOM.Document as WDD import Web.DOM.Element (Element) import Web.DOM.Element as WDE +import Web.DOM.ParentNode (QuerySelector(..)) import Web.Event.Internal.Types (Event) import Web.HTML as WH import Web.HTML.HTMLDocument as WHH @@ -35,13 +34,11 @@ derive instance genericModel ∷ Generic Model _ data Message = Increment | Decrement Event -- | `update` is called to handle events -update ∷ AffUpdate Model Message -update { model: Model m, message } = - pure $ const - ( Model $ case message of - Increment → m + 1 - Decrement _ → m - 1 - ) +update ∷ Update Model Message +update (Model m) message = + F.noMessages <<< Model $ case message of + Increment → m + 1 + Decrement _ → m - 1 -- | `view` is called whenever the model is updated view ∷ Model → Html Message @@ -72,14 +69,13 @@ children (Model model) = preMount ∷ Effect Unit preMount = do - contents ← F.preMount (QuerySelector "#my-id") { init: Model 2, view: preView } + contents ← F.preMount (QuerySelector "#my-id") { model: Model 2, view: preView } EU.runEffectFn2 setInnerHTML "#mount-point" contents -- | Mount the application on the given selector mount ∷ Effect Unit -mount = FAE.resumeMount_ (QuerySelector "#my-id") - { init: Nothing - , subscribe: [] +mount = void $ F.resumeMount_ (QuerySelector "#my-id") + { subscribe: [] , update , view } \ No newline at end of file diff --git a/test/Subscription/EffectList.purs b/test/Subscription/Application.purs similarity index 77% rename from test/Subscription/EffectList.purs rename to test/Subscription/Application.purs index 8f8500d..33d8739 100644 --- a/test/Subscription/EffectList.purs +++ b/test/Subscription/Application.purs @@ -6,12 +6,15 @@ import Prelude import Data.Maybe (Maybe) import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.EffectList as FAE +import Flame (Html) +import Flame as F +import Flame.Application as FA import Flame.Html.Element as HE import Flame.Types (AppId(..)) +import Web.DOM.ParentNode (QuerySelector(..)) -- | The model represents the state of the app type Model = Int @@ -22,8 +25,8 @@ data TEELMessage = TEELIncrement | TEELDecrement -- | `update` is called to handle events update ∷ Model → TEELMessage → Tuple Model (Array (Aff (Maybe TEELMessage))) update model = case _ of - TEELIncrement → (model + 1) :> [] - TEELDecrement → (model - 1) :> [] + TEELIncrement → (model + 1) /\ [] + TEELDecrement → (model - 1) /\ [] -- | `view` is called whenever the model is updated view ∷ Model → Html TEELMessage @@ -35,8 +38,8 @@ view model = HE.main "main" mount ∷ Effect (AppId String TEELMessage) mount = do let id = AppId "teel" - FAE.mount (QuerySelector "#mount-point") id - { init: 0 :> [] + F.mount (QuerySelector "#mount-point") id + { model: 0 , subscribe: [] , update , view diff --git a/test/Subscription/Broadcast.purs b/test/Subscription/Broadcast.purs index 4b2b64a..aff3fa2 100644 --- a/test/Subscription/Broadcast.purs +++ b/test/Subscription/Broadcast.purs @@ -7,12 +7,15 @@ import Prelude import Data.Maybe (Maybe) import Data.Maybe as DM import Data.Tuple (Tuple) +import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff) -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.EffectList as FAE +import Flame (Html) +import Flame as F +import Flame.Application as FA import Flame.Html.Element as HE import Flame.Subscription as FS +import Web.DOM.ParentNode (QuerySelector(..)) import Web.Event.Event (EventType(..)) -- | The model represents the state of the app @@ -24,8 +27,8 @@ data TSBMessage = TEELIncrement | TEELDecrement (Maybe Int) -- | `update` is called to handle events update ∷ Model → TSBMessage → Tuple Model (Array (Aff (Maybe TSBMessage))) update model = case _ of - TEELIncrement → (model + 1) :> [] - TEELDecrement amount → (model - (DM.fromMaybe 1 amount)) :> [] + TEELIncrement → (model + 1) /\ [] + TEELDecrement amount → (model - (DM.fromMaybe 1 amount)) /\ [] -- | `view` is called whenever the model is updated view ∷ Model → Html TSBMessage @@ -36,8 +39,8 @@ view model = HE.main "main" -- | Mount the application on the given selector mount ∷ Effect Unit mount = do - FAE.mount_ (QuerySelector "#mount-point") - { init: 0 :> [] + F.mount_ (QuerySelector "#mount-point") + { model: 0 , subscribe: [ FS.onCustomEvent' (EventType "increment-event") TEELIncrement, FS.onCustomEvent (EventType "decrement-event") TEELDecrement ] , update , view diff --git a/test/Subscription/Effectful.purs b/test/Subscription/Effectful.purs deleted file mode 100644 index 602fc98..0000000 --- a/test/Subscription/Effectful.purs +++ /dev/null @@ -1,48 +0,0 @@ -module Test.Subscription.Effectful (mount) where - --- | Counter example using a side effects free function - -import Prelude - -import Data.Maybe (Maybe(..)) -import Effect (Effect) -import Flame (QuerySelector(..), Html, (:>)) -import Flame.Application.Effectful (AffUpdate) -import Flame.Application.Effectful as FAE -import Flame.Html.Attribute as HA -import Flame.Html.Element as HE -import Flame.Subscription.Window as FEW -import Web.Event.Internal.Types (Event) - --- | The model represents the state of the app -type Model = Int - --- | This datatype is used to signal events to `update` -data Message = Increment | Decrement Event - --- | `update` is called to handle events -update ∷ AffUpdate Model Message -update { model, message } = - pure $ - ( case message of - Increment → (_ + 1) - Decrement _ → (_ - 1) - ) - --- | `view` is called whenever the model is updated -view ∷ Model → Html Message -view model = HE.main "main" - [ HE.span "text-output" $ show model - , HE.br - , HE.button (HA.onClick Increment) "+" - ] - --- | Mount the application on the given selector -mount ∷ Effect Unit -mount = do - FAE.mount_ (QuerySelector "#mount-point") - { init: 5 :> Nothing - , subscribe: [ FEW.onError' Decrement, FEW.onOffline Increment ] - , update - , view - } \ No newline at end of file diff --git a/test/Subscription/NoEffects.purs b/test/Subscription/NoEffects.purs deleted file mode 100644 index 631a194..0000000 --- a/test/Subscription/NoEffects.purs +++ /dev/null @@ -1,40 +0,0 @@ -module Test.Subscription.NoEffects (mount) where - --- | Counter example using a side effects free function - -import Prelude - -import Effect (Effect) -import Flame (QuerySelector(..), Html) -import Flame.Application.NoEffects as FAN -import Flame.Html.Element as HE -import Flame.Subscription.Document as FED -import Web.Event.Internal.Types (Event) - --- | The model represents the state of the app -type Model = Int - --- | This datatype is used to signal events to `update` -data Message = Increment String | Decrement Event - --- | `update` is called to handle events -update ∷ Model → Message → Model -update model = case _ of - Increment _ → model + 1 - Decrement _ → model - 1 - --- | `view` is called whenever the model is updated -view ∷ Model → Html Message -view model = HE.main "main" - [ HE.span "text-output" $ show model - ] - --- | Mount the application on the given selector -mount ∷ Effect Unit -mount = do - FAN.mount_ (QuerySelector "#mount-point") - { init: 0 - , subscribe: [ FED.onClick' Decrement, FED.onKeydown Increment ] - , update - , view - } \ No newline at end of file