```{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}
module Diagrams.Core.Measure
( Measured (..)
, Measure
, fromMeasured
, output
, local
, global
, normalized
, normalised
, scaleLocal
, atLeast
, atMost
) where

import           Control.Applicative
import           Control.Lens
import           Data.Distributive
import           Data.Functor.Rep
import           Data.Semigroup
import           Data.Typeable

import           Diagrams.Core.V

import           Linear.Vector

-- | 'Measured n a' is an object that depends on 'local', 'normalized'
--   and 'global' scales. The 'normalized' and 'global' scales are
--   calculated when rendering a diagram.
--
--   For attributes, the 'local' scale gets multiplied by the average
--   scale of the transform.
newtype Measured n a = Measured { unmeasure :: (n,n,n) -> a }
-- (local, global, normalized) -> output

type instance V (Measured n a) = V a
type instance N (Measured n a) = N a

-- | A measure is a 'Measured' number.
type Measure n = Measured n n

-- | @fromMeasured globalScale normalizedScale measure -> a@
fromMeasured :: Num n => n -> n -> Measured n a -> a
fromMeasured g n (Measured m) = m (1,g,n)

-- | Output units don't change.
output :: Num n => n -> Measure n
output = pure

-- | Local units are scaled by the average scale of a transform.
local :: Num n => n -> Measure n
local x = views _1 (*x)

-- | Global units are ?
global :: Num n => n -> Measure n
global x = views _2 (*x)

-- | Normalized units get scaled so that one normalized unit is the size of the
--   final diagram.
normalized :: Num n => n -> Measure n
normalized x = views _3 (*x)

-- | Just like 'normalized' but spelt properly.
normalised :: Num n => n -> Measure n
normalised x = views _3 (*x)

-- | Scale the local units of a 'Measured' thing.
scaleLocal :: Num n => n -> Measured n a -> Measured n a
scaleLocal s = R.local (_1 *~ s)

-- | Calculate the smaller of two measures.
atLeast :: Ord n => Measure n -> Measure n -> Measure n
atLeast = liftA2 max

-- | Calculate the larger of two measures.
atMost :: Ord n => Measure n -> Measure n -> Measure n
atMost = liftA2 min

instance Num a => Num (Measured n a) where
(+) = (^+^)
(-) = (^-^)
(*) = liftA2 (*)

fromInteger = pure . fromInteger
abs         = fmap abs
signum      = fmap signum

instance Fractional a => Fractional (Measured n a) where
(/)   = liftA2 (/)
recip = fmap recip

fromRational = pure . fromRational

instance Floating a => Floating (Measured n a) where
pi      = pure pi
exp     = fmap exp
sqrt    = fmap sqrt
log     = fmap log
(**)    = liftA2 (**)
logBase = liftA2 logBase
sin     = fmap sin
tan     = fmap tan
cos     = fmap cos
asin    = fmap asin
atan    = fmap atan
acos    = fmap acos
sinh    = fmap sinh
tanh    = fmap tanh
cosh    = fmap cosh
asinh   = fmap asinh
atanh   = fmap atanh
acosh   = fmap acosh

instance Semigroup a => Semigroup (Measured n a) where
(<>) = liftA2 (<>)

instance Monoid a => Monoid (Measured n a) where
mempty  = pure mempty
mappend = liftA2 mappend

instance Distributive (Measured n) where
distribute a = Measured \$ \x -> fmap (\(Measured m) -> m x) a

instance Representable (Measured n) where
type Rep (Measured n) = (n,n,n)
tabulate = Measured
index    = unmeasure

instance Profunctor Measured where
lmap f (Measured m) = Measured \$ \(l,g,n) -> m (f l, f g, f n)
rmap f (Measured m) = Measured \$ f . m

```