Measuring distance on a diagram using names.

diagram-distance.hs

Prelude> import Diagrams.Prelude
Prelude Diagrams.Prelude> :set -XFlexibleContexts
Prelude Diagrams.Prelude> let a = circle 1 # named "a"
Prelude Diagrams.Prelude> let b = circle 2 # named "b"
Prelude Diagrams.Prelude> let d = beside unitX a b :: D V2 Double
Prelude Diagrams.Prelude> names d
[(toName "a",[P (V2 0.0 0.0)]),(toName "b",[P (V2 2.9999999999999996 0.0)])]

Measure.hs

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
import Diagrams.Prelude

newtype M = M { unM :: Last (P2 Double) }

type instance V M = V2
type instance N M = Double

instance Enveloped M where
    getEnvelope _ = mempty

instance HasOrigin M where
    moveOriginTo x (M (Last p)) = M (Last (moveOriginTo x p))

instance Semigroup M where
    M a <> M b = M (a <> b)
    sconcat = M . sconcat . fmap unM
    stimes b = M . stimes b . unM

here :: M
here = M (Last (p2 (0,0)))

hereToThere :: M -> V2 Double
hereToThere (M (Last p)) = p .-. p2 (0,0)

main = do
    let a = circle 1 :: D V2 Double
        b = circle 2 :: D V2 Double
        d = hereToThere . snd $ beside unitX (a, here) (b, here)
    print d
-- *Main> :main
-- V2 2.9999999999999996 0.0

Here's a utility function that does this using named points:

vectorBetween v d1 d2 = beside v (mark d1) (mark d2) # names # lookup (toName ()) # fromJust # (\[p,q] -> p .-. q)
  where  mark = named () . localize

Kind of ugly but it works!

>>> vectorBetween unitX (circle 1 :: D V2 Double) (circle 2 :: D V2 Double)
V2 2.9999999999999996 0.0