{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE ViewPatterns               #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Attributes
-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Diagrams may have /attributes/ which affect the way they are
-- rendered.  This module defines some common attributes; particular
-- backends may also define more backend-specific attributes.
--
-- Every attribute type must have a /semigroup/ structure, that is, an
-- associative binary operation for combining two attributes into one.
-- Unless otherwise noted, all the attributes defined here use the
-- 'Last' structure, that is, combining two attributes simply keeps
-- the second one and throws away the first.  This means that child
-- attributes always override parent attributes.
--
-----------------------------------------------------------------------------

module Diagrams.Attributes (
    -- ** Standard measures
    ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick, none
  , tiny, verySmall, small, normal, large, veryLarge, huge

    -- ** Line width
  , LineWidth, getLineWidth
  , _LineWidth, _LineWidthM
  , lineWidth, lineWidthM
  , _lineWidth, _lw, _lineWidthU
  , lw, lwN, lwO, lwL, lwG

    -- ** Dashing
  , Dashing(..), getDashing
  , dashing, dashingN, dashingO, dashingL, dashingG
  , _dashing, _dashingU

  -- * Color
  -- $color

  , Color(..), SomeColor(..), _SomeColor, someToAlpha

  -- ** Opacity
  , Opacity, _Opacity
  , getOpacity, opacity, _opacity

  , FillOpacity, _FillOpacity
  , getFillOpacity, fillOpacity, _fillOpacity

  , StrokeOpacity, _StrokeOpacity
  , getStrokeOpacity, strokeOpacity, _strokeOpacity

  -- ** Converting colors
  , colorToSRGBA, colorToRGBA

  -- * Line stuff
  -- ** Cap style
  , LineCap(..)
  , getLineCap, lineCap, _lineCap

  -- ** Join style
  , LineJoin(..)
  , getLineJoin, lineJoin, _lineJoin

  -- ** Miter limit
  , LineMiterLimit(..), _LineMiterLimit
  , getLineMiterLimit, lineMiterLimit, lineMiterLimitA, _lineMiterLimit

  -- * Recommend optics

  , _Recommend
  , _Commit
  , _recommend
  , isCommitted
  , committed

  ) where

import           Control.Lens          hiding (none, over)
import           Data.Colour
import           Data.Colour.RGBSpace  (RGB (..))
import           Data.Colour.SRGB      (toSRGB)
import           Data.Default.Class
import           Data.Distributive
import           Data.Monoid.Recommend
import           Data.Semigroup
import           Data.Typeable

import           Diagrams.Core

------------------------------------------------------------------------
-- Standard measures
------------------------------------------------------------------------

none, ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick,
  tiny, verySmall, small, normal, large, veryLarge, huge
  :: OrderedField n => Measure n
none :: forall n. OrderedField n => Measure n
none       = forall n. n -> Measure n
output n
0
ultraThin :: forall n. OrderedField n => Measure n
ultraThin  = forall n. Num n => n -> Measure n
normalized n
0.0005 forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
veryThin :: forall n. OrderedField n => Measure n
veryThin   = forall n. Num n => n -> Measure n
normalized n
0.001  forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
thin :: forall n. OrderedField n => Measure n
thin       = forall n. Num n => n -> Measure n
normalized n
0.002  forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
medium :: forall n. OrderedField n => Measure n
medium     = forall n. Num n => n -> Measure n
normalized n
0.004  forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
thick :: forall n. OrderedField n => Measure n
thick      = forall n. Num n => n -> Measure n
normalized n
0.0075 forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
veryThick :: forall n. OrderedField n => Measure n
veryThick  = forall n. Num n => n -> Measure n
normalized n
0.01   forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5
ultraThick :: forall n. OrderedField n => Measure n
ultraThick = forall n. Num n => n -> Measure n
normalized n
0.02   forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` forall n. n -> Measure n
output n
0.5

tiny :: forall n. OrderedField n => Measure n
tiny      = forall n. Num n => n -> Measure n
normalized n
0.01
verySmall :: forall n. OrderedField n => Measure n
verySmall = forall n. Num n => n -> Measure n
normalized n
0.015
small :: forall n. OrderedField n => Measure n
small     = forall n. Num n => n -> Measure n
normalized n
0.023
normal :: forall n. OrderedField n => Measure n
normal    = forall n. Num n => n -> Measure n
normalized n
0.035
large :: forall n. OrderedField n => Measure n
large     = forall n. Num n => n -> Measure n
normalized n
0.05
veryLarge :: forall n. OrderedField n => Measure n
veryLarge = forall n. Num n => n -> Measure n
normalized n
0.07
huge :: forall n. OrderedField n => Measure n
huge      = forall n. Num n => n -> Measure n
normalized n
0.10

------------------------------------------------------------------------
-- Line width
------------------------------------------------------------------------

-- | Line widths specified on child nodes always override line widths
--   specified at parent nodes.
newtype LineWidth n = LineWidth (Last n)
  deriving (Typeable, NonEmpty (LineWidth n) -> LineWidth n
LineWidth n -> LineWidth n -> LineWidth n
forall b. Integral b => b -> LineWidth n -> LineWidth n
forall n. NonEmpty (LineWidth n) -> LineWidth n
forall n. LineWidth n -> LineWidth n -> LineWidth n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> LineWidth n -> LineWidth n
stimes :: forall b. Integral b => b -> LineWidth n -> LineWidth n
$cstimes :: forall n b. Integral b => b -> LineWidth n -> LineWidth n
sconcat :: NonEmpty (LineWidth n) -> LineWidth n
$csconcat :: forall n. NonEmpty (LineWidth n) -> LineWidth n
<> :: LineWidth n -> LineWidth n -> LineWidth n
$c<> :: forall n. LineWidth n -> LineWidth n -> LineWidth n
Semigroup)

_LineWidth :: Iso' (LineWidth n) n
_LineWidth :: forall n. Iso' (LineWidth n) n
_LineWidth = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall n. LineWidth n -> n
getLineWidth (forall n. Last n -> LineWidth n
LineWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last)

_LineWidthM :: Iso' (LineWidthM n) (Measure n)
_LineWidthM :: forall n. Iso' (LineWidthM n) (Measure n)
_LineWidthM = forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping forall n. Iso' (LineWidth n) n
_LineWidth

instance Typeable n => AttributeClass (LineWidth n)

type LineWidthM n = Measured n (LineWidth n)

instance OrderedField n => Default (LineWidthM n) where
  def :: LineWidthM n
def = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Last n -> LineWidth n
LineWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last) forall n. OrderedField n => Measure n
medium

getLineWidth :: LineWidth n -> n
getLineWidth :: forall n. LineWidth n -> n
getLineWidth (LineWidth (Last n
w)) = n
w

-- | Set the line (stroke) width.
lineWidth :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
lineWidth :: forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lineWidth = forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Last n -> LineWidth n
LineWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last)

-- | Apply a 'LineWidth' attribute.
lineWidthM :: (N a ~ n, HasStyle a, Typeable n) => LineWidthM n -> a -> a
lineWidthM :: forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
LineWidthM n -> a -> a
lineWidthM = forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr

-- | Default for 'lineWidth'.
lw :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
lw :: forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lineWidth

-- | A convenient synonym for 'lineWidth (global w)'.
lwG :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG :: forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => n -> Measure n
global

-- | A convenient synonym for 'lineWidth (normalized w)'.
lwN :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwN :: forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwN = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => n -> Measure n
normalized

-- | A convenient synonym for 'lineWidth (output w)'.
lwO :: (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO :: forall a n. (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. n -> Measure n
output

-- | A convenient sysnonym for 'lineWidth (local w)'.
lwL :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL :: forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => n -> Measure n
local

-- | Lens onto a measured line width in a style.
_lineWidth, _lw :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
_lineWidth :: forall n (v :: * -> *).
(Typeable n, OrderedField n) =>
Lens' (Style v n) (Measure n)
_lineWidth = forall a n (v :: * -> *).
(AttributeClass a, Typeable n) =>
Lens' (Style v n) (Maybe (Measured n a))
atMAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon forall a. Default a => a
def (forall a b. a -> b -> a
const Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Iso' (LineWidthM n) (Measure n)
_LineWidthM
_lw :: forall n (v :: * -> *).
(Typeable n, OrderedField n) =>
Lens' (Style v n) (Measure n)
_lw = forall n (v :: * -> *).
(Typeable n, OrderedField n) =>
Lens' (Style v n) (Measure n)
_lineWidth

-- | Lens onto the unmeasured linewith attribute. This is useful for
--   backends to use on styles once they have been unmeasured. Using on
--   a diagram style could lead to unexpected results.
_lineWidthU :: Typeable n => Lens' (Style v n) (Maybe n)
_lineWidthU :: forall n (v :: * -> *). Typeable n => Lens' (Style v n) (Maybe n)
_lineWidthU = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping forall n. Iso' (LineWidth n) n
_LineWidth

------------------------------------------------------------------------
-- Dashing
------------------------------------------------------------------------

-- | Create lines that are dashing... er, dashed.
data Dashing n = Dashing [n] n
  deriving (forall a b. a -> Dashing b -> Dashing a
forall a b. (a -> b) -> Dashing a -> Dashing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Dashing b -> Dashing a
$c<$ :: forall a b. a -> Dashing b -> Dashing a
fmap :: forall a b. (a -> b) -> Dashing a -> Dashing b
$cfmap :: forall a b. (a -> b) -> Dashing a -> Dashing b
Functor, Typeable, Dashing n -> Dashing n -> Bool
forall n. Eq n => Dashing n -> Dashing n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dashing n -> Dashing n -> Bool
$c/= :: forall n. Eq n => Dashing n -> Dashing n -> Bool
== :: Dashing n -> Dashing n -> Bool
$c== :: forall n. Eq n => Dashing n -> Dashing n -> Bool
Eq)

instance Semigroup (Dashing n) where
  Dashing n
_ <> :: Dashing n -> Dashing n -> Dashing n
<> Dashing n
b = Dashing n
b

instance Typeable n => AttributeClass (Dashing n)

getDashing :: Dashing n -> Dashing n
getDashing :: forall n. Dashing n -> Dashing n
getDashing = forall a. a -> a
id

-- | Set the line dashing style.
dashing :: (N a ~ n, HasStyle a, Typeable n)
        => [Measure n]  -- ^ A list specifying alternate lengths of on
                        --   and off portions of the stroke.  The empty
                        --   list indicates no dashing.
        -> Measure n    -- ^ An offset into the dash pattern at which the
                        --   stroke should start.
        -> a -> a
dashing :: forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing [Measure n]
ds Measure n
offs = forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute forall a b. (a -> b) -> a -> b
$ forall n. [n] -> n -> Dashing n
Dashing [Measure n]
ds Measure n
offs

-- | A convenient synonym for 'dashing (global w)'.
dashingG :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingG :: forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingG [n]
w n
v = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing (forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => n -> Measure n
global [n]
w) (forall n. Num n => n -> Measure n
global n
v)

-- | A convenient synonym for 'dashing (normalized w)'.
dashingN :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingN :: forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingN [n]
w n
v = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing (forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => n -> Measure n
normalized [n]
w) (forall n. Num n => n -> Measure n
normalized n
v)

-- | A convenient synonym for 'dashing (output w)'.
dashingO :: (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a
dashingO :: forall a n. (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a
dashingO [n]
w n
v = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing (forall a b. (a -> b) -> [a] -> [b]
map forall n. n -> Measure n
output [n]
w) (forall n. n -> Measure n
output n
v)

-- | A convenient sysnonym for 'dashing (local w)'.
dashingL :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingL :: forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingL [n]
w n
v = forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing (forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => n -> Measure n
local [n]
w) (forall n. Num n => n -> Measure n
local n
v)

-- | Lens onto a measured dashing attribute in a style.
_dashing :: Typeable n
         => Lens' (Style v n) (Maybe (Measured n (Dashing n)))
_dashing :: forall n (v :: * -> *).
Typeable n =>
Lens' (Style v n) (Maybe (Measured n (Dashing n)))
_dashing = forall a n (v :: * -> *).
(AttributeClass a, Typeable n) =>
Lens' (Style v n) (Maybe (Measured n a))
atMAttr

-- | Lens onto the unmeasured 'Dashing' attribute. This is useful for
--   backends to use on styles once they have been unmeasured. Using on
--   a diagram style could lead to unexpected results.
_dashingU :: Typeable n => Lens' (Style v n) (Maybe (Dashing n))
_dashingU :: forall n (v :: * -> *).
Typeable n =>
Lens' (Style v n) (Maybe (Dashing n))
_dashingU = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr

------------------------------------------------------------------------
-- Color
------------------------------------------------------------------------

-- $color
-- Diagrams outsources all things color-related to Russell O\'Connor\'s
-- very nice colour package
-- (<http://hackage.haskell.org/package/colour>).  For starters, it
-- provides a large collection of standard color names.  However, it
-- also provides a rich set of combinators for combining and
-- manipulating colors; see its documentation for more information.

-- | The 'Color' type class encompasses color representations which
--   can be used by the Diagrams library.  Instances are provided for
--   both the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types
--   from the "Data.Colour" library.
class Color c where
  -- | Convert a color to its standard representation, AlphaColour.
  toAlphaColour :: c -> AlphaColour Double

  -- | Convert from an AlphaColour Double.  Note that this direction
  --   may lose some information. For example, the instance for
  --   'Colour' drops the alpha channel.
  fromAlphaColour :: AlphaColour Double -> c

-- | An existential wrapper for instances of the 'Color' class.
data SomeColor = forall c. Color c => SomeColor c
  deriving Typeable

instance Show SomeColor where
  showsPrec :: Int -> SomeColor -> ShowS
showsPrec Int
d (forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA -> (Double
r,Double
g,Double
b,Double
a)) =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"SomeColor " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      if Double
a forall a. Eq a => a -> a -> Bool
== Double
0
        then String -> ShowS
showString String
"transparent"
        else String -> ShowS
showString String
"(sRGB " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
b forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (if Double
a forall a. Eq a => a -> a -> Bool
/= Double
1
                           then String -> ShowS
showString String
" `withOpacity` " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
a
                           else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'

-- | Isomorphism between 'SomeColor' and 'AlphaColour' 'Double'.
_SomeColor :: Iso' SomeColor (AlphaColour Double)
_SomeColor :: Iso' SomeColor (AlphaColour Double)
_SomeColor = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall c. Color c => c -> AlphaColour Double
toAlphaColour forall c. Color c => AlphaColour Double -> c
fromAlphaColour

someToAlpha :: SomeColor -> AlphaColour Double
someToAlpha :: SomeColor -> AlphaColour Double
someToAlpha (SomeColor c
c) = forall c. Color c => c -> AlphaColour Double
toAlphaColour c
c

instance a ~ Double => Color (Colour a) where
  toAlphaColour :: Colour a -> AlphaColour Double
toAlphaColour   = forall a. Num a => Colour a -> AlphaColour a
opaque
  fromAlphaColour :: AlphaColour Double -> Colour a
fromAlphaColour = (forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` forall a. Num a => Colour a
black)

instance a ~ Double => Color (AlphaColour a) where
  toAlphaColour :: AlphaColour a -> AlphaColour Double
toAlphaColour   = forall a. a -> a
id
  fromAlphaColour :: AlphaColour Double -> AlphaColour a
fromAlphaColour = forall a. a -> a
id

instance Color SomeColor where
  toAlphaColour :: SomeColor -> AlphaColour Double
toAlphaColour (SomeColor c
c) = forall c. Color c => c -> AlphaColour Double
toAlphaColour c
c
  fromAlphaColour :: AlphaColour Double -> SomeColor
fromAlphaColour             = forall c. Color c => c -> SomeColor
SomeColor

-- | Convert to sRGBA.
colorToSRGBA, colorToRGBA :: Color c => c -> (Double, Double, Double, Double)
colorToSRGBA :: forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA c
col = (Double
r, Double
g, Double
b, Double
a)
  where
    c' :: AlphaColour Double
c' = forall c. Color c => c -> AlphaColour Double
toAlphaColour c
col
    c :: Colour Double
c = forall a. (Floating a, Ord a) => AlphaColour a -> Colour a
alphaToColour AlphaColour Double
c'
    a :: Double
a = forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
c'
    RGB Double
r Double
g Double
b = forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Colour Double
c

colorToRGBA :: forall c. Color c => c -> (Double, Double, Double, Double)
colorToRGBA = forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA
{-# DEPRECATED colorToRGBA "Renamed to colorToSRGBA." #-}

alphaToColour :: (Floating a, Ord a) => AlphaColour a -> Colour a
alphaToColour :: forall a. (Floating a, Ord a) => AlphaColour a -> Colour a
alphaToColour AlphaColour a
ac | forall a. AlphaColour a -> a
alphaChannel AlphaColour a
ac forall a. Eq a => a -> a -> Bool
== a
0 = AlphaColour a
ac forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` forall a. Num a => Colour a
black
                 | Bool
otherwise = forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
darken (forall a. Fractional a => a -> a
recip (forall a. AlphaColour a -> a
alphaChannel AlphaColour a
ac)) (AlphaColour a
ac forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` forall a. Num a => Colour a
black)

