├── .gitignore ├── README.md ├── bower.json ├── dist ├── CNAME ├── index.html ├── logo.png ├── logo.svg └── styles.scss ├── package-lock.json ├── package.json └── src ├── Application.purs ├── Chart.purs ├── Crypto.purs ├── Footer.purs ├── Helpers.purs ├── Main.purs ├── Market.purs ├── Models.purs ├── Navbar.purs ├── Quote.purs ├── Router.purs ├── Stock.purs ├── Summary.purs └── Typeahead ├── Component.purs └── Container.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.travis.yml 4 | /bower_components/ 5 | /node_modules/ 6 | /output/ 7 | /dist/app.js 8 | /dist/styles.css 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Stk 2 | 3 | Stk is a free, real time stock quotes, charts and market overview. 4 | 5 | ## Background & Motivations 6 | 7 | After attending a talk about [Purescript](http://www.purescript.org/) at the Elixir Conf Europe 2017 in Barcelona, I started to read [Purescript by example](https://leanpub.com/purescript/read). 8 | The book is a very good learning material, even though I felt the need to make an application in order to get the grasp 9 | of the language and its ecosystem. 10 | 11 | ## Roadmap 12 | 13 | - [x] v1 14 | - [x] Display a component with Halogen 15 | - [x] Fetch an API 16 | - [x] Parse the JSON 17 | - [x] by using purescript-foreign 18 | - [x] by using purescript-foreign-generics 19 | - [x] Display a lifecycle component and fetch on mount 20 | - [x] Display a typeahead and send the selection to the parent 21 | - [x] Display a chart with purescript-echarts 22 | - [x] Use Bulma CSS framework 23 | - [x] Use Parcel web application bundler 24 | - [x] Display multiple types of child component 25 | - [ ] v2 26 | - [ ] Use local storage to save symbols 27 | - [ ] Use Signals to update the data 28 | - [ ] Use purescript-routing 29 | - [ ] Display market gainers and losers 30 | - [ ] Display worldwide map with market indexes 31 | 32 | ## Inspiration & Thanks 33 | 34 | * Thanks to [Phil Freeman](https://github.com/paf31), creator of the Purescript language and author of Purescript by Example 35 | * Thanks to [Slamdata](https://github.com/slamdata) for the Halogen type-safe UI library 36 | * Thanks to [Citizennet](https://github.com/citizennet) for the typeahead search component 37 | * Thanks to [IEX](https://iextrading.com/) for providing the data for free 38 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "name": "stk", 4 | "ignore": [ 5 | "**/.*", 6 | "node_modules", 7 | "bower_components", 8 | "output", 9 | "dist" 10 | ], 11 | "dependencies": { 12 | "purescript-affjax": "^5.0.0", 13 | "purescript-console": "^3.0.0", 14 | "purescript-fixed-precision": "^2.0.0", 15 | "purescript-foreign-generic": "^6.0.0", 16 | "purescript-foreign": "^4.0.1", 17 | "purescript-formatters": "^3.0.1", 18 | "purescript-halogen-echarts": "^14.0.0", 19 | "purescript-halogen-select": "^1.0.0", 20 | "purescript-halogen": "^3.1.3", 21 | "purescript-js-timers": "^3.0.0", 22 | "purescript-now": "^3.0.0", 23 | "purescript-routing": "^7.1.0", 24 | "purescript-simple-json": "^3.0.0", 25 | "purescript-strings": "^3.5.0" 26 | }, 27 | "devDependencies": { 28 | "purescript-psci-support": "^3.0.0" 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /dist/CNAME: -------------------------------------------------------------------------------- 1 | stk.exchange 2 | -------------------------------------------------------------------------------- /dist/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Stk 8 | 9 | 10 | 11 | 12 | 13 | 14 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /dist/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ninjarab/stk/17f10b8125af434028fc67f8ca57f6a202b0a022/dist/logo.png -------------------------------------------------------------------------------- /dist/logo.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /dist/styles.scss: -------------------------------------------------------------------------------- 1 | @import "./node_modules/bulma/sass/utilities/initial-variables"; 2 | @import "./node_modules/bulma/sass/utilities/functions"; 3 | 4 | $family-monospace: 'Roboto Mono', monospace; 5 | $family-primary: $family-monospace; 6 | 7 | $text-strong: $white; 8 | $text: $white; 9 | $title-color: $white; 10 | 11 | $background: $black; 12 | $body-background-color: $black; 13 | 14 | $navbar-item-color: $white; 15 | $navbar-item-hover-color: $white; 16 | $navbar-background-color: $black; 17 | 18 | $dropdown-item-hover-background-color: $grey-lighter; 19 | 20 | $input-disabled-color: $white; 21 | $input-disabled-background-color: $grey-darker; 22 | $input-disabled-border-color: $grey-darker; 23 | 24 | $table-background-color: $black; 25 | $table-color: $white; 26 | $table-row-hover-background-color: $grey-darker; 27 | 28 | $button-color: $white; 29 | $button-background-color: $black; 30 | $button-border-color: $white; 31 | $button-hover-color: $white; 32 | $button-hover-border-color: $white; 33 | 34 | $button-disabled-background-color: $grey-darker; 35 | 36 | $footer-background-color: $black; 37 | 38 | $navbar-item-hover-color: $black; 39 | 40 | @import "./node_modules/bulma/bulma.sass"; 41 | 42 | .is-red { 43 | color: rgb(220, 55, 45); 44 | margin-left: 10px; 45 | } 46 | 47 | .is-red-down { 48 | @extend .is-red; 49 | 50 | &:before { 51 | content: "▼"; 52 | margin-right: 5px; 53 | } 54 | } 55 | 56 | .is-green { 57 | color: rgb(22, 136, 84); 58 | margin-left: 10px; 59 | } 60 | 61 | .is-green-up { 62 | @extend .is-green; 63 | 64 | &:before { 65 | content: "▲"; 66 | margin-right: 5px; 67 | } 68 | } 69 | 70 | .is-grey { 71 | color: $grey-light; 72 | margin-left: 10px; 73 | } 74 | 75 | .is-grey-eq { 76 | @extend .is-grey; 77 | 78 | &:before { 79 | content: "▶"; 80 | margin-right: 5px; 81 | } 82 | } 83 | 84 | .dropdown, .dropdown-menu { 85 | width: 100%; 86 | } 87 | 88 | .dropdown-content { 89 | max-height: 190px; 90 | overflow: scroll; 91 | } 92 | 93 | .input[disabled]::-webkit-input-placeholder { 94 | color: $white; 95 | } 96 | 97 | .navbar { 98 | border-bottom: 1px solid $white; 99 | 100 | .navbar-brand > a.navbar-item { 101 | &:hover { 102 | color: $white; 103 | } 104 | } 105 | } 106 | 107 | .empty-box { 108 | height: 122px; 109 | } 110 | 111 | .custom-section { 112 | @extend .section; 113 | 114 | padding: 1.5rem 1.5rem; 115 | } 116 | 117 | .summary { 118 | margin-top: 40px; 119 | margin-left: auto; 120 | margin-right: auto; 121 | } 122 | 123 | .button:hover { 124 | background-color: $grey-darker; 125 | } 126 | 127 | sup { 128 | color: rgb(220, 55, 45); 129 | vertical-align: top; 130 | position: relative; 131 | top: -0.5em; 132 | } 133 | 134 | a.navbar-item.coming-soon { 135 | cursor: not-allowed; 136 | text-decoration: none; 137 | } 138 | 139 | table a:hover { 140 | color: $white; 141 | } 142 | 143 | span.warning-sign:before { 144 | content: "\26A0"; 145 | margin-right: 5px; 146 | } 147 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Stk", 3 | "version": "0.1.0", 4 | "private": true, 5 | "description": "Stk is a free, real time stock quotes, charts and market overview.", 6 | "license": "MIT", 7 | "repository": "ninjarab/stk", 8 | "author": { 9 | "name": "Mehdi Beddiaf", 10 | "email": "mehdi.beddiaf@gmail.com" 11 | }, 12 | "scripts": { 13 | "build:ps": "pulp build --to dist/app.js && parcel build --no-source-maps dist/app.js", 14 | "build:styles": "parcel build dist/styles.scss --no-source-maps", 15 | "build": "npm run build:ps && npm run build:styles", 16 | "watch": "pulp -w build --to dist/app.js" 17 | }, 18 | "devDependencies": { 19 | "big-integer": "^1.6.28", 20 | "bulma": "^0.7.1", 21 | "echarts": "^4.1.0", 22 | "node-sass": "^4.9.3", 23 | "parcel-bundler": "^1.9.7", 24 | "pulp": "^12.2.0", 25 | "purescript": "^0.11.7", 26 | "purescript-psa": "^0.6.0" 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /src/Application.purs: -------------------------------------------------------------------------------- 1 | module Application (component, matchRoutes, Query) where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff (Aff, launchAff_) 6 | import Control.Monad.Aff.Class (class MonadAff) 7 | import Control.Monad.Aff.Console (log) 8 | import Control.Monad.Eff (Eff) 9 | import Control.Monad.Eff.Console (CONSOLE) 10 | import Control.Monad.Eff.Timer (TIMER) 11 | import Data.Either.Nested (Either5) 12 | import Data.Functor.Coproduct.Nested (Coproduct5) 13 | import Data.Maybe (Maybe(..)) 14 | import Footer as Footer 15 | import Halogen as H 16 | import Halogen.Aff as HA 17 | import Halogen.Component.ChildPath as CP 18 | import Halogen.ECharts as EC 19 | import Halogen.HTML as HH 20 | import Market as Market 21 | import Navbar as Navigation 22 | import Network.HTTP.Affjax as AX 23 | import Router as RT 24 | import Routing.Hash (matches) 25 | import Stock as Stock 26 | import Crypto as Crypto 27 | 28 | type State = RT.Routes 29 | 30 | data Query a = GOTO RT.Routes a 31 | 32 | type Input = Unit 33 | 34 | type Output = Void 35 | 36 | type Component m = H.Component HH.HTML Query Input Output m 37 | 38 | type ChildQuery = Coproduct5 Navigation.Query Market.Query Stock.Query Crypto.Query Footer.Query 39 | 40 | type ChildSlot = Either5 Unit Unit Unit Unit Unit 41 | 42 | type CustomEff eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 43 | 44 | component :: ∀ eff m. MonadAff ( CustomEff eff ) m => Component m 45 | component = 46 | H.parentComponent 47 | { initialState: const initialState 48 | , render 49 | , eval 50 | , receiver: const Nothing 51 | } 52 | where 53 | initialState :: State 54 | initialState = RT.Market 55 | 56 | render :: State -> H.ParentHTML Query ChildQuery ChildSlot m 57 | render state = HH.div_ 58 | [ HH.slot' CP.cp1 unit Navigation.component unit absurd 59 | , renderContent state 60 | , HH.slot' CP.cp5 unit Footer.component unit absurd 61 | ] 62 | 63 | renderContent :: RT.Routes -> H.ParentHTML Query ChildQuery ChildSlot m 64 | renderContent route = case route of 65 | RT.Crypto -> HH.slot' CP.cp4 unit Crypto.component unit absurd 66 | RT.Forex -> HH.h1_ [ HH.text "Forex coming soon" ] 67 | RT.Market -> HH.slot' CP.cp2 unit Market.component unit absurd 68 | RT.Stock -> HH.slot' CP.cp3 unit Stock.component (Nothing) absurd 69 | (RT.StockShow s) -> HH.slot' CP.cp3 unit Stock.component (Just s) absurd 70 | 71 | eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Output m 72 | eval = case _ of 73 | GOTO route next -> do 74 | H.liftAff $ log $ "Route >>>>>> " <> show route 75 | H.put route 76 | pure next 77 | 78 | matchRoutes :: forall eff. H.HalogenIO Query Void (Aff (HA.HalogenEffects eff)) 79 | -> Eff (HA.HalogenEffects eff) (Eff (HA.HalogenEffects eff) Unit) 80 | matchRoutes app = matches RT.routing (\old new -> redirects app old new) 81 | where 82 | redirects driver _old = launchAff_ <<< driver.query <<< H.action <<< GOTO 83 | -------------------------------------------------------------------------------- /src/Chart.purs: -------------------------------------------------------------------------------- 1 | module Chart where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Aff.Console (log) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | 10 | import Data.Array (filter) 11 | import Data.Either (Either(..)) 12 | import Data.Foldable as F 13 | import Data.Foreign (renderForeignError) 14 | import Data.Maybe (Maybe(..)) 15 | import Data.Tuple (Tuple(..)) 16 | import Data.Tuple.Nested ((/\)) 17 | 18 | import ECharts.Commands as E 19 | import ECharts.Monad (interpret, DSL') 20 | import ECharts.Types as ET 21 | import ECharts.Types.Phantom as ETP 22 | 23 | import Halogen as H 24 | import Halogen.ECharts as EC 25 | import Halogen.HTML as HH 26 | import Halogen.HTML.Events as HE 27 | import Halogen.HTML.Properties as HP 28 | 29 | import Color as C 30 | import Helpers (class_) 31 | import Models (OneDayChart, AllCharts) 32 | import Network.HTTP.Affjax as AX 33 | import Simple.JSON as JSON 34 | 35 | lineOptions ∷ String -> Array String -> Array Number -> DSL' ETP.OptionI 36 | lineOptions symbol xAxis yAxis = do 37 | E.useUTC true 38 | E.tooltip do 39 | E.trigger ET.AxisTrigger 40 | E.animationEnabled false 41 | F.for_ (C.fromHexString "#11ffee00") E.backgroundColor 42 | E.xAxis do 43 | E.axisType ET.Category 44 | E.items $ map ET.strItem xAxis 45 | 46 | E.yAxis do 47 | E.axisType ET.Value 48 | E.scale true 49 | E.splitLine $ E.lineStyle $ E.dashedLine 50 | 51 | E.series $ E.line do 52 | E.name symbol 53 | E.showSymbol false 54 | E.items $ map ET.numItem yAxis 55 | E.lineStyle do 56 | E.normalLineStyle $ E.color $ C.rgb 220 55 45 57 | E.itemStyle do 58 | E.normalItemStyle $ F.for_ (C.fromHexString "#FFFFFF") E.color 59 | E.symbol ET.Circle 60 | F.for_ (C.fromHexString "#0a0a0a") E.backgroundColor 61 | E.textStyle do 62 | F.for_ (C.fromHexString "#FFFFFF") E.color 63 | pure unit 64 | 65 | type ChartData = Either (Array OneDayChart) (Array AllCharts) 66 | 67 | type Input = Maybe String 68 | 69 | type State = 70 | { index :: Int 71 | , symbol :: Maybe String 72 | , loading :: Boolean 73 | , result :: Maybe ChartData 74 | , unitOfTime :: String 75 | } 76 | 77 | data UnitOfTime 78 | = Day 79 | | Month 80 | | Year 81 | | YearToDate 82 | 83 | data Query a 84 | = HandleSymbol (Maybe String) a 85 | | HandleEChartsMessage Int EC.EChartsMessage a 86 | | Range Int UnitOfTime a 87 | 88 | type AppEffects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 89 | 90 | type Component m = H.Component HH.HTML Query Input Void m 91 | type HTML q m = H.ParentHTML Query q Int m 92 | type DSL q m = H.ParentDSL State Query q Int Void m 93 | 94 | component :: ∀ eff m. MonadAff ( AppEffects eff ) m => Component m 95 | component = 96 | H.parentComponent 97 | { initialState 98 | , render 99 | , eval 100 | , receiver: HE.input HandleSymbol 101 | } 102 | where 103 | initialState ∷ Input -> State 104 | initialState i = { index: 1, symbol: i, loading: false, result: Nothing, unitOfTime: "1m" } 105 | 106 | render :: State -> HTML EC.EChartsQuery m 107 | render state = 108 | case state.result of 109 | Nothing -> 110 | HH.div_ [] 111 | Just chartData -> 112 | HH.div_ 113 | [ HH.h1 114 | [ class_ "is-size-3 has-text-centered" ] 115 | [ HH.text "Chart" ] 116 | , HH.slot state.index (EC.echarts Nothing) ({width: 880, height: 660} /\ unit) 117 | (Just <<< H.action <<< HandleEChartsMessage state.index) 118 | , HH.div 119 | [ class_ "columns" ] 120 | [ HH.div 121 | [ class_ "column is-half is-offset-one-quarter" ] 122 | [ HH.div 123 | [ class_ "buttons" ] 124 | [ HH.button 125 | [ class_ "button", HE.onClick (HE.input_ (Range 1 Day)), HP.disabled $ isDisabled "1d" state.unitOfTime ] 126 | [ HH.text "1d"] 127 | , HH.button 128 | [ class_ "button", HE.onClick (HE.input_ (Range 1 Month)), HP.disabled $ isDisabled "1m" state.unitOfTime ] 129 | [ HH.text "1m"] 130 | , HH.button 131 | [ class_ "button", HE.onClick (HE.input_ (Range 3 Month)), HP.disabled $ isDisabled "3m" state.unitOfTime ] 132 | [ HH.text "3m"] 133 | , HH.button 134 | [ class_ "button", HE.onClick (HE.input_ (Range 6 Month)), HP.disabled $ isDisabled "6m" state.unitOfTime ] 135 | [ HH.text "6m"] 136 | , HH.button 137 | [ class_ "button", HE.onClick (HE.input_ (Range 0 YearToDate)), HP.disabled $ isDisabled "ytd" state.unitOfTime ] 138 | [ HH.text "ytd"] 139 | , HH.button 140 | [ class_ "button", HE.onClick (HE.input_ (Range 1 Year)), HP.disabled $ isDisabled "1y" state.unitOfTime ] 141 | [ HH.text "1y"] 142 | , HH.button 143 | [ class_ "button", HE.onClick (HE.input_ (Range 2 Year)), HP.disabled $ isDisabled "2y" state.unitOfTime ] 144 | [ HH.text "2y"] 145 | , HH.button 146 | [ class_ "button", HE.onClick (HE.input_ (Range 5 Year)), HP.disabled $ isDisabled "5y" state.unitOfTime ] 147 | [ HH.text "5y"] 148 | ] 149 | ] 150 | ] 151 | ] 152 | where 153 | isDisabled :: String -> String -> Boolean 154 | isDisabled unit unitOfTime = unit == unitOfTime 155 | 156 | eval :: Query ~> DSL EC.EChartsQuery m 157 | eval = case _ of 158 | HandleEChartsMessage ix EC.Initialized next -> do 159 | pure next 160 | HandleEChartsMessage ix (EC.EventRaised evt) next -> do 161 | pure next 162 | HandleSymbol s next -> do 163 | case s of 164 | Nothing -> pure next 165 | Just symbol -> do 166 | oldState <- H.get 167 | 168 | H.modify (_ { loading = true, symbol = s }) 169 | 170 | response <- H.liftAff $ AX.get $ "https://api.iextrading.com/1.0/stock/" <> symbol <> "/chart/1m" 171 | 172 | case JSON.readJSON response.response of 173 | Left err -> do 174 | H.liftAff $ F.traverse_ (log <<< renderForeignError) err 175 | pure unit 176 | Right something -> 177 | H.modify (_ { loading = false, result = Just (Right something), unitOfTime = "1m" }) 178 | 179 | newState <- H.get 180 | 181 | case newState.result of 182 | Nothing -> pure unit 183 | Just chartData -> 184 | let (Tuple labels values) = parseChartData chartData 185 | in void $ H.query newState.index $ H.action $ EC.Set $ interpret $ lineOptions symbol labels values 186 | 187 | pure next 188 | 189 | Range value unitOfTime next -> do 190 | oldState <- H.get 191 | 192 | case oldState.symbol of 193 | Nothing -> pure next 194 | Just symbol -> do 195 | u <- case unitOfTime of 196 | Day -> pure "d" 197 | Month -> pure "m" 198 | Year -> pure "y" 199 | YearToDate -> pure "ytd" 200 | v <- if value == 0 then pure "" else pure $ show value 201 | H.modify (_ { loading = true }) 202 | response <- H.liftAff $ AX.get $ "https://api.iextrading.com/1.0/stock/" <> symbol <> "/chart/" <> v <> u 203 | 204 | case unitOfTime of 205 | Day -> 206 | case JSON.readJSON response.response of 207 | Left err -> do 208 | H.liftAff $ F.traverse_ (log <<< renderForeignError) err 209 | pure unit 210 | Right something -> 211 | let filtered = filter (\({average} :: OneDayChart) -> average > 0.0) something 212 | in H.modify (_ { loading = false, result = Just (Left filtered), unitOfTime = "1d" }) 213 | _ -> 214 | case JSON.readJSON response.response of 215 | Left err -> do 216 | H.liftAff $ F.traverse_ (log <<< renderForeignError) err 217 | pure unit 218 | Right something -> 219 | H.modify (_ { loading = false, result = Just (Right something), unitOfTime = v <> u }) 220 | 221 | newState <- H.get 222 | 223 | case newState.result of 224 | Nothing -> pure unit 225 | Just chartData -> 226 | let (Tuple labels values) = parseChartData chartData 227 | in void $ H.query newState.index $ H.action $ EC.Set $ interpret $ lineOptions symbol labels values 228 | 229 | pure next 230 | 231 | parseChartData :: ChartData -> Tuple (Array String) (Array Number) 232 | parseChartData chartData = do 233 | case chartData of 234 | Left oneDayData -> 235 | let labels = map (\({ label } :: OneDayChart) -> label) oneDayData 236 | values = map (\({ average } :: OneDayChart) -> average) oneDayData 237 | in Tuple labels values 238 | Right allCharstData -> 239 | let labels = map (\({ label } :: AllCharts) -> label) allCharstData 240 | values = map (\({ close } :: AllCharts) -> close) allCharstData 241 | in Tuple labels values 242 | -------------------------------------------------------------------------------- /src/Crypto.purs: -------------------------------------------------------------------------------- 1 | module Crypto where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Aff.Console (log) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | import Data.Array (mapWithIndex) 10 | import Data.Either (Either(..)) 11 | import Data.Foldable (traverse_) 12 | import Data.Foreign (renderForeignError) 13 | import Data.Maybe (Maybe(..)) 14 | import Halogen as H 15 | import Halogen.ECharts as EC 16 | import Halogen.HTML as HH 17 | import Models (Quote) 18 | import Network.HTTP.Affjax as AX 19 | import Quote as Quote 20 | import Simple.JSON as JSON 21 | import Helpers (class_) 22 | 23 | type Quotes = Array Quote 24 | 25 | type State = 26 | { loading :: Boolean 27 | , quotes :: Maybe Quotes 28 | } 29 | 30 | data Query a 31 | = Initialize a 32 | | Finalize a 33 | 34 | type Input = Unit 35 | 36 | type Output = Void 37 | 38 | newtype Slot = Slot Int 39 | derive newtype instance eqSlot :: Eq Slot 40 | derive newtype instance ordSlot :: Ord Slot 41 | 42 | type Component m = H.Component HH.HTML Query Input Output m 43 | 44 | type CustomEff eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 45 | 46 | component :: ∀ eff m. MonadAff ( CustomEff eff ) m => Component m 47 | component = 48 | H.lifecycleParentComponent 49 | { initialState: const initialState 50 | , render 51 | , eval 52 | , initializer: Just (H.action Initialize) 53 | , finalizer: Just (H.action Finalize) 54 | , receiver: const Nothing 55 | } 56 | where 57 | initialState :: State 58 | initialState = { loading: false, quotes: Nothing } 59 | 60 | render :: State -> H.ParentHTML Query Quote.Query Slot m 61 | render state = 62 | case state.quotes of 63 | Nothing -> 64 | HH.div_ [] 65 | Just (quotes :: Quotes) -> 66 | HH.div [ class_ "columns is-multiline is-desktop has-text-centered" ] $ mapWithIndex (\(i :: Int) ({ symbol } :: Quote ) -> renderQuote i symbol) quotes 67 | 68 | where 69 | renderQuote i s = 70 | let c = case i `mod` 2 of 71 | 0 -> "column is-4 is-offset-2" 72 | _ -> "column is-4" 73 | in 74 | HH.div 75 | [ class_ c ] 76 | [ HH.slot (Slot i) Quote.component (Just s) absurd ] 77 | 78 | eval :: Query ~> H.ParentDSL State Query Quote.Query Slot Output m 79 | eval = case _ of 80 | Initialize next -> do 81 | H.modify (_ { loading = true }) 82 | cryptoResponse <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/stock/market/crypto" 83 | 84 | case JSON.readJSON cryptoResponse.response of 85 | Left err -> do 86 | H.liftAff $ traverse_ (log <<< renderForeignError) err 87 | pure unit 88 | Right crypto -> 89 | H.modify (_ { quotes = (Just crypto) }) 90 | 91 | H.modify (_ { loading = false }) 92 | 93 | pure next 94 | Finalize next -> do 95 | pure next 96 | -------------------------------------------------------------------------------- /src/Footer.purs: -------------------------------------------------------------------------------- 1 | module Footer where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | 7 | import Halogen as H 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Properties as HP 10 | 11 | import Helpers (class_) 12 | 13 | type State = Unit 14 | 15 | data Query a = Unit a 16 | 17 | component :: forall m. H.Component HH.HTML Query Unit Void m 18 | component = 19 | H.component 20 | { initialState: const unit 21 | , render 22 | , eval 23 | , receiver: const Nothing 24 | } 25 | where 26 | render :: State -> H.ComponentHTML Query 27 | render state = 28 | HH.footer 29 | [ class_ "footer" ] 30 | [ HH.div 31 | [ class_ "container" ] 32 | [ HH.div 33 | [ class_ "content has-text-centered" ] 34 | [ HH.p_ 35 | [ HH.strong_ [ HH.text "Stk"] 36 | , HH.span_ [ HH.text " by " ] 37 | , HH.a [ HP.href "https://mehdi-beddiaf.com" ] [ HH.text "Mehdi Beddiaf." ] 38 | , HH.span_ [ HH.text " Powered by " ] 39 | , HH.a [ HP.href "http://www.purescript.org/" ] [ HH.text "PureScript."] 40 | , HH.span_ [ HH.text " Data provided for free by " ] 41 | , HH.a [ HP.href "https://iextrading.com/developer" ] [ HH.text "iEx." ] 42 | ] 43 | ] 44 | ] 45 | ] 46 | eval :: Query ~> H.ComponentDSL State Query Void m 47 | eval (Unit a) = pure a 48 | -------------------------------------------------------------------------------- /src/Helpers.purs: -------------------------------------------------------------------------------- 1 | module Helpers where 2 | 3 | import Prelude 4 | 5 | import Halogen as H 6 | import Halogen.HTML as HH 7 | import Halogen.HTML.Properties as HP 8 | 9 | class_ :: ∀ p i. String -> H.IProp ( "class" :: String | i ) p 10 | class_ = HP.class_ <<< HH.ClassName 11 | -------------------------------------------------------------------------------- /src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Eff (Eff) 6 | import Control.Monad.Eff.Class (liftEff) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | 10 | import Halogen.Aff as HA 11 | import Halogen.ECharts as EC 12 | import Halogen.VDom.Driver (runUI) 13 | 14 | import Network.HTTP.Affjax as AX 15 | 16 | import Application (component, matchRoutes) 17 | 18 | main :: Eff (HA.HalogenEffects ( EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER ) )) Unit 19 | main = HA.runHalogenAff do 20 | body <- HA.awaitBody 21 | app <- runUI component unit body 22 | liftEff $ matchRoutes app 23 | -------------------------------------------------------------------------------- /src/Market.purs: -------------------------------------------------------------------------------- 1 | module Market where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Eff.Console (CONSOLE) 7 | import Control.Monad.Eff.Timer (TIMER) 8 | 9 | import Data.Either (Either(..)) 10 | import Data.Fixed (Fixed, P10000, fromNumber, toNumber) 11 | import Data.Foreign (ForeignError) 12 | import Data.List.NonEmpty (NonEmptyList) 13 | import Data.Maybe (Maybe(..)) 14 | 15 | import Halogen as H 16 | import Halogen.ECharts as EC 17 | import Halogen.HTML as HH 18 | import Halogen.HTML.Events as HE 19 | 20 | import Helpers (class_) 21 | import Models (Quote) 22 | import Network.HTTP.Affjax as AX 23 | import Routing.Hash (setHash) 24 | import Simple.JSON as JSON 25 | 26 | type Quotes = Array Quote 27 | 28 | type State = 29 | { gainersLoading :: Boolean 30 | , losersLoading :: Boolean 31 | , mostActiveLoading :: Boolean 32 | , gainers :: Maybe Quotes 33 | , losers :: Maybe Quotes 34 | , mostActive :: Maybe Quotes 35 | } 36 | 37 | data Query a 38 | = Initialize a 39 | | Finalize a 40 | | Redirect String a 41 | 42 | type DSL q m = H.ComponentDSL State q Void m 43 | type Component m = H.Component HH.HTML Query Unit Void m 44 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 45 | 46 | component :: ∀ eff m. MonadAff ( Effects eff ) m => Component m 47 | component = 48 | H.lifecycleComponent 49 | { initialState: const initialState 50 | , render 51 | , eval 52 | , initializer: Just (H.action Initialize) 53 | , finalizer: Just (H.action Finalize) 54 | , receiver: const Nothing 55 | } 56 | where 57 | initialState :: State 58 | initialState = 59 | { gainersLoading: false 60 | , losersLoading: false 61 | , mostActiveLoading: false 62 | , gainers: Nothing 63 | , losers: Nothing 64 | , mostActive: Nothing 65 | } 66 | 67 | render :: State -> H.ComponentHTML Query 68 | render state = 69 | HH.div 70 | [ class_ "section" ] 71 | [ HH.div 72 | [ class_ "container" ] 73 | [ HH.div 74 | [ class_ "columns is-desktop" ] 75 | [ case state.mostActive of 76 | Nothing -> (renderNoDataAvailable "Most Active") 77 | Just mostActives -> ( renderTable "Most Active" mostActives ) 78 | , case state.gainers of 79 | Nothing -> (renderNoDataAvailable "Gainers") 80 | Just gainers -> ( renderTable "Gainers" gainers ) 81 | , case state.losers of 82 | Nothing -> (renderNoDataAvailable "Losers") 83 | Just losers -> ( renderTable "Losers" losers ) 84 | ] 85 | ] 86 | ] 87 | where 88 | renderNoDataAvailable title = 89 | HH.div 90 | [ class_ "column" ] 91 | [ HH.div_ 92 | [ HH.h1 93 | [ class_ "is-size-3 has-text-centered" ] 94 | [ HH.text title ] 95 | , HH.h2 96 | [ class_ "has-text-centered" ] 97 | [ HH.text "No data available" ] 98 | ] 99 | ] 100 | 101 | renderTable title quotes = 102 | HH.div 103 | [ class_ "column" ] 104 | [ HH.div_ 105 | [ HH.h1 106 | [ class_ "is-size-3 has-text-centered" ] 107 | [ HH.text title ] 108 | , HH.table 109 | [ class_ "table is-fullwidth is-hoverable summary" ] 110 | [ HH.thead_ 111 | [ HH.tr_ 112 | [ HH.td [ class_ "has-text-left" ] [ HH.text "Symbol" ] 113 | , HH.td [ class_ "has-text-centered" ] [ HH.text "Change" ] 114 | , HH.td [ class_ "has-text-right" ] [ HH.text "Last Price" ] 115 | ] 116 | ] 117 | , HH.tbody_ 118 | case state.losers of 119 | Nothing -> 120 | [ 121 | HH.tr_ [ HH.text "No data available" ] 122 | ] 123 | Just losers -> ( renderBody quotes ) 124 | ] 125 | ] 126 | ] 127 | 128 | renderBody quotes = renderRow <$> quotes 129 | 130 | renderRow (quote :: Quote) = 131 | HH.tr_ 132 | [ HH.td 133 | [ class_ "has-text-left" ] 134 | [ HH.a [ HE.onClick (HE.input_ (Redirect quote.symbol)) ] [ HH.text quote.symbol ] 135 | , HH.p [ class_ "has-text-grey is-size-7" ] [ HH.text quote.companyName ] 136 | ] 137 | , HH.td [ class_ "has-text-centered" ] 138 | [ case quote.change of 139 | Nothing -> 140 | HH.span [ class_ "is-grey"] [ HH.text $ "0" ] 141 | Just c -> 142 | HH.span [ class_ $ classAgainstPercent c] [ HH.text $ formatNumber c <> show c ] 143 | , formatPercent quote.changePercent 144 | ] 145 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show quote.latestPrice ] 146 | ] 147 | 148 | classAgainstPercent i = do 149 | case compare i 0.0 of 150 | GT -> "is-green" 151 | LT -> "is-red" 152 | EQ -> "is-grey" 153 | 154 | formatNumber n = if n >= 0.0 then "+" else "" 155 | 156 | formatPercent percent = 157 | let i = toNumber $ fromNumber percent * fromNumber 100.0 :: Fixed P10000 158 | c = classAgainstPercent i 159 | in HH.span [ class_ c ] [ HH.text $ "(" <> formatNumber i <> show i <> "%)" ] 160 | 161 | eval :: Query ~> DSL Query m 162 | eval = case _ of 163 | Initialize next -> do 164 | H.modify (_ { mostActiveLoading = true }) 165 | mostActiveResponse <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/stock/market/list/mostactive" 166 | let parsedMostActiveResponse = handleResponse $ JSON.readJSON mostActiveResponse.response 167 | H.modify (_ { mostActive = parsedMostActiveResponse, mostActiveLoading = false }) 168 | 169 | H.modify (_ { gainersLoading = true }) 170 | gainersResponse <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/stock/market/list/gainers" 171 | let parsedGainersResponse = handleResponse $ JSON.readJSON gainersResponse.response 172 | H.modify (_ { gainers = parsedGainersResponse, gainersLoading = false }) 173 | 174 | H.modify (_ { losersLoading = true }) 175 | losersResponse <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/stock/market/list/losers" 176 | let parsedLosersResponse = handleResponse $ JSON.readJSON losersResponse.response 177 | H.modify (_ { losers = parsedLosersResponse, losersLoading = false }) 178 | 179 | pure next 180 | 181 | Finalize next -> do 182 | pure next 183 | 184 | Redirect symbol next -> do 185 | H.liftEff $ setHash $ "stock/" <> symbol 186 | pure next 187 | 188 | handleResponse :: Either (NonEmptyList ForeignError) Quotes -> Maybe Quotes 189 | handleResponse r = do 190 | case r of 191 | Left err -> Nothing 192 | Right something -> Just something 193 | -------------------------------------------------------------------------------- /src/Models.purs: -------------------------------------------------------------------------------- 1 | module Models 2 | ( AllCharts(..) 3 | , Indice(..) 4 | , KeyStats(..) 5 | , OneDayChart(..) 6 | , Previous(..) 7 | , Quote(..) 8 | , Stats(..) 9 | , Symbol(..) 10 | , SystemEvent(..) 11 | , readKeyStatsJSON 12 | ) 13 | where 14 | 15 | import Prelude 16 | import Data.Maybe (Maybe) 17 | import Control.Alt ((<|>)) 18 | import Control.Monad.Except (runExcept) 19 | import Data.Either (Either(..)) 20 | import Data.Foreign (Foreign) 21 | import Data.Foreign as Foreign 22 | import Simple.JSON as JSON 23 | 24 | type AllCharts = 25 | { date :: String 26 | , open :: Number 27 | , high :: Number 28 | , low :: Number 29 | , close :: Number 30 | , volume :: Number 31 | , unadjustedVolume :: Number 32 | , change :: Number 33 | , changePercent :: Number 34 | , vwap :: Number 35 | , label :: String 36 | , changeOverTime :: Number 37 | } 38 | 39 | type Indice = 40 | { label :: String 41 | , change :: Number 42 | } 43 | 44 | type OneDayChart = 45 | { date :: String 46 | , minute :: String 47 | , label :: String 48 | , high :: Number 49 | , low :: Number 50 | , average :: Number 51 | , volume :: Number 52 | , notional :: Number 53 | , numberOfTrades :: Number 54 | , marketHigh :: Number 55 | , marketLow :: Number 56 | , marketAverage :: Number 57 | , marketVolume :: Number 58 | , marketNotional :: Number 59 | , marketNumberOfTrades :: Number 60 | , changeOverTime :: Maybe Number 61 | , marketChangeOverTime :: Maybe Number 62 | } 63 | 64 | type Previous = 65 | { symbol :: String 66 | , date :: String 67 | , open :: Number 68 | , high :: Number 69 | , low :: Number 70 | , close :: Number 71 | , volume :: Number 72 | , unadjustedVolume :: Number 73 | , change :: Number 74 | , changePercent :: Number 75 | , vwap :: Number 76 | } 77 | 78 | type Quote = 79 | { symbol :: String 80 | , companyName :: String 81 | , primaryExchange :: String 82 | , sector :: String 83 | , calculationPrice :: String 84 | , open :: Number 85 | , openTime :: Number 86 | , close :: Number 87 | , closeTime :: Number 88 | , high :: Maybe Number 89 | , low :: Maybe Number 90 | , latestPrice :: Number 91 | , latestSource :: String 92 | , latestTime :: String 93 | , latestUpdate :: Number 94 | , latestVolume :: Maybe Number 95 | , iexRealtimePrice :: Maybe Number 96 | , iexRealtimeSize :: Maybe Int 97 | , iexLastUpdated :: Maybe Number 98 | , delayedPrice :: Maybe Number 99 | , delayedPriceTime :: Maybe Number 100 | , previousClose :: Number 101 | , change :: Maybe Number 102 | , changePercent :: Number 103 | , iexMarketPercent :: Maybe Number 104 | , iexVolume :: Maybe Int 105 | , avgTotalVolume :: Maybe Number 106 | , iexBidPrice :: Maybe Number 107 | , iexBidSize :: Maybe Int 108 | , iexAskPrice :: Maybe Number 109 | , iexAskSize :: Maybe Int 110 | , marketCap :: Maybe Number 111 | , peRatio :: Maybe Number 112 | , week52High :: Maybe Number 113 | , week52Low :: Maybe Number 114 | , ytdChange :: Maybe Number 115 | } 116 | 117 | type Stats = 118 | { companyName :: String 119 | , marketcap :: Number 120 | , beta :: Number 121 | , week52high :: Number 122 | , week52low :: Number 123 | , week52change :: Number 124 | , dividendRate :: Number 125 | , dividendYield :: Number 126 | , exDividendDate :: Either Int String 127 | , latestEPS :: Number 128 | , latestEPSDate :: String 129 | , symbol :: String 130 | } 131 | 132 | readEitherImpl 133 | :: forall a b 134 | . JSON.ReadForeign a 135 | => JSON.ReadForeign b 136 | => Foreign 137 | -> Foreign.F (Either a b) 138 | readEitherImpl f 139 | = Left <$> JSON.readImpl f 140 | <|> Right <$> JSON.readImpl f 141 | 142 | type KeyStats = { stats :: Stats, quote :: Quote } 143 | 144 | readKeyStatsJSON :: String -> Either Foreign.MultipleErrors KeyStats 145 | readKeyStatsJSON ks = runExcept do 146 | keyStats <- JSON.readJSON' ks 147 | exDividendDate <- readEitherImpl keyStats.stats.exDividendDate 148 | let stats = keyStats.stats { exDividendDate = exDividendDate } 149 | pure $ keyStats { stats = stats } 150 | 151 | type Symbol = 152 | { symbol :: String 153 | , name :: String 154 | , isEnabled :: Boolean 155 | } 156 | 157 | type SystemEvent = 158 | { systemEvent :: Maybe String 159 | , timestamp :: Maybe Number 160 | } 161 | -------------------------------------------------------------------------------- /src/Navbar.purs: -------------------------------------------------------------------------------- 1 | module Navbar where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Eff.Console (CONSOLE) 7 | import Control.Monad.Eff.Timer (TIMER) 8 | 9 | import Data.Array ((:)) 10 | import Data.Either (Either(..)) 11 | import Data.Fixed (Fixed, P10000, fromNumber, toNumber) 12 | import Data.Foreign (ForeignError) 13 | import Data.List.NonEmpty (NonEmptyList) 14 | import Data.Maybe (Maybe(..)) 15 | 16 | import Halogen (AttrName(..)) 17 | import Halogen as H 18 | import Halogen.ECharts as EC 19 | import Halogen.HTML as HH 20 | import Halogen.HTML.Properties as HP 21 | import Halogen.HTML.Properties.ARIA as ARIA 22 | 23 | import Helpers (class_) 24 | import Models (Indice, SystemEvent) 25 | import Network.HTTP.Affjax as AX 26 | import Simple.JSON as JSON 27 | 28 | type Indices = Array Indice 29 | 30 | type GlobalData = { indices :: Indices, systemEvent :: SystemEvent } 31 | 32 | type State = 33 | { loading :: Boolean 34 | , result :: Maybe GlobalData 35 | } 36 | 37 | data Query a 38 | = Initialize a 39 | | Finalize a 40 | 41 | type DSL q m = H.ComponentDSL State q Void m 42 | type Component m = H.Component HH.HTML Query Unit Void m 43 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 44 | 45 | component :: ∀ eff m. MonadAff ( Effects eff ) m => Component m 46 | component = 47 | H.lifecycleComponent 48 | { initialState: const initialState 49 | , render 50 | , eval 51 | , initializer: Just (H.action Initialize) 52 | , finalizer: Just (H.action Finalize) 53 | , receiver: const Nothing 54 | } 55 | where 56 | 57 | initialState :: State 58 | initialState = { loading: false, result: Nothing } 59 | 60 | render :: State -> H.ComponentHTML Query 61 | render st = 62 | HH.nav 63 | [ class_ "navbar", ARIA.label "navigation", ARIA.label "main navigation" ] 64 | [ HH.div 65 | [ class_ "navbar-brand" ] 66 | [ HH.a 67 | [ class_ "navbar-item has-text-weight-bold is-size-3", HP.href "#market" ] 68 | [ HH.span_ [ HH.text "Stk" ] 69 | , HH.img [ HP.src "logo.svg" ] 70 | ] 71 | , HH.div 72 | [ class_ "navbar-burger", HP.attr (AttrName "data-target") "navbar-burger" ] 73 | [ HH.span_ [ ] 74 | , HH.span_ [ ] 75 | , HH.span_ [ ] 76 | ] 77 | ] 78 | , HH.div 79 | [ class_ "navbar-menu", HP.id_ "navbar-burger" ] 80 | [ HH.div 81 | [ class_ "navbar-start" ] 82 | [ HH.a 83 | [ class_ "navbar-item", HP.href "#market" ] 84 | [ HH.text "Market" ] 85 | , HH.a 86 | [ class_ "navbar-item", HP.href "#stock" ] 87 | [ HH.text "Stocks" ] 88 | , HH.a 89 | [ class_ "navbar-item", HP.href "#crypto" ] 90 | [ HH.text "Crypto Currencies" ] 91 | , HH.a 92 | [ class_ "navbar-item coming-soon" ] 93 | [ HH.text "Foreign Exchange" 94 | , HH.sup_ [ HH.text "soon" ] 95 | ] 96 | ] 97 | , HH.div 98 | [ class_ "navbar-end" ] 99 | case st.result of 100 | Nothing -> [] 101 | Just ({ indices, systemEvent } :: GlobalData) -> 102 | (renderSystemEvent systemEvent : renderIndices indices) 103 | ] 104 | ] 105 | where 106 | renderSystemEvent (systemEvent :: SystemEvent) = do 107 | case systemEvent.systemEvent of 108 | Nothing -> 109 | HH.div 110 | [ class_ "navbar-item" ] 111 | [ HH.span 112 | [ class_ "is-red warning-sign" ] 113 | [ HH.text "Market is closed" ] 114 | ] 115 | Just value -> 116 | HH.div 117 | [ class_ "navbar-item" ] 118 | case value of 119 | "S" -> 120 | [ HH.span 121 | [ class_ "has-text-link warning-sign" ] 122 | [ HH.text "Pre-market" ] 123 | ] 124 | "M" -> 125 | [ HH.span 126 | [ class_ "has-text-warning warning-sign" ] 127 | [ HH.text "Post-market" ] 128 | ] 129 | "R" -> 130 | [ HH.span 131 | [ class_ "is-green warning-sign" ] 132 | [ HH.text "Market is open" ] 133 | ] 134 | _ -> 135 | [ HH.span 136 | [ class_ "is-red warning-sign" ] 137 | [ HH.text "Market is closed" ] 138 | ] 139 | 140 | renderIndices indices = renderIndice <$> indices 141 | 142 | renderIndice (indice :: Indice) = 143 | HH.div 144 | [ class_ "navbar-item" ] 145 | [ HH.text indice.label 146 | , formatIndice indice.change 147 | ] 148 | 149 | formatIndice indice = 150 | let i = toNumber $ fromNumber indice * fromNumber 100.0 :: Fixed P10000 151 | c = case compare i 0.0 of 152 | GT -> "is-green-up" 153 | LT -> "is-red-down" 154 | EQ -> "is-grey-eq" 155 | in HH.span [ class_ c ] [ HH.text $ show i <> "%" ] 156 | 157 | eval :: Query ~> DSL Query m 158 | eval = case _ of 159 | Initialize next -> do 160 | H.modify (_ { loading = true }) 161 | response <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/stock/DIA/app-global-data" 162 | let parsedResponse = handleResponse $ JSON.readJSON response.response 163 | H.modify (_ { loading = false, result = parsedResponse }) 164 | pure next 165 | Finalize next -> do 166 | pure next 167 | 168 | handleResponse :: Either (NonEmptyList ForeignError) GlobalData -> Maybe GlobalData 169 | handleResponse r = do 170 | case r of 171 | Left err -> Nothing 172 | Right something -> Just something 173 | -------------------------------------------------------------------------------- /src/Quote.purs: -------------------------------------------------------------------------------- 1 | module Quote where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Aff.Console (log) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | import Data.Either (Either(..)) 10 | import Data.Fixed (Fixed, P10000, fromNumber, toNumber) 11 | import Data.Foldable (traverse_) 12 | import Data.Foreign (renderForeignError) 13 | import Data.Maybe (Maybe(..)) 14 | import Halogen as H 15 | import Halogen.ECharts as EC 16 | import Halogen.HTML as HH 17 | import Halogen.HTML.Events as HE 18 | import Helpers (class_) 19 | import Models (Quote) 20 | import Network.HTTP.Affjax as AX 21 | import Simple.JSON as JSON 22 | 23 | type Input = Maybe String 24 | 25 | type State = 26 | { loading :: Boolean 27 | , result :: Maybe Quote 28 | , symbol :: Maybe String 29 | } 30 | 31 | data Query a = HandleSymbol (Maybe String) a 32 | 33 | type DSL q m = H.ComponentDSL State q Void m 34 | type Component m = H.Component HH.HTML Query Input Void m 35 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 36 | 37 | component :: ∀ eff m. MonadAff ( Effects eff ) m => Component m 38 | component = 39 | H.component 40 | { initialState 41 | , render 42 | , eval 43 | , receiver: HE.input HandleSymbol 44 | } 45 | where 46 | initialState :: Input -> State 47 | initialState i = { loading: false, result: Nothing, symbol: i } 48 | 49 | render :: State -> H.ComponentHTML Query 50 | render state = 51 | case state.result of 52 | Nothing -> 53 | HH.div 54 | [ class_ "empty-box" ] 55 | [ ] 56 | Just ({ companyName, symbol, latestPrice, change, changePercent, latestSource, latestTime } :: Quote) -> 57 | HH.div 58 | [ class_ "content" ] 59 | [ HH.p [ class_ "is-size-5 has-text-weight-bold" ] [ HH.text $ companyName <> " (" <> symbol <> ")" ] 60 | , HH.p_ 61 | [ HH.span [ class_ "is-size-1 has-text-weight-bold"] [ HH.text $ show latestPrice ] 62 | , case change of 63 | Nothing -> 64 | HH.span [ class_ "is-grey" ] [ HH.text $ "0" ] 65 | Just c -> 66 | HH.span [ class_ $ classAgainstPercent c] [ HH.text $ formatNumber c <> show c ] 67 | , formatPercent changePercent 68 | ] 69 | , HH.p [ class_ "is-size-7 is-grey" ] [ HH.text $ latestSource <> " as of " <> latestTime ] 70 | ] 71 | 72 | where 73 | classAgainstPercent i = 74 | let color = case compare i 0.0 of 75 | GT -> "is-green" 76 | LT -> "is-red" 77 | EQ -> "is-grey" 78 | in color <> " is-size-3" 79 | 80 | formatNumber n = if n >= 0.0 then "+" else "" 81 | 82 | formatPercent percent = 83 | let i = toNumber $ fromNumber percent * fromNumber 100.0 :: Fixed P10000 84 | c = classAgainstPercent i 85 | in HH.span [ class_ c ] [ HH.text $ "(" <> formatNumber i <> show i <> "%)" ] 86 | 87 | eval :: Query ~> DSL Query m 88 | eval = case _ of 89 | HandleSymbol s next -> do 90 | case s of 91 | Nothing -> pure next 92 | Just symbol -> do 93 | oldState <- H.get 94 | 95 | H.modify (_ { loading = true, symbol = s }) 96 | 97 | response <- H.liftAff $ AX.get $ "https://api.iextrading.com/1.0/stock/" <> symbol <> "/quote" 98 | 99 | case JSON.readJSON response.response of 100 | Left err -> do 101 | H.liftAff $ traverse_ (log <<< renderForeignError) err 102 | pure unit 103 | Right something -> 104 | H.modify (_ { loading = false, result = Just something }) 105 | 106 | pure next 107 | -------------------------------------------------------------------------------- /src/Router.purs: -------------------------------------------------------------------------------- 1 | module Router where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Routing.Match (Match) 7 | import Routing.Match.Class (lit, str) 8 | 9 | data Routes 10 | = Crypto 11 | | Forex 12 | | Market 13 | | Stock 14 | | StockShow String 15 | 16 | instance showRoutes :: Show Routes where 17 | show Crypto = "crypto" 18 | show Forex = "forex" 19 | show Market = "market" 20 | show Stock = "stock" 21 | show (StockShow s) = "stock " <> s 22 | 23 | routing :: Match Routes 24 | routing = crypto <|> forex <|> market <|> stockShow <|> stock 25 | where 26 | crypto = Crypto <$ lit "crypto" 27 | forex = Forex <$ lit "forex" 28 | market = Market <$ lit "market" 29 | stockShow = StockShow <$ lit "stock" <*> str 30 | stock = Stock <$ lit "stock" 31 | -------------------------------------------------------------------------------- /src/Stock.purs: -------------------------------------------------------------------------------- 1 | module Stock where 2 | 3 | import Prelude 4 | 5 | import Chart as Chart 6 | import Control.Monad.Aff.Class (class MonadAff) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | import Data.Either.Nested (Either4) 10 | import Data.Functor.Coproduct.Nested (Coproduct4) 11 | import Data.Maybe (Maybe(..)) 12 | import Data.String (Pattern(..), stripPrefix) 13 | import Halogen as H 14 | import Halogen.Component.ChildPath as CP 15 | import Halogen.ECharts as EC 16 | import Halogen.HTML as HH 17 | import Halogen.HTML.Events as HE 18 | import Helpers (class_) 19 | import Network.HTTP.Affjax as AX 20 | import Quote as Quote 21 | import Routing.Hash (getHash) 22 | import Summary as Summary 23 | import Typeahead.Container as Typeahead 24 | 25 | type State = { symbol :: Maybe String } 26 | 27 | data Query a 28 | = HandleSelection Typeahead.Message a 29 | | Receive (Maybe String) a 30 | | Initialize a 31 | | Finalize a 32 | 33 | type Input = Maybe String 34 | 35 | type Output = Void 36 | 37 | type Component m = H.Component HH.HTML Query Input Output m 38 | 39 | type ChildQuery = Coproduct4 Quote.Query Typeahead.Query Summary.Query Chart.Query 40 | 41 | type ChildSlot = Either4 Unit Unit Unit Unit 42 | 43 | type CustomEff eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 44 | 45 | component :: ∀ eff m. MonadAff ( CustomEff eff ) m => Component m 46 | component = 47 | H.lifecycleParentComponent 48 | { initialState 49 | , render 50 | , eval 51 | , initializer: Just (H.action Initialize) 52 | , finalizer: Just (H.action Finalize) 53 | , receiver: HE.input Receive 54 | } 55 | where 56 | initialState :: Input -> State 57 | initialState i = { symbol: i } 58 | 59 | render :: State -> H.ParentHTML Query ChildQuery ChildSlot m 60 | render state = 61 | HH.div_ 62 | [ HH.div_ 63 | [ HH.section 64 | [ class_ "custom-section" ] 65 | [ HH.div 66 | [ class_ "container" ] 67 | [ HH.div_ 68 | [ HH.div 69 | [ class_ "columns is-mobile" ] 70 | [ HH.div 71 | [ class_ "column is-half is-offset-one-quarter" ] 72 | [ HH.slot' CP.cp1 unit Quote.component state.symbol absurd ] 73 | ] 74 | ] 75 | ] 76 | ] 77 | ] 78 | , HH.slot' CP.cp2 unit Typeahead.component unit (HE.input HandleSelection) 79 | , HH.div 80 | [ class_ "section" ] 81 | [ HH.div 82 | [ class_ "container" ] 83 | [ HH.div 84 | [ class_ "columns is-desktop"] 85 | [ HH.div 86 | [ class_ "column is-one-third-desktop" ] 87 | [ HH.slot' CP.cp3 unit Summary.component state.symbol absurd ] 88 | , HH.div 89 | [ class_ "column is-two-third-desktop" ] 90 | [ HH.slot' CP.cp4 unit Chart.component state.symbol absurd ] 91 | ] 92 | ] 93 | ] 94 | ] 95 | 96 | eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Output m 97 | eval = case _ of 98 | Initialize next -> do 99 | h <- H.liftEff getHash 100 | case stripPrefix (Pattern "stock/") h of 101 | Nothing -> 102 | pure unit 103 | Just symbol -> do 104 | H.modify (_ { symbol = Just symbol }) 105 | pure next 106 | Finalize next -> do 107 | pure next 108 | HandleSelection (Typeahead.Selected item) next -> do 109 | H.modify (_ { symbol = Just item }) 110 | pure next 111 | Receive s next -> do 112 | H.modify (_ { symbol = s }) 113 | pure next 114 | -------------------------------------------------------------------------------- /src/Summary.purs: -------------------------------------------------------------------------------- 1 | module Summary where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Aff.Console (log) 7 | import Control.Monad.Eff.Console (CONSOLE) 8 | import Control.Monad.Eff.Timer (TIMER) 9 | 10 | import Data.Either (Either(..)) 11 | import Data.Fixed (Fixed, P10000, fromNumber, toNumber) 12 | import Data.Foldable (traverse_) 13 | import Data.Foreign (renderForeignError) 14 | import Data.Formatter.Number (Formatter(..), format) 15 | import Data.Maybe (Maybe(..)) 16 | 17 | import Halogen as H 18 | import Halogen.ECharts as EC 19 | import Halogen.HTML as HH 20 | import Halogen.HTML.Events as HE 21 | 22 | import Helpers (class_) 23 | import Models (Stats, Quote, KeyStats, readKeyStatsJSON) 24 | import Network.HTTP.Affjax as AX 25 | 26 | fmt ∷ Formatter 27 | fmt = Formatter 28 | { comma: true 29 | , before: 0 30 | , after: 0 31 | , abbreviations: false 32 | , sign: false 33 | } 34 | 35 | type Input = Maybe String 36 | 37 | type State = 38 | { loading :: Boolean 39 | , result :: Maybe KeyStats 40 | , symbol :: Maybe String 41 | } 42 | 43 | data Query a = HandleSymbol (Maybe String) a 44 | 45 | type DSL q m = H.ComponentDSL State q Void m 46 | type Component m = H.Component HH.HTML Query Input Void m 47 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 48 | 49 | component :: ∀ eff m. MonadAff ( Effects eff ) m => Component m 50 | component = 51 | H.component 52 | { initialState 53 | , render 54 | , eval 55 | , receiver: HE.input HandleSymbol 56 | } 57 | where 58 | initialState :: Input -> State 59 | initialState i = { loading: false, result: Nothing, symbol: i } 60 | 61 | render :: State -> H.ComponentHTML Query 62 | render state = 63 | case state.result of 64 | Nothing -> 65 | HH.div_ [] 66 | Just ({stats : (s :: Stats), quote : (q :: Quote) } :: KeyStats) -> 67 | HH.div_ 68 | [ HH.h1 69 | [ class_ "is-size-3 has-text-centered" ] 70 | [ HH.text "Summary" ] 71 | , HH.table 72 | [ class_ "table is-hoverable summary" ] 73 | [ HH.tbody_ 74 | [ HH.tr_ 75 | [ HH.td_ [ HH.text "Volume" ] 76 | , case q.latestVolume of 77 | Nothing -> 78 | HH.td [ class_ "has-text-right" ] [ HH.text "0" ] 79 | Just value -> 80 | HH.td [ class_ "has-text-right" ] [ HH.text $ format fmt value ] 81 | ] 82 | , HH.tr_ 83 | [ HH.td_ [ HH.text "Avg daily volume" ] 84 | , HH.td [ class_ "has-text-right" ] 85 | [ case q.avgTotalVolume of 86 | Nothing -> 87 | HH.td [ class_ "has-text-right" ] [ HH.text "0" ] 88 | Just avg -> 89 | HH.td [ class_ "has-text-right" ] [ HH.text $ format fmt avg ] 90 | ] 91 | ] 92 | , HH.tr_ 93 | [ HH.td_ [ HH.text "Previous close" ] 94 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show q.previousClose ] 95 | ] 96 | , HH.tr_ 97 | [ HH.td_ [ HH.text "52 week range" ] 98 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show s.week52low <> " - " <> show s.week52high ] 99 | ] 100 | , HH.tr_ 101 | [ HH.td_ [ HH.text "Market cap" ] 102 | , HH.td [ class_ "has-text-right" ] [ HH.text $ formatMarketCap s.marketcap ] 103 | ] 104 | , HH.tr_ 105 | [ HH.td_ [ HH.text "Beta" ] 106 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show $ formatNumber s.beta ] 107 | ] 108 | , HH.tr_ 109 | [ HH.td_ [ HH.text "Latest EPS" ] 110 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show s.latestEPS ] 111 | ] 112 | , HH.tr_ 113 | [ HH.td_ [ HH.text "Latest EPS date" ] 114 | , HH.td [ class_ "has-text-right" ] [ HH.text s.latestEPSDate ] 115 | ] 116 | , HH.tr_ 117 | [ HH.td_ [ HH.text "Dividend & yield" ] 118 | , HH.td [ class_ "has-text-right" ] [ HH.text $ show s.dividendRate <> formatPercent s.dividendYield ] 119 | ] 120 | , HH.tr_ 121 | [ HH.td_ [ HH.text "Ex-dividend date" ] 122 | , case s.exDividendDate of 123 | Left i -> 124 | HH.td [ class_ "has-text-right" ] [ HH.text "0" ] 125 | Right e -> 126 | HH.td [ class_ "has-text-right" ] [ HH.text $ show e ] 127 | ] 128 | , HH.tr_ 129 | [ HH.td_ [ HH.text "P/E ratio" ] 130 | , case q.peRatio of 131 | Nothing -> 132 | HH.td [ class_ "has-text-right" ] [ HH.text "0" ] 133 | Just value -> 134 | HH.td [ class_ "has-text-right" ] [ HH.text $ show value ] 135 | ] 136 | ] 137 | ] 138 | ] 139 | where 140 | formatNumber n = toNumber $ fromNumber n :: Fixed P10000 141 | 142 | formatPercent percent = 143 | let i = toNumber $ fromNumber percent * fromNumber 100.0 :: Fixed P10000 144 | in " (" <> show i <> "%)" 145 | 146 | formatMarketCap m = 147 | let n = m / 1000000000.0 148 | in if n < 1.0 149 | then (show $ formatNumber $ m / 1000000.0) <> "M" 150 | else (show $ formatNumber n) <> "B" 151 | 152 | eval :: Query ~> DSL Query m 153 | eval = case _ of 154 | HandleSymbol s next -> do 155 | case s of 156 | Nothing -> pure next 157 | Just symbol -> do 158 | oldState <- H.get 159 | 160 | H.modify (_ { loading = true, symbol = s }) 161 | 162 | response <- H.liftAff $ AX.get $ "https://api.iextrading.com/1.0/stock/" <> symbol <> "/batch?types=stats,quote" 163 | 164 | case readKeyStatsJSON response.response of 165 | Left err -> do 166 | H.liftAff $ traverse_ (log <<< renderForeignError) err 167 | pure unit 168 | Right something -> 169 | H.modify (_ { loading = false, result = Just something }) 170 | 171 | pure next 172 | -------------------------------------------------------------------------------- /src/Typeahead/Component.purs: -------------------------------------------------------------------------------- 1 | module Typeahead.Component where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Aff.Console (CONSOLE, log) 7 | import Control.Monad.Eff.Timer (TIMER) 8 | 9 | import Data.Array (elemIndex, mapWithIndex, filter, take, (:)) 10 | import Data.Foldable (length, traverse_) 11 | import Data.Maybe (Maybe(..)) 12 | import Data.String (Pattern(..), contains, toLower) 13 | 14 | import Halogen as H 15 | import Halogen.ECharts as EC 16 | import Halogen.HTML as HH 17 | import Halogen.HTML.Events as HE 18 | import Halogen.HTML.Properties as HP 19 | import Halogen.HTML.Properties.ARIA as ARIA 20 | 21 | import Helpers (class_) 22 | import Network.HTTP.Affjax as AX 23 | 24 | import Select as Select 25 | import Select.Utils.Setters as Setters 26 | 27 | type TypeaheadItem = String 28 | 29 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 30 | 31 | data Query a 32 | = Log String a 33 | | HandleInputContainer (Select.Message Query TypeaheadItem) a 34 | 35 | type State = 36 | { items :: Array TypeaheadItem 37 | , selected :: TypeaheadItem 38 | , keepOpen :: Boolean } 39 | 40 | type Input = { items :: Array String, keepOpen :: Boolean } 41 | data Message = Selected String 42 | 43 | type ChildSlot = Unit 44 | type ChildQuery eff = Select.Query Query TypeaheadItem eff 45 | 46 | component :: ∀ m e 47 | . MonadAff ( Effects e ) m 48 | => H.Component HH.HTML Query Input Message m 49 | component = 50 | H.parentComponent 51 | { initialState 52 | , render 53 | , eval 54 | , receiver: const Nothing 55 | } 56 | where 57 | initialState :: Input -> State 58 | initialState i = { items: i.items, selected: "", keepOpen: i.keepOpen } 59 | 60 | render 61 | :: State 62 | -> H.ParentHTML Query (ChildQuery (Effects e)) ChildSlot m 63 | render st = 64 | HH.div 65 | [ class_ "columns is-mobile" ] 66 | [ 67 | HH.div 68 | [ class_ "column is-half is-offset-one-quarter" ] 69 | [ HH.slot unit Select.component input (HE.input HandleInputContainer) ] 70 | ] 71 | 72 | where 73 | input = 74 | { initialSearch: Nothing 75 | , debounceTime: Nothing 76 | , inputType: Select.TextInput 77 | , items: st.items 78 | , render: renderInputContainer 79 | } 80 | 81 | eval 82 | :: Query 83 | ~> H.ParentDSL State Query (ChildQuery (Effects e)) ChildSlot Message m 84 | eval = case _ of 85 | Log str a -> a <$ do 86 | H.liftAff $ log str 87 | 88 | HandleInputContainer m a -> a <$ case m of 89 | Select.Emit q -> eval q 90 | 91 | Select.Searched search -> do 92 | st <- H.get 93 | let newItems = filterItems search st.items 94 | index = elemIndex search st.items 95 | _ <- H.query unit $ Select.replaceItems newItems 96 | traverse_ (H.query unit <<< Select.highlight <<< Select.Index) index 97 | 98 | Select.Selected item -> do 99 | st <- H.get 100 | 101 | _ <- if st.keepOpen 102 | then pure unit 103 | else do 104 | _ <- H.query unit $ Select.setVisibility Select.Off 105 | pure unit 106 | 107 | if length (filter ((==) item) st.items) > 0 108 | then H.modify _ { selected = item } 109 | else H.modify _ 110 | { items = ( item : st.items ) 111 | , selected = item } 112 | 113 | H.raise $ Selected item 114 | 115 | otherwise -> pure unit 116 | 117 | filterItems :: TypeaheadItem -> Array TypeaheadItem -> Array TypeaheadItem 118 | filterItems str = filter (\i -> contains (Pattern (toLower str)) $ toLower i) 119 | 120 | renderInputContainer :: ∀ e 121 | . Select.State TypeaheadItem e 122 | -> Select.ComponentHTML Query TypeaheadItem e 123 | renderInputContainer state = HH.div_ [ renderInput, renderContainer ] 124 | where 125 | renderInput = 126 | HH.div 127 | [ class_ "field" ] 128 | [ HH.div 129 | [ class_ "control"] 130 | [ 131 | HH.input $ Setters.setInputProps 132 | [ class_ "input is-medium", HP.placeholder "Start typing a symbol or a company..." ] 133 | ] 134 | ] 135 | 136 | renderContainer = 137 | HH.div [ class_ "field" ] 138 | $ if state.visibility == Select.Off then [] 139 | else [ renderItems $ renderItem `mapWithIndex` (take 10 state.items) ] 140 | where 141 | renderItems html = 142 | HH.div 143 | ( Setters.setContainerProps 144 | [ class_ "dropdown is-active" ] 145 | ) 146 | [ HH.div 147 | [ class_ "dropdown-menu", HP.id_ "dropdown-menu", ARIA.role "menu" ] 148 | [ 149 | HH.div 150 | [ class_ "dropdown-content" ] 151 | html 152 | ] 153 | ] 154 | 155 | renderItem index item = 156 | HH.a ( Setters.setItemProps index [ class_ "dropdown-item" ] ) [ HH.text item ] 157 | -------------------------------------------------------------------------------- /src/Typeahead/Container.purs: -------------------------------------------------------------------------------- 1 | module Typeahead.Container where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Aff.Class (class MonadAff) 6 | import Control.Monad.Eff.Console (CONSOLE) 7 | import Control.Monad.Eff.Timer (TIMER) 8 | 9 | import Data.Array (head) 10 | import Data.Either (Either(..)) 11 | import Data.Foreign (ForeignError) 12 | import Data.List.NonEmpty (NonEmptyList) 13 | import Data.Maybe (Maybe(..)) 14 | import Data.String (Pattern(..), split) 15 | 16 | import Halogen as H 17 | import Halogen.ECharts as EC 18 | import Halogen.HTML as HH 19 | import Halogen.HTML.Events as HE 20 | import Halogen.HTML.Properties as HP 21 | 22 | import Helpers (class_) 23 | import Models (Symbol) 24 | import Network.HTTP.Affjax as AX 25 | import Routing.Hash (setHash) 26 | import Simple.JSON as JSON 27 | import Typeahead.Component as Typeahead 28 | 29 | type Symbols = Array Symbol 30 | 31 | type State = 32 | { loading :: Boolean 33 | , result :: Maybe Symbols 34 | } 35 | 36 | type Input = Unit 37 | 38 | data Message = Selected String 39 | 40 | data Query a 41 | = Initialize a 42 | | Finalize a 43 | | HandleSelection Typeahead.Message a 44 | 45 | type Component m = H.Component HH.HTML Query Unit Message m 46 | type DSL q m = H.ParentDSL State Query q Unit Message m 47 | type HTML q m = H.ParentHTML Query q Unit m 48 | 49 | type Effects eff = EC.EChartsEffects ( console :: CONSOLE, ajax :: AX.AJAX, timer :: TIMER | eff ) 50 | 51 | component :: ∀ eff m. MonadAff ( Effects eff ) m => Component m 52 | component = 53 | H.lifecycleParentComponent 54 | { initialState: const initialState 55 | , render 56 | , eval 57 | , initializer: Just (H.action Initialize) 58 | , finalizer: Just (H.action Finalize) 59 | , receiver: const Nothing 60 | } 61 | where 62 | initialState :: State 63 | initialState = { loading: false, result: Nothing } 64 | 65 | eval :: Query ~> DSL Typeahead.Query m 66 | eval = case _ of 67 | Initialize next -> do 68 | H.modify (_ { loading = true }) 69 | response <- H.liftAff $ AX.get "https://api.iextrading.com/1.0/ref-data/symbols" 70 | let parsedResponse = handleResponse $ JSON.readJSON response.response 71 | H.modify (_ { loading = false, result = parsedResponse }) 72 | pure next 73 | 74 | Finalize next -> do 75 | pure next 76 | 77 | HandleSelection (Typeahead.Selected string) next -> do 78 | case (head $ split (Pattern " - ") string) of 79 | Nothing -> 80 | pure unit 81 | Just symbol -> do 82 | H.liftEff $ setHash $ "stock/" <> symbol 83 | H.raise $ Selected symbol 84 | 85 | pure next 86 | 87 | render :: State -> HTML Typeahead.Query m 88 | render st = 89 | HH.div_ 90 | [HH.section 91 | [ class_ "hero" ] 92 | [ HH.div 93 | [ class_ "hero-body" ] 94 | [ HH.div 95 | [ class_ "container" ] 96 | [ HH.form_ $ 97 | [ HH.div_ 98 | case st.result of 99 | Nothing -> 100 | [ HH.div 101 | [ class_ "columns is-mobile" ] 102 | [ HH.div 103 | [ class_ "column is-half is-offset-one-quarter" ] 104 | [ HH.div 105 | [ class_ "field" ] 106 | [ HH.div 107 | [ class_ "control is-loading is-medium"] 108 | [ HH.input 109 | [ class_ "input is-medium", 110 | HP.placeholder "Loading stock symbols...", 111 | HP.disabled true 112 | ] 113 | ] 114 | ] 115 | ] 116 | ] 117 | ] 118 | Just symbols -> 119 | let config = { items: (map (\({ symbol, name } :: Symbol) -> symbol <> " - " <> name) symbols) 120 | , keepOpen: false 121 | } 122 | in [HH.slot unit Typeahead.component config (HE.input HandleSelection)] 123 | ] 124 | ] 125 | ] 126 | ] 127 | ] 128 | 129 | handleResponse :: Either (NonEmptyList ForeignError) Symbols -> Maybe Symbols 130 | handleResponse r = do 131 | case r of 132 | Left err -> Nothing 133 | Right something -> Just something 134 | --------------------------------------------------------------------------------