    -- | 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(..),
      -- * Functions
      graphNew,
      graphAddSample,
      defaultGraphConfig
      ) where

    import Prelude hiding ( mapM_ )
    import Control.Concurrent
    import Data.Sequence ( Seq, (<|), viewl, ViewL(..) )
    import Data.Foldable ( mapM_ )
    import qualified Data.Sequence as S
    import Graphics.Rendering.Cairo
    import Graphics.UI.Gtk

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

    -- | 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)
                  , graphDataColors :: [(Double, Double, Double, Double)] -- ^ Colors for each data set (default [])
                  , 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)
                  }

    defaultGraphConfig :: GraphConfig
    defaultGraphConfig = GraphConfig { graphPadding = 2
                                     , graphBackgroundColor = (0.0, 0.0, 0.0)
                                     , graphBorderColor = (0.5, 0.5, 0.5)
                                     , graphDataColors = []
                                     , graphHistorySize = 20
                                     , graphLabel = Nothing
                                     , graphWidth = 50
                                     }

    -- | 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 })
          postGUIAsync $ 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 -> Render ()
    outlineData pctToY xStep pct = do
      (curX,_) <- getCurrentPoint
      lineTo (curX + xStep) (pctToY pct)

    renderFrameAndBackground :: GraphConfig -> Int -> Int -> 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
      setSourceRGB backR backG backB
      rectangle fpad fpad (fw - 2 * fpad) (fh - 2 * fpad)
      fill

      -- Draw a frame around the widget area
      setLineWidth 1.0
      setSourceRGB frameR frameG frameB
      rectangle fpad fpad (fw - 2 * fpad) (fh - 2 * fpad)
      stroke

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

      setLineWidth 0.1

      let pad = graphPadding 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.
      translate (fromIntegral pad + 1) (fromIntegral pad + 1)
      let xS = fromIntegral (w - 2 * pad - 2) / fromIntegral w
          yS = fromIntegral (h - 2 * pad - 2) / fromIntegral h
      scale xS yS

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

              mapM_ (outlineData pctToY xStep) hist'
              (endX, _) <- getCurrentPoint
              lineTo endX (fromIntegral h)
              lineTo 0 (fromIntegral h)
              fill

      mapM_ renderDataSet histsAndColors

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

    drawGraph :: MVar GraphState -> DrawingArea -> IO ()
    drawGraph mv drawArea = do
      (w, h) <- widgetGetSize drawArea
      drawWin <- 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
        [] -> renderWithDrawable drawWin (renderFrameAndBackground cfg w h)
        _ -> renderWithDrawable drawWin (renderGraph hist cfg w h xStep)

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

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

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

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