------------------------------------------------------------------------
-- Opacity
------------------------------------------------------------------------

-- | Although the individual colors in a diagram can have
--   transparency, the opacity/transparency of a diagram as a whole
--   can be specified with the @Opacity@ attribute.  The opacity is a
--   value between 1 (completely opaque, the default) and 0
--   (completely transparent).  Opacity is multiplicative, that is,
--   @'opacity' o1 . 'opacity' o2 === 'opacity' (o1 * o2)@.  In other
--   words, for example, @opacity 0.8@ means \"decrease this diagram's
--   opacity to 80% of its previous opacity\".
newtype Opacity = Opacity (Product Double)
  deriving (Typeable, NonEmpty Opacity -> Opacity
Opacity -> Opacity -> Opacity
forall b. Integral b => b -> Opacity -> Opacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Opacity -> Opacity
$cstimes :: forall b. Integral b => b -> Opacity -> Opacity
sconcat :: NonEmpty Opacity -> Opacity
$csconcat :: NonEmpty Opacity -> Opacity
<> :: Opacity -> Opacity -> Opacity
$c<> :: Opacity -> Opacity -> Opacity
Semigroup)
instance AttributeClass Opacity

_Opacity :: Iso' Opacity Double
_Opacity :: Iso' Opacity Double
_Opacity = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Opacity -> Double
getOpacity (Product Double -> Opacity
Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product)

