Adapt State and Actions

ClickCounter.purs

module ClickCounter where

import Prelude
import Component as C
import Pux.Html as H
import Pux.Html.Events as E
import Data.Generic (class Generic)

type State = Int

data Action = Click
derive instance genericAction :: Generic Action

initialState :: State
initialState = 0

component :: ∀ e. C.PuxComponent Action State e
component = C.Simple update view
    where
    update Click s = s + 1
    view s = H.div [] [
        H.strong [] [H.text "Count your clicks"],
        H.div [] [H.text $ "you have clicked " ++ show s ++ " times."],
        H.button [E.onClick $ const Click] [H.text "click"]
    ]

Component.purs

module Component where

import Prelude
import Pux as Pux
import Pux.Html as H
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Generic (class Generic, GenericSpine(..), fromSpine, toSpine)
import Data.Array (length, (!!), head)
import Data.Foldable (class Foldable, foldl)

data PuxComponent action state eff =
      Stateless (H.Html action)
    | Simple (action -> state -> state) (state -> H.Html action)
    | Effectful (action -> state -> Pux.EffModel state action eff) (state -> H.Html action)

adaptState :: ∀ s1 s2 a e. (s2 -> s1 -> s2) -> (s2 -> s1) -> PuxComponent a s1 e -> PuxComponent a s2 e
adaptState _ _ (Stateless html) = Stateless html
adaptState updateInS2 toS1 (Simple update view) =
    Simple (\a s -> updateInS2 s $ update a $ toS1 s) (view <<< toS1)
adaptState updateInS2 toS1 (Effectful update view) =
    Effectful updateEff (view <<< toS1)
        where
        updateEff :: a -> s2 -> Pux.EffModel s2 a e
        updateEff a s =
            let updatedState = update a $ toS1 s in
            updatedState{state = updateInS2 s updatedState.state}

adaptAction :: ∀ a1 a2 s e. (a1 -> a2) -> (a2 -> Maybe a1) -> PuxComponent a1 s e -> PuxComponent a2 s e
adaptAction toa2 _ (Stateless html) = Stateless $ toa2 <$> html
adaptAction toa2 toa1 (Simple update view) =
    Simple maybeUpdate (\s -> toa2 <$> (view s))
    where
    maybeUpdate a s = fromMaybe s $ update <$> toa1 a <*> Just s
adaptAction toa2 toa1 (Effectful update view) =
    Effectful maybeUpdateEff (\s -> toa2 <$> (view s))
    where
    maybeUpdateEff :: a2 -> s -> Pux.EffModel s a2 e
    maybeUpdateEff a s = case toa1 a of
        Just action -> let  updated = update action s
                            effects = (map toa2) <$> updated.effects
                        in
                        updated{effects = effects}
        Nothing -> Pux.noEffects s


gFrom :: ∀ a b. (Generic a, Generic b) => a -> Maybe b
gFrom a = case toSpine a of
    SProd constr ar | length ar == 1 ->
        (head ar) <*> Just unit >>= fromSpine
    _ -> Nothing

gFromTagged :: ∀ a b t. (Generic a, Generic b, Generic t) => t -> a -> Maybe b
gFromTagged t a = case toSpine a of
    SProd _ ar | length ar == 2 -> do
        gtag <- (ar !! 0) <*> Just unit
        gval <- (ar !! 1) <*> Just unit
        if gtag == toSpine t then fromSpine gval else Nothing
    _ -> Nothing

gAdaptAction :: ∀ a1 a2 s e. (Generic a1, Generic a2) => (a1 -> a2) -> PuxComponent a1 s e -> PuxComponent a2 s e
gAdaptAction toa2 = adaptAction toa2 gFrom

gAdaptTaggedAction :: ∀ a1 a2 s t e. (Generic t, Generic a1, Generic a2) => (t -> a1 -> a2) -> t -> PuxComponent a1 s e -> PuxComponent a2 s e
gAdaptTaggedAction toTaggeda2 tag = adaptAction (toTaggeda2 tag) (gFromTagged tag)

wrapWith :: ∀ a s e. (H.Html a -> H.Html a) -> PuxComponent a s e -> PuxComponent a s e
wrapWith wrapper (Stateless html) = Stateless $ wrapper html
wrapWith wrapper (Simple update view) = Simple update (wrapper <<< view)
wrapWith wrapper (Effectful update view) = Effectful update (wrapper <<< view)

wrapManyWith :: ∀ a s f e. (Foldable f, Functor f) => (f (H.Html a) -> H.Html a) -> f (PuxComponent a s e) -> PuxComponent a s e
wrapManyWith wrapper m = Effectful (updateManyComponents m) (viewManyComponents m wrapper)

viewComponent :: ∀ a s e. PuxComponent a s e -> s -> H.Html a
viewComponent (Stateless html) = const html
viewComponent (Simple _ view) = view
viewComponent (Effectful _ view) = view

