    -----------------------------------------------------------------------------
    -- |
    -- 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 Data.Monoid

    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
    [Candle x y] -> ShowS
    Candle x y -> String
    (Int -> Candle x y -> ShowS)
    -> (Candle x y -> String)
    -> ([Candle x y] -> ShowS)
    -> Show (Candle x y)
    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
    $cshowsPrec :: forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
    showsPrec :: Int -> Candle x y -> ShowS
    $cshow :: forall x y. (Show x, Show y) => Candle x y -> String
    show :: Candle x y -> String
    $cshowList :: forall x y. (Show x, Show y) => [Candle x y] -> ShowS
    showList :: [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     = PlotCandle x y -> PointMapFn x y -> BackendProgram ()
    forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
    renderPlotCandle PlotCandle x y
    p,
            _plot_legend :: [(String, Rect -> BackendProgram ())]
    _plot_legend     = [(PlotCandle x y -> String
    forall x y. PlotCandle x y -> String
    _plot_candle_title PlotCandle x y
    p, PlotCandle x y -> Rect -> BackendProgram ()
    forall x y. PlotCandle x y -> Rect -> BackendProgram ()
    renderPlotLegendCandle PlotCandle x y
    p)],
            _plot_all_points :: ([x], [y])
    _plot_all_points = ( (Candle x y -> x) -> [Candle x y] -> [x]
    forall a b. (a -> b) -> [a] -> [b]
    map Candle x y -> x
    forall x y. Candle x y -> x
    candle_x [Candle x y]
    pts
                               , [[y]] -> [y]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [Candle x y -> y
    forall x y. Candle x y -> y
    candle_low Candle x y
    c, Candle x y -> y
    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 = PlotCandle x y -> [Candle x y]
    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 =
        (Candle x y -> BackendProgram ())
    -> [Candle x y] -> BackendProgram ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (PlotCandle x y -> Candle Double Double -> BackendProgram ()
    forall x y.
    PlotCandle x y -> Candle Double Double -> BackendProgram ()
    drawCandle PlotCandle x y
    p (Candle Double Double -> BackendProgram ())
    -> (Candle x y -> Candle Double Double)
    -> Candle x y
    -> BackendProgram ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Candle x y -> Candle Double Double
    candlemap) (PlotCandle x y -> [Candle x y]
    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) =
            Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Candle Double Double
    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' = PointMapFn x y -> (x, y) -> Point
    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 = PlotCandle x y -> Double
    forall x y. PlotCandle x y -> Double
    _plot_candle_tick_length PlotCandle x y
    ps
            let wd :: Double
    wd = PlotCandle x y -> Double
    forall x y. PlotCandle x y -> Double
    _plot_candle_width PlotCandle x y
    ps
            let ct :: Double
    ct = PlotCandle x y -> Double
    forall x y. PlotCandle x y -> Double
    _plot_candle_centre PlotCandle x y
    ps
            let f :: Bool
    f  = PlotCandle x y -> Bool
    forall x y. PlotCandle x y -> Bool
    _plot_candle_fill PlotCandle x y
    ps
            -- the pixel coordinate system is inverted wrt the value coords.
            Bool -> BackendProgram () -> BackendProgram ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    f (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ FillStyle -> BackendProgram () -> BackendProgram ()
    forall a. FillStyle -> BackendProgram a -> BackendProgram a
    withFillStyle (if Double
    open Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Double
    close
                                       then PlotCandle x y -> FillStyle
    forall x y. PlotCandle x y -> FillStyle
    _plot_candle_rise_fill_style PlotCandle x y
    ps
                                       else PlotCandle x y -> FillStyle
    forall x y. PlotCandle x y -> FillStyle
    _plot_candle_fall_fill_style PlotCandle x y
    ps) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $
                        Path -> BackendProgram ()
    fillPath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Path
    moveTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    wd) Double
    open
                                Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    wd) Double
    close
                                Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    wd) Double
    close
                                Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    wd) Double
    open
                                Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    wd) Double
    open

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

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

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

              Bool -> BackendProgram () -> BackendProgram ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Double
    ct Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    0) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ Path -> BackendProgram ()
    strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Path
    moveTo' (Double
    xDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    ct) Double
    mid
                                        Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Double
    xDouble -> Double -> Double
    forall 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
        PlotCandle x y -> Candle Double Double -> BackendProgram ()
    forall x y.
    PlotCandle x y -> Candle Double Double -> BackendProgram ()
    drawCandle PlotCandle x y
    pc2 (Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Candle Double Double
    forall x y. x -> y -> y -> y -> y -> y -> Candle x y
    Candle (Double
    xwidDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4) Double
    lo Double
    open Double
    mid Double
    close Double
    hi)
        PlotCandle x y -> Candle Double Double -> BackendProgram ()
    forall x y.
    PlotCandle x y -> Candle Double Double -> BackendProgram ()
    drawCandle PlotCandle x y
    pc2 (Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Double
    -> Candle Double Double
    forall x y. x -> y -> y -> y -> y -> y -> Candle x y
    Candle (Double
    xwidDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    2Double -> Double -> Double
    forall 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 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Point -> Double
    p_x Point
    p2
        lo :: Double
    lo    = Double -> Double -> Double
    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 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Point -> Double
    p_y Point
    p2)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2
        hi :: Double
    hi    = Double -> Double -> Double
    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 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    mid) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    2
        close :: Double
    close = (Double
    mid Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    hi) Double -> Double -> Double
    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 (AlphaColour Double -> LineStyle)
    -> AlphaColour Double -> LineStyle
    forall a b. (a -> b) -> a -> b
    $ Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque Colour Double
    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 (AlphaColour Double -> FillStyle)
    -> AlphaColour Double -> FillStyle
    forall a b. (a -> b) -> a -> b
    $ Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque Colour Double
    forall a. (Ord a, Floating a) => Colour a
    white
        , _plot_candle_fall_fill_style :: FillStyle
    _plot_candle_fall_fill_style  = AlphaColour Double -> FillStyle
    solidFillStyle (AlphaColour Double -> FillStyle)
    -> AlphaColour Double -> FillStyle
    forall a b. (a -> b) -> a -> b
    $ Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque Colour Double
    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 )