{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans       #-}
-- We have some orphan Action instances here, but since Action is a multi-param
-- class there is really no better place to put them.

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Core.Types
-- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- The core library of primitives forming the basis of an embedded
-- domain-specific language for describing and rendering diagrams.
--
-- "Diagrams.Core.Types" defines types and classes for
-- primitives, diagrams, and backends.
--
-----------------------------------------------------------------------------

{- ~~~~ Note [breaking up Types module]

   Although it's not as bad as it used to be, this module has a lot of
   stuff in it, and it might seem a good idea in principle to break it up
   into smaller modules.  However, it's not as easy as it sounds: everything
   in this module cyclically depends on everything else.
-}

module Diagrams.Core.Types
       (
         -- * Diagrams

         -- ** Annotations

         -- *** Static annotations
         Annotation(Href, OpacityGroup, KeyVal)
       , applyAnnotation, href, opacityGroup, groupOpacity, keyVal

         -- *** Dynamic (monoidal) annotations
       , UpAnnots, DownAnnots, transfToAnnot, transfFromAnnot

         -- ** Basic type definitions
       , QDiaLeaf(..), withQDiaLeaf
       , QDiagram(..), Diagram

         -- * Operations on diagrams
         -- ** Creating diagrams
       , mkQD, mkQD', pointDiagram

         -- ** Extracting information
       , envelope, trace, subMap, names, query

         -- ** Combining diagrams

         -- | For many more ways of combining diagrams, see
         --   "Diagrams.Combinators" and "Diagrams.TwoD.Combinators"
         --   from the diagrams-lib package.

       , atop

         -- ** Modifying diagrams
         -- *** Names
       , nameSub
       , lookupName
       , withName
       , withNameAll
       , withNames
       , localize

         -- *** Other
       , setEnvelope
       , setTrace

         -- * Subdiagrams

       , Subdiagram(..), mkSubdiagram
       , getSub, rawSub
       , location
       , subPoint

         -- * Subdiagram maps

       , SubMap(..)

       , fromNames, rememberAs, lookupSub

         -- * Primtives
         -- $prim

       , Prim(..)
       , _Prim

         -- * Backends

       , Backend(..)
       , DTree
       , DNode(..)

       , RTree
       , RNode(..)
       , _RStyle
       , _RAnnot
       , _RPrim
       , _REmpty

         -- ** Null backend

       , NullBackend, D

         -- ** Number classes
       , TypeableFloat

         -- * Renderable

       , Renderable(..)

       ) where

import           Control.Arrow             (first, second, (***))
import           Control.Lens              (Lens', Prism', Rewrapped,
                                            Wrapped (..), iso, lens, over,
                                            prism', view, (^.), _Wrapped,
                                            _Wrapping)
import           Control.Monad             (mplus)
import           Data.List                 (isSuffixOf)
import qualified Data.Map                  as M
import           Data.Maybe                (fromMaybe, listToMaybe)
import           Data.Semigroup
import qualified Data.Traversable          as T
import           Data.Tree
import           Data.Typeable

import           Data.Monoid.Action
import           Data.Monoid.Coproduct
import           Data.Monoid.Deletable
import           Data.Monoid.MList
import           Data.Monoid.WithSemigroup
import qualified Data.Tree.DUAL            as D

import           Diagrams.Core.Envelope
import           Diagrams.Core.HasOrigin
import           Diagrams.Core.Juxtapose
import           Diagrams.Core.Names
import           Diagrams.Core.Points
import           Diagrams.Core.Query
import           Diagrams.Core.Style
import           Diagrams.Core.Trace
import           Diagrams.Core.Transform
import           Diagrams.Core.V

import           Linear.Affine
import           Linear.Metric
import           Linear.Vector

-- XXX TODO: add lots of actual diagrams to illustrate the
-- documentation!  Haddock supports \<\<inline image urls\>\>.

-- | Constraint for numeric types that are 'RealFloat' and 'Typeable',
--   which often occur together.  This is used to shorten shorten type
--   constraint contexts.
type TypeableFloat n = (Typeable n, RealFloat n)

------------------------------------------------------------
--  Diagrams  ----------------------------------------------
------------------------------------------------------------

-- | Monoidal annotations which travel up the diagram tree, /i.e./ which
--   are aggregated from component diagrams to the whole:
--
--   * envelopes (see "Diagrams.Core.Envelope").
--     The envelopes are \"deletable\" meaning that at any point we can
--     throw away the existing envelope and replace it with a new one;
--     sometimes we want to consider a diagram as having a different
--     envelope unrelated to its \"natural\" envelope.
--
--   * traces (see "Diagrams.Core.Trace"), also
--     deletable.
--
--   * name/subdiagram associations (see "Diagrams.Core.Names")
--
--   * query functions (see "Diagrams.Core.Query")
type UpAnnots b v n m = Deletable (Envelope v n)
                    ::: Deletable (Trace v n)
                    ::: Deletable (SubMap b v n m)
                    ::: Query v n m
                    ::: ()

-- | Monoidal annotations which travel down the diagram tree,
--   /i.e./ which accumulate along each path to a leaf (and which can
--   act on the upwards-travelling annotations):
--
--   * styles (see "Diagrams.Core.Style")
--
--   * names (see "Diagrams.Core.Names")
type DownAnnots v n = (Transformation v n :+: Style v n)
                  ::: Name
                  ::: ()

  -- Note that we have to put the transformations and styles together
  -- using a coproduct because the transformations can act on the
  -- styles.

-- | Inject a transformation into a default downwards annotation
--   value.
transfToAnnot :: Transformation v n -> DownAnnots v n
transfToAnnot :: forall (v :: * -> *) n. Transformation v n -> DownAnnots v n
transfToAnnot
  = forall l a. (l :>: a) => a -> l
inj
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall m n. m -> m :+: n
inL :: Transformation v n -> Transformation v n :+: Style v n)

-- | Extract the (total) transformation from a downwards annotation
--   value.
transfFromAnnot :: (Additive v, Num n) => DownAnnots v n -> Transformation v n
transfFromAnnot :: forall (v :: * -> *) n.
(Additive v, Num n) =>
DownAnnots v n -> Transformation v n
transfFromAnnot = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall m n. Monoid m => (m :+: n) -> m
killR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

-- | A leaf in a 'QDiagram' tree is either a 'Prim', or a \"delayed\"
--   @QDiagram@ which expands to a real @QDiagram@ once it learns the
--   \"final context\" in which it will be rendered.  For example, in
--   order to decide how to draw an arrow, we must know the precise
--   transformation applied to it (since the arrow head and tail are
--   scale-invariant).
data QDiaLeaf b v n m
  = PrimLeaf (Prim b v n)
  | DelayedLeaf (DownAnnots v n -> n -> n -> QDiagram b v n m)
    -- ^ The @QDiagram@ produced by a @DelayedLeaf@ function /must/
    --   already apply any transformation in the given
    --   @DownAnnots@ (that is, the transformation will not
    --   be applied by the context).
  deriving forall a b. a -> QDiaLeaf b v n b -> QDiaLeaf b v n a
forall a b. (a -> b) -> QDiaLeaf b v n a -> QDiaLeaf b v n b
forall b (v :: * -> *) n a b.
a -> QDiaLeaf b v n b -> QDiaLeaf b v n a
forall b (v :: * -> *) n a b.
(a -> b) -> QDiaLeaf b v n a -> QDiaLeaf b v n 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 -> QDiaLeaf b v n b -> QDiaLeaf b v n a
$c<$ :: forall b (v :: * -> *) n a b.
a -> QDiaLeaf b v n b -> QDiaLeaf b v n a
fmap :: forall a b. (a -> b) -> QDiaLeaf b v n a -> QDiaLeaf b v n b
$cfmap :: forall b (v :: * -> *) n a b.
(a -> b) -> QDiaLeaf b v n a -> QDiaLeaf b v n b
Functor

withQDiaLeaf :: (Prim b v n -> r)
            -> ((DownAnnots v n -> n -> n -> QDiagram b v n m) -> r)
            -> QDiaLeaf b v n m -> r
withQDiaLeaf :: forall b (v :: * -> *) n r m.
(Prim b v n -> r)
-> ((DownAnnots v n -> n -> n -> QDiagram b v n m) -> r)
-> QDiaLeaf b v n m
-> r
withQDiaLeaf Prim b v n -> r
f (DownAnnots v n -> n -> n -> QDiagram b v n m) -> r
_ (PrimLeaf Prim b v n
p)      = Prim b v n -> r
f Prim b v n
p
withQDiaLeaf Prim b v n -> r
_ (DownAnnots v n -> n -> n -> QDiagram b v n m) -> r
g (DelayedLeaf DownAnnots v n -> n -> n -> QDiagram b v n m
dgn) = (DownAnnots v n -> n -> n -> QDiagram b v n m) -> r
g DownAnnots v n -> n -> n -> QDiagram b v n m
dgn

-- | Static annotations which can be placed at a particular node of a
--   diagram tree.
data Annotation
  = Href String    -- ^ Hyperlink
  | OpacityGroup Double
  | KeyVal (String, String)
  deriving Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show

-- | Apply a static annotation at the root of a diagram.
applyAnnotation
  :: (Metric v, OrderedField n, Semigroup m)
  => Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation Annotation
an (QD DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
dt) = forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD (forall u d a l.
(Semigroup u, Action d u) =>
a -> DUALTree d u a l -> DUALTree d u a l
D.annot Annotation
an DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
dt)

-- | Make a diagram into a hyperlink.  Note that only some backends
--   will honor hyperlink annotations.
href :: (Metric v, OrderedField n, Semigroup m)
  => String -> QDiagram b v n m -> QDiagram b v n m
href :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
String -> QDiagram b v n m -> QDiagram b v n m
href = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Annotation
Href

-- | Change the transparency of a 'Diagram' as a group.
opacityGroup, groupOpacity :: (Metric v, OrderedField n, Semigroup m)
  => Double -> QDiagram b v n m -> QDiagram b v n m
opacityGroup :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Double -> QDiagram b v n m -> QDiagram b v n m
opacityGroup = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Annotation
OpacityGroup
groupOpacity :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Double -> QDiagram b v n m -> QDiagram b v n m
groupOpacity = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Annotation
OpacityGroup

-- | Apply a general Key-Value annotation
keyVal :: (Metric v, OrderedField n, Semigroup m)
  => (String, String) -> QDiagram b v n m -> QDiagram b v n m
keyVal :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
(String, String) -> QDiagram b v n m -> QDiagram b v n m
keyVal = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Annotation -> QDiagram b v n m -> QDiagram b v n m
applyAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> Annotation
KeyVal

-- | The fundamental diagram type.  The type variables are as follows:
--
--   * @b@ represents the backend, such as @SVG@ or @Cairo@.  Note
--     that each backend also exports a type synonym @B@ for itself,
--     so the type variable @b@ may also typically be instantiated by
--     @B@, meaning \"use whatever backend is in scope\".
--
--   * @v@ represents the vector space of the diagram.  Typical
--     instantiations include @V2@ (for a two-dimensional diagram) or
--     @V3@ (for a three-dimensional diagram).
--
--   * @n@ represents the numerical field the diagram uses.  Typically
--     this will be a concrete numeric type like @Double@.
--
--   * @m@ is the monoidal type of \"query annotations\": each point
--     in the diagram has a value of type @m@ associated to it, and
--     these values are combined according to the 'Monoid' instance
--     for @m@.  Most often, @m@ is simply instantiated to 'Any',
--     associating a simple @Bool@ value to each point indicating
--     whether the point is inside the diagram; 'Diagram' is a synonym
--     for @QDiagram@ with @m@ thus instantiated to @Any@.
--
--   Diagrams can be combined via their 'Monoid' instance, transformed
--   via their 'Transformable' instance, and assigned attributes via
--   their 'HasStyle' instance.
--
--   Note that the @Q@ in @QDiagram@ stands for \"Queriable\", as
--   distinguished from 'Diagram', where @m@ is fixed to @Any@.  This
--   is not really a very good name, but it's probably not worth
--   changing it at this point.
newtype QDiagram b v n m
  = QD (D.DUALTree (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m))
#if __GLASGOW_HASKELL__ >= 707
  deriving Typeable
#else

instance forall b v. (Typeable b, Typeable1 v) => Typeable2 (QDiagram b v) where
  typeOf2 _ = mkTyConApp (mkTyCon3 "diagrams-core" "Diagrams.Core.Types" "QDiagram") [] `mkAppTy`
              typeOf (undefined :: b)                                                   `mkAppTy`
              typeOf1 (undefined :: v n)
#endif

instance Wrapped (QDiagram b v n m) where
  type Unwrapped (QDiagram b v n m) =
        D.DUALTree (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
  _Wrapped' :: Iso' (QDiagram b v n m) (Unwrapped (QDiagram b v n m))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(QD DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d) -> DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d) forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD

instance Rewrapped (QDiagram b v n m) (QDiagram b' v' n' m')

type instance V (QDiagram b v n m) = v
type instance N (QDiagram b v n m) = n

-- | @Diagram b@ is a synonym for @'QDiagram' b (V b) (N b) 'Any'@.  That is,
--   the default sort of diagram is one where querying at a point
--   simply tells you whether the diagram contains that point or not.
--   Transforming a default diagram into one with a more interesting
--   query can be done via the 'Functor' instance of @'QDiagram' b v n@ or
--   the 'value' function.
type Diagram b = QDiagram b (V b) (N b) Any

-- | Create a \"point diagram\", which has no content, no trace, an
--   empty query, and a point envelope.
pointDiagram :: (Metric v, Fractional n)
             => Point v n -> QDiagram b v n m
pointDiagram :: forall (v :: * -> *) n b m.
(Metric v, Fractional n) =>
Point v n -> QDiagram b v n m
pointDiagram Point v n
p = forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD forall a b. (a -> b) -> a -> b
$ forall u d a l. u -> DUALTree d u a l
D.leafU (forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. m -> Deletable m
toDeletable forall a b. (a -> b) -> a -> b
$ forall n (v :: * -> *).
(Fractional n, Metric v) =>
Point v n -> Envelope v n
pointEnvelope Point v n
p)

-- | A useful variant of 'getU' which projects out a certain
--   component.
getU' :: (Monoid u', u :>: u') => D.DUALTree d u a l -> u'
getU' :: forall u' u d a l. (Monoid u', u :>: u') => DUALTree d u a l -> u'
getU' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. (l :>: a) => l -> Maybe a
get) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u a l. DUALTree d u a l -> Maybe u
D.getU

