Skip to content

Instantly share code, notes, and snippets.

@lgastako
Forked from jeffreyrosenbluth/global-local
Created May 30, 2017 22:07
Show Gist options
  • Save lgastako/69b5068e55aed91903aec5ce9b580039 to your computer and use it in GitHub Desktop.
Save lgastako/69b5068e55aed91903aec5ce9b580039 to your computer and use it in GitHub Desktop.
A Reflex app with both global and local state
{-# LANGUAGE RecursiveDo #-}
-- | A simple example of a Reflex application that uses both elm style "global"
-- state and component level "local" state. The global state is a counter that
-- can be incremented and decremented by buttons that remember how many times
-- they have been clicked.
module Main where
import Control.Applicative
import Reflex
import Reflex.Dom
-- | The global state.
type Model = Int
data Action = Increment | Decrement
update :: Action -> Model -> Model
update Increment n = n + 1
update Decrement n = n - 1
-- | A 'clickButton' is a button that remembers and displays the
-- number of times it has been clicked. That is, it has local state.
clickButton :: MonadWidget t m => String -> m (El t)
clickButton label = do
el "div" $ do
(action, _) <- el' "button" $ text label
hspace
presses <- foldDyn (\_ b -> b + 1) (0 :: Int) (_el_clicked action)
str <- mapDyn (\p -> "clicked " ++ show p ++ " times") presses
dynText str
return action
view :: MonadWidget t m => Dynamic t Model -> m (Event t Action)
view model =
el "div" $ do
inc <- clickButton "INCREMENT"
vspace
el "div" $ do
t <- mapDyn (\m -> ">> [ " ++ show m ++ " ] <<") model
dynText t
vspace
dec <- clickButton "DECREMENT"
return $ leftmost [ Decrement <$ (_el_clicked dec)
, Increment <$ (_el_clicked inc) ]
hspace :: MonadWidget t m => m ()
hspace = el "span" $ text " "
vspace :: MonadWidget t m => m ()
vspace = el "p" $ text " "
main :: IO ()
main = mainWidget $ el "div" $ do
rec changes <- view model
model <- foldDyn update 0 changes
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment