├── .gitignore ├── app.js ├── index.html ├── README.md ├── src ├── 0Hello.purs ├── 1Counter.purs ├── 2CounterPair.purs ├── 3CounterList.purs ├── 4CounterListR.purs ├── 5Viewer.purs ├── 6ViewerPair.purs └── 7ViewerList.purs ├── bower.json ├── package.json └── gulpfile.js /.gitignore: -------------------------------------------------------------------------------- 1 | /node_modules 2 | /bower_components 3 | /output 4 | .psci_modules 5 | -------------------------------------------------------------------------------- /app.js: -------------------------------------------------------------------------------- 1 | /* global exports, require */ 2 | "use strict"; 3 | require('Two').main(); 4 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # opticui-elm-architecture 2 | Examples from [The Elm Architecture](https://github.com/evancz/elm-architecture-tutorial) in Purescript with [Optic UI](https://github.com/zrho/purescript-optic-ui/). 3 | -------------------------------------------------------------------------------- /src/0Hello.purs: -------------------------------------------------------------------------------- 1 | module Zero where 2 | -------------------------------------------------------------------------------- 3 | import Prelude 4 | import OpticUI 5 | -------------------------------------------------------------------------------- 6 | 7 | main = animate unit $ ui $ text "Hello" 8 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "todo", 3 | "private": true, 4 | "dependencies": { 5 | "purescript-optic-ui": "*", 6 | "purescript-affjax": "latest", 7 | "purescript-json": "latest" 8 | }, 9 | "resolutions": { 10 | "purescript-transformers": "^0.6.1", 11 | "purescript-sets": "~0.5.1", 12 | "purescript-maps": "~0.5.2" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "opticui-elm-architecture", 3 | "description": "Elm architecture guide with OpticUI", 4 | "license": "MIT", 5 | "dependencies": { 6 | "virtual-dom": "latest" 7 | }, 8 | "devDependencies": { 9 | "bower": "latest", 10 | "browserify": "latest", 11 | "gulp": "latest", 12 | "gulp-purescript": "latest", 13 | "purescript": "latest", 14 | "vinyl-source-stream": "latest", 15 | "rimraf": "latest" 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /src/1Counter.purs: -------------------------------------------------------------------------------- 1 | module One where 2 | -------------------------------------------------------------------------------- 3 | import Prelude 4 | import Data.Foldable (mconcat) 5 | import Data.Lens 6 | import DOM (DOM ()) 7 | import OpticUI 8 | import OpticUI.Markup.HTML as H 9 | -------------------------------------------------------------------------------- 10 | 11 | type Counter = { count :: Int } 12 | count = lens _.count (_ { count = _ }) 13 | 14 | data Action = Increment | Decrement 15 | 16 | update :: Action -> Counter -> Counter 17 | update Increment = count +~ 1 18 | update Decrement = count -~ 1 19 | 20 | counter :: forall eff. UI (dom :: DOM | eff) Markup Counter Counter 21 | counter = with $ \st h -> 22 | let clicked a = const $ runHandler h $ st # update a 23 | in ui $ H.div_ $ mconcat 24 | [ H.button [ H.onClick $ clicked Decrement ] $ text "-" 25 | , text $ show st.count 26 | , H.button [ H.onClick $ clicked Increment ] $ text "+" 27 | ] 28 | 29 | main = animate { count : 0 } $ counter 30 | -------------------------------------------------------------------------------- /gulpfile.js: -------------------------------------------------------------------------------- 1 | 'use strict' 2 | 3 | var gulp = require('gulp'); 4 | var purescript = require('gulp-purescript'); 5 | var browserify = require('browserify'); 6 | var source = require('vinyl-source-stream'); 7 | var rimraf = require("rimraf"); 8 | 9 | process.env['NODE_PATH'] = __dirname + '/output'; 10 | 11 | var sources = 12 | [ 'src/**/*.purs' 13 | , 'bower_components/purescript-*/src/**/*.purs' 14 | ]; 15 | 16 | var foreigns = 17 | [ 'src/**/*.js' 18 | , 'bower_components/purescript-*/src/**/*.js' 19 | ]; 20 | 21 | gulp.task('make', function() { 22 | return purescript.psc({ src: sources, ffi: foreigns }); 23 | }); 24 | 25 | gulp.task("clean-output", function (cb) { 26 | rimraf("output", cb); 27 | }); 28 | 29 | gulp.task("clean", ["clean-output"]); 30 | 31 | gulp.task('browserify', ['make'], function () { 32 | var b = browserify({ 33 | entries: './app.js', 34 | debug: true, 35 | }); 36 | 37 | return b.bundle() 38 | .pipe(source('app.js')) 39 | .pipe(gulp.dest('./output/')); 40 | }); 41 | 42 | gulp.task('default', ['browserify']); 43 | -------------------------------------------------------------------------------- /src/2CounterPair.purs: -------------------------------------------------------------------------------- 1 | module Two where 2 | -------------------------------------------------------------------------------- 3 | import Prelude hiding (top, bottom) 4 | import Data.Foldable (mconcat) 5 | import Data.Lens 6 | import DOM (DOM ()) 7 | import OpticUI 8 | import OpticUI.Markup.HTML as H 9 | -------------------------------------------------------------------------------- 10 | 11 | type Counter = { count :: Int } 12 | count = lens _.count (_ { count = _ }) 13 | 14 | init x = { count : x } 15 | 16 | data Action = Increment | Decrement 17 | 18 | update :: Action -> Counter -> Counter 19 | update Increment = count +~ 1 20 | update Decrement = count -~ 1 21 | 22 | counter :: forall eff. UI (dom :: DOM | eff) Markup Counter Counter 23 | counter = with $ \st h -> 24 | let clicked a = const $ runHandler h $ st # update a 25 | in ui $ H.div_ $ mconcat 26 | [ H.button [ H.onClick $ clicked Decrement ] $ text "-" 27 | , text $ show st.count 28 | , H.button [ H.onClick $ clicked Increment ] $ text "+" 29 | ] 30 | 31 | -- new stuff 32 | 33 | type Counter2 = { top :: Counter, bottom :: Counter} 34 | top = lens _.top (_ { top = _ }) 35 | bottom = lens _.bottom (_ { bottom = _ }) 36 | 37 | init2 a b = { top : init a, bottom : init b } 38 | 39 | data Action2 = Reset 40 | 41 | update2 :: Action2 -> Counter2 -> Counter2 42 | update2 Reset = (top .~ init 0) <<< (bottom .~ init 0) 43 | -- or simply 44 | -- update2 Reset = const $ init2 0 0 45 | 46 | main = animate (init2 0 0) $ with \st h -> 47 | let clicked2 a = const $ runHandler h $ st # update2 a 48 | in mconcat 49 | [ top $ counter 50 | , bottom $ counter 51 | , ui $ H.button [ H.onClick $ clicked2 Reset ] $ text "RESET" 52 | ] 53 | -------------------------------------------------------------------------------- /src/3CounterList.purs: -------------------------------------------------------------------------------- 1 | module Three where 2 | -------------------------------------------------------------------------------- 3 | import Prelude hiding (top, bottom) 4 | import Data.Foldable (mconcat) 5 | import Data.Lens 6 | import Data.List hiding (init) 7 | import Data.Maybe (maybe) 8 | import DOM (DOM ()) 9 | import OpticUI 10 | import OpticUI.Markup.HTML as H 11 | -------------------------------------------------------------------------------- 12 | 13 | type Counter = { count :: Int } 14 | count = lens _.count (_ { count = _ }) 15 | 16 | init :: Int -> Counter 17 | init x = { count : x } 18 | 19 | data Action = Increment | Decrement 20 | 21 | update :: Action -> Counter -> Counter 22 | update Increment = count +~ 1 23 | update Decrement = count -~ 1 24 | 25 | counter :: forall eff. UI (dom :: DOM | eff) Markup Counter Counter 26 | counter = with $ \st h -> 27 | let clicked a = const $ runHandler h $ st # update a 28 | in ui $ H.div_ $ mconcat 29 | [ H.button [ H.onClick $ clicked Decrement ] $ text "-" 30 | , text $ show st.count 31 | , H.button [ H.onClick $ clicked Increment ] $ text "+" 32 | ] 33 | 34 | -- new stuff 35 | 36 | type CounterL = { counters :: List Counter } 37 | counters = lens _.counters (_ { counters = _ }) 38 | 39 | data ActionL = Insert | Remove 40 | 41 | updateL :: ActionL -> CounterL -> CounterL 42 | updateL Remove = counters %~ tail >>> maybe Nil id 43 | updateL Insert = counters %~ ((flip snoc) $ init 0) 44 | 45 | main = animate { counters : Nil } $ with \st h -> 46 | let clickedL a = const $ runHandler h $ st # updateL a 47 | in mconcat 48 | [ ui $ H.button [ H.onClick $ clickedL Remove ] $ text "Remove" 49 | , ui $ H.button [ H.onClick $ clickedL Insert ] $ text "Add" 50 | , counters $ foreach $ const counter 51 | ] 52 | -------------------------------------------------------------------------------- /src/4CounterListR.purs: -------------------------------------------------------------------------------- 1 | module Four where 2 | -------------------------------------------------------------------------------- 3 | import Prelude hiding (top, bottom) 4 | import Data.Foldable (mconcat) 5 | import Data.Lens 6 | import Data.List hiding (init) 7 | import Data.Maybe (maybe) 8 | import DOM (DOM ()) 9 | import OpticUI 10 | import OpticUI.Markup.HTML as H 11 | -------------------------------------------------------------------------------- 12 | 13 | type Counter = { count :: Int } 14 | count = lens _.count (_ { count = _ }) 15 | 16 | init :: Int -> Counter 17 | init x = { count : x } 18 | 19 | data Action = Increment | Decrement 20 | 21 | update :: Action -> Counter -> Counter 22 | update Increment = count +~ 1 23 | update Decrement = count -~ 1 24 | 25 | counter = with $ \st h -> 26 | let clicked a = const $ runHandler h $ st # update a 27 | in ui $ H.span [] $ mconcat 28 | [ H.button [ H.onClick $ clicked Decrement ] $ text "-" 29 | , text $ show st.count 30 | , H.button [ H.onClick $ clicked Increment ] $ text "+" 31 | ] 32 | 33 | -- new stuff 34 | 35 | removable component callback = flip withView component $ \componentUI -> 36 | H.div_ $ mconcat 37 | [ componentUI 38 | , H.button [ H.onClick callback ] $ text "X" 39 | ] 40 | 41 | -- 42 | 43 | type CounterLR = { counters :: List Counter } 44 | counters = lens _.counters (_ { counters = _ }) 45 | 46 | data ActionLR = Insert | Remove Int 47 | 48 | updateLR :: ActionLR -> CounterLR -> CounterLR 49 | updateLR Insert = counters %~ ((flip snoc) $ init 0) 50 | updateLR (Remove i) = counters %~ deleteAt i >>> maybe Nil id 51 | 52 | main = animate { counters : Nil } $ with \st h -> 53 | let handleLR a = const $ runHandler h $ st # updateLR a 54 | in mconcat 55 | [ ui $ H.button [ H.onClick $ handleLR Insert ] $ text "Add" 56 | , counters $ foreach (\i -> removable counter <<< handleLR $ Remove i) 57 | ] 58 | -------------------------------------------------------------------------------- /src/5Viewer.purs: -------------------------------------------------------------------------------- 1 | module Five where 2 | -------------------------------------------------------------------------------- 3 | import Prelude 4 | import Control.Monad.Aff (runAff) 5 | import Data.Foldable (mconcat) 6 | import Data.Lens 7 | import Data.Lens.Index (ix) 8 | import Data.Maybe 9 | import Data.Monoid 10 | 11 | import DOM (DOM ()) 12 | import Data.JSON as JS 13 | import Network.HTTP.Affjax as AJ 14 | import OpticUI 15 | import OpticUI.Markup.HTML as H 16 | -------------------------------------------------------------------------------- 17 | 18 | _JObject = prism' JS.JObject $ \x -> case x of 19 | JS.JObject y -> Just y 20 | _ -> Nothing 21 | _JString = prism' JS.JString $ \x -> case x of 22 | JS.JString y -> Just y 23 | _ -> Nothing 24 | 25 | type GifViewer = { topic :: String, gifUrl :: String } 26 | topic = lens _.topic (_ { topic = _ }) 27 | gifUrl = lens _.gifUrl (_ { gifUrl = _ }) 28 | 29 | init :: String -> GifViewer 30 | init t = { topic : t , gifUrl : "" } 31 | 32 | randomGiphy :: String -> String 33 | randomGiphy t = mconcat 34 | [ "https://api.giphy.com/v1/gifs/random" 35 | , "?tag=", t 36 | , "&api_key=", "dc6zaTOxFJmzC" 37 | ] 38 | 39 | extractUrl :: Maybe JS.JValue -> String 40 | extractUrl a = a ^. _Just 41 | <<< _JObject <<< ix "data" 42 | <<< _JObject <<< ix "image_url" 43 | <<< _JString 44 | 45 | viewer :: forall eff. UI (dom :: DOM, ajax :: AJ.AJAX| eff) Markup GifViewer GifViewer 46 | viewer = with \st h -> let 47 | setUrl u = runHandler h $ st # gifUrl .~ u 48 | more = runAff 49 | (const $ setUrl "error") 50 | (_.response >>> JS.decode >>> extractUrl >>> setUrl) 51 | (AJ.get (randomGiphy st.topic)) 52 | in ui $ H.div_ $ mconcat 53 | [ H.h2_ $ text st.topic 54 | , H.div [ H.onInitialized st.topic $ const more] $ H.img 55 | [ H.srcA st.gifUrl 56 | , H.heightA 200, H.widthA 200 ] mempty 57 | , H.button [ H.onClick $ const more ] $ text "More Please!" 58 | ] 59 | 60 | main = animate (init "funny cats") viewer 61 | -------------------------------------------------------------------------------- /src/6ViewerPair.purs: -------------------------------------------------------------------------------- 1 | module Six where 2 | -------------------------------------------------------------------------------- 3 | import Prelude 4 | import Control.Monad.Aff (runAff) 5 | import Data.Foldable (mconcat) 6 | import Data.Lens 7 | import Data.Lens.Index (ix) 8 | import Data.Maybe 9 | import Data.Monoid 10 | 11 | import DOM (DOM ()) 12 | import Data.JSON as JS 13 | import Network.HTTP.Affjax as AJ 14 | import OpticUI 15 | import OpticUI.Markup.HTML as H 16 | -------------------------------------------------------------------------------- 17 | 18 | _JObject = prism' JS.JObject $ \x -> case x of 19 | JS.JObject y -> Just y 20 | _ -> Nothing 21 | _JString = prism' JS.JString $ \x -> case x of 22 | JS.JString y -> Just y 23 | _ -> Nothing 24 | 25 | type GifViewer = { topic :: String, gifUrl :: String } 26 | topic = lens _.topic (_ { topic = _ }) 27 | gifUrl = lens _.gifUrl (_ { gifUrl = _ }) 28 | 29 | init :: String -> GifViewer 30 | init t = { topic : t , gifUrl : "" } 31 | 32 | randomGiphy :: String -> String 33 | randomGiphy t = mconcat 34 | [ "https://api.giphy.com/v1/gifs/random" 35 | , "?tag=", t 36 | , "&api_key=", "dc6zaTOxFJmzC" 37 | ] 38 | 39 | extractUrl :: Maybe JS.JValue -> String 40 | extractUrl a = a ^. _Just 41 | <<< _JObject <<< ix "data" 42 | <<< _JObject <<< ix "image_url" 43 | <<< _JString 44 | 45 | viewer :: forall eff. UI (dom :: DOM, ajax :: AJ.AJAX| eff) Markup GifViewer GifViewer 46 | viewer = with \st h -> let 47 | setUrl u = runHandler h $ st # gifUrl .~ u 48 | more = runAff 49 | (const $ setUrl "error") 50 | (_.response >>> JS.decode >>> extractUrl >>> setUrl) 51 | (AJ.get (randomGiphy st.topic)) 52 | in ui $ H.div_ $ mconcat 53 | [ H.h2_ $ text st.topic 54 | , H.div [ H.onInitialized st.topic $ const more] $ H.img 55 | [ H.srcA st.gifUrl 56 | , H.heightA 200, H.widthA 200 ] mempty 57 | , H.button [ H.onClick $ const more ] $ text "More Please!" 58 | ] 59 | 60 | -- new stuff 61 | 62 | type Viewer2 = { leftV :: GifViewer, rightV :: GifViewer } 63 | leftV = lens _.leftV (_ { leftV = _ }) 64 | rightV = lens _.rightV (_ { rightV = _ }) 65 | 66 | main = let 67 | cats = init "funny cats" 68 | dogs = init "funny dogs" in 69 | animate { leftV: cats , rightV: dogs } $ 70 | withView (H.div [ H.styleA "display: flex;" ]) $ mconcat 71 | [ leftV $ viewer 72 | , rightV $ viewer 73 | ] 74 | -------------------------------------------------------------------------------- /src/7ViewerList.purs: -------------------------------------------------------------------------------- 1 | module Seven where 2 | -------------------------------------------------------------------------------- 3 | import Prelude 4 | import Control.Monad.Aff (runAff) 5 | import Data.Foldable (mconcat) 6 | import Data.Lens 7 | import Data.Lens.Index (ix) 8 | import Data.List hiding (init) 9 | import Data.Maybe 10 | import Data.Monoid 11 | 12 | import DOM (DOM ()) 13 | import Data.JSON as JS 14 | import Network.HTTP.Affjax as AJ 15 | import OpticUI 16 | import OpticUI.Components 17 | import OpticUI.Markup.HTML as H 18 | -------------------------------------------------------------------------------- 19 | 20 | _JObject = prism' JS.JObject $ \x -> case x of 21 | JS.JObject y -> Just y 22 | _ -> Nothing 23 | _JString = prism' JS.JString $ \x -> case x of 24 | JS.JString y -> Just y 25 | _ -> Nothing 26 | 27 | type GifViewer = { topic :: String, gifUrl :: String } 28 | topic = lens _.topic (_ { topic = _ }) 29 | gifUrl = lens _.gifUrl (_ { gifUrl = _ }) 30 | 31 | init :: String -> GifViewer 32 | init t = { topic : t , gifUrl : "" } 33 | 34 | randomGiphy :: String -> String 35 | randomGiphy t = mconcat 36 | [ "https://api.giphy.com/v1/gifs/random" 37 | , "?tag=", t 38 | , "&api_key=", "dc6zaTOxFJmzC" 39 | ] 40 | 41 | extractUrl :: Maybe JS.JValue -> String 42 | extractUrl a = a ^. _Just 43 | <<< _JObject <<< ix "data" 44 | <<< _JObject <<< ix "image_url" 45 | <<< _JString 46 | 47 | viewer :: forall eff. UI (dom :: DOM, ajax :: AJ.AJAX| eff) Markup GifViewer GifViewer 48 | viewer = with \st h -> let 49 | setUrl u = runHandler h $ st # gifUrl .~ u 50 | more = runAff 51 | (const $ setUrl "error") 52 | (_.response >>> JS.decode >>> extractUrl >>> setUrl) 53 | (AJ.get (randomGiphy st.topic)) 54 | in ui $ H.div_ $ mconcat 55 | [ H.h2_ $ text st.topic 56 | , H.div [ H.onInitialized st.topic $ const more] $ H.img 57 | [ H.srcA st.gifUrl 58 | , H.heightA 200, H.widthA 200 ] mempty 59 | , H.button [ H.onClick $ const more ] $ text "More Please!" 60 | ] 61 | 62 | -- new stuff 63 | 64 | type ViewerL = { input :: String, viewers :: List GifViewer } 65 | viewers = lens _.viewers (_ { viewers = _ }) 66 | input = lens _.input (_ { input = _ }) 67 | 68 | main = animate { input : "", viewers : Nil } $ with $ \s h -> let 69 | addOnEnter ev (Just t) = if (ev.keyCode == 13) then 70 | runHandler h $ s # (viewers %~ ((flip snoc) $ init t)) <<< (input .~ "") 71 | else pure unit 72 | addOnEnter _ Nothing = pure unit 73 | in mconcat 74 | [ input $ textField [H.onKeydown addOnEnter] 75 | , withView (H.div [ H.styleA "display: flex;" ]) (viewers $ foreach $ const viewer) 76 | ] 77 | --------------------------------------------------------------------------------