-- | Lens onto the 'Envelope' of a 'QDiagram'.
envelope :: (OrderedField n, Metric v, Monoid' m)
         => Lens' (QDiagram b v n m) (Envelope v n)
envelope :: forall n (v :: * -> *) m b.
(OrderedField n, Metric v, Monoid' m) =>
Lens' (QDiagram b v n m) (Envelope v n)
envelope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall m. Deletable m -> m
unDelete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u' u d a l. (Monoid u', u :>: u') => DUALTree d u a l -> u'
getU' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Monoid' m) =>
Envelope v n -> QDiagram b v n m -> QDiagram b v n m
setEnvelope)

-- | Replace the envelope of a diagram.
setEnvelope :: forall b v n m. ( OrderedField n, Metric v
                               , Monoid' m)
          => Envelope v n -> QDiagram b v n m -> QDiagram b v n m
setEnvelope :: forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Monoid' m) =>
Envelope v n -> QDiagram b v n m -> QDiagram b v n m
setEnvelope Envelope v n
e =
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' ( forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre (forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. m -> Deletable m
toDeletable forall a b. (a -> b) -> a -> b
$ Envelope v n
e)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteL :: Deletable (Envelope v n)))
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpost (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteR :: Deletable (Envelope v n)))
              )

-- | Lens onto the 'Trace' of a 'QDiagram'.
trace :: (Metric v, OrderedField n, Semigroup m) =>
         Lens' (QDiagram b v n m) (Trace v n)
trace :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Lens' (QDiagram b v n m) (Trace v n)
trace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall m. Deletable m -> m
unDelete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u' u d a l. (Monoid u', u :>: u') => DUALTree d u a l -> u'
getU' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Semigroup m) =>
Trace v n -> QDiagram b v n m -> QDiagram b v n m
setTrace)

-- | Replace the trace of a diagram.
setTrace :: forall b v n m. ( OrderedField n, Metric v
                            , Semigroup m)
         => Trace v n -> QDiagram b v n m -> QDiagram b v n m
setTrace :: forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Semigroup m) =>
Trace v n -> QDiagram b v n m -> QDiagram b v n m
setTrace Trace v n
t = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' ( forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre (forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. m -> Deletable m
toDeletable forall a b. (a -> b) -> a -> b
$ Trace v n
t)
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteL :: Deletable (Trace v n)))
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpost (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteR :: Deletable (Trace v n)))
                            )

-- | Lens onto the 'SubMap' of a 'QDiagram' (/i.e./ an association from
--   names to subdiagrams).
subMap :: (Metric v, Semigroup m, OrderedField n)
       => Lens' (QDiagram b v n m) (SubMap b v n m)
subMap :: forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall m. Deletable m -> m
unDelete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u' u d a l. (Monoid u', u :>: u') => DUALTree d u a l -> u'
getU' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
SubMap b v n m -> QDiagram b v n m -> QDiagram b v n m
setMap)
  where
    setMap :: (Metric v, Semigroup m, OrderedField n) =>
              SubMap b v n m -> QDiagram b v n m -> QDiagram b v n m
    setMap :: forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
SubMap b v n m -> QDiagram b v n m -> QDiagram b v n m
setMap SubMap b v n m
m = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' ( forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. m -> Deletable m
toDeletable forall a b. (a -> b) -> a -> b
$ SubMap b v n m
m)

-- | Get a list of names of subdiagrams and their locations.
names :: (Metric v, Semigroup m, OrderedField n)
      => QDiagram b v n m -> [(Name, [Point v n])]
names :: forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
QDiagram b v n m -> [(Name, [Point v n])]
names = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) forall (v :: * -> *) n b m.
(Additive v, Num n) =>
Subdiagram b v n m -> Point v n
location forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped')

-- | Attach an atomic name to a certain subdiagram, computed from the
--   given diagram /with the mapping from name to subdiagram
--   included/.  The upshot of this knot-tying is that if @d' = d #
--   named x@, then @lookupName x d' == Just d'@ (instead of @Just
--   d@).
nameSub :: (IsName nm , Metric v, OrderedField n, Semigroup m)
  => (QDiagram b v n m -> Subdiagram b v n m) -> nm -> QDiagram b v n m -> QDiagram b v n m
nameSub :: forall nm (v :: * -> *) n m b.
(IsName nm, Metric v, OrderedField n, Semigroup m) =>
(QDiagram b v n m -> Subdiagram b v n m)
-> nm -> QDiagram b v n m -> QDiagram b v n m
nameSub QDiagram b v n m -> Subdiagram b v n m
s nm
n QDiagram b v n m
d = QDiagram b v n m
d'
  where d' :: QDiagram b v n m
d' = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' (forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. m -> Deletable m
toDeletable forall a b. (a -> b) -> a -> b
$ forall a b (v :: * -> *) n m.
IsName a =>
[(a, Subdiagram b v n m)] -> SubMap b v n m
fromNames [(nm
n,QDiagram b v n m -> Subdiagram b v n m
s QDiagram b v n m
d')]) QDiagram b v n m
d

-- | Lookup the most recent diagram associated with (some
--   qualification of) the given name.
lookupName :: (IsName nm, Metric v, Semigroup m, OrderedField n)
           => nm -> QDiagram b v n m -> Maybe (Subdiagram b v n m)
lookupName :: forall nm (v :: * -> *) m n b.
(IsName nm, Metric v, Semigroup m, OrderedField n) =>
nm -> QDiagram b v n m -> Maybe (Subdiagram b v n m)
lookupName nm
n QDiagram b v n m
d = forall nm b (v :: * -> *) n m.
IsName nm =>
nm -> SubMap b v n m -> Maybe [Subdiagram b v n m]
lookupSub (forall a. IsName a => a -> Name
toName nm
n) (QDiagram b v n m
dforall s a. s -> Getting a s a -> a
^.forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe a
listToMaybe

-- | Given a name and a diagram transformation indexed by a
--   subdiagram, perform the transformation using the most recent
--   subdiagram associated with (some qualification of) the name,
--   or perform the identity transformation if the name does not exist.
withName :: (IsName nm, Metric v
            , Semigroup m, OrderedField n)
         => nm -> (Subdiagram b v n m -> QDiagram b v n m -> QDiagram b v n m)
         -> QDiagram b v n m -> QDiagram b v n m
withName :: forall nm (v :: * -> *) m n b.
(IsName nm, Metric v, Semigroup m, OrderedField n) =>
nm
-> (Subdiagram b v n m -> QDiagram b v n m -> QDiagram b v n m)
-> QDiagram b v n m
-> QDiagram b v n m
withName nm
n Subdiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
f QDiagram b v n m
d = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Subdiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
f (forall nm (v :: * -> *) m n b.
(IsName nm, Metric v, Semigroup m, OrderedField n) =>
nm -> QDiagram b v n m -> Maybe (Subdiagram b v n m)
lookupName nm
n QDiagram b v n m
d) QDiagram b v n m
d

-- | Given a name and a diagram transformation indexed by a list of
--   subdiagrams, perform the transformation using the
--   collection of all such subdiagrams associated with (some
--   qualification of) the given name.
withNameAll :: (IsName nm, Metric v
               , Semigroup m, OrderedField n)
            => nm -> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m)
            -> QDiagram b v n m -> QDiagram b v n m
withNameAll :: forall nm (v :: * -> *) m n b.
(IsName nm, Metric v, Semigroup m, OrderedField n) =>
nm
-> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m)
-> QDiagram b v n m
-> QDiagram b v n m
withNameAll nm
n [Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m
f QDiagram b v n m
d = [Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m
f (forall a. a -> Maybe a -> a
fromMaybe [] (forall nm b (v :: * -> *) n m.
IsName nm =>
nm -> SubMap b v n m -> Maybe [Subdiagram b v n m]
lookupSub (forall a. IsName a => a -> Name
toName nm
n) (QDiagram b v n m
dforall s a. s -> Getting a s a -> a
^.forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap))) QDiagram b v n m
d

-- | Given a list of names and a diagram transformation indexed by a
--   list of subdiagrams, perform the transformation using the
--   list of most recent subdiagrams associated with (some qualification
--   of) each name.  Do nothing (the identity transformation) if any
--   of the names do not exist.
withNames :: (IsName nm, Metric v
             , Semigroup m, OrderedField n)
          => [nm] -> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m)
          -> QDiagram b v n m -> QDiagram b v n m
withNames :: forall nm (v :: * -> *) m n b.
(IsName nm, Metric v, Semigroup m, OrderedField n) =>
[nm]
-> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m)
-> QDiagram b v n m
-> QDiagram b v n m
withNames [nm]
ns [Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m
f QDiagram b v n m
d = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id [Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m
f Maybe [Subdiagram b v n m]
ns' QDiagram b v n m
d
  where
    nd :: SubMap b v n m
nd = QDiagram b v n m
dforall s a. s -> Getting a s a -> a
^.forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap
    ns' :: Maybe [Subdiagram b v n m]
ns' = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. [a] -> Maybe a
listToMaybeforall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ SubMap b v n m
nd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall nm b (v :: * -> *) n m.
IsName nm =>
nm -> SubMap b v n m -> Maybe [Subdiagram b v n m]
lookupSub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsName a => a -> Name
toName) [nm]
ns)

-- | \"Localize\" a diagram by hiding all the names, so they are no
--   longer visible to the outside.
localize :: forall b v n m. (Metric v, OrderedField n, Semigroup m)
         => QDiagram b v n m -> QDiagram b v n m
localize :: forall b (v :: * -> *) n m.
(Metric v, OrderedField n, Semigroup m) =>
QDiagram b v n m -> QDiagram b v n m
localize = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' ( forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpre  (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteL :: Deletable (SubMap b v n m)))
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u d a l.
(Semigroup u, Action d u) =>
u -> DUALTree d u a l -> DUALTree d u a l
D.applyUpost (forall l a. (l :>: a) => a -> l
inj (forall m. Monoid m => Deletable m
deleteR :: Deletable (SubMap b v n m)))
                   )

-- | Get the query function associated with a diagram.
query :: Monoid m => QDiagram b v n m -> Query v n m
query :: forall m b (v :: * -> *) n.
Monoid m =>
QDiagram b v n m -> Query v n m
query = forall u' u d a l. (Monoid u', u :>: u') => DUALTree d u a l -> u'
getU' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'

-- | Create a diagram from a single primitive, along with an envelope,
--   trace, subdiagram map, and query function.
mkQD :: Prim b v n -> Envelope v n -> Trace v n -> SubMap b v n m -> Query v n m
     -> QDiagram b v n m
mkQD :: forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD Prim b v n
p = forall b (v :: * -> *) n m.
QDiaLeaf b v n m
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD' (forall b (v :: * -> *) n m. Prim b v n -> QDiaLeaf b v n m
PrimLeaf Prim b v n
p)

-- | Create a diagram from a generic QDiaLeaf, along with an envelope,
--   trace, subdiagram map, and query function.
mkQD' :: QDiaLeaf b v n m -> Envelope v n -> Trace v n -> SubMap b v n m -> Query v n m
      -> QDiagram b v n m
mkQD' :: forall b (v :: * -> *) n m.
QDiaLeaf b v n m
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD' QDiaLeaf b v n m
l Envelope v n
e Trace v n
t SubMap b v n m
n Query v n m
q
  = forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD forall a b. (a -> b) -> a -> b
$ forall u l d a. u -> l -> DUALTree d u a l
D.leaf (forall m. m -> Deletable m
toDeletable Envelope v n
e forall a l. a -> l -> a ::: l
*: forall m. m -> Deletable m
toDeletable Trace v n
t forall a l. a -> l -> a ::: l
*: forall m. m -> Deletable m
toDeletable SubMap b v n m
n forall a l. a -> l -> a ::: l
*: Query v n m
q forall a l. a -> l -> a ::: l
*: ()) QDiaLeaf b v n m
l

------------------------------------------------------------
--  Instances
------------------------------------------------------------

---- Monoid

-- | Diagrams form a monoid since each of their components do: the
--   empty diagram has no primitives, an empty envelope, an empty
--   trace, no named subdiagrams, and a constantly empty query
--   function.
--
--   Diagrams compose by aligning their respective local origins.  The
--   new diagram has all the primitives and all the names from the two
--   diagrams combined, and query functions are combined pointwise.
--   The first diagram goes on top of the second.  \"On top of\"
--   probably only makes sense in vector spaces of dimension lower
--   than 3, but in theory it could make sense for, say, 3-dimensional
--   diagrams when viewed by 4-dimensional beings.
instance (Metric v, OrderedField n, Semigroup m)
  => Monoid (QDiagram b v n m) where
  mempty :: QDiagram b v n m
mempty  = forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD forall d u a l. DUALTree d u a l
D.empty
  mappend :: QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance (Metric v, OrderedField n, Semigroup m)
  => Semigroup (QDiagram b v n m) where
  (QD DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d1) <> :: QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
<> (QD DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d2) = forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD (DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d2 forall a. Semigroup a => a -> a -> a
<> DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
d1)
    -- swap order so that primitives of d2 come first, i.e. will be
    -- rendered first, i.e. will be on the bottom.

-- | A convenient synonym for 'mappend' on diagrams, designed to be
--   used infix (to help remember which diagram goes on top of which
--   when combining them, namely, the first on top of the second).
atop :: (OrderedField n, Metric v, Semigroup m)
     => QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
atop :: forall n (v :: * -> *) m b.
(OrderedField n, Metric v, Semigroup m) =>
QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
atop = forall a. Semigroup a => a -> a -> a
(<>)

infixl 6 `atop`

---- Functor

instance Functor (QDiagram b v n) where
  fmap :: forall a b. (a -> b) -> QDiagram b v n a -> QDiagram b v n b
fmap a -> b
f = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall s t.
Rewrapping s t =>
(Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t)
_Wrapping forall b (v :: * -> *) n m.
DUALTree
  (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)
