---------------------------------------------------------------
-- |
-- Module      : Graphics.Rendering.Chart.Sparkline
-- Copyright   : (c) Hitesh Jasani, 2008, Malcolm Wallace 2011, Tim Docker 2014
-- License     : BSD3
--
-- Sparklines are mini graphs inspired by Edward Tufte; see
-- <http://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=0001OR>
-- and
-- <http://en.wikipedia.org/wiki/Sparkline> for more information.
--
-- The original implementation (by Hitesh Jasani) used the gd
-- package as a backend renderer, and is still available at
-- <http://hackage.haskell.org/package/hsparklines>.
--
-- The present version integrates with
-- the Chart package, in the sense that Sparklines are just another
-- kind of (@ToRenderable a => a@), so they can be composed into grids
-- and used with the rest of Chart.
--
-- > dp :: [Double]
-- > dp = [24,21,32.3,24,15,34,43,55,57,72,74,75,73,72,55,44]
-- >
-- > sl = SparkLine barSpark dp
-- > fopts = FileOptions (sparkSize sl) PNG
-- > renderableToFile fopts (sparkLineToRenderable sl) "bar_spark.png" 
-- >
---------------------------------------------------------------

module Graphics.Rendering.Chart.SparkLine
  ( -- * SparkLine type
    SparkLine(..)
    -- * Drawing options
  , SparkOptions(..)
  , smoothSpark
  , barSpark
    -- * Size calculation
  , sparkSize
    -- * Rendering function
  , renderSparkLine
  , sparkLineToRenderable
  , sparkWidth
  ) where

import Control.Monad
import Data.List
import Data.Ord
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
import Data.Colour
import Data.Colour.Names

-- | A sparkline is a single sequence of data values, treated as y-values.
--   The x-values are anonymous and implicit in the sequence.
data SparkLine = SparkLine { SparkLine -> SparkOptions
sl_options :: SparkOptions
                           , SparkLine -> [Double]
sl_data    :: [Double]
                           }

-- | Options to render the sparklines in different ways.
data SparkOptions = SparkOptions
  { SparkOptions -> Bool
so_smooth     :: Bool            -- ^ smooth or bars
  , SparkOptions -> Int
so_step       :: Int             -- ^ step size
  , SparkOptions -> Int
so_height     :: Int             -- ^ graph height (pixels)
  , SparkOptions -> (Double, Double)
so_limits     :: (Double,Double) -- ^ data point limits
  , SparkOptions -> Colour Double
so_bgColor    :: Colour Double   -- ^ background color
  , SparkOptions -> Colour Double
so_minColor   :: Colour Double   -- ^ color of minimum datapoint
  , SparkOptions -> Colour Double
so_maxColor   :: Colour Double   -- ^ color of maximum datapoint
  , SparkOptions -> Colour Double
so_lastColor  :: Colour Double   -- ^ color of last datapoint
  , SparkOptions -> Bool
so_minMarker  :: Bool            -- ^ display minimum marker
  , SparkOptions -> Bool
so_maxMarker  :: Bool            -- ^ display maximum marker
  , SparkOptions -> Bool
so_lastMarker :: Bool            -- ^ display last marker
  } deriving (Int -> SparkOptions -> ShowS
[SparkOptions] -> ShowS
SparkOptions -> String
(Int -> SparkOptions -> ShowS)
-> (SparkOptions -> String)
-> ([SparkOptions] -> ShowS)
-> Show SparkOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparkOptions] -> ShowS
$cshowList :: [SparkOptions] -> ShowS
show :: SparkOptions -> String
$cshow :: SparkOptions -> String
showsPrec :: Int -> SparkOptions -> ShowS
$cshowsPrec :: Int -> SparkOptions -> ShowS
Show)

-- | Default options for a smooth sparkline.
smoothSpark :: SparkOptions
smoothSpark :: SparkOptions
smoothSpark  = SparkOptions :: Bool
-> Int
-> Int
-> (Double, Double)
-> Colour Double
-> Colour Double
-> Colour Double
-> Colour Double
-> Bool
-> Bool
-> Bool
-> SparkOptions
SparkOptions
  { so_smooth :: Bool
so_smooth     = Bool
True
  , so_step :: Int
so_step       = Int
2
  , so_height :: Int
so_height     = Int
20
  , so_limits :: (Double, Double)
so_limits     = (Double
0,Double
100)
  , so_bgColor :: Colour Double
so_bgColor    = Colour Double
forall a. (Ord a, Floating a) => Colour a
white
  , so_minColor :: Colour Double
so_minColor   = Colour Double
forall a. (Ord a, Floating a) => Colour a
red
  , so_maxColor :: Colour Double
so_maxColor   = Colour Double
forall a. (Ord a, Floating a) => Colour a
green
  , so_lastColor :: Colour Double
so_lastColor  = Colour Double
forall a. (Ord a, Floating a) => Colour a
blue
  , so_minMarker :: Bool
so_minMarker  = Bool
True
  , so_maxMarker :: Bool
so_maxMarker  = Bool
True
  , so_lastMarker :: Bool
so_lastMarker = Bool
True
  }

-- | Default options for a barchart sparkline.
barSpark :: SparkOptions
barSpark :: SparkOptions
barSpark  = SparkOptions
smoothSpark { so_smooth :: Bool
so_smooth=Bool
False }

