├── 1 └── Counter.hs ├── 2 ├── Counter.hs └── CounterPair.hs ├── 3 ├── Counter.hs └── CounterList.hs ├── 4 ├── Counter.hs └── CounterList.hs ├── README.md └── shell.nix /1/Counter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | module Countere where 3 | 4 | import Reflex.Dom 5 | 6 | type Model = Int 7 | 8 | data Action = Increment | Decrement 9 | 10 | update :: Action -> Model -> Model 11 | update Increment model = model + 1 12 | update Decrement model = model - 1 13 | 14 | -- we do not return html, it's done by MonadWidget 15 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 16 | view model = 17 | el "div" $ do 18 | (decrement, _) <- el' "button" $ text "-" 19 | el "div" $ do 20 | t <- mapDyn show model 21 | dynText t 22 | (increment, _) <- el' "button" $ text "+" 23 | return $ leftmost [ fmap (const Decrement) (_el_clicked decrement) 24 | , fmap (const Increment) (_el_clicked increment) ] 25 | 26 | main = mainWidget $ el "div" $ do 27 | let initial = 0 28 | rec changes <- view model 29 | model <- foldDyn update initial changes 30 | return () 31 | -------------------------------------------------------------------------------- /2/Counter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | module Counter (Model, initCounter, Action, update, view) where 3 | 4 | import Reflex.Dom 5 | 6 | type Model = Int 7 | 8 | initCounter :: Int -> Model 9 | initCounter count = count 10 | 11 | data Action = Increment | Decrement 12 | 13 | update :: Action -> Model -> Model 14 | update Increment model = model + 1 15 | update Decrement model = model - 1 16 | 17 | -- we do not return html, it's done by MonadWidget 18 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 19 | view model = 20 | el "div" $ do 21 | (decrement, _) <- el' "button" $ text "-" 22 | el "div" $ do 23 | t <- mapDyn show model 24 | dynText t 25 | (increment, _) <- el' "button" $ text "+" 26 | return $ leftmost [ fmap (const Decrement) (_el_clicked decrement) 27 | , fmap (const Increment) (_el_clicked increment) ] 28 | 29 | -------------------------------------------------------------------------------- /2/CounterPair.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | module CounterPair where 3 | 4 | import Reflex.Dom 5 | import qualified Counter 6 | 7 | data Model = Model { topCounter :: Counter.Model 8 | , bottomCounter :: Counter.Model } 9 | 10 | initCounter :: Int -> Int -> Model 11 | initCounter = Model 12 | 13 | data Action 14 | = Reset 15 | | Top Counter.Action 16 | | Bottom Counter.Action 17 | 18 | update :: Action -> Model -> Model 19 | update Reset model = initCounter 0 0 20 | update (Top act) model = model { topCounter = Counter.update act (topCounter model) } 21 | update (Bottom act) model = model { bottomCounter = Counter.update act (bottomCounter model) } 22 | 23 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 24 | view model = 25 | el "div" $ do 26 | tc <- mapDyn topCounter model 27 | bc <- mapDyn bottomCounter model 28 | topAction <- Counter.view tc 29 | bottomAction <- Counter.view bc 30 | (btn, _) <- el' "button" $ text "RESET" 31 | return $ leftmost [ fmap Top topAction 32 | , fmap Bottom bottomAction 33 | , fmap (const Reset) (_el_clicked btn)] 34 | 35 | main = mainWidget $ do 36 | let initial = initCounter 0 0 37 | rec changes <- view model 38 | model <- foldDyn update initial changes 39 | return () 40 | -------------------------------------------------------------------------------- /3/Counter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | module Counter (Model, initCounter, Action, update, view) where 3 | 4 | import Reflex.Dom 5 | 6 | type Model = Int 7 | 8 | initCounter :: Int -> Model 9 | initCounter count = count 10 | 11 | data Action = Increment | Decrement 12 | 13 | update :: Action -> Model -> Model 14 | update Increment model = model + 1 15 | update Decrement model = model - 1 16 | 17 | -- we do not return html, it's done by MonadWidget 18 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 19 | view model = 20 | el "div" $ do 21 | (decrement, _) <- el' "button" $ text "-" 22 | el "div" $ do 23 | t <- mapDyn show model 24 | dynText t 25 | (increment, _) <- el' "button" $ text "+" 26 | return $ leftmost [ fmap (const Decrement) (_el_clicked decrement) 27 | , fmap (const Increment) (_el_clicked increment) ] 28 | 29 | -------------------------------------------------------------------------------- /3/CounterList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | {-# LANGUAGE RecursiveDo #-} 3 | module CounterList where 4 | 5 | import Reflex.Dom 6 | import qualified Counter 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | -- MODEL 11 | 12 | type ID = Int 13 | 14 | data Model = Model { counters :: [(ID, Counter.Model)] 15 | , nextID :: ID } 16 | 17 | initModel :: Model 18 | initModel = Model { counters = [] 19 | , nextID = 0 } 20 | 21 | -- UPDATE 22 | 23 | data Action 24 | = Insert 25 | | Remove 26 | | Modify ID Counter.Action 27 | 28 | update :: Action -> Model -> Model 29 | update Insert model = 30 | let newCounter = (nextID model, Counter.initCounter 0) 31 | newCounters = (counters model) ++ [ newCounter ] 32 | in model { counters = newCounters 33 | , nextID = (nextID model) + 1 } 34 | update Remove model = model { counters = drop 1 (counters model) } 35 | update (Modify id counterAction) model = 36 | model { counters = map updateCounter (counters model) } 37 | where 38 | updateCounter (counterID, counterModel) = 39 | if counterID == id 40 | then (counterID, Counter.update counterAction counterModel) 41 | else (counterID, counterModel) 42 | 43 | -- VIEW 44 | 45 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 46 | view model = 47 | el "div" $ do 48 | (remove, _) <- el' "button" $ text "Remove" 49 | (insert, _) <- el' "button" $ text "Add" 50 | counters <- mapDyn (Map.fromList . counters) model 51 | -- we enhance the normal counter event with the id 52 | counterEvs <- listWithKey counters (\k m -> do 53 | ev <- Counter.view m 54 | return $ fmap (k,) ev) 55 | -- because we follow Elm example, let's simplify here and choose first event 56 | modEvt <- mapDyn (leftmost . Map.elems) counterEvs 57 | return $ leftmost [ fmap (const Remove) (_el_clicked remove) 58 | , fmap (const Insert) (_el_clicked insert) 59 | , fmap (uncurry Modify) $ switchPromptlyDyn modEvt] 60 | 61 | main = mainWidget $ do 62 | rec changes <- view model 63 | model <- foldDyn update initModel changes 64 | return () 65 | -------------------------------------------------------------------------------- /4/Counter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | module Counter (Model, initCounter, Action, update, view, viewWithRemoveButton) where 3 | 4 | import Reflex.Dom 5 | 6 | type Model = Int 7 | 8 | initCounter :: Int -> Model 9 | initCounter count = count 10 | 11 | data Action = Increment | Decrement 12 | 13 | update :: Action -> Model -> Model 14 | update Increment model = model + 1 15 | update Decrement model = model - 1 16 | 17 | -- we do not return html, it's done by MonadWidget 18 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 19 | view model = 20 | el "div" $ do 21 | (decrement, _) <- el' "button" $ text "-" 22 | el "div" $ do 23 | t <- mapDyn show model 24 | dynText t 25 | (increment, _) <- el' "button" $ text "+" 26 | return $ leftmost [ fmap (const Decrement) (_el_clicked decrement) 27 | , fmap (const Increment) (_el_clicked increment) ] 28 | 29 | viewWithRemoveButton :: MonadWidget t m => Dynamic t Model -> m (Event t Action, Event t ()) 30 | viewWithRemoveButton model = 31 | el "div" $ do 32 | modEv <- view model 33 | (remove, _) <- el' "button" $ text "X" 34 | return $ ( modEv 35 | , fmap (const ()) (_el_clicked remove) ) 36 | -------------------------------------------------------------------------------- /4/CounterList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | {-# LANGUAGE RecursiveDo #-} 3 | module CounterList where 4 | 5 | import Reflex.Dom 6 | import qualified Counter 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | -- MODEL 11 | 12 | type ID = Int 13 | 14 | data Model = Model { counters :: [(ID, Counter.Model)] 15 | , nextID :: ID } 16 | 17 | initModel :: Model 18 | initModel = Model { counters = [] 19 | , nextID = 0 } 20 | 21 | -- UPDATE 22 | 23 | data Action 24 | = Insert 25 | | Remove ID 26 | | Modify ID Counter.Action 27 | 28 | update :: Action -> Model -> Model 29 | update Insert model = 30 | let newCounter = (nextID model, Counter.initCounter 0) 31 | newCounters = (counters model) ++ [ newCounter ] 32 | in model { counters = newCounters 33 | , nextID = (nextID model) + 1 } 34 | update (Remove id) model = 35 | model { counters = filter (\(counterID,_) -> counterID /= id) (counters model) } 36 | update (Modify id counterAction) model = 37 | model { counters = map updateCounter (counters model) } 38 | where 39 | updateCounter (counterID, counterModel) = 40 | if counterID == id 41 | then (counterID, Counter.update counterAction counterModel) 42 | else (counterID, counterModel) 43 | 44 | -- VIEW 45 | 46 | view :: MonadWidget t m => Dynamic t Model -> m (Event t Action) 47 | view model = 48 | el "div" $ do 49 | (insert, _) <- el' "button" $ text "Add" 50 | counters <- mapDyn (Map.fromList . counters) model 51 | -- we enhance the normal counter events with the id 52 | counterEvs <- listWithKey counters (\k m -> do 53 | (modEv, remEv) <- Counter.viewWithRemoveButton m 54 | return (fmap (k,) modEv, fmap (k,) remEv)) 55 | -- because we follow Elm example, let's simplify here and choose first event 56 | modEvt <- mapDyn (leftmost . map fst . Map.elems) counterEvs 57 | remEvt <- mapDyn (leftmost . map snd . Map.elems) counterEvs 58 | return $ leftmost [ fmap (const Insert) (_el_clicked insert) 59 | , fmap (uncurry Modify) (switchPromptlyDyn modEvt) 60 | , fmap (Remove . fst) (switchPromptlyDyn remEvt) ] 61 | 62 | main = mainWidget $ do 63 | rec changes <- view model 64 | model <- foldDyn update initModel changes 65 | return () 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-architecture-tutorial-reflex 2 | Elm architecture tutorial reworked in Haskell' Reflex library 3 | 4 | Tried to follow original code closely, hence some stuff might be unidiomatic. 5 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | with (import {}).pkgs; 2 | let 3 | ghc = haskell.packages.ghc7101.ghcWithPackages 4 | (pkgs: with pkgs; [ reflex reflex-dom ]); 5 | in 6 | stdenv.mkDerivation { 7 | name = "my-haskell-env-0"; 8 | buildInputs = [ ghc ]; 9 | shellHook = "eval $(grep export ${ghc}/bin/ghc)"; 10 | } 11 | --------------------------------------------------------------------------------