-> QDiagram b v n m
QD)
           ( (forall u u' d a l.
(u -> u') -> DUALTree d u a l -> DUALTree d u' a l
D.mapU forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second)
             ( (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)   a -> b
f
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f
             )
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f
           )

---- Applicative

-- XXX what to do with this?
-- A diagram with queries of result type @(a -> b)@ can be \"applied\"
--   to a diagram with queries of result type @a@, resulting in a
--   combined diagram with queries of result type @b@.  In particular,
--   all components of the two diagrams are combined as in the
--   @Monoid@ instance, except the queries which are combined via
--   @(<*>)@.

-- instance (Backend b v n, Num n, Ord n)
--            => Applicative (QDiagram b v n) where
--   pure a = Diagram mempty mempty mempty (Query $ const a)
--
--   (Diagram ps1 bs1 ns1 smp1) <*> (Diagram ps2 bs2 ns2 smp2)
--     = Diagram (ps1 <> ps2) (bs1 <> bs2) (ns1 <> ns2) (smp1 <*> smp2)

---- HasStyle

instance (Metric v, OrderedField n, Semigroup m)
      => HasStyle (QDiagram b v n m) where
  applyStyle :: Style (V (QDiagram b v n m)) (N (QDiagram b v n m))
-> QDiagram b v n m -> QDiagram b v n m
applyStyle = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u a l.
(Semigroup d, Semigroup u, Action d u) =>
d -> DUALTree d u a l -> DUALTree d u a l
D.applyD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. (l :>: a) => a -> l
inj
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall n m. n -> m :+: n
inR :: Style v n -> Transformation v n :+: Style v n)

---- Juxtaposable

instance (Metric v, OrderedField n, Monoid' m)
      => Juxtaposable (QDiagram b v n m) where
  juxtapose :: Vn (QDiagram b v n m)
-> QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
juxtapose = forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
juxtaposeDefault

---- Enveloped

instance (Metric v, OrderedField n, Monoid' m)
         => Enveloped (QDiagram b v n m) where
  getEnvelope :: QDiagram b v n m
-> Envelope (V (QDiagram b v n m)) (N (QDiagram b v n m))
getEnvelope = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n (v :: * -> *) m b.
(OrderedField n, Metric v, Monoid' m) =>
Lens' (QDiagram b v n m) (Envelope v n)
envelope

---- Traced

instance (Metric v, OrderedField n, Semigroup m)
         => Traced (QDiagram b v n m) where
  getTrace :: QDiagram b v n m
-> Trace (V (QDiagram b v n m)) (N (QDiagram b v n m))
getTrace = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Lens' (QDiagram b v n m) (Trace v n)
trace

---- HasOrigin

-- | Every diagram has an intrinsic \"local origin\" which is the
--   basis for all combining operations.
instance (Metric v, OrderedField n, Semigroup m)
      => HasOrigin (QDiagram b v n m) where
  moveOriginTo :: Point (V (QDiagram b v n m)) (N (QDiagram b v n m))
-> QDiagram b v n m -> QDiagram b v n m
moveOriginTo = forall t. Transformable t => Vn t -> t -> t
translate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-.)

---- Transformable

-- | Diagrams can be transformed by transforming each of their
--   components appropriately.
instance (OrderedField n, Metric v, Semigroup m)
      => Transformable (QDiagram b v n m) where
  transform :: Transformation (V (QDiagram b v n m)) (N (QDiagram b v n m))
-> QDiagram b v n m -> QDiagram b v n m
transform = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u a l.
(Semigroup d, Semigroup u, Action d u) =>
d -> DUALTree d u a l -> DUALTree d u a l
D.applyD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Transformation v n -> DownAnnots v n
transfToAnnot

---- Qualifiable

-- | Diagrams can be qualified so that all their named points can
--   now be referred to using the qualification prefix.
instance (Metric v, OrderedField n, Semigroup m)
      => Qualifiable (QDiagram b v n m) where
  .>> :: forall a. IsName a => a -> QDiagram b v n m -> QDiagram b v n m
(.>>) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d u a l.
(Semigroup d, Semigroup u, Action d u) =>
d -> DUALTree d u a l -> DUALTree d u a l
D.applyD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l a. (l :>: a) => a -> l
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsName a => a -> Name
toName


------------------------------------------------------------
--  Subdiagrams
------------------------------------------------------------

-- | A @Subdiagram@ represents a diagram embedded within the context
--   of a larger diagram.  Essentially, it consists of a diagram
--   paired with any accumulated information from the larger context
--   (transformations, attributes, etc.).

data Subdiagram b v n m = Subdiagram (QDiagram b v n m) (DownAnnots v n)

type instance V (Subdiagram b v n m) = v
type instance N (Subdiagram b v n m) = n

-- | Turn a diagram into a subdiagram with no accumulated context.
mkSubdiagram :: QDiagram b v n m -> Subdiagram b v n m
mkSubdiagram :: forall b (v :: * -> *) n m. QDiagram b v n m -> Subdiagram b v n m
mkSubdiagram QDiagram b v n m
d = forall b (v :: * -> *) n m.
QDiagram b v n m -> DownAnnots v n -> Subdiagram b v n m
Subdiagram QDiagram b v n m
d forall l. MList l => l
empty

-- | Create a \"point subdiagram\", that is, a 'pointDiagram' (with no
--   content and a point envelope) treated as a subdiagram with local
--   origin at the given point.  Note this is not the same as
--   @mkSubdiagram . pointDiagram@, which would result in a subdiagram
--   with local origin at the parent origin, rather than at the given
--   point.
subPoint :: (Metric v, OrderedField n)
         => Point v n -> Subdiagram b v n m
subPoint :: forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
Point v n -> Subdiagram b v n m
subPoint Point v n
p = forall b (v :: * -> *) n m.
QDiagram b v n m -> DownAnnots v n -> Subdiagram b v n m
Subdiagram
               (forall (v :: * -> *) n b m.
(Metric v, Fractional n) =>
Point v n -> QDiagram b v n m
pointDiagram forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)
               (forall (v :: * -> *) n. Transformation v n -> DownAnnots v n
transfToAnnot forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. v n -> Transformation v n
translation (Point v n
p forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin))

instance Functor (Subdiagram b v n) where
  fmap :: forall a b. (a -> b) -> Subdiagram b v n a -> Subdiagram b v n b
fmap a -> b
f (Subdiagram QDiagram b v n a
d DownAnnots v n
a) = forall b (v :: * -> *) n m.
QDiagram b v n m -> DownAnnots v n -> Subdiagram b v n m
Subdiagram (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f QDiagram b v n a
d) DownAnnots v n
a

instance (OrderedField n, Metric v, Monoid' m)
      => Enveloped (Subdiagram b v n m) where
  getEnvelope :: Subdiagram b v n m
-> Envelope (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
getEnvelope (Subdiagram QDiagram b v n m
d DownAnnots v n
a) = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Additive v, Num n) =>
DownAnnots v n -> Transformation v n
transfFromAnnot DownAnnots v n
a) forall a b. (a -> b) -> a -> b
$ forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope QDiagram b v n m
d

instance (OrderedField n, Metric v, Semigroup m)
      => Traced (Subdiagram b v n m) where
  getTrace :: Subdiagram b v n m
-> Trace (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
getTrace (Subdiagram QDiagram b v n m
d DownAnnots v n
a) = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Additive v, Num n) =>
DownAnnots v n -> Transformation v n
transfFromAnnot DownAnnots v n
a) forall a b. (a -> b) -> a -> b
$ forall a. Traced a => a -> Trace (V a) (N a)
getTrace QDiagram b v n m
d

instance (Metric v, OrderedField n)
      => HasOrigin (Subdiagram b v n m) where
  moveOriginTo :: Point (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
-> Subdiagram b v n m -> Subdiagram b v n m
moveOriginTo = forall t. Transformable t => Vn t -> t -> t
translate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-.)