getOpacity :: Opacity -> Double
getOpacity :: Opacity -> Double
getOpacity (Opacity (Product Double
d)) = Double
d

-- | Multiply the opacity (see 'Opacity') by the given value.  For
--   example, @opacity 0.8@ means \"decrease this diagram's opacity to
--   80% of its previous opacity\".
opacity :: HasStyle a => Double -> a -> a
opacity :: forall a. HasStyle a => Double -> a -> a
opacity = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> Opacity
Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product

-- | Lens onto the opacity in a style.
_opacity :: Lens' (Style v n) Double
_opacity :: forall (v :: * -> *) n. Lens' (Style v n) Double
_opacity = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping Iso' Opacity Double
_Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

-- fill opacity --------------------------------------------------------

-- | Like 'Opacity', but set the opacity only for fills (as opposed to strokes).
--   As with 'Opacity', the fill opacity is a value between 1
--   (completely opaque, the default) and 0 (completely transparent),
--   and is multiplicative.
newtype FillOpacity = FillOpacity (Product Double)
  deriving (Typeable, NonEmpty FillOpacity -> FillOpacity
FillOpacity -> FillOpacity -> FillOpacity
forall b. Integral b => b -> FillOpacity -> FillOpacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> FillOpacity -> FillOpacity
$cstimes :: forall b. Integral b => b -> FillOpacity -> FillOpacity
sconcat :: NonEmpty FillOpacity -> FillOpacity
$csconcat :: NonEmpty FillOpacity -> FillOpacity
<> :: FillOpacity -> FillOpacity -> FillOpacity
$c<> :: FillOpacity -> FillOpacity -> FillOpacity
Semigroup)
instance AttributeClass FillOpacity

