{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Model
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Tools for visualizing diagrams' internal model: local origins,
-- envelopes, traces, /etc./
--
-----------------------------------------------------------------------------
module Diagrams.TwoD.Model
       ( -- * Showing the local origin
         showOrigin
       , showOrigin'
       , OriginOpts(..), oColor, oScale, oMinSize

         -- * Showing an approximation of the envelope
       , showEnvelope
       , showEnvelope'
       , EnvelopeOpts(..), eColor, eLineWidth, ePoints

         -- * Showing an approximation of the trace
       , showTrace
       , showTrace'
       , TraceOpts(..), tColor, tScale, tMinSize, tPoints

         -- * Showing labels of all named subdiagrams
       , showLabels
       ) where

import           Control.Arrow            (second)
import           Control.Lens             (makeLenses, (^.))
import           Data.Colour              (Colour)
import           Data.Colour.Names
import           Data.Default.Class
import           Data.List                (intercalate)
import qualified Data.Map                 as M
import           Data.Maybe               (catMaybes)
import           Data.Semigroup

import           Diagrams.Attributes
import           Diagrams.Combinators     (atPoints)
import           Diagrams.Core
import           Diagrams.Core.Names
import           Diagrams.CubicSpline
import           Diagrams.Path
import           Diagrams.TwoD.Attributes
import           Diagrams.TwoD.Ellipse
import           Diagrams.TwoD.Path
import           Diagrams.TwoD.Text
import           Diagrams.TwoD.Transform  (rotateBy)
import           Diagrams.TwoD.Types
import           Diagrams.TwoD.Vector     (unitX)
import           Diagrams.Util

import           Linear.Affine
import           Linear.Vector

------------------------------------------------------------
-- Marking the origin
------------------------------------------------------------

data OriginOpts n = OriginOpts
  { forall n. OriginOpts n -> Colour Double
_oColor   :: Colour Double
  , forall n. OriginOpts n -> n
_oScale   :: n
  , forall n. OriginOpts n -> n
_oMinSize :: n
  }

makeLenses ''OriginOpts

instance Fractional n => Default (OriginOpts n) where
  def :: OriginOpts n
def = Colour Double -> n -> n -> OriginOpts n
forall n. Colour Double -> n -> n -> OriginOpts n
OriginOpts Colour Double
forall a. (Ord a, Floating a) => Colour a
red (n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
50) n
0.001

data EnvelopeOpts n = EnvelopeOpts
  { forall n. EnvelopeOpts n -> Colour Double
_eColor     :: Colour Double
  , forall n. EnvelopeOpts n -> Measure n
_eLineWidth :: Measure n
  , forall n. EnvelopeOpts n -> Int
_ePoints    :: Int
  }

makeLenses ''EnvelopeOpts

instance OrderedField n => Default (EnvelopeOpts n) where
  def :: EnvelopeOpts n
def = Colour Double -> Measure n -> Int -> EnvelopeOpts n
forall n. Colour Double -> Measure n -> Int -> EnvelopeOpts n
EnvelopeOpts Colour Double
forall a. (Ord a, Floating a) => Colour a
red Measure n
forall n. OrderedField n => Measure n
medium Int
32

data TraceOpts n = TraceOpts
  { forall n. TraceOpts n -> Colour Double
_tColor   :: Colour Double
  , forall n. TraceOpts n -> n
_tScale   :: n
  , forall n. TraceOpts n -> n
_tMinSize :: n
  , forall n. TraceOpts n -> Int
_tPoints  :: Int
  }

makeLenses ''TraceOpts

instance Floating n => Default (TraceOpts n) where
  def :: TraceOpts n
def = Colour Double -> n -> n -> Int -> TraceOpts n
forall n. Colour Double -> n -> n -> Int -> TraceOpts n
TraceOpts Colour Double
forall a. (Ord a, Floating a) => Colour a
red (n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
100) n
0.001 Int
64

-- | Mark the origin of a diagram by placing a red dot 1/50th its size.
showOrigin :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' m)
           => QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin :: forall n b m.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' m) =>
QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin = OriginOpts n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall n b m.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' m) =>
OriginOpts n -> QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin' OriginOpts n
forall a. Default a => a
def

-- | Mark the origin of a diagram, with control over colour and scale
-- of marker dot.
showOrigin' :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' m)
           => OriginOpts n -> QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin' :: forall n b m.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' m) =>
OriginOpts n -> QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin' OriginOpts n
oo QDiagram b V2 n m
d = QDiagram b V2 n m
o QDiagram b V2 n m -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n m
d
  where o :: QDiagram b V2 n m
o      = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (n -> Path V2 n
forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
sz)
                   # fc (oo^.oColor)
                   # lw none
                   # fmap (const mempty)
        V2 n
w n
h = OriginOpts n
ooOriginOpts n -> Getting n (OriginOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (OriginOpts n) n
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> OriginOpts n -> f (OriginOpts n)
oScale n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ QDiagram b V2 n m -> V2 n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
a -> v n
size QDiagram b V2 n m
d
        sz :: n
sz     = [n] -> n
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [n
w, n
h, OriginOpts n
ooOriginOpts n -> Getting n (OriginOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (OriginOpts n) n
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> OriginOpts n -> f (OriginOpts n)
oMinSize]

-- | Mark the envelope with an approximating cubic spline with control 
--   over the color, line width and number of points.
showEnvelope' :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) 
              => EnvelopeOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showEnvelope' :: forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
EnvelopeOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showEnvelope' EnvelopeOpts n
opts QDiagram b V2 n Any
d = Bool -> [Point V2 n] -> QDiagram b V2 n Any
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) =>
Bool -> [Point v n] -> t
cubicSpline Bool
True [Point V2 n]
pts QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc (EnvelopeOpts n
optsEnvelopeOpts n
-> Getting (Colour Double) (EnvelopeOpts n) (Colour Double)
-> Colour Double
forall s a. s -> Getting a s a -> a
^.Getting (Colour Double) (EnvelopeOpts n) (Colour Double)
forall n (f :: * -> *).
Functor f =>
(Colour Double -> f (Colour Double))
-> EnvelopeOpts n -> f (EnvelopeOpts n)
eColor)
                                            # lw w <> d
  where
    pts :: [Point V2 n]
pts = [Maybe (Point V2 n)] -> [Point V2 n]
forall a. [Maybe a] -> [a]
catMaybes [V2 n -> QDiagram b V2 n Any -> Maybe (Point V2 n)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> Maybe (Point v n)
envelopePMay V2 n
v QDiagram b V2 n Any
d | V2 n
v <- (n -> V2 n) -> [n] -> [V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
`rotateBy` V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX) [n
0,n
inc..n
top]]
    w :: Measure n
w   = EnvelopeOpts n
opts EnvelopeOpts n
-> Getting (Measure n) (EnvelopeOpts n) (Measure n) -> Measure n
forall s a. s -> Getting a s a -> a
^. Getting (Measure n) (EnvelopeOpts n) (Measure n)
forall n n (f :: * -> *).
Functor f =>
(Measure n -> f (Measure n))
-> EnvelopeOpts n -> f (EnvelopeOpts n)
eLineWidth
    inc :: n
inc = n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EnvelopeOpts n
optsEnvelopeOpts n -> Getting Int (EnvelopeOpts n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (EnvelopeOpts n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> EnvelopeOpts n -> f (EnvelopeOpts n)
ePoints)
    top :: n
top = n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
inc


-- | Mark the envelope with an approximating cubic spline
--   using 32 points, medium line width and red line color.
showEnvelope :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b)
             => QDiagram b V2 n Any -> QDiagram b V2 n Any
showEnvelope :: forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
QDiagram b V2 n Any -> QDiagram b V2 n Any
showEnvelope = EnvelopeOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
EnvelopeOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showEnvelope' EnvelopeOpts n
forall a. Default a => a
def

-- | Mark the trace of a diagram, with control over colour and scale
-- of marker dot and the number of points on the trace.
showTrace' :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) 
          => TraceOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showTrace' :: forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
TraceOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showTrace' TraceOpts n
opts QDiagram b V2 n Any
d =  [Point V2 n] -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall (v :: * -> *) n a.
(InSpace v n a, HasOrigin a, Monoid' a) =>
[Point v n] -> [a] -> a
atPoints [Point V2 n]
ps (QDiagram b V2 n Any -> [QDiagram b V2 n Any]
forall a. a -> [a]
repeat QDiagram b V2 n Any
pt) QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
d
  where
    ps :: [Point V2 n]
ps = (([n], V2 n) -> [Point V2 n]) -> [([n], V2 n)] -> [Point V2 n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([n], V2 n) -> [Point V2 n]
forall {f :: * -> *} {a}.
(Additive f, Num a) =>
([a], f a) -> [Point f a]
p [([n], V2 n)]
ts
    ts :: [([n], V2 n)]
ts = [[n]] -> [V2 n] -> [([n], V2 n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[n]]
rs [V2 n]
vs
    p :: ([a], f a) -> [Point f a]
p ([a]
r, f a
v) = [Point f a
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point f a -> Diff (Point f) a -> Point f a
forall a. Num a => Point f a -> Diff (Point f) a -> Point f a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (a
s a -> f a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ f a
v) | a
s <- [a]
r]
    vs :: [V2 n]
vs = (n -> V2 n) -> [n] -> [V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
`rotateBy` V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX) [n
0, n
inc..n
top]
    rs :: [[n]]
rs = [SortedList n -> [n]
forall a. SortedList a -> [a]
getSortedList (SortedList n -> [n]) -> SortedList n -> [n]
forall a b. (a -> b) -> a -> b
$ (Trace V2 n -> Point V2 n -> V2 n -> SortedList n
forall (v :: * -> *) n.
Trace v n -> Point v n -> v n -> SortedList n
appTrace (Trace V2 n -> Point V2 n -> V2 n -> SortedList n)
-> (QDiagram b V2 n Any -> Trace V2 n)
-> QDiagram b V2 n Any
-> Point V2 n
-> V2 n
-> SortedList n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 n Any
-> Trace (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
QDiagram b V2 n Any -> Trace V2 n
forall a. Traced a => a -> Trace (V a) (N a)
getTrace) QDiagram b V2 n Any
d Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin V2 n
v | V2 n
v <- [V2 n]
vs]
    pt :: QDiagram b V2 n Any
pt = n -> QDiagram b V2 n Any
forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
sz QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc (TraceOpts n
optsTraceOpts n
-> Getting (Colour Double) (TraceOpts n) (Colour Double)
-> Colour Double
forall s a. s -> Getting a s a -> a
^.Getting (Colour Double) (TraceOpts n) (Colour Double)
forall n (f :: * -> *).
Functor f =>
(Colour Double -> f (Colour Double))
-> TraceOpts n -> f (TraceOpts n)
tColor) QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Measure n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure n
forall n. OrderedField n => Measure n
none
    V2 n
w n
h = TraceOpts n
optsTraceOpts n -> Getting n (TraceOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (TraceOpts n) n
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> TraceOpts n -> f (TraceOpts n)
tScale n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ QDiagram b V2 n Any -> V2 n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
a -> v n
size QDiagram b V2 n Any
d
    sz :: n
sz     = [n] -> n
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [n
w, n
h, TraceOpts n
optsTraceOpts n -> Getting n (TraceOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (TraceOpts n) n
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> TraceOpts n -> f (TraceOpts n)
tMinSize]
    inc :: n
inc = n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TraceOpts n
optsTraceOpts n -> Getting Int (TraceOpts n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (TraceOpts n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> TraceOpts n -> f (TraceOpts n)
tPoints)
    top :: n
top = n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
inc

-- | Mark the trace of a diagram by placing 64 red dots 1/100th its size
--   along the trace.
showTrace :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) 
          => QDiagram b V2 n Any -> QDiagram b V2 n Any
showTrace :: forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
QDiagram b V2 n Any -> QDiagram b V2 n Any
showTrace = TraceOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n b.
(Enum n, TypeableFloat n, Renderable (Path V2 n) b) =>
TraceOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
showTrace' TraceOpts n
forall a. Default a => a
def

------------------------------------------------------------
-- Labeling named points
------------------------------------------------------------

showLabels :: (TypeableFloat n, Renderable (Text n) b, Semigroup m)
           => QDiagram b V2 n m -> QDiagram b V2 n Any
showLabels :: forall n b m.
(TypeableFloat n, Renderable (Text n) b, Semigroup m) =>
QDiagram b V2 n m -> QDiagram b V2 n Any
showLabels QDiagram b V2 n m
d =
             ( [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall a. Monoid a => [a] -> a
mconcat
             ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> (Map Name [Subdiagram b V2 n m] -> [QDiagram b V2 n Any])
-> Map Name [Subdiagram b V2 n m]
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Point V2 n) -> QDiagram b V2 n Any)
-> [(Name, Point V2 n)] -> [QDiagram b V2 n Any]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
n,Point V2 n
p) -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
text (Name -> String
simpleName Name
n) QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Vn (QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall t. Transformable t => Vn t -> t -> t
translate (Point V2 n
p Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin))
             ([(Name, Point V2 n)] -> [QDiagram b V2 n Any])
-> (Map Name [Subdiagram b V2 n m] -> [(Name, Point V2 n)])
-> Map Name [Subdiagram b V2 n m]
-> [QDiagram b V2 n Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, [Point V2 n]) -> [(Name, Point V2 n)])
-> [(Name, [Point V2 n])] -> [(Name, Point V2 n)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Name
n,[Point V2 n]
ps) -> [Name] -> [Point V2 n] -> [(Name, Point V2 n)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Name -> [Name]
forall a. a -> [a]
repeat Name
n) [Point V2 n]
ps)
             ([(Name, [Point V2 n])] -> [(Name, Point V2 n)])
-> (Map Name [Subdiagram b V2 n m] -> [(Name, [Point V2 n])])
-> Map Name [Subdiagram b V2 n m]
-> [(Name, Point V2 n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Name, [Subdiagram b V2 n m]) -> (Name, [Point V2 n]))
-> [(Name, [Subdiagram b V2 n m])] -> [(Name, [Point V2 n])]
forall a b. (a -> b) -> [a] -> [b]
map (((Name, [Subdiagram b V2 n m]) -> (Name, [Point V2 n]))
 -> [(Name, [Subdiagram b V2 n m])] -> [(Name, [Point V2 n])])
-> ((Subdiagram b V2 n m -> Point V2 n)
    -> (Name, [Subdiagram b V2 n m]) -> (Name, [Point V2 n]))
-> (Subdiagram b V2 n m -> Point V2 n)
-> [(Name, [Subdiagram b V2 n m])]
-> [(Name, [Point V2 n])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Subdiagram b V2 n m] -> [Point V2 n])
-> (Name, [Subdiagram b V2 n m]) -> (Name, [Point V2 n])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Subdiagram b V2 n m] -> [Point V2 n])
 -> (Name, [Subdiagram b V2 n m]) -> (Name, [Point V2 n]))
-> ((Subdiagram b V2 n m -> Point V2 n)
    -> [Subdiagram b V2 n m] -> [Point V2 n])
-> (Subdiagram b V2 n m -> Point V2 n)
-> (Name, [Subdiagram b V2 n m])
-> (Name, [Point V2 n])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subdiagram b V2 n m -> Point V2 n)
-> [Subdiagram b V2 n m] -> [Point V2 n]
forall a b. (a -> b) -> [a] -> [b]
map) Subdiagram b V2 n m -> Point V2 n
forall (v :: * -> *) n b m.
(Additive v, Num n) =>
Subdiagram b v n m -> Point v n
location
             ([(Name, [Subdiagram b V2 n m])] -> [(Name, [Point V2 n])])
-> (Map Name [Subdiagram b V2 n m]
    -> [(Name, [Subdiagram b V2 n m])])
-> Map Name [Subdiagram b V2 n m]
-> [(Name, [Point V2 n])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name [Subdiagram b V2 n m] -> [(Name, [Subdiagram b V2 n m])]
forall k a. Map k a -> [(k, a)]
M.assocs
             (Map Name [Subdiagram b V2 n m] -> QDiagram b V2 n Any)
-> Map Name [Subdiagram b V2 n m] -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Map Name [Subdiagram b V2 n m]
m
             ) QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<>
             (m -> Any) -> QDiagram b V2 n m -> QDiagram b V2 n Any
forall a b. (a -> b) -> QDiagram b V2 n a -> QDiagram b V2 n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Any -> m -> Any
forall a b. a -> b -> a
const (Bool -> Any
Any Bool
False)) QDiagram b V2 n m
d
  where
    SubMap Map Name [Subdiagram b V2 n m]
m = QDiagram b V2 n m
dQDiagram b V2 n m
-> Getting (SubMap b V2 n m) (QDiagram b V2 n m) (SubMap b V2 n m)
-> SubMap b V2 n m
forall s a. s -> Getting a s a -> a
^.Getting (SubMap b V2 n m) (QDiagram b V2 n m) (SubMap b V2 n m)
Lens' (QDiagram b V2 n m) (SubMap b V2 n m)
forall (v :: * -> *) m n b.
(Metric v, Semigroup m, OrderedField n) =>
Lens' (QDiagram b v n m) (SubMap b v n m)
subMap
    simpleName :: Name -> String
simpleName (Name [AName]
ns) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" .> " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (AName -> String) -> [AName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AName -> String
simpleAName [AName]
ns
    simpleAName :: AName -> String
simpleAName (AName a
n) = a -> String
forall a. Show a => a -> String
show a
n