instance Transformable (Subdiagram b v n m) where
  transform :: Transformation (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
-> Subdiagram b v n m -> Subdiagram b v n m
transform Transformation (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
t (Subdiagram QDiagram b v n m
d DownAnnots v n
a) = forall b (v :: * -> *) n m.
QDiagram b v n m -> DownAnnots v n -> Subdiagram b v n m
Subdiagram QDiagram b v n m
d (forall (v :: * -> *) n. Transformation v n -> DownAnnots v n
transfToAnnot Transformation (V (Subdiagram b v n m)) (N (Subdiagram b v n m))
t forall a. Semigroup a => a -> a -> a
<> DownAnnots v n
a)

-- | Get the location of a subdiagram; that is, the location of its
--   local origin /with respect to/ the vector space of its parent
--   diagram.  In other words, the point where its local origin
--   \"ended up\".
location :: (Additive v, Num n) => Subdiagram b v n m -> Point v n
location :: forall (v :: * -> *) n b m.
(Additive v, Num n) =>
Subdiagram b v n m -> Point v n
location (Subdiagram QDiagram b v n m
_ DownAnnots v n
a) = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Additive v, Num n) =>
DownAnnots v n -> Transformation v n
transfFromAnnot DownAnnots v n
a) forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin

-- | Turn a subdiagram into a normal diagram, including the enclosing
--   context.  Concretely, a subdiagram is a pair of (1) a diagram and
--   (2) a \"context\" consisting of an extra transformation and
--   attributes.  @getSub@ simply applies the transformation and
--   attributes to the diagram to get the corresponding \"top-level\"
--   diagram.
getSub :: (Metric v, OrderedField n, Semigroup m)
       => Subdiagram b v n m -> QDiagram b v n m
getSub :: forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Semigroup m) =>
Subdiagram b v n m -> QDiagram b v n m
getSub (Subdiagram QDiagram b v n m
d DownAnnots v n
a) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' (forall d u a l.
(Semigroup d, Semigroup u, Action d u) =>
d -> DUALTree d u a l -> DUALTree d u a l
D.applyD DownAnnots v n
a) QDiagram b v n m
d

-- | Extract the \"raw\" content of a subdiagram, by throwing away the
--   context.
rawSub :: Subdiagram b v n m -> QDiagram b v n m
rawSub :: forall b (v :: * -> *) n m. Subdiagram b v n m -> QDiagram b v n m
rawSub (Subdiagram QDiagram b v n m
d DownAnnots v n
_) = QDiagram b v n m
d

------------------------------------------------------------
--  Subdiagram maps  ---------------------------------------
------------------------------------------------------------

-- | A 'SubMap' is a map associating names to subdiagrams. There can
--   be multiple associations for any given name.
newtype SubMap b v n m = SubMap (M.Map Name [Subdiagram b v n m])
  -- See Note [SubMap Set vs list]

instance Wrapped (SubMap b v n m) where
  type Unwrapped (SubMap b v n m) = M.Map Name [Subdiagram b v n m]
  _Wrapped' :: Iso' (SubMap b v n m) (Unwrapped (SubMap b v n m))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(SubMap Map Name [Subdiagram b v n m]
m) -> Map Name [Subdiagram b v n m]
m) forall b (v :: * -> *) n m.
Map Name [Subdiagram b v n m] -> SubMap b v n m
SubMap

instance Rewrapped (SubMap b v n m) (SubMap b' v' n' m')

-- ~~~~ [SubMap Set vs list]
-- In some sense it would be nicer to use
-- Sets instead of a list, but then we would have to put Ord
-- constraints on v everywhere. =P

type instance V (SubMap b v n m) = v
type instance N (SubMap b v n m) = n

instance Functor (SubMap b v n) where
  fmap :: forall a b. (a -> b) -> SubMap b v n a -> SubMap b v n b
fmap = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Semigroup (SubMap b v n m) where
  SubMap Map Name [Subdiagram b v n m]
s1 <> :: SubMap b v n m -> SubMap b v n m -> SubMap b v n m
<> SubMap Map Name [Subdiagram b v n m]
s2 = forall b (v :: * -> *) n m.
Map Name [Subdiagram b v n m] -> SubMap b v n m
SubMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. [a] -> [a] -> [a]
(++) Map Name [Subdiagram b v n m]
s1 Map Name [Subdiagram b v n m]
s2

-- | 'SubMap's form a monoid with the empty map as the identity, and
--   map union as the binary operation.  No information is ever lost:
--   if two maps have the same name in their domain, the resulting map
--   will associate that name to the concatenation of the information
--   associated with that name.
instance Monoid (SubMap b v n m) where
  mempty :: SubMap b v n m
mempty  = forall b (v :: * -> *) n m.
Map Name [Subdiagram b v n m] -> SubMap b v n m
SubMap forall k a. Map k a
M.empty
  mappend :: SubMap b v n m -> SubMap b v n m -> SubMap b v n m
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance (OrderedField n, Metric v)
      => HasOrigin (SubMap b v n m) where
  moveOriginTo :: Point (V (SubMap b v n m)) (N (SubMap b v n m))
-> SubMap b v n m -> SubMap b v n m
moveOriginTo = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo

instance Transformable (SubMap b v n m) where
  transform :: Transformation (V (SubMap b v n m)) (N (SubMap b v n m))
-> SubMap b v n m -> SubMap b v n m
transform = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

-- | 'SubMap's are qualifiable: if @ns@ is a 'SubMap', then @a |>
--   ns@ is the same 'SubMap' except with every name qualified by
--   @a@.
instance Qualifiable (SubMap b v n m) where
  a
a .>> :: forall a. IsName a => a -> SubMap b v n m -> SubMap b v n m
.>> (SubMap Map Name [Subdiagram b v n m]
m) = forall b (v :: * -> *) n m.
Map Name [Subdiagram b v n m] -> SubMap b v n m
SubMap forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (a
a forall q a. (Qualifiable q, IsName a) => a -> q -> q
.>>) Map Name [Subdiagram b v n m]
m

-- | Construct a 'SubMap' from a list of associations between names
--   and subdiagrams.
fromNames :: IsName a => [(a, Subdiagram b v n m)] -> SubMap b v n m
fromNames :: forall a b (v :: * -> *) n m.
IsName a =>
[(a, Subdiagram b v n m)] -> SubMap b v n m
fromNames = forall b (v :: * -> *) n m.
Map Name [Subdiagram b v n m] -> SubMap b v n m
SubMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsName a => a -> Name
toName forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (forall a. a -> [a] -> [a]
:[]))

-- | Add a name/diagram association to a submap.
rememberAs :: IsName a => a -> QDiagram b v n m -> SubMap b v n m -> SubMap b v n m
rememberAs :: forall a b (v :: * -> *) n m.
IsName a =>
a -> QDiagram b v n m -> SubMap b v n m -> SubMap b v n m
rememberAs a
n QDiagram b v n m
b = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped' forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) (forall a. IsName a => a -> Name
toName a
n) [forall b (v :: * -> *) n m. QDiagram b v n m -> Subdiagram b v n m
mkSubdiagram QDiagram b v n m
b]

-- | A name acts on a name map by qualifying every name in it.
instance Action Name (SubMap b v n m) where
  act :: Name -> SubMap b v n m -> SubMap b v n m
act = forall q a. (Qualifiable q, IsName a) => a -> q -> q
(.>>)