_FillOpacity :: Iso' FillOpacity Double
_FillOpacity :: Iso' FillOpacity Double
_FillOpacity = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FillOpacity -> Double
getFillOpacity (Product Double -> FillOpacity
FillOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product)

getFillOpacity :: FillOpacity -> Double
getFillOpacity :: FillOpacity -> Double
getFillOpacity (FillOpacity (Product Double
d)) = Double
d

-- | Multiply the fill opacity (see 'FillOpacity') by the given value.  For
--   example, @fillOpacity 0.8@ means \"decrease this diagram's fill opacity to
--   80% of its previous value\".
fillOpacity :: HasStyle a => Double -> a -> a
fillOpacity :: forall a. HasStyle a => Double -> a -> a
fillOpacity = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> FillOpacity
FillOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product

-- | Lens onto the fill opacity in a style.
_fillOpacity :: Lens' (Style v n) Double
_fillOpacity :: forall (v :: * -> *) n. Lens' (Style v n) Double
_fillOpacity = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping Iso' FillOpacity Double
_FillOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

-- stroke opacity --------------------------------------------------------

-- | Like 'Opacity', but set the opacity only for strokes (as opposed to fills).
--   As with 'Opacity', the fill opacity is a value between 1
--   (completely opaque, the default) and 0 (completely transparent),
--   and is multiplicative.
newtype StrokeOpacity = StrokeOpacity (Product Double)
  deriving (Typeable, NonEmpty StrokeOpacity -> StrokeOpacity
StrokeOpacity -> StrokeOpacity -> StrokeOpacity
forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity
$cstimes :: forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity
sconcat :: NonEmpty StrokeOpacity -> StrokeOpacity
$csconcat :: NonEmpty StrokeOpacity -> StrokeOpacity
<> :: StrokeOpacity -> StrokeOpacity -> StrokeOpacity
$c<> :: StrokeOpacity -> StrokeOpacity -> StrokeOpacity
Semigroup)
instance AttributeClass StrokeOpacity

