-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Candle
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Candlestick charts for financial plotting
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Candle(
    PlotCandle(..),
    Candle(..),

    plot_candle_title,
    plot_candle_line_style,
    plot_candle_tick_length,
    plot_candle_width,
    plot_candle_centre,
    plot_candle_fill,
    plot_candle_rise_fill_style,
    plot_candle_fall_fill_style,
    plot_candle_values,
) where

import Control.Lens hiding (op)

import Graphics.Rendering.Chart.Geometry hiding (close)
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (white, blue)
import Data.Default.Class

-- | Value defining a financial interval: opening and closing prices, with
--   maxima and minima; and a style in which to render them.
--   By convention, there are different fill styles depending on whether
--   the price rises (open < close) or falls (close < open).
--   (This plot type can also be re-purposed for statistical intervals, e.g.
--    minimum, first quartile, median, third quartile, maximum.)
data PlotCandle x y = PlotCandle {
    forall x y. PlotCandle x y -> String
_plot_candle_title           :: String,
    forall x y. PlotCandle x y -> LineStyle
_plot_candle_line_style      :: LineStyle,
    forall x y. PlotCandle x y -> Bool
_plot_candle_fill            :: Bool,
    forall x y. PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style :: FillStyle,
    forall x y. PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style :: FillStyle,
    forall x y. PlotCandle x y -> Double
_plot_candle_tick_length     :: Double,
    forall x y. PlotCandle x y -> Double
_plot_candle_width           :: Double,
    forall x y. PlotCandle x y -> Double
_plot_candle_centre          :: Double,
    forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values          :: [Candle x y]
}

-- | A Value holding price intervals for a given x-coord.
--   An alternative view is that these are statistical intervals: the
--   0th, 25th, 50th, 75th, and 100th percentiles.
data Candle x y = Candle { forall x y. Candle x y -> x
candle_x     :: x
                         , forall x y. Candle x y -> y
candle_low   :: y
                         , forall x y. Candle x y -> y
candle_open  :: y
                         , forall x y. Candle x y -> y
candle_mid   :: y
                         , forall x y. Candle x y -> y
candle_close :: y
                         , forall x y. Candle x y -> y
candle_high  :: y
                         } deriving (Int -> Candle x y -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
forall x y. (Show x, Show y) => [Candle x y] -> ShowS
forall x y. (Show x, Show y) => Candle x y -> String
showList :: [Candle x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [Candle x y] -> ShowS
show :: Candle x y -> String
$cshow :: forall x y. (Show x, Show y) => Candle x y -> String
showsPrec :: Int -> Candle x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
Show)

instance ToPlot PlotCandle where
    toPlot :: forall x y. PlotCandle x y -> Plot x y
toPlot PlotCandle x y
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p,
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [(forall x y. PlotCandle x y -> String
_plot_candle_title PlotCandle x y
p, forall x y. PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
p)],
        _plot_all_points :: ([x], [y])
_plot_all_points = ( forall a b. (a -> b) -> [a] -> [b]
map forall x y. Candle x y -> x
candle_x [Candle x y]
pts
                           , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [forall x y. Candle x y -> y
candle_low Candle x y
c, forall x y. Candle x y -> y
candle_high Candle x y
c]
                                    | Candle x y
c <- [Candle x y]
pts ] )
    }
      where
        pts :: [Candle x y]
pts = forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p

renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle :: forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p PointMapFn x y
pmap =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candle x y -> Candle Double Double
candlemap) (forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p)
  where
    candlemap :: Candle x y -> Candle Double Double
candlemap (Candle x
x y
lo y
op y
mid y
cl y
hi) =
        forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle Double
x' Double
lo' Double
op' Double
mid' Double
cl' Double
hi'
        where (Point Double
x' Double
mid')  = (x, y) -> Point
pmap' (x
x,y
mid)
              (Point Double
_  Double
lo')   = (x, y) -> Point
pmap' (x
x,y
lo)
              (Point Double
_  Double
op')   = (x, y) -> Point
pmap' (x
x,y
op)
              (Point Double
_  Double
cl')   = (x, y) -> Point
pmap' (x
x,y
cl)
              (Point Double
_  Double
hi')   = (x, y) -> Point
pmap' (x
x,y
hi)
    pmap' :: (x, y) -> Point
pmap' = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap

