    {-# LANGUAGE ScopedTypeVariables #-}
    -- | This is a graph widget inspired by the widget of the same name in
    -- Awesome (the window manager).  It plots a series of data points
    -- similarly to a bar graph.  This version must be explicitly fed data
    -- with 'graphAddSample'.  For a more automated version, see
    -- 'PollingGraph'.
    --
    -- Like Awesome, this graph can plot multiple data sets in one widget.
    -- The data sets are plotted in the order provided by the caller.
    --
    -- Note: all of the data fed to this widget should be in the range
    -- [0,1].
    module System.Taffybar.Widgets.Graph (
      -- * Types
      GraphHandle,
      GraphConfig(..),
      GraphDirection(..),
      GraphStyle(..),
      -- * Functions
      graphNew,
      graphAddSample,
      defaultGraphConfig
      ) where

    import Prelude hiding ( mapM_ )
    import Control.Concurrent
    import Data.Sequence ( Seq, (<|), viewl, ViewL(..) )
    import Data.Foldable ( mapM_ )
    import Control.Monad ( when )
    import Control.Monad.Trans ( liftIO )
    import qualified Data.Sequence as S
    import qualified Graphics.Rendering.Cairo as C
    import qualified Graphics.Rendering.Cairo.Matrix as M
    import qualified Graphics.UI.Gtk as Gtk

    newtype GraphHandle = GH (MVar GraphState)
    data GraphState =
      GraphState { graphIsBootstrapped :: Bool
                 , graphHistory :: [Seq Double]
                 , graphCanvas :: Gtk.DrawingArea
                 , graphConfig :: GraphConfig
                 }

    data GraphDirection = LEFT_TO_RIGHT | RIGHT_TO_LEFT deriving (Eq)

    -- | The style of the graph. Generally, you will want to draw all 'Area' graphs first, and then all 'Line' graphs.
    data GraphStyle
        = Area -- ^ Thea area below the value is filled
        | Line -- ^ The values are connected by a line (one pixel wide)

    -- | The configuration options for the graph.  The padding is the
    -- number of pixels reserved as blank space around the widget in each
    -- direction.
    data GraphConfig =
      GraphConfig { graphPadding :: Int -- ^ Number of pixels of padding on each side of the graph widget
                  , graphBackgroundColor :: (Double, Double, Double) -- ^ The background color of the graph (default black)
                  , graphBorderColor :: (Double, Double, Double) -- ^ The border color drawn around the graph (default gray)
                  , graphBorderWidth :: Int -- ^ The width of the border (default 1, use 0 to disable the border)
                  , graphDataColors :: [(Double, Double, Double, Double)] -- ^ Colors for each data set (default cycles between red, green and blue)
                  , graphDataStyles :: [GraphStyle] -- ^ How to draw each data point (default @repeat Area@)
                  , graphHistorySize :: Int -- ^ The number of data points to retain for each data set (default 20)
                  , graphLabel :: Maybe String -- ^ May contain Pango markup (default @Nothing@)
                  , graphWidth :: Int -- ^ The width (in pixels) of the graph widget (default 50)
                  , graphDirection :: GraphDirection
                  }

    defaultGraphConfig :: GraphConfig
    defaultGraphConfig = GraphConfig { graphPadding = 2
                                     , graphBackgroundColor = (0.0, 0.0, 0.0)
                                     , graphBorderColor = (0.5, 0.5, 0.5)
                                     , graphBorderWidth = 1
                                     , graphDataColors = cycle [(1,0,0,0), (0,1,0,0), (0,0,1,0)]
                                     , graphDataStyles = repeat Area
                                     , graphHistorySize = 20
                                     , graphLabel = Nothing
                                     , graphWidth = 50
                                     , graphDirection = LEFT_TO_RIGHT
                                     }

    -- | Add a data point to the graph for each of the tracked data sets.
    -- There should be as many values in the list as there are data sets.
    graphAddSample :: GraphHandle -> [Double] -> IO ()
    graphAddSample (GH mv) rawData = do
      s <- readMVar mv
      let drawArea = graphCanvas s
          histSize = graphHistorySize (graphConfig s)
          histsAndNewVals = zip pcts (graphHistory s)
          newHists = case graphHistory s of
            [] -> map S.singleton pcts
            _ -> map (\(p,h) -> S.take histSize $ p <| h) histsAndNewVals
      case graphIsBootstrapped s of
        False -> return ()
        True -> do
          modifyMVar_ mv (\s' -> return s' { graphHistory = newHists })
          Gtk.postGUIAsync $ Gtk.widgetQueueDraw drawArea
      where
        pcts = map (clamp 0 1) rawData

    clamp :: Double -> Double -> Double -> Double
    clamp lo hi d = max lo $ min hi d

    outlineData :: (Double -> Double) -> Double -> Double -> C.Render ()
    outlineData pctToY xStep pct = do
      (curX,_) <- C.getCurrentPoint
      C.lineTo (curX + xStep) (pctToY pct)

    renderFrameAndBackground :: GraphConfig -> Int -> Int -> C.Render ()
    renderFrameAndBackground cfg w h = do
      let (backR, backG, backB) = graphBackgroundColor cfg
          (frameR, frameG, frameB) = graphBorderColor cfg
          pad = graphPadding cfg
          fpad = fromIntegral pad
          fw = fromIntegral w
          fh = fromIntegral h

      -- Draw the requested background
      C.setSourceRGB backR backG backB
      C.rectangle fpad fpad (fw - 2 * fpad) (fh - 2 * fpad)
      C.fill

      -- Draw a frame around the widget area
      -- (unless equal to background color, which likely means the user does not
      -- want a frame)
      when (graphBorderWidth cfg > 0) $ do
        let p = fromIntegral (graphBorderWidth cfg)
        C.setLineWidth p
        C.setSourceRGB frameR frameG frameB
        C.rectangle (fpad + (p / 2)) (fpad + (p / 2)) (fw - 2 * fpad - p) (fh - 2 * fpad - p)
        C.stroke

    renderGraph :: [Seq Double] -> GraphConfig -> Int -> Int -> Double -> C.Render ()
    renderGraph hists cfg w h xStep = do
      renderFrameAndBackground cfg w h

      C.setLineWidth 0.1

      let pad = fromIntegral $ graphPadding cfg
      let framePad = fromIntegral $ graphBorderWidth cfg

      -- Make the new origin be inside the frame and then scale the
      -- drawing area so that all operations in terms of width and height
      -- are inside the drawn frame.
      C.translate (pad + framePad) (pad + framePad)
      let xS = (fromIntegral w - 2 * pad - 2 * framePad) / fromIntegral w
          yS = (fromIntegral h - 2 * pad - 2 * framePad) / fromIntegral h
      C.scale xS yS

      -- If right-to-left direction is requested, apply an horizontal inversion
      -- transformation with an offset to the right equal to the width of the widget.
      if graphDirection cfg == RIGHT_TO_LEFT
          then C.transform $ M.Matrix (-1) 0 0 1 (fromIntegral w) 0
          else return ()

      let pctToY pct = fromIntegral h * (1 - pct)
          renderDataSet hist color style
            | S.length hist <= 1 = return ()
            | otherwise = do
              let (r, g, b, a) = color
                  originY = pctToY newestSample
                  originX = 0
                  newestSample :< hist' = viewl hist
              C.setSourceRGBA r g b a
              C.moveTo originX originY

              mapM_ (outlineData pctToY xStep) hist'
              case style of
                Area -> do
                  (endX, _) <- C.getCurrentPoint
                  C.lineTo endX (fromIntegral h)
                  C.lineTo 0 (fromIntegral h)
                  C.fill
                Line -> do
                  C.setLineWidth 1.0
                  C.stroke

      sequence_ $ zipWith3 renderDataSet hists (graphDataColors cfg) (graphDataStyles cfg)

    drawBorder :: MVar GraphState -> Gtk.DrawingArea -> IO ()
    drawBorder mv drawArea = do
      (w, h) <- Gtk.widgetGetSize drawArea
      drawWin <- Gtk.widgetGetDrawWindow drawArea
      s <- readMVar mv
      let cfg = graphConfig s
      Gtk.renderWithDrawable drawWin (renderFrameAndBackground cfg w h)
      modifyMVar_ mv (\s' -> return s' { graphIsBootstrapped = True })
      return ()

    drawGraph :: MVar GraphState -> Gtk.DrawingArea -> IO ()
    drawGraph mv drawArea = do
      (w, h) <- Gtk.widgetGetSize drawArea
      drawWin <- Gtk.widgetGetDrawWindow drawArea
      s <- readMVar mv
      let hist = graphHistory s
          cfg = graphConfig s
          histSize = graphHistorySize cfg
          -- Subtract 1 here since the first data point doesn't require
          -- any movement in the X direction
          xStep = fromIntegral w / fromIntegral (histSize - 1)

      case hist of
        [] -> Gtk.renderWithDrawable drawWin (renderFrameAndBackground cfg w h)
        _ -> Gtk.renderWithDrawable drawWin (renderGraph hist cfg w h xStep)

    graphNew :: GraphConfig -> IO (Gtk.Widget, GraphHandle)
    graphNew cfg = do
      drawArea <- Gtk.drawingAreaNew
      mv <- newMVar GraphState { graphIsBootstrapped = False
                               , graphHistory = []
                               , graphCanvas = drawArea
                               , graphConfig = cfg
                               }

      Gtk.widgetSetSizeRequest drawArea (graphWidth cfg) (-1)
      _ <- Gtk.on drawArea Gtk.exposeEvent $ Gtk.tryEvent $ liftIO (drawGraph mv drawArea)
      _ <- Gtk.on drawArea Gtk.realize $ liftIO (drawBorder mv drawArea)
      box <- Gtk.hBoxNew False 1

      case graphLabel cfg of
        Nothing  -> return ()
        Just lbl -> do
          l <- Gtk.labelNew (Nothing :: Maybe String)
          Gtk.labelSetMarkup l lbl
          Gtk.boxPackStart box l Gtk.PackNatural 0

      Gtk.boxPackStart box drawArea Gtk.PackGrow 0
      Gtk.widgetShowAll box
      return (Gtk.toWidget box, GH mv)