_StrokeOpacity :: Iso' StrokeOpacity Double
_StrokeOpacity :: Iso' StrokeOpacity Double
_StrokeOpacity = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso StrokeOpacity -> Double
getStrokeOpacity (Product Double -> StrokeOpacity
StrokeOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product)

getStrokeOpacity :: StrokeOpacity -> Double
getStrokeOpacity :: StrokeOpacity -> Double
getStrokeOpacity (StrokeOpacity (Product Double
d)) = Double
d

-- | Multiply the stroke opacity (see 'StrokeOpacity') by the given value.  For
--   example, @strokeOpacity 0.8@ means \"decrease this diagram's
--   stroke opacity to 80% of its previous value\".
strokeOpacity :: HasStyle a => Double -> a -> a
strokeOpacity :: forall a. HasStyle a => Double -> a -> a
strokeOpacity = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> StrokeOpacity
StrokeOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Product a
Product

-- | Lens onto the stroke opacity in a style.
_strokeOpacity :: Lens' (Style v n) Double
_strokeOpacity :: forall (v :: * -> *) n. Lens' (Style v n) Double
_strokeOpacity = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping Iso' StrokeOpacity Double
_StrokeOpacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

------------------------------------------------------------------------
-- Line stuff
------------------------------------------------------------------------

-- line cap ------------------------------------------------------------

-- | What sort of shape should be placed at the endpoints of lines?
data LineCap = LineCapButt   -- ^ Lines end precisely at their endpoints.
             | LineCapRound  -- ^ Lines are capped with semicircles
                             --   centered on endpoints.
             | LineCapSquare -- ^ Lines are capped with a squares
                             --   centered on endpoints.
  deriving (LineCap -> LineCap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineCap -> LineCap -> Bool
$c/= :: LineCap -> LineCap -> Bool
== :: LineCap -> LineCap -> Bool
$c== :: LineCap -> LineCap -> Bool
Eq, Eq LineCap
LineCap -> LineCap -> Bool
LineCap -> LineCap -> Ordering
LineCap -> LineCap -> LineCap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineCap -> LineCap -> LineCap
$cmin :: LineCap -> LineCap -> LineCap
max :: LineCap -> LineCap -> LineCap
$cmax :: LineCap -> LineCap -> LineCap
>= :: LineCap -> LineCap -> Bool
$c>= :: LineCap -> LineCap -> Bool
> :: LineCap -> LineCap -> Bool
$c> :: LineCap -> LineCap -> Bool
<= :: LineCap -> LineCap -> Bool
$c<= :: LineCap -> LineCap -> Bool
< :: LineCap -> LineCap -> Bool
$c< :: LineCap -> LineCap -> Bool
compare :: LineCap -> LineCap -> Ordering
$ccompare :: LineCap -> LineCap -> Ordering
Ord, Int -> LineCap -> ShowS
[LineCap] -> ShowS
LineCap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCap] -> ShowS
$cshowList :: [LineCap] -> ShowS
show :: LineCap -> String
$cshow :: LineCap -> String
showsPrec :: Int -> LineCap -> ShowS
$cshowsPrec :: Int -> LineCap -> ShowS
Show, Typeable)

instance Default LineCap where
  def :: LineCap
def = LineCap
LineCapButt

instance AttributeClass LineCap

-- | Last semigroup structure.
instance Semigroup LineCap where
  LineCap
_ <> :: LineCap -> LineCap -> LineCap
<> LineCap
b = LineCap
b

getLineCap :: LineCap -> LineCap
getLineCap :: LineCap -> LineCap
getLineCap = forall a. a -> a
id

-- | Set the line end cap attribute.
lineCap :: HasStyle a => LineCap -> a -> a
lineCap :: forall a. HasStyle a => LineCap -> a -> a
lineCap = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line cap in a style.
_lineCap :: Lens' (Style v n) LineCap
_lineCap :: forall (v :: * -> *) n. Lens' (Style v n) LineCap
_lineCap = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def

-- line join -----------------------------------------------------------