infixl 9 viewComponent as <:

updateComponent :: ∀ a s e. PuxComponent a s e -> a -> s -> Pux.EffModel s a e
updateComponent (Stateless _) _ s = Pux.noEffects s
updateComponent (Simple update _ ) a s = Pux.noEffects $ update a s
updateComponent (Effectful update _ ) a s = update a s

updateManyComponents :: ∀ a s f e. (Foldable f) => f (PuxComponent a s e) -> a -> s -> Pux.EffModel s a e
updateManyComponents m a s =
    foldl go (Pux.noEffects s) m
    where
    go {state,effects} comp =
        updated{effects = effects <> updated.effects}
        where
        updated = updateComponent comp a state

viewManyComponents :: ∀ a s f e. (Functor f) => f (PuxComponent a s e) -> (f (H.Html a) -> H.Html a) -> s -> H.Html a
viewManyComponents m wrapper s = wrapper $ flip viewComponent s <$> m

Console.purs

module Console where

import Prelude
import Component as C
import Pux as Pux
import Control.Monad.Eff.Console (CONSOLE, print)
import Control.Monad.Eff.Class (liftEff)
import Pux.Html as H
import Pux.Html.Events as E
import Pux.Html.Attributes as A
import Data.Generic (class Generic)

data Action = TextChanged String
            | Print
            | Clear
derive instance genericAction :: Generic Action

type State = String

