    {-# LANGUAGE DataKinds             #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE GADTs                 #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE Rank2Types            #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE ViewPatterns          #-}

    {-# OPTIONS_GHC -fno-warn-unused-imports       #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.Style
    -- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- A definition of /styles/ for diagrams as extensible, heterogeneous
    -- collections of attributes.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Style
      ( -- * Attributes
        -- $attr

        AttributeClass
      , Attribute(..)

        -- ** Attributes prisms
      , _Attribute
      , _MAttribute
      , _TAttribute

        -- ** Attributes utilities
      , unwrapAttribute
      , unmeasureAttribute
      , attributeType

        -- * Styles
        -- $style

      , Style(..)

        -- ** Making styles
      , attributeToStyle

        -- ** Extracting attibutes from styles
      , getAttr
      , unmeasureAttrs

        -- ** Attibute lenses
      , atAttr
      , atMAttr
      , atTAttr

        -- ** Applying styles
      , applyAttr
      , applyMAttr
      , applyTAttr

      , HasStyle(..)

      ) where

    import           Control.Applicative
    import           Control.Arrow           ((***))
    import           Control.Lens            hiding (transform)
    import qualified Data.HashMap.Strict     as HM
    import           Data.Kind               (Type)
    import qualified Data.Map                as M
    import           Data.Monoid.Action      as A
    import           Data.Semigroup
    import qualified Data.Set                as S
    import           Data.Typeable

    import           Diagrams.Core.Measure
    import           Diagrams.Core.Transform
    import           Diagrams.Core.V

    import           Linear.Vector

    ------------------------------------------------------------
    --  Attributes  --------------------------------------------
    ------------------------------------------------------------

    -- $attr
    -- An /attribute/ is anything that determines some aspect of a
    -- diagram's rendering.  The standard diagrams library defines several
    -- standard attributes (line color, line width, fill color, etc.) but
    -- additional attributes may easily be created.  Additionally, a given
    -- backend need not handle (or even know about) attributes used in
    -- diagrams it renders.
    --
    -- The attribute code is inspired by xmonad's @Message@ type, which
    -- was in turn based on ideas in:
    --
    -- Simon Marlow.
    -- /An Extensible Dynamically-Typed Hierarchy of Exceptions/.
    -- Proceedings of the 2006 ACM SIGPLAN workshop on
    -- Haskell. <http://research.microsoft.com/apps/pubs/default.aspx?id=67968>.

    -- | Every attribute must be an instance of @AttributeClass@, which
    --   simply guarantees 'Typeable' and 'Semigroup' constraints.  The
    --   'Semigroup' instance for an attribute determines how it will combine
    --   with other attributes of the same type.
    class (Typeable a, Semigroup a) => AttributeClass a

    -- | An existential wrapper type to hold attributes.  Some attributes
    --   are simply inert/static; some are affected by transformations;
    --   and some are affected by transformations and can be modified
    --   generically.
    data Attribute (v :: Type -> Type) n :: Type where
      Attribute  :: AttributeClass a => a -> Attribute v n
      MAttribute :: AttributeClass a => Measured n a -> Attribute v n
      TAttribute :: (AttributeClass a, Transformable a, V a ~ v, N a ~ n) => a -> Attribute v n

    type instance V (Attribute v n) = v
    type instance N (Attribute v n) = n

    -- | Attributes form a semigroup, where the semigroup operation simply
    --   returns the right-hand attribute when the types do not match, and
    --   otherwise uses the semigroup operation specific to the (matching)
    --   types.
    instance Typeable n => Semigroup (Attribute v n) where
      (Attribute a
    a1)  <> :: Attribute v n -> Attribute v n -> Attribute v n
    <> (Getting (First a) (Attribute v n) a -> Attribute v n -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) (Attribute v n) a
    forall a (v :: * -> *) n.
    AttributeClass a =>
    Prism' (Attribute v n) a
    Prism' (Attribute v n) a
    _Attribute  -> Just a
    a2) = a -> Attribute v n
    forall a (v :: * -> *) n. AttributeClass a => a -> Attribute v n
    Attribute  (a
    a1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    a2)
      (MAttribute Measured n a
    a1) <> (Getting (First (Measured n a)) (Attribute v n) (Measured n a)
    -> Attribute v n -> Maybe (Measured n a)
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First (Measured n a)) (Attribute v n) (Measured n a)
    forall a n (v :: * -> *).
    (AttributeClass a, Typeable n) =>
    Prism' (Attribute v n) (Measured n a)
    Prism' (Attribute v n) (Measured n a)
    _MAttribute -> Just Measured n a
    a2) = Measured n a -> Attribute v n
    forall a n (v :: * -> *).
    AttributeClass a =>
    Measured n a -> Attribute v n
    MAttribute (Measured n a
    a1 Measured n a -> Measured n a -> Measured n a
    forall a. Semigroup a => a -> a -> a
    <> Measured n a
    a2)
      (TAttribute a
    a1) <> (Getting (First a) (Attribute (V a) (N a)) a
    -> Attribute v n -> Maybe a
    forall s (m :: * -> *) a.
    MonadReader s m =>
    Getting (First a) s a -> m (Maybe a)
    preview Getting (First a) (Attribute (V a) (N a)) a
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
    Prism' (Attribute v n) a
    Prism' (Attribute (V a) (N a)) a
    _TAttribute -> Just a
    a2) = a -> Attribute v n
    forall a (v :: * -> *) n.
    (AttributeClass a, Transformable a, V a ~ v, N a ~ n) =>
    a -> Attribute v n
    TAttribute (a
    a1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    a2)
      Attribute v n
    _               <> Attribute v n
    a2                               = Attribute v n
    a2

    -- | 'TAttribute's are transformed directly, 'MAttribute's have their
    --   local scale multiplied by the average scale of the transform.
    --   Plain 'Attribute's are unaffected.
    instance (Additive v, Traversable v, Floating n) => Transformable (Attribute v n) where
      transform :: Transformation (V (Attribute v n)) (N (Attribute v n))
    -> Attribute v n -> Attribute v n
    transform Transformation (V (Attribute v n)) (N (Attribute v n))
    _ (Attribute a
    a)  = a -> Attribute v n
    forall a (v :: * -> *) n. AttributeClass a => a -> Attribute v n
    Attribute a
    a
      transform Transformation (V (Attribute v n)) (N (Attribute v n))
    t (MAttribute Measured n a
    a) = Measured n a -> Attribute v n
    forall a n (v :: * -> *).
    AttributeClass a =>
    Measured n a -> Attribute v n
    MAttribute (Measured n a -> Attribute v n) -> Measured n a -> Attribute v n
    forall a b. (a -> b) -> a -> b
    $ n -> Measured n a -> Measured n a
    forall n a. Num n => n -> Measured n a -> Measured n a
    scaleLocal (Transformation v n -> n
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Floating n) =>
    Transformation v n -> n
    avgScale Transformation v n
    Transformation (V (Attribute v n)) (N (Attribute v n))
    t) Measured n a
    a
      transform Transformation (V (Attribute v n)) (N (Attribute v n))
    t (TAttribute a
    a) = a -> Attribute v n
    forall a (v :: * -> *) n.
    (AttributeClass a, Transformable a, V a ~ v, N a ~ n) =>
    a -> Attribute v n
    TAttribute (a -> Attribute v n) -> a -> Attribute v n
    forall a b. (a -> b) -> a -> b
    $ Transformation (V a) (N a) -> a -> a
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V a) (N a)
    Transformation (V (Attribute v n)) (N (Attribute v n))
    t a
    a

    -- | Shows the kind of attribute and the type contained in the
    --   attribute.
    instance Show (Attribute v n) where
      showsPrec :: Int -> Attribute v n -> ShowS
    showsPrec Int
    d Attribute v n
    attr = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ case Attribute v n
    attr of
        Attribute a
    a  -> String -> ShowS
    showString String
    "Attribute "  ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> TypeRep -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 (a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a)
        MAttribute Measured n a
    a -> String -> ShowS
    showString String
    "MAttribute " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> TypeRep -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 (Measured n a -> TypeRep
    forall n a. Typeable a => Measured n a -> TypeRep
    mType Measured n a
    a)
        TAttribute a
    a -> String -> ShowS
    showString String
    "TAttribute " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> TypeRep -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 (a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a)

    -- | Unwrap an unknown 'Attribute' type, performing a dynamic (but
    --   safe) check on the type of the result. If the required type
    --   matches the type of the attribute, the attribute value is
    --   returned wrapped in @Just@; if the types do not match, @Nothing@
    --   is returned.
    --
    --   Measured attributes cannot be extrated from this function until
    --   they have been unmeasured with 'unmeasureAttribute'. If you want a
    --   measured attibute use the '_MAttribute' prism.
    unwrapAttribute :: AttributeClass a => Attribute v n -> Maybe a
    unwrapAttribute :: forall a (v :: * -> *) n.
    AttributeClass a =>
    Attribute v n -> Maybe a
    unwrapAttribute (Attribute a
    a)  = a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a
    unwrapAttribute (MAttribute Measured n a
    _) = Maybe a
    forall a. Maybe a
    Nothing
    unwrapAttribute (TAttribute a
    a) = a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a
    {-# INLINE unwrapAttribute #-}

    -- | Prism onto an 'Attribute'.
    _Attribute :: AttributeClass a => Prism' (Attribute v n) a
    _Attribute :: forall a (v :: * -> *) n.
    AttributeClass a =>
    Prism' (Attribute v n) a
    _Attribute = (a -> Attribute v n)
    -> (Attribute v n -> Maybe a)
    -> Prism (Attribute v n) (Attribute v n) a a
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' a -> Attribute v n
    forall a (v :: * -> *) n. AttributeClass a => a -> Attribute v n
    Attribute ((Attribute v n -> Maybe a)
     -> Prism (Attribute v n) (Attribute v n) a a)
    -> (Attribute v n -> Maybe a)
    -> Prism (Attribute v n) (Attribute v n) a a
    forall a b. (a -> b) -> a -> b
    $ \Attribute v n
    t -> case Attribute v n
    t of Attribute a
    a -> a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a; Attribute v n
    _ -> Maybe a
    forall a. Maybe a
    Nothing
    {-# INLINE _Attribute #-}

    -- | Prism onto an 'MAttribute'.
    _MAttribute :: (AttributeClass a, Typeable n) => Prism' (Attribute v n) (Measured n a)
    _MAttribute :: forall a n (v :: * -> *).
    (AttributeClass a, Typeable n) =>
    Prism' (Attribute v n) (Measured n a)
    _MAttribute = (Measured n a -> Attribute v n)
    -> (Attribute v n -> Maybe (Measured n a))
    -> Prism
         (Attribute v n) (Attribute v n) (Measured n a) (Measured n a)
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' Measured n a -> Attribute v n
    forall a n (v :: * -> *).
    AttributeClass a =>
    Measured n a -> Attribute v n
    MAttribute ((Attribute v n -> Maybe (Measured n a))
     -> Prism
          (Attribute v n) (Attribute v n) (Measured n a) (Measured n a))
    -> (Attribute v n -> Maybe (Measured n a))
    -> Prism
         (Attribute v n) (Attribute v n) (Measured n a) (Measured n a)
    forall a b. (a -> b) -> a -> b
    $ \Attribute v n
    t -> case Attribute v n
    t of MAttribute Measured n a
    a -> Measured n a -> Maybe (Measured n a)
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast Measured n a
    a; Attribute v n
    _ -> Maybe (Measured n a)
    forall a. Maybe a
    Nothing
    {-# INLINE _MAttribute #-}

    -- | Prism onto a 'TAttribute'.
    _TAttribute :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a)
                => Prism' (Attribute v n) a
    _TAttribute :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
    Prism' (Attribute v n) a
    _TAttribute = (a -> Attribute v n)
    -> (Attribute v n -> Maybe a)
    -> Prism (Attribute v n) (Attribute v n) a a
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' a -> Attribute v n
    forall a (v :: * -> *) n.
    (AttributeClass a, Transformable a, V a ~ v, N a ~ n) =>
    a -> Attribute v n
    TAttribute ((Attribute v n -> Maybe a)
     -> Prism (Attribute v n) (Attribute v n) a a)
    -> (Attribute v n -> Maybe a)
    -> Prism (Attribute v n) (Attribute v n) a a
    forall a b. (a -> b) -> a -> b
    $ \Attribute v n
    t -> case Attribute v n
    t of TAttribute a
    a -> a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a; Attribute v n
    _ -> Maybe a
    forall a. Maybe a
    Nothing
    {-# INLINE _TAttribute #-}

    -- | Turn an 'MAttribute' into an 'Attribute' using the given 'global'
    --   and 'normalized' scale.
    unmeasureAttribute :: (Num n)
                       => n -> n -> Attribute v n -> Attribute v n
    unmeasureAttribute :: forall n (v :: * -> *).
    Num n =>
    n -> n -> Attribute v n -> Attribute v n
    unmeasureAttribute n
    g n
    n (MAttribute Measured n a
    m) = a -> Attribute v n
    forall a (v :: * -> *) n. AttributeClass a => a -> Attribute v n
    Attribute (n -> n -> Measured n a -> a
    forall n a. Num n => n -> n -> Measured n a -> a
    fromMeasured n
    g n
    n Measured n a
    m)
    unmeasureAttribute n
    _ n
    _ Attribute v n
    a              = Attribute v n
    a

    -- | Type of an attribute that is stored with a style. Measured
    --   attributes return the type as if it where unmeasured.
    attributeType :: Attribute v n -> TypeRep
    attributeType :: forall (v :: * -> *) n. Attribute v n -> TypeRep
    attributeType (Attribute a
    a)  = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a
    attributeType (MAttribute Measured n a
    a) = Measured n a -> TypeRep
    forall n a. Typeable a => Measured n a -> TypeRep
    mType Measured n a
    a
    attributeType (TAttribute a
    a) = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a

    -- Note that we use type 'a' not 'Measured n a' so we don't have to rebuild
    -- when unmeasuring the attributes.
    mType :: forall n a. Typeable a => Measured n a -> TypeRep
    mType :: forall n a. Typeable a => Measured n a -> TypeRep
    mType Measured n a
    _ = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf (a
    forall a. HasCallStack => a
    undefined :: a)

    -- naming convention: "Attribute" deals with the 'AttibuteType'
    -- directly and "Attr" is for other things (like styles). Users should
    -- rarely (if at all) deal with the 'Attibute' type directly.

    ------------------------------------------------------------
    --  Styles  ------------------------------------------------
    ------------------------------------------------------------

    -- $style
    -- A 'Style' is a heterogeneous collection of attributes, containing
    -- at most one attribute of any given type.  This is also based on
    -- ideas stolen from xmonad, specifically xmonad's implementation of
    -- user-extensible state.

    -- | A @Style@ is a heterogeneous collection of attributes, containing
    --   at most one attribute of any given type.
    newtype Style v n = Style (HM.HashMap TypeRep (Attribute v n))

    -- instances -----------------------------------------------------------

    type instance V (Style v n) = v
    type instance N (Style v n) = n

    instance Rewrapped (Style v n) (Style v' n')
    instance Wrapped (Style v n) where
      type Unwrapped (Style v n) = HM.HashMap TypeRep (Attribute v n)
      _Wrapped' :: Iso' (Style v n) (Unwrapped (Style v n))
    _Wrapped' = (Style v n -> HashMap TypeRep (Attribute v n))
    -> (HashMap TypeRep (Attribute v n) -> Style v n)
    -> Iso
         (Style v n)
         (Style v n)
         (HashMap TypeRep (Attribute v n))
         (HashMap TypeRep (Attribute v n))
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso (\(Style HashMap TypeRep (Attribute v n)
    m) -> HashMap TypeRep (Attribute v n)
    m) HashMap TypeRep (Attribute v n) -> Style v n
    forall (v :: * -> *) n.
    HashMap TypeRep (Attribute v n) -> Style v n
    Style
      {-# INLINE _Wrapped' #-}

    instance Each (Style v n) (Style v' n') (Attribute v n) (Attribute v' n') where
      each :: Traversal
      (Style v n) (Style v' n') (Attribute v n) (Attribute v' n')
    each = (Unwrapped (Style v n) -> f (Unwrapped (Style v' n')))
    -> Style v n -> f (Style v' n')
    forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
    Iso
      (Style v n)
      (Style v' n')
      (Unwrapped (Style v n))
      (Unwrapped (Style v' n'))
    _Wrapped ((Unwrapped (Style v n) -> f (Unwrapped (Style v' n')))
     -> Style v n -> f (Style v' n'))
    -> ((Attribute v n -> f (Attribute v' n'))
        -> Unwrapped (Style v n) -> f (Unwrapped (Style v' n')))
    -> (Attribute v n -> f (Attribute v' n'))
    -> Style v n
    -> f (Style v' n')
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Attribute v n -> f (Attribute v' n'))
    -> Unwrapped (Style v n) -> f (Unwrapped (Style v' n'))
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal
      (Unwrapped (Style v n))
      (Unwrapped (Style v' n'))
      (Attribute v n)
      (Attribute v' n')
    each
      {-# INLINE each #-}

    type instance Index (Style v n)   = TypeRep
    type instance IxValue (Style v n) = Attribute v n

    instance Ixed (Style v n) where
      ix :: Index (Style v n) -> Traversal' (Style v n) (IxValue (Style v n))
    ix Index (Style v n)
    k = (Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
    -> Style v n -> f (Style v n)
    forall s. Wrapped s => Iso' s (Unwrapped s)
    Iso' (Style v n) (Unwrapped (Style v n))
    _Wrapped' ((Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
     -> Style v n -> f (Style v n))
    -> ((Attribute v n -> f (Attribute v n))
        -> Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
    -> (Attribute v n -> f (Attribute v n))
    -> Style v n
    -> f (Style v n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Index (Unwrapped (Style v n))
    -> Traversal'
         (Unwrapped (Style v n)) (IxValue (Unwrapped (Style v n)))
    forall m. Ixed m => Index m -> Traversal' m (IxValue m)
    ix Index (Unwrapped (Style v n))
    Index (Style v n)
    k
      {-# INLINE ix #-}

    instance At (Style v n) where
      at :: Index (Style v n)
    -> Lens' (Style v n) (Maybe (IxValue (Style v n)))
    at Index (Style v n)
    k = (Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
    -> Style v n -> f (Style v n)
    forall s. Wrapped s => Iso' s (Unwrapped s)
    Iso' (Style v n) (Unwrapped (Style v n))
    _Wrapped' ((Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
     -> Style v n -> f (Style v n))
    -> ((Maybe (Attribute v n) -> f (Maybe (Attribute v n)))
        -> Unwrapped (Style v n) -> f (Unwrapped (Style v n)))
    -> (Maybe (Attribute v n) -> f (Maybe (Attribute v n)))
    -> Style v n
    -> f (Style v n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Index (Unwrapped (Style v n))
    -> Lens'
         (Unwrapped (Style v n)) (Maybe (IxValue (Unwrapped (Style v n))))
    forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
    at Index (Unwrapped (Style v n))
    Index (Style v n)
    k
      {-# INLINE at #-}

    -- | Combine a style by combining the attributes; if the two styles have
    --   attributes of the same type they are combined according to their
    --   semigroup structure.
    instance Typeable n => Semigroup (Style v n) where
      Style HashMap TypeRep (Attribute v n)
    s1 <> :: Style v n -> Style v n -> Style v n
    <> Style HashMap TypeRep (Attribute v n)
    s2 = HashMap TypeRep (Attribute v n) -> Style v n
    forall (v :: * -> *) n.
    HashMap TypeRep (Attribute v n) -> Style v n
    Style (HashMap TypeRep (Attribute v n) -> Style v n)
    -> HashMap TypeRep (Attribute v n) -> Style v n
    forall a b. (a -> b) -> a -> b
    $ (Attribute v n -> Attribute v n -> Attribute v n)
    -> HashMap TypeRep (Attribute v n)
    -> HashMap TypeRep (Attribute v n)
    -> HashMap TypeRep (Attribute v n)
    forall k v.
    Eq k =>
    (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
    HM.unionWith Attribute v n -> Attribute v n -> Attribute v n
    forall a. Semigroup a => a -> a -> a
    (<>) HashMap TypeRep (Attribute v n)
    s1 HashMap TypeRep (Attribute v n)
    s2

    -- | The empty style contains no attributes.
    instance Typeable n => Monoid (Style v n) where
      mempty :: Style v n
    mempty  = HashMap TypeRep (Attribute v n) -> Style v n
    forall (v :: * -> *) n.
    HashMap TypeRep (Attribute v n) -> Style v n
    Style HashMap TypeRep (Attribute v n)
    forall k v. HashMap k v
    HM.empty
      mappend :: Style v n -> Style v n -> Style v n
    mappend = Style v n -> Style v n -> Style v n
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance (Additive v, Traversable v, Floating n) => Transformable (Style v n) where
      transform :: Transformation (V (Style v n)) (N (Style v n))
    -> Style v n -> Style v n
    transform Transformation (V (Style v n)) (N (Style v n))
    t = ASetter (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    -> (Attribute v n -> Attribute v n) -> Style v n -> Style v n
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    each (Transformation (V (Attribute v n)) (N (Attribute v n))
    -> Attribute v n -> Attribute v n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Style v n)) (N (Style v n))
    Transformation (V (Attribute v n)) (N (Attribute v n))
    t)

    -- | Styles have no action on other monoids.
    instance A.Action (Style v n) m

    -- | Show the attributes in the style.
    instance Show (Style v n) where
      showsPrec :: Int -> Style v n -> ShowS
    showsPrec Int
    d Style v n
    sty = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
        String -> ShowS
    showString String
    "Style " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Attribute v n] -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    d (Style v n
    sty Style v n
    -> Getting (Endo [Attribute v n]) (Style v n) (Attribute v n)
    -> [Attribute v n]
    forall s a. s -> Getting (Endo [a]) s a -> [a]
    ^.. Getting (Endo [Attribute v n]) (Style v n) (Attribute v n)
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    each)

    -- making styles -------------------------------------------------------

    -- | Turn an attribute into a style. An easier way to make a style is to
    --   use the monoid instance and apply library functions for applying
    --   that attribute:
    --
    -- @
    -- myStyle = mempty # fc blue :: Style V2 Double
    -- @
    attributeToStyle :: Attribute v n -> Style v n
    attributeToStyle :: forall (v :: * -> *) n. Attribute v n -> Style v n
    attributeToStyle Attribute v n
    a = HashMap TypeRep (Attribute v n) -> Style v n
    forall (v :: * -> *) n.
    HashMap TypeRep (Attribute v n) -> Style v n
    Style (HashMap TypeRep (Attribute v n) -> Style v n)
    -> HashMap TypeRep (Attribute v n) -> Style v n
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> Attribute v n -> HashMap TypeRep (Attribute v n)
    forall k v. Hashable k => k -> v -> HashMap k v
    HM.singleton (Attribute v n -> TypeRep
    forall (v :: * -> *) n. Attribute v n -> TypeRep
    attributeType Attribute v n
    a) Attribute v n
    a

    -- extracting attributes -----------------------------------------------

    -- | Extract an attribute from a style of a particular type.  If the
    --   style contains an attribute of the requested type, it will be
    --   returned wrapped in @Just@; otherwise, @Nothing@ is returned.
    --
    --   Trying to extract a measured attibute will fail. It either has to
    --   be unmeasured with 'unmeasureAttrs' or use the 'atMAttr' lens.
    getAttr :: forall a v n. AttributeClass a => Style v n -> Maybe a
    getAttr :: forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
    getAttr (Style HashMap TypeRep (Attribute v n)
    s) = TypeRep -> HashMap TypeRep (Attribute v n) -> Maybe (Attribute v n)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    HM.lookup TypeRep
    ty HashMap TypeRep (Attribute v n)
    s Maybe (Attribute v n) -> (Attribute v n -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Attribute v n -> Maybe a
    forall a (v :: * -> *) n.
    AttributeClass a =>
    Attribute v n -> Maybe a
    unwrapAttribute
      where ty :: TypeRep
    ty = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf (a
    forall a. HasCallStack => a
    undefined :: a)
      -- unwrapAttribute can fail if someone tries to unwrap a measured
      -- attribute before it gets "unmeasured"

    -- | Replace all 'MAttribute's with 'Attribute's using the 'global' and
    --   'normalized' scales.
    unmeasureAttrs :: (Num n) => n -> n -> Style v n -> Style v n
    unmeasureAttrs :: forall n (v :: * -> *). Num n => n -> n -> Style v n -> Style v n
    unmeasureAttrs n
    g n
    n = ASetter (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    -> (Attribute v n -> Attribute v n) -> Style v n -> Style v n
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal (Style v n) (Style v n) (Attribute v n) (Attribute v n)
    each (n -> n -> Attribute v n -> Attribute v n
    forall n (v :: * -> *).
    Num n =>
    n -> n -> Attribute v n -> Attribute v n
    unmeasureAttribute n
    g n
    n)

    -- style lenses --------------------------------------------------------

    mkAttrLens :: forall v n a. Typeable a
               => (a -> TypeRep)
               -> Prism' (Attribute v n) a
               -> Lens' (Style v n) (Maybe a)
    mkAttrLens :: forall (v :: * -> *) n a.
    Typeable a =>
    (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    mkAttrLens a -> TypeRep
    tyF Prism' (Attribute v n) a
    p Maybe a -> f (Maybe a)
    f Style v n
    sty =
      Maybe a -> f (Maybe a)
    f (Style v n
    sty Style v n -> Getting (First a) (Style v n) a -> Maybe a
    forall s a. s -> Getting (First a) s a -> Maybe a
    ^? Index (Style v n) -> Traversal' (Style v n) (IxValue (Style v n))
    forall m. Ixed m => Index m -> Traversal' m (IxValue m)
    ix TypeRep
    Index (Style v n)
    ty ((Attribute v n -> Const (First a) (Attribute v n))
     -> Style v n -> Const (First a) (Style v n))
    -> ((a -> Const (First a) a)
        -> Attribute v n -> Const (First a) (Attribute v n))
    -> Getting (First a) (Style v n) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Const (First a) a)
    -> Attribute v n -> Const (First a) (Attribute v n)
    Prism' (Attribute v n) a
    p) f (Maybe a) -> (Maybe a -> Style v n) -> f (Style v n)
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> \Maybe a
    mAtt -> Style v n
    sty Style v n -> (Style v n -> Style v n) -> Style v n
    forall a b. a -> (a -> b) -> b
    & Index (Style v n)
    -> Lens' (Style v n) (Maybe (IxValue (Style v n)))
    forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
    at TypeRep
    Index (Style v n)
    ty ((Maybe (Attribute v n) -> Identity (Maybe (Attribute v n)))
     -> Style v n -> Identity (Style v n))
    -> Maybe (Attribute v n) -> Style v n -> Style v n
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ (AReview (Attribute v n) a -> a -> Attribute v n
    forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
    review AReview (Attribute v n) a
    Prism' (Attribute v n) a
    p (a -> Attribute v n) -> Maybe a -> Maybe (Attribute v n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe a
    mAtt)
      where ty :: TypeRep
    ty = a -> TypeRep
    tyF (a
    forall a. HasCallStack => a
    undefined :: a)
    {-# INLINE mkAttrLens #-}

    -- | Lens onto a plain attribute of a style.
    atAttr :: AttributeClass a
           => Lens' (Style v n) (Maybe a)
    atAttr :: forall a (v :: * -> *) n.
    AttributeClass a =>
    Lens' (Style v n) (Maybe a)
    atAttr = (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    forall (v :: * -> *) n a.
    Typeable a =>
    (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    mkAttrLens a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf p a (f a) -> p (Attribute v n) (f (Attribute v n))
    forall a (v :: * -> *) n.
    AttributeClass a =>
    Prism' (Attribute v n) a
    Prism' (Attribute v n) a
    _Attribute
    {-# INLINE atAttr #-}

    -- | Lens onto a measured attribute of a style.
    atMAttr :: (AttributeClass a, Typeable n)
            => Lens' (Style v n) (Maybe (Measured n a))
    atMAttr :: forall a n (v :: * -> *).
    (AttributeClass a, Typeable n) =>
    Lens' (Style v n) (Maybe (Measured n a))
    atMAttr = (Measured n a -> TypeRep)
    -> Prism' (Attribute v n) (Measured n a)
    -> Lens' (Style v n) (Maybe (Measured n a))
    forall (v :: * -> *) n a.
    Typeable a =>
    (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    mkAttrLens Measured n a -> TypeRep
    forall n a. Typeable a => Measured n a -> TypeRep
    mType p (Measured n a) (f (Measured n a))
    -> p (Attribute v n) (f (Attribute v n))
    forall a n (v :: * -> *).
    (AttributeClass a, Typeable n) =>
    Prism' (Attribute v n) (Measured n a)
    Prism' (Attribute v n) (Measured n a)
    _MAttribute
    {-# INLINE atMAttr #-}

    -- | Lens onto a transformable attribute of a style.
    atTAttr :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a)
            => Lens' (Style v n) (Maybe a)
    atTAttr :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
    Lens' (Style v n) (Maybe a)
    atTAttr = (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    forall (v :: * -> *) n a.
    Typeable a =>
    (a -> TypeRep)
    -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a)
    mkAttrLens a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf p a (f a) -> p (Attribute v n) (f (Attribute v n))
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
    Prism' (Attribute v n) a
    Prism' (Attribute v n) a
    _TAttribute
    {-# INLINE atTAttr #-}

    -- applying styles -----------------------------------------------------

    -- | Type class for things which have a style.
    class HasStyle a where
      -- | /Apply/ a style by combining it (on the left) with the
      --   existing style.
      applyStyle :: Style (V a) (N a) -> a -> a

    instance Typeable n => HasStyle (Style v n) where
      applyStyle :: Style (V (Style v n)) (N (Style v n)) -> Style v n -> Style v n
    applyStyle = Style v n -> Style v n -> Style v n
    Style (V (Style v n)) (N (Style v n)) -> Style v n -> Style v n
    forall a. Monoid a => a -> a -> a
    mappend

    instance (HasStyle a, HasStyle b, V a ~ V b, N a ~ N b) => HasStyle (a,b) where
      applyStyle :: Style (V (a, b)) (N (a, b)) -> (a, b) -> (a, b)
    applyStyle Style (V (a, b)) (N (a, b))
    s = Style (V a) (N a) -> a -> a
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle Style (V a) (N a)
    Style (V (a, b)) (N (a, b))
    s (a -> a) -> (b -> b) -> (a, b) -> (a, b)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Style (V b) (N b) -> b -> b
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle Style (V b) (N b)
    Style (V (a, b)) (N (a, b))
    s

    instance HasStyle a => HasStyle [a] where
      applyStyle :: Style (V [a]) (N [a]) -> [a] -> [a]
    applyStyle = (a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> a) -> [a] -> [a])
    -> (Style (V a) (N a) -> a -> a) -> Style (V a) (N a) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style (V a) (N a) -> a -> a
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle

    instance HasStyle b => HasStyle (a -> b) where
      applyStyle :: Style (V (a -> b)) (N (a -> b)) -> (a -> b) -> a -> b
    applyStyle = (b -> b) -> (a -> b) -> a -> b
    forall a b. (a -> b) -> (a -> a) -> a -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> b) -> (a -> b) -> a -> b)
    -> (Style (V b) (N b) -> b -> b)
    -> Style (V b) (N b)
    -> (a -> b)
    -> a
    -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style (V b) (N b) -> b -> b
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle

    instance HasStyle a => HasStyle (M.Map k a) where
      applyStyle :: Style (V (Map k a)) (N (Map k a)) -> Map k a -> Map k a
    applyStyle = (a -> a) -> Map k a -> Map k a
    forall a b. (a -> b) -> Map k a -> Map k b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> a) -> Map k a -> Map k a)
    -> (Style (V a) (N a) -> a -> a)
    -> Style (V a) (N a)
    -> Map k a
    -> Map k a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style (V a) (N a) -> a -> a
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle

    instance (HasStyle a, Ord a) => HasStyle (S.Set a) where
      applyStyle :: Style (V (Set a)) (N (Set a)) -> Set a -> Set a
    applyStyle = (a -> a) -> Set a -> Set a
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map ((a -> a) -> Set a -> Set a)
    -> (Style (V a) (N a) -> a -> a)
    -> Style (V a) (N a)
    -> Set a
    -> Set a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style (V a) (N a) -> a -> a
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle

    instance HasStyle b => HasStyle (Measured n b) where
      applyStyle :: Style (V (Measured n b)) (N (Measured n b))
    -> Measured n b -> Measured n b
    applyStyle = (b -> b) -> Measured n b -> Measured n b
    forall a b. (a -> b) -> Measured n a -> Measured n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> b) -> Measured n b -> Measured n b)
    -> (Style (V b) (N b) -> b -> b)
    -> Style (V b) (N b)
    -> Measured n b
    -> Measured n b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style (V b) (N b) -> b -> b
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle

    -- | Apply an attribute to an instance of 'HasStyle' (such as a
    --   diagram or a style). If the object already has an attribute of
    --   the same type, the new attribute is combined on the left with the
    --   existing attribute, according to their semigroup structure.
    applyAttr :: (AttributeClass a, HasStyle d) => a -> d -> d
    applyAttr :: forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
    applyAttr = Style (V d) (N d) -> d -> d
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle (Style (V d) (N d) -> d -> d)
    -> (a -> Style (V d) (N d)) -> a -> d -> d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attribute (V d) (N d) -> Style (V d) (N d)
    forall (v :: * -> *) n. Attribute v n -> Style v n
    attributeToStyle (Attribute (V d) (N d) -> Style (V d) (N d))
    -> (a -> Attribute (V d) (N d)) -> a -> Style (V d) (N d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Attribute (V d) (N d)
    forall a (v :: * -> *) n. AttributeClass a => a -> Attribute v n
    Attribute

    -- | Apply a measured attribute to an instance of 'HasStyle' (such as a
    --   diagram or a style). If the object already has an attribute of
    --   the same type, the new attribute is combined on the left with the
    --   existing attribute, according to their semigroup structure.
    applyMAttr :: (AttributeClass a, N d ~ n, HasStyle d) => Measured n a -> d -> d
    applyMAttr :: forall a d n.
    (AttributeClass a, N d ~ n, HasStyle d) =>
    Measured n a -> d -> d
    applyMAttr = Style (V d) n -> d -> d
    Style (V d) (N d) -> d -> d
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle (Style (V d) n -> d -> d)
    -> (Measured n a -> Style (V d) n) -> Measured n a -> d -> d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attribute (V d) n -> Style (V d) n
    forall (v :: * -> *) n. Attribute v n -> Style v n
    attributeToStyle (Attribute (V d) n -> Style (V d) n)
    -> (Measured n a -> Attribute (V d) n)
    -> Measured n a
    -> Style (V d) n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Measured n a -> Attribute (V d) n
    forall a n (v :: * -> *).
    AttributeClass a =>
    Measured n a -> Attribute v n
    MAttribute

    -- | Apply a transformable attribute to an instance of 'HasStyle'
    --   (such as a diagram or a style). If the object already has an
    --   attribute of the same type, the new attribute is combined on the
    --   left with the existing attribute, according to their semigroup
    --   structure.
    applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, N a ~ N d, HasStyle d) => a -> d -> d
    applyTAttr :: forall a d.
    (AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
     HasStyle d) =>
    a -> d -> d
    applyTAttr = Style (V d) (N d) -> d -> d
    forall a. HasStyle a => Style (V a) (N a) -> a -> a
    applyStyle (Style (V d) (N d) -> d -> d)
    -> (a -> Style (V d) (N d)) -> a -> d -> d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attribute (V d) (N d) -> Style (V d) (N d)
    forall (v :: * -> *) n. Attribute v n -> Style v n
    attributeToStyle (Attribute (V d) (N d) -> Style (V d) (N d))
    -> (a -> Attribute (V d) (N d)) -> a -> Style (V d) (N d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Attribute (V d) (N d)
    forall a (v :: * -> *) n.
    (AttributeClass a, Transformable a, V a ~ v, N a ~ n) =>
    a -> Attribute v n
    TAttribute