-- | How should the join points between line segments be drawn?
data LineJoin = LineJoinMiter    -- ^ Use a \"miter\" shape (whatever that is).
              | LineJoinRound    -- ^ Use rounded join points.
              | LineJoinBevel    -- ^ Use a \"bevel\" shape (whatever
                                 --   that is).  Are these...
                                 --   carpentry terms?
  deriving (LineJoin -> LineJoin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineJoin -> LineJoin -> Bool
$c/= :: LineJoin -> LineJoin -> Bool
== :: LineJoin -> LineJoin -> Bool
$c== :: LineJoin -> LineJoin -> Bool
Eq, Eq LineJoin
LineJoin -> LineJoin -> Bool
LineJoin -> LineJoin -> Ordering
LineJoin -> LineJoin -> LineJoin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineJoin -> LineJoin -> LineJoin
$cmin :: LineJoin -> LineJoin -> LineJoin
max :: LineJoin -> LineJoin -> LineJoin
$cmax :: LineJoin -> LineJoin -> LineJoin
>= :: LineJoin -> LineJoin -> Bool
$c>= :: LineJoin -> LineJoin -> Bool
> :: LineJoin -> LineJoin -> Bool
$c> :: LineJoin -> LineJoin -> Bool
<= :: LineJoin -> LineJoin -> Bool
$c<= :: LineJoin -> LineJoin -> Bool
< :: LineJoin -> LineJoin -> Bool
$c< :: LineJoin -> LineJoin -> Bool
compare :: LineJoin -> LineJoin -> Ordering
$ccompare :: LineJoin -> LineJoin -> Ordering
Ord, Int -> LineJoin -> ShowS
[LineJoin] -> ShowS
LineJoin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineJoin] -> ShowS
$cshowList :: [LineJoin] -> ShowS
show :: LineJoin -> String
$cshow :: LineJoin -> String
showsPrec :: Int -> LineJoin -> ShowS
$cshowsPrec :: Int -> LineJoin -> ShowS
Show, Typeable)

instance AttributeClass LineJoin

-- | Last semigroup structure.
instance Semigroup LineJoin where
  LineJoin
_ <> :: LineJoin -> LineJoin -> LineJoin
<> LineJoin
b = LineJoin
b

instance Default LineJoin where
  def :: LineJoin
def = LineJoin
LineJoinMiter

getLineJoin :: LineJoin -> LineJoin
getLineJoin :: LineJoin -> LineJoin
getLineJoin = forall a. a -> a
id

-- | Set the segment join style.
lineJoin :: HasStyle a => LineJoin -> a -> a
lineJoin :: forall a. HasStyle a => LineJoin -> a -> a
lineJoin = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line join type in a style.
_lineJoin :: Lens' (Style v n) LineJoin
_lineJoin :: forall (v :: * -> *) n. Lens' (Style v n) LineJoin
_lineJoin = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def

-- miter limit ---------------------------------------------------------

-- | Miter limit attribute affecting the 'LineJoinMiter' joins.
--   For some backends this value may have additional effects.
newtype LineMiterLimit = LineMiterLimit (Last Double)
  deriving (Typeable, NonEmpty LineMiterLimit -> LineMiterLimit
LineMiterLimit -> LineMiterLimit -> LineMiterLimit
forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit
$cstimes :: forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit
sconcat :: NonEmpty LineMiterLimit -> LineMiterLimit
$csconcat :: NonEmpty LineMiterLimit -> LineMiterLimit
<> :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$c<> :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
Semigroup, LineMiterLimit -> LineMiterLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineMiterLimit -> LineMiterLimit -> Bool
$c/= :: LineMiterLimit -> LineMiterLimit -> Bool
== :: LineMiterLimit -> LineMiterLimit -> Bool
$c== :: LineMiterLimit -> LineMiterLimit -> Bool
Eq, Eq LineMiterLimit
LineMiterLimit -> LineMiterLimit -> Bool
LineMiterLimit -> LineMiterLimit -> Ordering
LineMiterLimit -> LineMiterLimit -> LineMiterLimit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$cmin :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
max :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$cmax :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
>= :: LineMiterLimit -> LineMiterLimit -> Bool
$c>= :: LineMiterLimit -> LineMiterLimit -> Bool
> :: LineMiterLimit -> LineMiterLimit -> Bool
$c> :: LineMiterLimit -> LineMiterLimit -> Bool
<= :: LineMiterLimit -> LineMiterLimit -> Bool
$c<= :: LineMiterLimit -> LineMiterLimit -> Bool
< :: LineMiterLimit -> LineMiterLimit -> Bool
$c< :: LineMiterLimit -> LineMiterLimit -> Bool
compare :: LineMiterLimit -> LineMiterLimit -> Ordering
$ccompare :: LineMiterLimit -> LineMiterLimit -> Ordering
Ord)
instance AttributeClass LineMiterLimit

