{-# LANGUAGE MultiParamTypeClasses #-}

module Monomer.Graph.GraphCfg
    ( -- * Configuration
      GraphCfg(..)
    , limitX
    , limitY
    , minimumX
    , maximumX
    , minimumY
    , maximumY
    , minScale
    , maxScale
    , minScaleX
    , maxScaleX
    , minScaleY
    , maxScaleY
    , lockX
    , lockX_
    , lockY
    , lockY_
    , hideMinorGridlines
    , hideMinorGridlines_
    , hideAxisNumbers
    , hideAxisNumbers_
    , hideGrid
    , hideGrid_
    , graphColors
    , onRightClick
    , onRightClickReq
    ) where

import Control.Applicative ((<|>))
import Data.Default
import Monomer.Widgets.Single

{-|
Configuration options for graph:

- 'wheelRate': speed of scaling.
- 'limitX': limits along X-axis.
- 'limitY': limits along Y-axis.
- 'minimumX': left limit along X-axis.
- 'maximumX': right limit along X-axis.
- 'minimumY': bottom limit along Y-axis.
- 'maximumY': top limit along Y-axis.
- 'minScale': minimum scale along both X-axis and Y-axis.
- 'maxScale': maximum scale along both X-axis and Y-axis.
- 'minScaleX': minimum scale along X-axis.
- 'maxScaleX': maximum scale along X-axis.
- 'minScaleY': minimum scale along Y-axis.
- 'maxScaleY': maximum scale along Y-axis.
- 'lockX': lock X-axis (scale only Y-axis).
- 'lockY': lock Y-axis (scale only X-axis).
- 'hideMinorGridlines': whether to hide minor gridlines.
- 'hideAxisNumbers': whether to hide axis numbers.
- 'hideGrid': whether to hide all gridlines and axis numbers.
- 'graphColors': which colors should be used to plot graphs.
- 'onRightClick': event to raise on right click.
- 'onRightClickReq': 'WidgetRequest' to generate on right click.
-}
data GraphCfg s e = GraphCfg
    { forall s e. GraphCfg s e -> Maybe Double
_gcWheelRate :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMinX :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMaxX :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMinY :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMaxY :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleX :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleX :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleY :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleY :: Maybe Double
    , forall s e. GraphCfg s e -> Maybe Bool
_gcLockX :: Maybe Bool
    , forall s e. GraphCfg s e -> Maybe Bool
_gcLockY :: Maybe Bool
    , forall s e. GraphCfg s e -> Maybe Bool
_gcHideMinor :: Maybe Bool
    , forall s e. GraphCfg s e -> Maybe Bool
_gcHideNumbers :: Maybe Bool
    , forall s e. GraphCfg s e -> Maybe Bool
_gcHideGrid :: Maybe Bool
    , forall s e. GraphCfg s e -> Maybe [Color]
_gcGraphColors :: Maybe [Color]
    , forall s e. GraphCfg s e -> [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
    }

instance Default (GraphCfg s e) where
    def :: GraphCfg s e
def = GraphCfg
        { _gcWheelRate :: Maybe Double
_gcWheelRate = forall a. Maybe a
Nothing
        , _gcMinX :: Maybe Double
_gcMinX = forall a. Maybe a
Nothing
        , _gcMaxX :: Maybe Double
_gcMaxX = forall a. Maybe a
Nothing
        , _gcMinY :: Maybe Double
_gcMinY = forall a. Maybe a
Nothing
        , _gcMaxY :: Maybe Double
_gcMaxY = forall a. Maybe a
Nothing
        , _gcMinScaleX :: Maybe Double
_gcMinScaleX = forall a. Maybe a
Nothing
        , _gcMaxScaleX :: Maybe Double
_gcMaxScaleX = forall a. Maybe a
Nothing
        , _gcMinScaleY :: Maybe Double
_gcMinScaleY = forall a. Maybe a
Nothing
        , _gcMaxScaleY :: Maybe Double
_gcMaxScaleY = forall a. Maybe a
Nothing
        , _gcLockX :: Maybe Bool
_gcLockX = forall a. Maybe a
Nothing
        , _gcLockY :: Maybe Bool
_gcLockY = forall a. Maybe a
Nothing
        , _gcHideMinor :: Maybe Bool
_gcHideMinor = forall a. Maybe a
Nothing
        , _gcHideNumbers :: Maybe Bool
_gcHideNumbers = forall a. Maybe a
Nothing
        , _gcHideGrid :: Maybe Bool
_gcHideGrid = forall a. Maybe a
Nothing
        , _gcGraphColors :: Maybe [Color]
_gcGraphColors = forall a. Maybe a
Nothing
        , _gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq = []
        }

instance Semigroup (GraphCfg s e) where
    <> :: GraphCfg s e -> GraphCfg s e -> GraphCfg s e
(<>) GraphCfg s e
a1 GraphCfg s e
a2 = forall a. Default a => a
def
        { _gcWheelRate :: Maybe Double
_gcWheelRate = forall s e. GraphCfg s e -> Maybe Double
_gcWheelRate GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcWheelRate GraphCfg s e
a1
        , _gcMinX :: Maybe Double
_gcMinX = forall s e. GraphCfg s e -> Maybe Double
_gcMinX GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMinX GraphCfg s e
a1
        , _gcMaxX :: Maybe Double
_gcMaxX = forall s e. GraphCfg s e -> Maybe Double
_gcMaxX GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMaxX GraphCfg s e
a1
        , _gcMinY :: Maybe Double
_gcMinY = forall s e. GraphCfg s e -> Maybe Double
_gcMinY GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMinY GraphCfg s e
a1
        , _gcMaxY :: Maybe Double
_gcMaxY = forall s e. GraphCfg s e -> Maybe Double
_gcMaxY GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMaxY GraphCfg s e
a1
        , _gcMinScaleX :: Maybe Double
_gcMinScaleX = forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleX GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleX GraphCfg s e
a1
        , _gcMaxScaleX :: Maybe Double
_gcMaxScaleX = forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleX GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleX GraphCfg s e
a1
        , _gcMinScaleY :: Maybe Double
_gcMinScaleY = forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleY GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMinScaleY GraphCfg s e
a1
        , _gcMaxScaleY :: Maybe Double
_gcMaxScaleY = forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleY GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Double
_gcMaxScaleY GraphCfg s e
a1
        , _gcLockX :: Maybe Bool
_gcLockX = forall s e. GraphCfg s e -> Maybe Bool
_gcLockX GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Bool
_gcLockX GraphCfg s e
a1
        , _gcLockY :: Maybe Bool
_gcLockY = forall s e. GraphCfg s e -> Maybe Bool
_gcLockY GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Bool
_gcLockY GraphCfg s e
a1
        , _gcHideMinor :: Maybe Bool
_gcHideMinor = forall s e. GraphCfg s e -> Maybe Bool
_gcHideMinor GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Bool
_gcHideMinor GraphCfg s e
a1
        , _gcHideNumbers :: Maybe Bool
_gcHideNumbers = forall s e. GraphCfg s e -> Maybe Bool
_gcHideNumbers GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Bool
_gcHideNumbers GraphCfg s e
a1
        , _gcHideGrid :: Maybe Bool
_gcHideGrid = forall s e. GraphCfg s e -> Maybe Bool
_gcHideGrid GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe Bool
_gcHideGrid GraphCfg s e
a1
        , _gcGraphColors :: Maybe [Color]
_gcGraphColors = forall s e. GraphCfg s e -> Maybe [Color]
_gcGraphColors GraphCfg s e
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. GraphCfg s e -> Maybe [Color]
_gcGraphColors GraphCfg s e
a1
        , _gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq =
            forall s e. GraphCfg s e -> [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq GraphCfg s e
a1 forall a. Semigroup a => a -> a -> a
<> forall s e. GraphCfg s e -> [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq GraphCfg s e
a2
        }

instance Monoid (GraphCfg s e) where
    mempty :: GraphCfg s e
mempty = forall a. Default a => a
def

instance CmbWheelRate (GraphCfg s e) Double where
    wheelRate :: Double -> GraphCfg s e
wheelRate Double
rate = forall a. Default a => a
def {
        _gcWheelRate :: Maybe Double
_gcWheelRate = forall a. a -> Maybe a
Just Double
rate
    }

{-|
Limits along X-axis.
-}
limitX :: (Double, Double) -> GraphCfg s e
limitX :: forall s e. (Double, Double) -> GraphCfg s e
limitX (Double
a, Double
b) = forall a. Default a => a
def
    { _gcMinX :: Maybe Double
_gcMinX = forall a. a -> Maybe a
Just Double
a
    , _gcMaxX :: Maybe Double
_gcMaxX = forall a. a -> Maybe a
Just Double
b
    }

{-|
Limits along Y-axis.
-}
limitY :: (Double, Double) -> GraphCfg s e
limitY :: forall s e. (Double, Double) -> GraphCfg s e
limitY (Double
a, Double
b) = forall a. Default a => a
def
    { _gcMinY :: Maybe Double
_gcMinY = forall a. a -> Maybe a
Just Double
a
    , _gcMaxY :: Maybe Double
_gcMaxY = forall a. a -> Maybe a
Just Double
b
    }

{-|
Left limit along X-axis.
-}
minimumX :: Double -> GraphCfg s e
minimumX :: forall s e. Double -> GraphCfg s e
minimumX Double
v = forall a. Default a => a
def
    { _gcMinX :: Maybe Double
_gcMinX = forall a. a -> Maybe a
Just Double
v
    }

{-|
Right limit along X-axis.
-}
maximumX :: Double -> GraphCfg s e
maximumX :: forall s e. Double -> GraphCfg s e
maximumX Double
v = forall a. Default a => a
def
    { _gcMaxX :: Maybe Double
_gcMaxX = forall a. a -> Maybe a
Just Double
v
    }

{-|
Bottom limit along Y-axis.
-}
minimumY :: Double -> GraphCfg s e
minimumY :: forall s e. Double -> GraphCfg s e
minimumY Double
v = forall a. Default a => a
def
    { _gcMinY :: Maybe Double
_gcMinY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Top limit along Y-axis.
-}
maximumY :: Double -> GraphCfg s e
maximumY :: forall s e. Double -> GraphCfg s e
maximumY Double
v = forall a. Default a => a
def
    { _gcMaxY :: Maybe Double
_gcMaxY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Minimum scale along both X-axis and Y-axis.
-}
minScale :: Double -> GraphCfg s e
minScale :: forall s e. Double -> GraphCfg s e
minScale Double
v = forall a. Default a => a
def
    { _gcMinScaleX :: Maybe Double
_gcMinScaleX = forall a. a -> Maybe a
Just Double
v
    , _gcMinScaleY :: Maybe Double
_gcMinScaleY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Maximum scale along both X-axis and Y-axis.
-}
maxScale :: Double -> GraphCfg s e
maxScale :: forall s e. Double -> GraphCfg s e
maxScale Double
v = forall a. Default a => a
def
    { _gcMaxScaleX :: Maybe Double
_gcMaxScaleX = forall a. a -> Maybe a
Just Double
v
    , _gcMaxScaleY :: Maybe Double
_gcMaxScaleY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Minimum scale along X-axis.
-}
minScaleX :: Double -> GraphCfg s e
minScaleX :: forall s e. Double -> GraphCfg s e
minScaleX Double
v = forall a. Default a => a
def
    { _gcMinScaleX :: Maybe Double
_gcMinScaleX = forall a. a -> Maybe a
Just Double
v
    }

{-|
Maximum scale along X-axis.
-}
maxScaleX :: Double -> GraphCfg s e
maxScaleX :: forall s e. Double -> GraphCfg s e
maxScaleX Double
v = forall a. Default a => a
def
    { _gcMaxScaleX :: Maybe Double
_gcMaxScaleX = forall a. a -> Maybe a
Just Double
v
    }

{-|
Minimum scale along Y-axis.
-}
minScaleY :: Double -> GraphCfg s e
minScaleY :: forall s e. Double -> GraphCfg s e
minScaleY Double
v = forall a. Default a => a
def
    { _gcMinScaleY :: Maybe Double
_gcMinScaleY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Maximum scale along Y-axis.
-}
maxScaleY :: Double -> GraphCfg s e
maxScaleY :: forall s e. Double -> GraphCfg s e
maxScaleY Double
v = forall a. Default a => a
def
    { _gcMaxScaleY :: Maybe Double
_gcMaxScaleY = forall a. a -> Maybe a
Just Double
v
    }

{-|
Lock X-axis (scale only Y-axis).
-}
lockX :: GraphCfg s e
lockX :: forall s e. GraphCfg s e
lockX = forall s e. Bool -> GraphCfg s e
lockX_ Bool
True

{-|
Whether X-axis is locked and only Y-axis is scaled.
-}
lockX_ :: Bool -> GraphCfg s e
lockX_ :: forall s e. Bool -> GraphCfg s e
lockX_ Bool
lock = forall a. Default a => a
def
    { _gcLockX :: Maybe Bool
_gcLockX = forall a. a -> Maybe a
Just Bool
lock
    }

{-|
Lock Y-axis (scale only X-axis).
-}
lockY :: GraphCfg s e
lockY :: forall s e. GraphCfg s e
lockY = forall s e. Bool -> GraphCfg s e
lockY_ Bool
True

{-|
Whether Y-axis is locked and only X-axis is scaled.
-}
lockY_ :: Bool -> GraphCfg s e
lockY_ :: forall s e. Bool -> GraphCfg s e
lockY_ Bool
lock = forall a. Default a => a
def
    { _gcLockY :: Maybe Bool
_gcLockY = forall a. a -> Maybe a
Just Bool
lock
    }

{-|
Hide minor gridlines.
-}
hideMinorGridlines :: GraphCfg s e
hideMinorGridlines :: forall s e. GraphCfg s e
hideMinorGridlines = forall s e. Bool -> GraphCfg s e
hideMinorGridlines_ Bool
True

{-|
Whether to hide minor gridlines.
-}
hideMinorGridlines_ :: Bool -> GraphCfg s e
hideMinorGridlines_ :: forall s e. Bool -> GraphCfg s e
hideMinorGridlines_ Bool
hide = forall a. Default a => a
def
    { _gcHideMinor :: Maybe Bool
_gcHideMinor = forall a. a -> Maybe a
Just Bool
hide
    }

{-|
Hide axis numbers.
-}
hideAxisNumbers :: GraphCfg s e
hideAxisNumbers :: forall s e. GraphCfg s e
hideAxisNumbers = forall s e. Bool -> GraphCfg s e
hideAxisNumbers_ Bool
True

{-|
Whether to hide axis numbers.
-}
hideAxisNumbers_ :: Bool -> GraphCfg s e
hideAxisNumbers_ :: forall s e. Bool -> GraphCfg s e
hideAxisNumbers_ Bool
hide = forall a. Default a => a
def
    { _gcHideNumbers :: Maybe Bool
_gcHideNumbers = forall a. a -> Maybe a
Just Bool
hide
    }

{-|
Hide all gridlines and axis numbers.
-}
hideGrid :: GraphCfg s e
hideGrid :: forall s e. GraphCfg s e
hideGrid = forall s e. Bool -> GraphCfg s e
hideGrid_ Bool
True

{-|
Whether to hide all gridlines and axis numbers.
-}
hideGrid_ :: Bool -> GraphCfg s e
hideGrid_ :: forall s e. Bool -> GraphCfg s e
hideGrid_ Bool
hide = forall a. Default a => a
def
    { _gcHideGrid :: Maybe Bool
_gcHideGrid = forall a. a -> Maybe a
Just Bool
hide
    }

{-|
List of colors which are used to plot graphs. This list is then
cycled when plotting graphs (in case there are more graphs than
provided colors).
-}
graphColors :: [Color] -> GraphCfg s e
graphColors :: forall s e. [Color] -> GraphCfg s e
graphColors [Color]
colors = forall a. Default a => a
def
    { _gcGraphColors :: Maybe [Color]
_gcGraphColors = forall a. a -> Maybe a
Just [Color]
colors
    }

{-|
Event to raise on right click.
-}
onRightClick
    :: WidgetEvent e
    => ((Double, Double) -> e)
    -> GraphCfg s e
onRightClick :: forall e s.
WidgetEvent e =>
((Double, Double) -> e) -> GraphCfg s e
onRightClick (Double, Double) -> e
f = forall a. Default a => a
def
    { _gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> e
f]
    }

{-|
'WidgetRequest' to generate on right click.
-}
onRightClickReq
    :: ((Double, Double) -> WidgetRequest s e)
    -> GraphCfg s e
onRightClickReq :: forall s e. ((Double, Double) -> WidgetRequest s e) -> GraphCfg s e
onRightClickReq (Double, Double) -> WidgetRequest s e
req = forall a. Default a => a
def
    { _gcOnRightClickReq :: [(Double, Double) -> WidgetRequest s e]
_gcOnRightClickReq = [(Double, Double) -> WidgetRequest s e
req]
    }