commit 864a24e465ac8447bb4e0d6e889b12724cfdada4 Author: Denis Tereshkin Date: Mon Feb 10 23:04:44 2020 +0700 initial commit diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..76778f3 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..f296bc5 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# atrade-brick diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/atrade-brick.cabal b/atrade-brick.cabal new file mode 100644 index 0000000..42ba956 --- /dev/null +++ b/atrade-brick.cabal @@ -0,0 +1,36 @@ +name: atrade-brick +version: 0.1.0.0 +-- synopsis: +-- description: +homepage: https://github.com/githubuser/atrade-brick#readme +license: BSD3 +license-file: LICENSE +author: Denis Tereshkin +maintainer: denis@kasan.ws +copyright: 2020 Denis Tereshkin +category: Web +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable atrade-brick + hs-source-dirs: src + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + default-extensions: OverloadedStrings + other-modules: QuoteTable + , Config + build-depends: base >= 4.7 && < 5 + , brick + , vty + , libatrade + , containers + , microlens-platform + , microlens-th + , BoundedChan + , zeromq4-haskell + , zeromq4-haskell-zap + , aeson + , text + , bytestring \ No newline at end of file diff --git a/atrade-brick.config b/atrade-brick.config new file mode 100644 index 0000000..45f06d3 --- /dev/null +++ b/atrade-brick.config @@ -0,0 +1,4 @@ +{ + "tickers" : ["FOO"], + "quotesource-endpoint" : "tcp://127.0.0.1:5000" +} \ No newline at end of file diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 index 0000000..2d3f142 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Config +( + AppConfig(..), + tickers, + quoteSourceEndpoint +) where + +import Data.Aeson + +import ATrade.Types +import qualified Data.Text as T +import Lens.Micro.Platform +import Lens.Micro.TH + +data AppConfig = AppConfig { + _tickers :: [TickerId], + _quoteSourceEndpoint :: T.Text +} deriving (Show, Eq) + +makeLenses ''AppConfig + +instance FromJSON AppConfig where + parseJSON = withObject "Config" $ \v -> AppConfig + <$> v .: "tickers" + <*> v .: "quotesource-endpoint" diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..9c6fb3c --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Brick.AttrMap +import Brick.BChan +import Brick.Main +import Brick.Types +import Brick.Widgets.Border +import Brick.Widgets.Core +import Control.Concurrent +import qualified Control.Concurrent.BoundedChan as BC +import Control.Exception +import Control.Monad +import Data.Aeson +import qualified Data.ByteString.Lazy as B +import qualified Data.Map.Strict as M +import qualified Graphics.Vty as Vty +import Lens.Micro.Platform +import Lens.Micro.TH +import System.ZMQ4 + +import ATrade.QuoteSource.Client +import ATrade.Types + +import Config +import QuoteTable + +data Name = Viewport1 + deriving (Show, Eq, Ord) + +data AppEvent = IncomingTick Tick + +data AppState = AppState { + _quotes :: QuoteTable +} deriving (Show, Eq) + +makeLenses ''AppState + +qsThread :: BChan AppEvent -> AppConfig -> IO () +qsThread eventChan config = withContext $ \ctx -> do + qschan <- BC.newBoundedChan 1000 + bracket (startQuoteSourceClient qschan (config ^. tickers) ctx (config ^. quoteSourceEndpoint) defaultClientSecurityParams) stopQuoteSourceClient $ \_ -> forever $ do + qsdata <- BC.readChan qschan + case qsdata of + QDTick tick -> writeBChan eventChan (IncomingTick tick) + _ -> return () + + +main :: IO () +main = do + maybeConfig <- decode' <$> B.readFile "atrade-brick.config" + case maybeConfig of + Nothing -> error "Can't parse config" + Just config -> do + let app = App { + appDraw = draw, + appChooseCursor = chooseCursor, + appHandleEvent = handleEvent, + appStartEvent = startEvent, + appAttrMap = attrMap' + } + eventChan <- Brick.BChan.newBChan 10 + let buildVty = Vty.mkVty Vty.defaultConfig + initialVty <- buildVty + qsThreadId <- forkIO $ qsThread eventChan config + void $ customMain buildVty (Just eventChan) app initialState + where + initialState = AppState M.empty + draw :: AppState -> [Widget Name] + draw s = [hBox [vBox (txt <$> tickers s), + vBorder, + vBox (str <$> fmap (printEntry s qteLastPrice) (tickers s)), + vBorder, + vBox (str <$> fmap (printEntry s qteBid) (tickers s)), + vBorder, + vBox (str <$> fmap (printEntry s qteAsk) (tickers s))] ] + printEntry s l tickerId = case s ^. quotes . at tickerId of + Just qte -> show $ qte ^. l + Nothing -> "-" + tickers s = M.keys (s ^. quotes) + chooseCursor s loc = Nothing + handleEvent s event = case event of + VtyEvent e -> case e of + Vty.EvKey (Vty.KChar 'q') [] -> halt s + _ -> continue s + AppEvent e -> case e of + IncomingTick t -> continue $ handleNewTick s t + _ -> continue s + startEvent = return + attrMap' s = attrMap Vty.defAttr [] + handleNewTick s t = case datatype t of + LastTradePrice -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteLastPrice .~ value t + BestBid -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteBid .~ value t + BestOffer -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteAsk .~ value t + _ -> s diff --git a/src/QuoteTable.hs b/src/QuoteTable.hs new file mode 100644 index 0000000..6c92cdd --- /dev/null +++ b/src/QuoteTable.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TemplateHaskell #-} + +module QuoteTable + ( + QuoteTableEntry(..), + QuoteTable(..), + qteLastPrice, + qteBid, + qteAsk, + emptyQuoteTableEntry + ) where + +import ATrade.Types + +import qualified Data.Map.Strict as M + +import Lens.Micro.Platform +import Lens.Micro.TH + +data QuoteTableEntry = + QuoteTableEntry { + _qteLastPrice :: Price, + _qteBid :: Price, + _qteAsk :: Price +} deriving (Show, Eq) + +makeLenses ''QuoteTableEntry + +emptyQuoteTableEntry = QuoteTableEntry 0 0 0 + +type QuoteTable = M.Map TickerId QuoteTableEntry + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..1ba97ff --- /dev/null +++ b/stack.yaml @@ -0,0 +1,71 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-12.9 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +- ../libatrade +- ../zeromq4-haskell-zap +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] +extra-deps: +- datetime-0.3.1 +- text-format-0.3.2 + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.1" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..4fb1a22 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,26 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: datetime-0.3.1@sha256:7e275bd0ce7a2f66445bedfa0006abaf4d41af4c2204c3f8004c17eab5480e74,1534 + pantry-tree: + size: 334 + sha256: d41d182c143676464cb1774f0b7777e870ddeaf8b6cd5fee6ff0114997a1f504 + original: + hackage: datetime-0.3.1 +- completed: + hackage: text-format-0.3.2@sha256:ea4e0cfd66e5a0224cbff2753eb160e71c9e383e86f293db77adeba5706bab94,1766 + pantry-tree: + size: 1029 + sha256: 8eab17d8e2ddcd878e7899f470bc23b9343b2a58a2e253a1a571ff09017799af + original: + hackage: text-format-0.3.2 +snapshots: +- completed: + size: 502604 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/9.yaml + sha256: 2b315ae05e003ce72e96e54849e8f8479959c45f750a814a018ff88bdaeaeff9 + original: lts-12.9