drawCandle :: PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle :: forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
ps (Candle Double
x Double
lo Double
open Double
mid Double
close Double
hi) = do
        let tl :: Double
tl = forall x y. PlotCandle x y -> Double
_plot_candle_tick_length PlotCandle x y
ps
        let wd :: Double
wd = forall x y. PlotCandle x y -> Double
_plot_candle_width PlotCandle x y
ps
        let ct :: Double
ct = forall x y. PlotCandle x y -> Double
_plot_candle_centre PlotCandle x y
ps
        let f :: Bool
f  = forall x y. PlotCandle x y -> Bool
_plot_candle_fill PlotCandle x y
ps
        -- the pixel coordinate system is inverted wrt the value coords.
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$ forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (if Double
open forall a. Ord a => a -> a -> Bool
>= Double
close
                                   then forall x y. PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style PlotCandle x y
ps
                                   else forall x y. PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style PlotCandle x y
ps) forall a b. (a -> b) -> a -> b
$
                    Path -> BackendProgram ()
fillPath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
                            forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
close
                            forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
close
                            forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
open
                            forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open

        forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (forall x y. PlotCandle x y -> LineStyle
_plot_candle_line_style PlotCandle x y
ps) forall a b. (a -> b) -> a -> b
$ do
          Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
close
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
close
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
wd) Double
open
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
-Double
wd) Double
open

          Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' Double
x (forall a. Ord a => a -> a -> a
min Double
lo Double
hi)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (forall a. Ord a => a -> a -> a
min Double
open Double
close)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (forall a. Ord a => a -> a -> a
max Double
open Double
close)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (forall a. Ord a => a -> a -> a
max Double
hi Double
lo)

          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
tl forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$ Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
lo
                                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
lo
                                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
hi
                                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
hi

          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
ct forall a. Ord a => a -> a -> Bool
> Double
0) forall a b. (a -> b) -> a -> b
$ Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
ct) Double
mid
                                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
ct) Double
mid

renderPlotLegendCandle :: PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle :: forall x y. PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
pc (Rect Point
p1 Point
p2) = do
    forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidforall a. Num a => a -> a -> a
*Double
1forall a. Fractional a => a -> a -> a
/Double
4) Double
lo Double
open Double
mid Double
close Double
hi)
    forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidforall a. Num a => a -> a -> a
*Double
2forall a. Fractional a => a -> a -> a
/Double
3) Double
lo Double
close Double
mid Double
open Double
hi)
  where
    pc2 :: PlotCandle x y
pc2   = PlotCandle x y
pc { _plot_candle_width :: Double
_plot_candle_width = Double
2 }
    xwid :: Double
xwid  = Point -> Double
p_x Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_x Point
p2
    lo :: Double
lo    = forall a. Ord a => a -> a -> a
max (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
    mid :: Double
mid   = (Point -> Double
p_y Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_y Point
p2)forall a. Fractional a => a -> a -> a
/Double
2
    hi :: Double
hi    = forall a. Ord a => a -> a -> a
min (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
    open :: Double
open  = (Double
lo forall a. Num a => a -> a -> a
+ Double
mid) forall a. Fractional a => a -> a -> a
/ Double
2
    close :: Double
close = (Double
mid forall a. Num a => a -> a -> a
+ Double
hi) forall a. Fractional a => a -> a -> a
/ Double
2

instance Default (PlotCandle x y) where
  def :: PlotCandle x y
def = PlotCandle
    { _plot_candle_title :: String
_plot_candle_title       = String
""
    , _plot_candle_line_style :: LineStyle
_plot_candle_line_style  = Double -> AlphaColour Double -> LineStyle
solidLine Double
1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
blue
    , _plot_candle_fill :: Bool
_plot_candle_fill        = Bool
False
    , _plot_candle_rise_fill_style :: FillStyle
_plot_candle_rise_fill_style  = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
white
    , _plot_candle_fall_fill_style :: FillStyle
_plot_candle_fall_fill_style  = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
blue
    , _plot_candle_tick_length :: Double
_plot_candle_tick_length = Double
2
    , _plot_candle_width :: Double
_plot_candle_width       = Double
5
    , _plot_candle_centre :: Double
_plot_candle_centre      = Double
0
    , _plot_candle_values :: [Candle x y]
_plot_candle_values      = []
    }

$( makeLenses ''PlotCandle )