    {-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
    module Graphics.Rendering.Chart.State(
      plot,
      plotLeft,
      plotRight,

      takeColor,
      takeShape,

      CState,
      colors,
      shapes,

      EC,
      execEC,
      liftEC,
      liftCState,
      ) where

    import Control.Lens
    import Control.Monad.State
    import Data.Default.Class

    import Data.Colour
    import Data.Colour.Names

    import Graphics.Rendering.Chart.Layout
    import Graphics.Rendering.Chart.Plot
    import Graphics.Rendering.Chart.Drawing
    import Graphics.Rendering.Chart.Renderable

    -- | The state held when monadically constructing a graphical element
    data CState = CState {
      CState -> [AlphaColour Double]
    _colors :: [AlphaColour Double], -- ^ An infinite source of colors, for use in plots
      CState -> [PointShape]
    _shapes :: [PointShape]          -- ^ An infinite source of shapes, for use in plots
      }

    $( makeLenses ''CState )

    -- | We use nested State monads to give nice syntax. The outer state
    -- is the graphical element being constructed (typically a
    -- layout). The inner state contains any additional state
    -- reqired. This approach means that lenses and the state monad lens
    -- operators can be used directly on the value being constructed.
    type EC l a = StateT l (State CState) a

    instance Default CState where
      def :: CState
    def = [AlphaColour Double] -> [PointShape] -> CState
    CState [AlphaColour Double]
    defColors [PointShape]
    defShapes
        where
          defColors :: [AlphaColour Double]
    defColors = [AlphaColour Double] -> [AlphaColour Double]
    forall a. HasCallStack => [a] -> [a]
    cycle ((Colour Double -> AlphaColour Double)
    -> [Colour Double] -> [AlphaColour Double]
    forall a b. (a -> b) -> [a] -> [b]
    map Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque [Colour Double
    forall a. (Ord a, Floating a) => Colour a
    blue,Colour Double
    forall a. (Ord a, Floating a) => Colour a
    green,Colour Double
    forall a. (Ord a, Floating a) => Colour a
    red,Colour Double
    forall a. (Ord a, Floating a) => Colour a
    orange,Colour Double
    forall a. (Ord a, Floating a) => Colour a
    yellow,Colour Double
    forall a. (Ord a, Floating a) => Colour a
    violet])
          defShapes :: [PointShape]
    defShapes = [PointShape] -> [PointShape]
    forall a. HasCallStack => [a] -> [a]
    cycle [PointShape
    PointShapeCircle,PointShape
    PointShapePlus,PointShape
    PointShapeCross,PointShape
    PointShapeStar]

    instance (Default a,ToRenderable a) => ToRenderable (EC a b) where
      toRenderable :: EC a b -> Renderable ()
    toRenderable = a -> Renderable ()
    forall a. ToRenderable a => a -> Renderable ()
    toRenderable (a -> Renderable ()) -> (EC a b -> a) -> EC a b -> Renderable ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EC a b -> a
    forall l a. Default l => EC l a -> l
    execEC

    -- | Run the monadic `EC` computation, and return the graphical
    -- element (ie the outer monad' state)
    execEC :: (Default l) => EC l a -> l
    execEC :: forall l a. Default l => EC l a -> l
    execEC EC l a
    ec = State CState l -> CState -> l
    forall s a. State s a -> s -> a
    evalState (EC l a -> l -> State CState l
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT EC l a
    ec l
    forall a. Default a => a
    def) CState
    forall a. Default a => a
    def

    -- | Nest the construction of a graphical element within
    -- the construction of another.
    liftEC :: (Default l1) => EC l1 a -> EC l2 l1
    liftEC :: forall l1 a l2. Default l1 => EC l1 a -> EC l2 l1
    liftEC EC l1 a
    ec = do
      cs <- State CState CState -> StateT l2 (StateT CState Identity) CState
    forall (m :: * -> *) a. Monad m => m a -> StateT l2 m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift State CState CState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (l,cs') = runState (execStateT ec def) cs
      lift (put cs')
      return l

    -- | Lift a a computation over `CState`
    liftCState :: State CState a -> EC l a
    liftCState :: forall a l. State CState a -> EC l a
    liftCState = StateT CState Identity a -> StateT l (StateT CState Identity) a
    forall (m :: * -> *) a. Monad m => m a -> StateT l m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    -- | Add a plot to the `Layout` being constructed.
    plot :: (ToPlot p) => EC (Layout x y) (p x y) -> EC (Layout x y) ()
    plot :: forall (p :: * -> * -> *) x y.
    ToPlot p =>
    EC (Layout x y) (p x y) -> EC (Layout x y) ()
    plot EC (Layout x y) (p x y)
    pm = do
        p <- EC (Layout x y) (p x y)
    pm
        layout_plots %= (++[toPlot p])

    -- | Add a plot against the left axis to the `LayoutLR` being constructed.
    plotLeft :: (ToPlot p) => EC (LayoutLR x y1 y2) (p x y1) -> EC (LayoutLR x y1 y2) ()
    plotLeft :: forall (p :: * -> * -> *) x y1 y2.
    ToPlot p =>
    EC (LayoutLR x y1 y2) (p x y1) -> EC (LayoutLR x y1 y2) ()
    plotLeft EC (LayoutLR x y1 y2) (p x y1)
    pm = do
      p <- EC (LayoutLR x y1 y2) (p x y1)
    pm
      layoutlr_plots %= (++[Left (toPlot p)])

    -- | Add a plot against the right axis tof the `LayoutLR` being constructed.
    plotRight :: (ToPlot p) => EC (LayoutLR x y1 y2) (p x y2) -> EC (LayoutLR x y1 y2) ()
    plotRight :: forall (p :: * -> * -> *) x y1 y2.
    ToPlot p =>
    EC (LayoutLR x y1 y2) (p x y2) -> EC (LayoutLR x y1 y2) ()
    plotRight EC (LayoutLR x y1 y2) (p x y2)
    pm = do
      p <- EC (LayoutLR x y1 y2) (p x y2)
    pm
      layoutlr_plots %= (++[Right (toPlot p)])

    -- | Pop and return the next color from the state
    takeColor :: EC l (AlphaColour Double)
    takeColor :: forall l. EC l (AlphaColour Double)
    takeColor = State CState (AlphaColour Double) -> EC l (AlphaColour Double)
    forall a l. State CState a -> EC l a
    liftCState (State CState (AlphaColour Double) -> EC l (AlphaColour Double))
    -> State CState (AlphaColour Double) -> EC l (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ do
      (c,cs) <- [AlphaColour Double] -> (AlphaColour Double, [AlphaColour Double])
    forall a. [a] -> (a, [a])
    fromInfiniteList ([AlphaColour Double]
     -> (AlphaColour Double, [AlphaColour Double]))
    -> StateT CState Identity [AlphaColour Double]
    -> StateT
         CState Identity (AlphaColour Double, [AlphaColour Double])
    forall a b.
    (a -> b) -> StateT CState Identity a -> StateT CState Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Getting [AlphaColour Double] CState [AlphaColour Double]
    -> StateT CState Identity [AlphaColour Double]
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting [AlphaColour Double] CState [AlphaColour Double]
    Lens' CState [AlphaColour Double]
    colors
      colors .= cs
      return c

    -- | Pop and return the next shape from the state
    takeShape :: EC l PointShape
    takeShape :: forall l. EC l PointShape
    takeShape = State CState PointShape -> EC l PointShape
    forall a l. State CState a -> EC l a
    liftCState (State CState PointShape -> EC l PointShape)
    -> State CState PointShape -> EC l PointShape
    forall a b. (a -> b) -> a -> b
    $ do
      (c,cs) <- [PointShape] -> (PointShape, [PointShape])
    forall a. [a] -> (a, [a])
    fromInfiniteList ([PointShape] -> (PointShape, [PointShape]))
    -> StateT CState Identity [PointShape]
    -> StateT CState Identity (PointShape, [PointShape])
    forall a b.
    (a -> b) -> StateT CState Identity a -> StateT CState Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Getting [PointShape] CState [PointShape]
    -> StateT CState Identity [PointShape]
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting [PointShape] CState [PointShape]
    Lens' CState [PointShape]
    shapes
      shapes .= cs
      return c

    fromInfiniteList :: [a] -> (a, [a])
    fromInfiniteList :: forall a. [a] -> (a, [a])
    fromInfiniteList []     = [Char] -> (a, [a])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "fromInfiniteList (takeColor or takeShape): empty list"
    fromInfiniteList (a
    x:[a]
    xs) = (a
    x, [a]
    xs)