_LineMiterLimit :: Iso' LineMiterLimit Double
_LineMiterLimit :: Iso' LineMiterLimit Double
_LineMiterLimit = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso LineMiterLimit -> Double
getLineMiterLimit (Last Double -> LineMiterLimit
LineMiterLimit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last)

instance Default LineMiterLimit where
  def :: LineMiterLimit
def = Last Double -> LineMiterLimit
LineMiterLimit (forall a. a -> Last a
Last Double
10)

getLineMiterLimit :: LineMiterLimit -> Double
getLineMiterLimit :: LineMiterLimit -> Double
getLineMiterLimit (LineMiterLimit (Last Double
l)) = Double
l

-- | Set the miter limit for joins with 'LineJoinMiter'.
lineMiterLimit :: HasStyle a => Double -> a -> a
lineMiterLimit :: forall a. HasStyle a => Double -> a -> a
lineMiterLimit = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last Double -> LineMiterLimit
LineMiterLimit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last

-- | Apply a 'LineMiterLimit' attribute.
lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a
lineMiterLimitA :: forall a. HasStyle a => LineMiterLimit -> a -> a
lineMiterLimitA = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line miter limit in a style.
_lineMiterLimit :: Lens' (Style v n) Double
_lineMiterLimit :: forall (v :: * -> *) n. Lens' (Style v n) Double
_lineMiterLimit = forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' LineMiterLimit Double
_LineMiterLimit

------------------------------------------------------------------------
-- Recommend optics
------------------------------------------------------------------------

-- | Prism onto a 'Recommend'.
_Recommend :: Prism' (Recommend a) a
_Recommend :: forall a. Prism' (Recommend a) a
_Recommend = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a. a -> Recommend a
Recommend forall a b. (a -> b) -> a -> b
$ \case (Recommend a
a) -> forall a. a -> Maybe a
Just a
a; Recommend a
_ -> forall a. Maybe a
Nothing

-- | Prism onto a 'Commit'.
_Commit :: Prism' (Recommend a) a
_Commit :: forall a. Prism' (Recommend a) a
_Commit = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a. a -> Recommend a
Commit forall a b. (a -> b) -> a -> b
$ \case (Commit a
a) -> forall a. a -> Maybe a
Just a
a; Recommend a
_ -> forall a. Maybe a
Nothing

-- | Lens onto the value inside either a 'Recommend' or 'Commit'. Unlike
--   'committed', this is a valid lens.
_recommend :: Lens (Recommend a) (Recommend b) a b
_recommend :: forall a b. Lens (Recommend a) (Recommend b) a b
_recommend a -> f b
f (Recommend a
a) = forall a. a -> Recommend a
Recommend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
_recommend a -> f b
f (Commit a
a)    = forall a. a -> Recommend a
Commit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

-- | Lens onto whether something is committed or not.
isCommitted :: Lens' (Recommend a) Bool
isCommitted :: forall a. Lens' (Recommend a) Bool
isCommitted Bool -> f Bool
f r :: Recommend a
r@(Recommend a
a) = Bool -> f Bool
f Bool
False forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
b -> if Bool
b then forall a. a -> Recommend a
Commit a
a else Recommend a
r
isCommitted Bool -> f Bool
f r :: Recommend a
r@(Commit a
a)    = Bool -> f Bool
f Bool
True  forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
b -> if Bool
b then Recommend a
r else forall a. a -> Recommend a
Recommend a
a

-- | 'Commit' a value for any 'Recommend'. This is *not* a valid 'Iso'
--   because the resulting @Recommend b@ is always a 'Commit'. This is
--   useful because it means any 'Recommend' styles set with a lens will
--   not be accidentally overridden. If you want a valid lens onto a
--   recommend value use '_recommend'.
--
--   Other lenses that use this are labeled with a warning.
committed :: Iso (Recommend a) (Recommend b) a b
committed :: forall a b. Iso (Recommend a) (Recommend b) a b
committed = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a. Recommend a -> a
getRecommend forall a. a -> Recommend a
Commit