component :: ∀ e. C.PuxComponent Action State (console :: CONSOLE | e)
component = C.Effectful update view
    where
    update (TextChanged txt) _ = Pux.noEffects txt
    update Print s = {state: s, effects: [liftEff $ print s <#> const Clear]}
    update Clear _ = Pux.noEffects ""

    view txt = H.div [] [
            H.input [A.value txt, E.onChange $ TextChanged <<< _.value <<< _.target] [],
            H.button [E.onClick $ const Print] [H.text "print"]
        ]

ConsoleAndCounter.purs

module ConsoleAndCounter where

import Prelude
import Component as C
import Component ((<:))
import Pux.Html as H
import Console as Console
import Counter as Counter
import ClickCounter as ClickCounter
import Data.Generic (class Generic)
import Control.Monad.Eff.Console (CONSOLE)

type State = {
    console :: Console.State,
    counterTop :: Counter.State,
    counterBottom :: Counter.State,
    clickCounter :: ClickCounter.State
}

data CounterTag = Top | Bottom
derive instance genericCounterTag :: Generic CounterTag

data Action = Console Console.Action
            | Counter CounterTag Counter.Action
            | ClickCounter ClickCounter.Action
derive instance genericAction :: Generic Action

initialState :: State
initialState = {console : "hello", counterTop: 0, counterBottom: 100, clickCounter: 0}

component :: ∀ e. C.PuxComponent Action State (console :: CONSOLE | e)
component = C.Effectful update view
    where
    counterTop = Counter.component # C.adaptState _{counterTop=_} _.counterTop >>> C.gAdaptTaggedAction Counter Top
    counterBottom = Counter.component # C.adaptState _{counterBottom=_} _.counterBottom >>> C.gAdaptTaggedAction Counter Bottom
    console = Console.component # C.adaptState _{console=_} _.console >>> C.gAdaptAction Console
    clickCounter = ClickCounter.component # C.adaptState _{clickCounter=_} _.clickCounter >>> C.gAdaptAction ClickCounter
    update = C.updateManyComponents [counterTop, console, clickCounter, counterBottom]
    view state = H.div [] [
        H.h4 [] [H.text "This is a counter"],
        H.div [] [
            counterTop <: state
        ],
        H.h4 [] [H.text "and this one logs to the console"],
        H.div [] [
            console <: state
        ],
        H.h4 [] [H.text "and finally you can click"],
        H.div [] [
            clickCounter <: state
        ],
        H.h4 [] [H.text "This is another counter"],
        H.div [] [
            counterBottom <: state
        ]
    ]

Counter.purs

module Counter where

import Prelude
import Component as C
import Pux.Html as H
import Pux.Html.Attributes as A
import Pux.Html.Events as E
import Data.Generic (class Generic)

data Action =  Increment | Decrement
derive instance genericAction :: Generic Action

type State = Int

component :: ∀ e. C.PuxComponent Action State e
component = C.Simple update view
    where
    update action s = case action of
        Increment -> s + 1
        Decrement -> s - 1
    view s = H.div [A.className "counter"] [
        H.div [] [H.text $ show s],
        H.div [A.className "counter-actions"] [
            H.button [E.onClick $ const Increment] [H.text "+"],
            H.button [E.onClick $ const Decrement] [H.text "-"]
        ]
    ]

Main.purs

module Main where

import Prelude
import Pux as Pux
import Pux.Html as H
import Control.Monad.Eff (Eff)
import Component as C
import ConsoleAndCounter as ConsoleAndCounter
import Counter as Counter
import Tab as Tab
import Tab (TabContent(..))
import Control.Monad.Eff.Console (CONSOLE)
import Data.Generic (class Generic)

type AppEff e = (console :: CONSOLE | e)

data MyTab = Static String String | Counter1 | Counter2 | Interactive
derive instance eqMyTab :: Eq MyTab
derive instance genericMyTalb :: Generic MyTab

data MyTabContentAction = Counter MyTab Counter.Action
                        | ConsoleAndCounter ConsoleAndCounter.Action
derive instance genericMyTabContentAction :: Generic MyTabContentAction

type MyTabAction = Tab.Action MyTab MyTabContentAction

type MyTabState = {
    counter1 :: Counter.State,
    counter2 :: Counter.State,
    consoleAndCounter :: ConsoleAndCounter.State,
    activeTab :: MyTab
}

myTabComponent :: ∀ e. C.PuxComponent MyTabAction MyTabState (AppEff e)
myTabComponent = Tab.component componentForTab [
        Counter1,
        Static "foo" "lorem ipsum",
        Static "HAL" "I'm sorry, Dave. I'm afraid I can't do that.",
        Counter2,
        Interactive
    ]
    where
    componentForTab Counter1 =
        TabContent  "A counter" $
                    Counter.component #
                    C.adaptState _{counter1=_} _.counter1 >>> C.gAdaptTaggedAction Counter Counter1
    componentForTab Counter2 =
        TabContent  "Another counter" $
                    Counter.component #
                    C.adaptState _{counter2=_} _.counter2 >>> C.gAdaptTaggedAction Counter Counter2
    componentForTab (Static t txt) =
        TabContent t $
            C.Stateless $ H.div [] [H.text txt]
    componentForTab Interactive =
        TabContent  "Interactive" $
                    ConsoleAndCounter.component #
                    C.adaptState _{consoleAndCounter=_} _.consoleAndCounter >>> C.gAdaptAction ConsoleAndCounter

main :: Eff _ Unit
main = do
    app <- Pux.start {
        initialState: {
            counter1: 0,
            counter2: 0,
            consoleAndCounter: ConsoleAndCounter.initialState,
            activeTab: Counter1
        },
        update: C.updateComponent myTabComponent,
        view: C.viewComponent myTabComponent,
        inputs: []
    }
    Pux.renderToDOM "#app" app.html

Tab.purs

module Tab (
    Action(..),
    TabContent(..),
    component,
    TabState
    ) where

import Prelude
import Pux.Html as H
import Pux as Pux
import Pux.Html.Attributes as A
import Pux.Html.Events as E
import Component as C
import Data.Generic (class Generic)

data Action tab a = Activate tab | ActionInTab tab a
derive instance genericAction :: (Generic tab, Generic a) => Generic (Action tab a)

data TabContent a s e = TabContent String (C.PuxComponent a s e)

viewTab :: ∀ a s e. TabContent a s e -> s -> H.Html a
viewTab (TabContent _ c) = C.viewComponent c

updateTab :: ∀ a s e. TabContent a s e -> a -> s -> Pux.EffModel s a e
updateTab (TabContent _ c) = C.updateComponent c

tabTitle :: ∀ a s e. TabContent a s e -> String
tabTitle (TabContent t _) = t

type TabState t s = {activeTab :: t | s}

component :: ∀ t a s e. (Eq t) => (t -> TabContent a (TabState t s) e) -> Array t -> C.PuxComponent (Action t a) (TabState t s) e
component componentForTab tabs = C.Effectful update view
    where
    update :: Action t a -> TabState t s -> Pux.EffModel (TabState t s) (Action t a) e
    update (Activate tab) s = Pux.noEffects s{activeTab = tab}
    update (ActionInTab tab a) s =
        updated{effects = (map $ ActionInTab tab) <$> updated.effects}
        where
        updated = updateTab (componentForTab tab) a s

    view :: TabState t s -> H.Html (Action t a)
    view state =
        H.div [A.className "tabs"] [
            H.div [A.className "tab-label"] (tabLabel <$> tabs),
            H.hr [] [],
            H.div [A.className "tab-content-wrapper"] [tabContent]
        ]
        where
        activeTab = state.activeTab
        tabLabel tab
            | activeTab == tab = H.strong [] [H.text $ tabTitle $ componentForTab tab]
            | otherwise =
                H.button [A.className "tab-label", E.onClick $ const $ Activate tab] [
                    H.text $ tabTitle $ componentForTab tab
                ]
        tabContent =
            H.div [A.className "tab-content"] [
                ActionInTab activeTab <$> viewTab (componentForTab activeTab) state
            ]