instance Action Name a => Action Name (Deletable a) where
  act :: Name -> Deletable a -> Deletable a
act Name
n (Deletable Int
l a
a Int
r) = forall m. Int -> m -> Int -> Deletable m
Deletable Int
l (forall m s. Action m s => m -> s -> s
act Name
n a
a) Int
r

-- Names do not act on other things.

instance Action Name (Query v n m)
instance Action Name (Envelope v n)
instance Action Name (Trace v n)

-- | Look for the given name in a name map, returning a list of
--   subdiagrams associated with that name.  If no names match the
--   given name exactly, return all the subdiagrams associated with
--   names of which the given name is a suffix.
lookupSub :: IsName nm => nm -> SubMap b v n m -> Maybe [Subdiagram b v n m]
lookupSub :: forall nm b (v :: * -> *) n m.
IsName nm =>
nm -> SubMap b v n m -> Maybe [Subdiagram b v n m]
lookupSub nm
a (SubMap Map Name [Subdiagram b v n m]
m)
  = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
n Map Name [Subdiagram b v n m]
m forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
    (forall {a} {b}. [(a, [b])] -> Maybe [b]
flattenNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((Name
n Name -> Name -> Bool
`nameSuffixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs forall a b. (a -> b) -> a -> b
$ Map Name [Subdiagram b v n m]
m)
  where (Name [AName]
n1) nameSuffixOf :: Name -> Name -> Bool
`nameSuffixOf` (Name [AName]
n2) = [AName]
n1 forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [AName]
n2
        flattenNames :: [(a, [b])] -> Maybe [b]
flattenNames [] = forall a. Maybe a
Nothing
        flattenNames [(a, [b])]
xs = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(a, [b])]
xs
        n :: Name
n = forall a. IsName a => a -> Name
toName nm
a

------------------------------------------------------------
--  Primitives  --------------------------------------------
------------------------------------------------------------

-- $prim
-- Ultimately, every diagram is essentially a tree whose leaves are /primitives/,
-- basic building blocks which can be rendered by backends.  However,
-- not every backend must be able to render every type of primitive;
-- the collection of primitives a given backend knows how to render is
-- determined by instances of 'Renderable'.

-- | A value of type @Prim b v n@ is an opaque (existentially quantified)
--   primitive which backend @b@ knows how to render in vector space @v@.
data Prim b v n where
  Prim :: (Transformable p, Typeable p, Renderable p b) => p -> Prim b (V p) (N p)

_Prim :: (Typeable p, Renderable p b) => Prism' (Prim b (V p) (N p)) p
_Prim :: forall p b.
(Typeable p, Renderable p b) =>
Prism' (Prim b (V p) (N p)) p
_Prim = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (\(Prim p
p) -> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
p)

type instance V (Prim b v n) = v
type instance N (Prim b v n) = n

-- | The 'Transformable' instance for 'Prim' just pushes calls to
--   'transform' down through the 'Prim' constructor.
instance Transformable (Prim b v n) where
  transform :: Transformation (V (Prim b v n)) (N (Prim b v n))
-> Prim b v n -> Prim b v n
transform Transformation (V (Prim b v n)) (N (Prim b v n))
t (Prim p
p) = forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Prim b v n)) (N (Prim b v n))
t p
p)

-- | The 'Renderable' instance for 'Prim' just pushes calls to
--   'render' down through the 'Prim' constructor.
instance Renderable (Prim b v n) b where
  render :: b -> Prim b v n -> Render b (V (Prim b v n)) (N (Prim b v n))
render b
b (Prim p
p) = forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render b
b p
p

------------------------------------------------------------
-- Backends  -----------------------------------------------
------------------------------------------------------------

-- | A 'DTree' is a raw tree representation of a 'QDiagram', with all
--   the @u@-annotations removed.  It is used as an intermediate type
--   by diagrams-core; backends should not need to make use of it.
--   Instead, backends can make use of 'RTree', which 'DTree' gets
--   compiled and optimized to.
type DTree b v n a = Tree (DNode b v n a)

data DNode b v n a = DStyle (Style v n)
                   | DTransform (Transformation v n)
                   | DAnnot a
                   | DDelay
                     -- ^ @DDelay@ marks a point where a delayed subtree
                     --   was expanded.  Such subtrees already take all
                     --   non-frozen transforms above them into account,
                     --   so when later processing the tree, upon
                     --   encountering a @DDelay@ node we must drop any
                     --   accumulated non-frozen transformation.
                   | DPrim (Prim b v n)
                   | DEmpty

-- | An 'RTree' is a compiled and optimized representation of a
--   'QDiagram', which can be used by backends.  They have the
--   following invariant which backends may rely upon:
--
--   * @RPrim@ nodes never have any children.
type RTree b v n a = Tree (RNode b v n a)

data RNode b v n a = RStyle (Style v n) -- ^ A style node.
                   | RAnnot a
                   | RPrim (Prim b v n) -- ^ A primitive.
                   | REmpty

-- | Prism onto a style of an 'RNode'.
_RStyle :: Prism' (RNode b v n a) (Style v n)
_RStyle :: forall b (v :: * -> *) n a. Prism' (RNode b v n a) (Style v n)
_RStyle = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall b (v :: * -> *) n a. Style v n -> RNode b v n a
RStyle forall a b. (a -> b) -> a -> b
$ \RNode b v n a
n -> case RNode b v n a
n of RStyle Style v n
s -> forall a. a -> Maybe a
Just Style v n
s; RNode b v n a
_ -> forall a. Maybe a
Nothing

-- | Prism onto an annotation of an 'RNode'.
_RAnnot :: Prism' (RNode b v n a) a
_RAnnot :: forall b (v :: * -> *) n a. Prism' (RNode b v n a) a
_RAnnot = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall b (v :: * -> *) n a. a -> RNode b v n a
RAnnot forall a b. (a -> b) -> a -> b
$ \RNode b v n a
n -> case RNode b v n a
n of RAnnot a
a -> forall a. a -> Maybe a
Just a
a; RNode b v n a
_ -> forall a. Maybe a
Nothing

-- | Prism onto a 'Prim' of an 'RNode'.
_RPrim :: Prism' (RNode b v n a) (Prim b v n)
_RPrim :: forall b (v :: * -> *) n a. Prism' (RNode b v n a) (Prim b v n)
_RPrim = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall b (v :: * -> *) n a. Prim b v n -> RNode b v n a
RPrim forall a b. (a -> b) -> a -> b
$ \RNode b v n a
n -> case RNode b v n a
n of RPrim Prim b v n
p -> forall a. a -> Maybe a
Just Prim b v n
p; RNode b v n a
_ -> forall a. Maybe a
Nothing

-- | Prism onto an empty 'RNode'.
_REmpty :: Prism' (RNode b v n a) ()
_REmpty :: forall b (v :: * -> *) n a. Prism' (RNode b v n a) ()
_REmpty = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (forall a b. a -> b -> a
const forall b (v :: * -> *) n a. RNode b v n a
REmpty) forall a b. (a -> b) -> a -> b
$ \RNode b v n a
n -> case RNode b v n a
n of RNode b v n a
REmpty -> forall a. a -> Maybe a
Just (); RNode b v n a
_ -> forall a. Maybe a
Nothing

-- | Abstract diagrams are rendered to particular formats by
--   /backends/.  Each backend/vector space combination must be an
--   instance of the 'Backend' class.
--
--   A minimal complete definition consists of 'Render', 'Result',
--   'Options', and 'renderRTree'. However, most backends will want to
--   implement 'adjustDia' as well; the default definition does
--   nothing.  Some useful standard definitions are provided in the
--   @Diagrams.TwoD.Adjust@ module from the @diagrams-lib@ package.
class Backend b v n where

  -- | An intermediate representation used for rendering primitives.
  --   (Typically, this will be some sort of monad, but it need not
  --   be.)  The 'Renderable' class guarantees that a backend will be
  --   able to convert primitives into this type; how these rendered
  --   primitives are combined into an ultimate 'Result' is completely
  --   up to the backend.
  data Render b v n :: *

  -- | The result of running/interpreting a rendering operation.
  type Result b v n :: *

  -- | Backend-specific rendering options.
  data Options b v n :: *

  -- | 'adjustDia' allows the backend to make adjustments to the final
  --   diagram (e.g. to adjust the size based on the options) before
  --   rendering it. It returns a modified options record, the
  --   transformation applied to the diagram (which can be used to
  --   convert attributes whose value is @Measure@, or transform
  --   /e.g./ screen coordinates back into local diagram coordinates),
  --   and the adjusted diagram itself.
  --
  --   See the diagrams-lib package (particularly the
  --   @Diagrams.TwoD.Adjust@ module) for some useful implementations.
  adjustDia :: (Additive v, Monoid' m, Num n) => b -> Options b v n
            -> QDiagram b v n m -> (Options b v n, Transformation v n, QDiagram b v n m)
  adjustDia b
_ Options b v n
o QDiagram b v n m
d = (Options b v n
o,forall a. Monoid a => a
mempty,QDiagram b v n m
d)

  -- | Given some options, take a representation of a diagram as a
  --   tree and render it.  The 'RTree' has already been simplified
  --   and has all measurements converted to @Output@ units.
  renderRTree :: b -> Options b v n -> RTree b v n Annotation -> Result b v n

  -- See Note [backend token]

-- | The @D@ type is provided for convenience in situations where you
--   must give a diagram a concrete, monomorphic type, but don't care
--   which one.  Such situations arise when you pass a diagram to a
--   function which is polymorphic in its input but monomorphic in its
--   output, such as 'width', 'height', 'phantom', or 'names'.  Such
--   functions compute some property of the diagram, or use it to
--   accomplish some other purpose, but do not result in the diagram
--   being rendered.  If the diagram does not have a monomorphic type,
--   GHC complains that it cannot determine the diagram's type.
--
--   For example, here is the error we get if we try to compute the
--   width of an image (this example requires @diagrams-lib@):
--
--   @
--   ghci> width (image (uncheckedImageRef \"foo.png\" 200 200))
--   \<interactive\>:11:8:
--       No instance for (Renderable (DImage n0 External) b0)
--         arising from a use of `image'
--       The type variables `n0', `b0' are ambiguous
--       Possible fix: add a type signature that fixes these type variable(s)
--       Note: there is a potential instance available:
--         instance Fractional n => Renderable (DImage n a) NullBackend
--           -- Defined in `Diagrams.TwoD.Image'
--       Possible fix:
--         add an instance declaration for
--         (Renderable (DImage n0 External) b0)
--       In the first argument of `width', namely
--         `(image (uncheckedImageRef \"foo.png\" 200 200))'
--       In the expression:
--         width (image (uncheckedImageRef \"foo.png\" 200 200))
--       In an equation for `it':
--           it = width (image (uncheckedImageRef \"foo.png\" 200 200))
--   @
--
--   GHC complains that there is no instance for @Renderable (DImage n0
--   External) b0@; what is really going on is that it does not have enough
--   information to decide what backend to use (hence the
--   uninstantiated @n0@ and @b0@). This is annoying because /we/ know that the
--   choice of backend cannot possibly affect the width of the image
--   (it's 200! it's right there in the code!); /but/ there is no way
--   for GHC to know that.
--
--   The solution is to annotate the call to 'image' with the type
--   @'D' 'V2' 'Double'@, like so:
--
--   @
--   ghci> width (image (uncheckedImageRef \"foo.png\" 200 200) :: D V2 Double)
--   200.00000000000006
--   @
--
--   (It turns out the width wasn't 200 after all...)
--
--   As another example, here is the error we get if we try to compute
--   the width of a radius-1 circle:
--
--   @
--   ghci> width (circle 1)
--   \<interactive\>:12:1:
--       Couldn't match expected type `V2' with actual type `V a0'
--       The type variable `a0' is ambiguous
--       Possible fix: add a type signature that fixes these type variable(s)
--       In the expression: width (circle 1)
--       In an equation for `it': it = width (circle 1)
--   @
--
--   There's even more ambiguity here.  Whereas 'image' always returns
--   a 'Diagram', the 'circle' function can produce any 'TrailLike'
--   type, and the 'width' function can consume any 'Enveloped' type,
--   so GHC has no idea what type to pick to go in the middle.
--   However, the solution is the same:
--
--   @
--   ghci> width (circle 1 :: D V2 Double)
--   1.9999999999999998
--   @

type D v n = QDiagram NullBackend v n Any


-- | A null backend which does no actual rendering.  It is provided
--   mainly for convenience in situations where you must give a
--   diagram a concrete, monomorphic type, but don't actually care
--   which one.  See 'D' for more explanation and examples.
--
--   It is courteous, when defining a new primitive @P@, to make an instance
--
--   > instance Renderable P NullBackend where
--   >   render _ _ = mempty
--
--   This ensures that the trick with 'D' annotations can be used for
--   diagrams containing your primitive.
data NullBackend
  deriving Typeable

-- Note: we can't make a once-and-for-all instance
--
-- > instance Renderable a NullBackend where
-- >   render _ _ = mempty
--
-- because it overlaps with the Renderable instance for NullPrim.

instance Semigroup (Render NullBackend v n) where
  Render NullBackend v n
_ <> :: Render NullBackend v n
-> Render NullBackend v n -> Render NullBackend v n
<> Render NullBackend v n
_ = forall (v :: * -> *) n. Render NullBackend v n
NullBackendRender

instance Monoid (Render NullBackend v n) where
  mempty :: Render NullBackend v n
mempty  = forall (v :: * -> *) n. Render NullBackend v n
NullBackendRender
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance Backend NullBackend v n where
  data Render NullBackend v n = NullBackendRender
  type Result NullBackend v n = ()
  data Options NullBackend v n

  renderRTree :: NullBackend
-> Options NullBackend v n
-> RTree NullBackend v n Annotation
-> Result NullBackend v n
renderRTree NullBackend
_ Options NullBackend v n
_ RTree NullBackend v n Annotation
_ = ()

-- | The Renderable type class connects backends to primitives which
--   they know how to render.
class Transformable t => Renderable t b where
  render :: b -> t -> Render b (V t) (N t)
  -- ^ Given a token representing the backend and a
  --   transformable object, render it in the appropriate rendering
  --   context.

  -- See Note [backend token]

{-
~~~~ Note [backend token]

A bunch of methods here take a "backend token" as an argument.  The
backend token is expected to carry no actual information; it is solely
to help out the type system. The problem is that all these methods
return some associated type applied to b (e.g. Render b) and unifying
them with something else will never work, since type families are not
necessarily injective.
-}