Skip to content

Instantly share code, notes, and snippets.

@NduatiK
Last active April 4, 2022 19:53
Show Gist options
  • Save NduatiK/b873b928693858727d4aaca293c2608e to your computer and use it in GitHub Desktop.
Save NduatiK/b873b928693858727d4aaca293c2608e to your computer and use it in GitHub Desktop.
Candle Chart with elm-charts
port module CandleStickComponent exposing (..)
import Browser
import Chart as C
import Chart.Attributes as CA exposing (dashed)
import Chart.Events as CE
import Chart.Item as CI
import Chart.Svg as CS
import Html as H exposing (Html, div, span, text)
import Html.Attributes exposing (class)
import Json.Decode as Decode exposing (Decoder, Value, string)
import Json.Decode.Pipeline exposing (required, requiredAt)
import Json.Encode
type alias Data =
Result Decode.Error (List ServerDatum)
type alias Model =
{ data : Data
, hovering : List (CI.Many ServerDatum CI.Any)
}
type alias ServerDatum =
{ open : Float
, high : Float
, low : Float
, close : Float
, x : Int
}
-- decoder : Decoder ServerDatum
-- decoder =
-- Decode.succeed ServerDatum
-- -- |> requiredAt [ "label" ] Decode.string
-- |> requiredAt [ "open" ] Decode.float
-- |> requiredAt [ "high" ] Decode.float
-- |> requiredAt [ "low" ] Decode.float
-- |> requiredAt [ "close" ] Decode.float
-- |> requiredAt [ "x" ] Decode.int
-- decode : String -> Data
-- decode string =
-- string
-- |> Decode.decodeString (Decode.list decoder)
-- type alias Flags =
-- { attributes :
-- { data : String }
-- }
-- init : Flags -> ( Model, Cmd Msg )
-- init flags =
-- ( Model
-- (flags.attributes.data
-- |> Decode.decodeString (Decode.list decoder)
-- )
-- []
-- , Cmd.none
-- )
-- init : Flags -> ( Model, Cmd Msg )
init _ =
( Model
(Ok
[ { close = 0, high = 20, low = 0, open = 12, x = 0 }
, { close = 4, high = 24, low = 1, open = 13, x = 1 }
, { close = 8, high = 28, low = 2, open = 14, x = 2 }
, { close = 12, high = 32, low = 3, open = 15, x = 3 }
, { close = 16, high = 36, low = 4, open = 16, x = 4 }
, { close = 20, high = 40, low = 5, open = 17, x = 5 }
, { close = 24, high = 44, low = 6, open = 18, x = 6 }
, { close = 28, high = 48, low = 7, open = 19, x = 7 }
, { close = 32, high = 52, low = 8, open = 20, x = 8 }
, { close = 36, high = 56, low = 9, open = 21, x = 9 }
, { close = 40, high = 60, low = 10, open = 22, x = 10 }
]
)
[]
, Cmd.none
)
main : Program () Model Msg
main =
Browser.element
{ init = init
, update = update
, subscriptions = \_ -> Sub.none
-- \model ->
-- onChangeCandleStickComponentData (decode >> UpdateData)
, view = view
}
port onChangeCandleStickComponentData : (String -> msg) -> Sub msg
type Msg
= OnHover (List (CI.Many ServerDatum CI.Any))
| UpdateData Data
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
OnHover hovering ->
( { model | hovering = hovering }, Cmd.none )
UpdateData data ->
( { model | data = data }, Cmd.none )
view : Model -> H.Html Msg
view model =
case model.data of
Ok data ->
div [ class "bg-white rounded " ] <|
List.singleton <|
C.chart
[ CA.height 200
, CA.width 700
-- , CA.margin { top = 40, bottom = 30, left = 30, right = 20 }
, CE.onMouseMove OnHover (CE.getNearest CI.stacks)
, CE.onMouseLeave (OnHover [])
, CA.domain
[ CA.lowest
(List.minimum (List.map .high data)
|> Maybe.withDefault 0
)
CA.orLower
-- Makes sure that your x-axis begins at -5 or lower, no matter
-- what your data is like.
, CA.highest
(List.maximum (List.map .high data)
|> Maybe.withDefault 10
)
CA.orHigher
-- Makes sure that your x-axis ends at 10 or higher, no matter
-- what your data is like.
]
]
[ -- C.binLabels .label [ CA.moveDown 20 ]
-- ,
C.xAxis []
, C.yAxis []
, C.xTicks []
, C.xLabels []
, C.yTicks []
, C.yLabels []
, C.legendsAt .max
.max
[ CA.row
, CA.moveUp 30
, CA.alignRight
, CA.spacing 5
]
[]
, C.list <|
let
heatmapItem : Int -> ServerDatum -> C.Element ServerDatum Msg
heatmapItem index report =
let
x =
toFloat report.x
borderColor =
if report.close > report.open then
"#188977"
else
"#188977"
color =
if report.close > report.open then
"#ffffff"
else
"#188977"
in
C.withPlane <|
\p ->
[ C.line
[ CA.x1 (x + 0.1)
, CA.x2 (x + 0.1)
, CA.y1 report.low
, CA.y2 report.high
, CA.color borderColor
]
, C.line
[ CA.x1 x
, CA.x2 (x + 0.2)
, CA.y1 report.low
, CA.y2 report.low
, CA.color borderColor
]
, C.line
[ CA.x1 x
, CA.x2 (x + 0.2)
, CA.y1 report.high
, CA.y2 report.high
, CA.color borderColor
]
]
in
List.indexedMap heatmapItem data
, C.list <|
let
heatmapItem : Int -> ServerDatum -> C.Element ServerDatum Msg
heatmapItem index report =
let
x =
toFloat report.x
borderColor =
if report.close > report.open then
"#188977"
else
"#188977"
color =
"#188977"
in
C.custom
{ name = "Stocks"
, color = color
, position = { x1 = x, x2 = x + 0.2, y1 = report.low, y2 = report.high }
, format =
\report_ ->
String.concat
[ "High: "
, String.fromFloat report_.high
, "\n"
, "Open: "
, String.fromFloat report_.open
, "\n"
, "Close: "
, String.fromFloat report_.close
, "\n"
, "Low: "
, String.fromFloat report_.low
]
, data = report
, render =
\p ->
CS.rect p
[ CA.x1 x
, CA.x2 (x + 0.2)
, CA.y1 report.open
, CA.y2 report.close
, CA.color color
, CA.border borderColor
]
}
in
List.indexedMap heatmapItem data
, C.list <|
let
heatmapItem : Int -> ServerDatum -> C.Element ServerDatum Msg
heatmapItem index report =
let
x =
toFloat report.x
borderColor =
if report.close > report.open then
"#188977"
else
"#188977"
color =
if report.close > report.open then
"#ffffff"
else
"#188977"
in
C.withPlane <|
\p ->
[ C.rect
[ CA.x1 x
, CA.x2 (x + 0.2)
, CA.y1 report.open
, CA.y2 report.close
, CA.color color
, CA.border "transparent"
]
]
in
List.indexedMap heatmapItem data
, C.each model.hovering <|
\_ item ->
[ C.tooltip item
[ CA.center
, CA.offset 0
, CA.onTopOrBottom
]
[ HA.style "white-space" "pre"
]
[]
]
]
_ ->
div [ class "w-full h-48 bg-gray-100 rounded border border-gray-200 flex justify-center items-center" ]
[ span [ class "text-gray-200 text-lg" ] [ text "Unable to load data" ]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment