    {-# 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. [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. [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 :: EC l a -> l
    execEC ec :: 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 :: EC l1 a -> EC l2 l1
    liftEC ec :: EC l1 a
    ec = do
      CState
    cs <- State CState CState -> StateT l2 (State CState) CState
    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 :: l1
    l,cs' :: CState
    cs') = State CState l1 -> CState -> (l1, CState)
    forall s a. State s a -> s -> (a, s)
    runState (EC l1 a -> l1 -> State CState l1
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT EC l1 a
    ec l1
    forall a. Default a => a
    def) CState
    cs
      State CState () -> StateT l2 (State CState) ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (CState -> State CState ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put CState
    cs')
      l1 -> EC l2 l1
    forall (m :: * -> *) a. Monad m => a -> m a
    return l1
    l

    -- | Lift a a computation over `CState`
    liftCState :: State CState a -> EC l a
    liftCState :: State CState a -> EC l a
    liftCState = State CState a -> EC l 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 :: EC (Layout x y) (p x y) -> EC (Layout x y) ()
    plot pm :: EC (Layout x y) (p x y)
    pm = do
        p x y
    p <- EC (Layout x y) (p x y)
    pm
        ([Plot x y] -> Identity [Plot x y])
    -> Layout x y -> Identity (Layout x y)
    forall x y. Lens' (Layout x y) [Plot x y]
    layout_plots (([Plot x y] -> Identity [Plot x y])
     -> Layout x y -> Identity (Layout x y))
    -> ([Plot x y] -> [Plot x y]) -> EC (Layout x y) ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= ([Plot x y] -> [Plot x y] -> [Plot x y]
    forall a. [a] -> [a] -> [a]
    ++[p x y -> Plot x y
    forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
    toPlot p x y
    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 :: EC (LayoutLR x y1 y2) (p x y1) -> EC (LayoutLR x y1 y2) ()
    plotLeft pm :: EC (LayoutLR x y1 y2) (p x y1)
    pm = do
      p x y1
    p <- EC (LayoutLR x y1 y2) (p x y1)
    pm
      ([Either (Plot x y1) (Plot x y2)]
     -> Identity [Either (Plot x y1) (Plot x y2)])
    -> LayoutLR x y1 y2 -> Identity (LayoutLR x y1 y2)
    forall x y1 y2.
    Lens' (LayoutLR x y1 y2) [Either (Plot x y1) (Plot x y2)]
    layoutlr_plots (([Either (Plot x y1) (Plot x y2)]
      -> Identity [Either (Plot x y1) (Plot x y2)])
     -> LayoutLR x y1 y2 -> Identity (LayoutLR x y1 y2))
    -> ([Either (Plot x y1) (Plot x y2)]
        -> [Either (Plot x y1) (Plot x y2)])
    -> EC (LayoutLR x y1 y2) ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= ([Either (Plot x y1) (Plot x y2)]
    -> [Either (Plot x y1) (Plot x y2)]
    -> [Either (Plot x y1) (Plot x y2)]
    forall a. [a] -> [a] -> [a]
    ++[Plot x y1 -> Either (Plot x y1) (Plot x y2)
    forall a b. a -> Either a b
    Left (p x y1 -> Plot x y1
    forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
    toPlot p x y1
    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 :: EC (LayoutLR x y1 y2) (p x y2) -> EC (LayoutLR x y1 y2) ()
    plotRight pm :: EC (LayoutLR x y1 y2) (p x y2)
    pm = do
      p x y2
    p <- EC (LayoutLR x y1 y2) (p x y2)
    pm
      ([Either (Plot x y1) (Plot x y2)]
     -> Identity [Either (Plot x y1) (Plot x y2)])
    -> LayoutLR x y1 y2 -> Identity (LayoutLR x y1 y2)
    forall x y1 y2.
    Lens' (LayoutLR x y1 y2) [Either (Plot x y1) (Plot x y2)]
    layoutlr_plots (([Either (Plot x y1) (Plot x y2)]
      -> Identity [Either (Plot x y1) (Plot x y2)])
     -> LayoutLR x y1 y2 -> Identity (LayoutLR x y1 y2))
    -> ([Either (Plot x y1) (Plot x y2)]
        -> [Either (Plot x y1) (Plot x y2)])
    -> EC (LayoutLR x y1 y2) ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> (a -> b) -> m ()
    %= ([Either (Plot x y1) (Plot x y2)]
    -> [Either (Plot x y1) (Plot x y2)]
    -> [Either (Plot x y1) (Plot x y2)]
    forall a. [a] -> [a] -> [a]
    ++[Plot x y2 -> Either (Plot x y1) (Plot x y2)
    forall a b. b -> Either a b
    Right (p x y2 -> Plot x y2
    forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
    toPlot p x y2
    p)])

    -- | Pop and return the next color from the state
    takeColor :: EC l (AlphaColour Double)
    takeColor :: 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 :: AlphaColour Double
    c,cs :: [AlphaColour Double]
    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 (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
      ([AlphaColour Double] -> Identity [AlphaColour Double])
    -> CState -> Identity CState
    Lens' CState [AlphaColour Double]
    colors (([AlphaColour Double] -> Identity [AlphaColour Double])
     -> CState -> Identity CState)
    -> [AlphaColour Double] -> State CState ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= [AlphaColour Double]
    cs
      AlphaColour Double -> State CState (AlphaColour Double)
    forall (m :: * -> *) a. Monad m => a -> m a
    return AlphaColour Double
    c

    -- | Pop and return the next shape from the state
    takeShape :: EC l PointShape
    takeShape :: 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 :: PointShape
    c,cs :: [PointShape]
    cs) <- [PointShape] -> (PointShape, [PointShape])
    forall a. [a] -> (a, [a])
    fromInfiniteList ([PointShape] -> (PointShape, [PointShape]))
    -> StateT CState Identity [PointShape]
    -> StateT CState Identity (PointShape, [PointShape])
    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
      ([PointShape] -> Identity [PointShape])
    -> CState -> Identity CState
    Lens' CState [PointShape]
    shapes (([PointShape] -> Identity [PointShape])
     -> CState -> Identity CState)
    -> [PointShape] -> State CState ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= [PointShape]
    cs
      PointShape -> State CState PointShape
    forall (m :: * -> *) a. Monad m => a -> m a
    return PointShape
    c

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