-- | Create a renderable from a SparkLine.
sparkLineToRenderable :: SparkLine -> Renderable ()
sparkLineToRenderable :: SparkLine -> Renderable ()
sparkLineToRenderable SparkLine
sp = Renderable :: forall a.
BackendProgram (Double, Double)
-> ((Double, Double) -> BackendProgram (PickFn a)) -> Renderable a
Renderable
            { minsize :: BackendProgram (Double, Double)
minsize = let (Int
w,Int
h) = SparkLine -> (Int, Int)
sparkSize SparkLine
sp in (Double, Double) -> BackendProgram (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w , Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
            , render :: (Double, Double) -> BackendProgram (PickFn ())
render  = \(Double, Double)
_rect-> SparkLine -> BackendProgram (PickFn ())
renderSparkLine SparkLine
sp
            }

instance ToRenderable SparkLine where
  toRenderable :: SparkLine -> Renderable ()
toRenderable = SparkLine -> Renderable ()
sparkLineToRenderable

-- | Compute the width of a SparkLine, for rendering purposes.
sparkWidth :: SparkLine -> Int
sparkWidth :: SparkLine -> Int
sparkWidth SparkLine{sl_options :: SparkLine -> SparkOptions
sl_options=SparkOptions
opt, sl_data :: SparkLine -> [Double]
sl_data=[Double]
ds} =
  let w :: Int
w = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SparkOptions -> Int
so_step SparkOptions
opt) Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extrawidth
      extrawidth :: Int
extrawidth | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
                 | Bool
otherwise  = Int
bw Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds
      bw :: Int
bw | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
         | Bool
otherwise  = Int
2
  in Int
w

-- | Return the width and height of the SparkLine.
sparkSize :: SparkLine -> (Int,Int)
sparkSize :: SparkLine -> (Int, Int)
sparkSize SparkLine
s = (SparkLine -> Int
sparkWidth SparkLine
s, SparkOptions -> Int
so_height (SparkLine -> SparkOptions
sl_options SparkLine
s))

-- | Render a SparkLine to a drawing surface.
renderSparkLine :: SparkLine -> BackendProgram (PickFn ())
renderSparkLine :: SparkLine -> BackendProgram (PickFn ())
renderSparkLine SparkLine{sl_options :: SparkLine -> SparkOptions
sl_options=SparkOptions
opt, sl_data :: SparkLine -> [Double]
sl_data=[Double]
ds} =
  let w :: Int
w = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SparkOptions -> Int
so_step SparkOptions
opt) Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extrawidth
      extrawidth :: Int
extrawidth | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
                 | Bool
otherwise  = Int
bw Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds
      bw :: Int
bw | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
         | Bool
otherwise  = Int
2
      h :: Int
h = SparkOptions -> Int
so_height SparkOptions
opt 
      dmin :: Double
dmin = (Double, Double) -> Double
forall a b. (a, b) -> a
fst (SparkOptions -> (Double, Double)
so_limits SparkOptions
opt)
      dmax :: Double
dmax = (Double, Double) -> Double
forall a b. (a, b) -> b
snd (SparkOptions -> (Double, Double)
so_limits SparkOptions
opt)
      coords :: [Point]
coords = (Int -> Double -> Point) -> [Int] -> [Double] -> [Point]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x Double
y-> Double -> Double -> Point
Point (Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi Int
x) Double
y)
                       [Int
1,(Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bwInt -> Int -> Int
forall a. Num a => a -> a -> a
+SparkOptions -> Int
so_step SparkOptions
opt)..(Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+(SparkOptions -> Int
so_step SparkOptions
optInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bw)Int -> Int -> Int
forall a. Num a => a -> a -> a
*([Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds))]
                       [ Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi Int
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- ( (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
dmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
                                  ((Double
dmaxDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
dminDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4)) )
                         | Double
y <- [Double]
ds ]
      -- remember y increases as we go down the page
      minpt :: Point
minpt = (Point -> Point -> Ordering) -> [Point] -> Point
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((Point -> Double) -> Point -> Point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Double
p_y) [Point]
coords
      maxpt :: Point
maxpt = (Point -> Point -> Ordering) -> [Point] -> Point
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((Point -> Double) -> Point -> Point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Double
p_y) [Point]
coords
      endpt :: Point
endpt = [Point] -> Point
forall a. [a] -> a
last [Point]
coords
      boxpt :: Point -> Rect
      boxpt :: Point -> Rect
boxpt (Point Double
x Double
y) = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)(Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)) (Double -> Double -> Point
Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1)(Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1))
      fi    :: (Num b, Integral a) => a -> b
      fi :: a -> b
fi    = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  in do

  FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_bgColor SparkOptions
opt))) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
    Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
0 Double
0) (Double -> Double -> Point
Point (Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi Int
w) (Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi Int
h))))
  if SparkOptions -> Bool
so_smooth SparkOptions
opt
    then do
      LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (Double -> AlphaColour Double -> LineStyle
solidLine Double
1 (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
grey)) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
        [Point]
p <- [Point] -> BackendProgram [Point]
alignStrokePoints [Point]
coords
        [Point] -> BackendProgram ()
strokePointPath [Point]
p
    else do
      FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
grey)) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
        [Point] -> (Point -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Point]
coords ((Point -> BackendProgram ()) -> BackendProgram ())
-> (Point -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \ (Point Double
x Double
y) ->
          Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double
y) (Double -> Double -> Point
Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) (Int -> Double
forall b a. (Num b, Integral a) => a -> b
fi Int
h))))
  Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_minMarker SparkOptions
opt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
      FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_minColor SparkOptions
opt))) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
        Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
minpt))
        Path -> BackendProgram ()
fillPath Path
p
  Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_maxMarker SparkOptions
opt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
      FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_maxColor SparkOptions
opt))) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
        Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
maxpt))
        Path -> BackendProgram ()
fillPath Path
p
  Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_lastMarker SparkOptions
opt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
      FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_lastColor SparkOptions
opt))) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
        Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
endpt))
        Path -> BackendProgram ()
fillPath Path
p
  PickFn () -> BackendProgram (PickFn ())
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn ()
forall a. PickFn a
nullPickFn