content: {-# LANGUAGE DeriveDataTypeable         #-}
  {-# LANGUAGE DeriveFunctor              #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE TypeFamilies               #-}
  
  {-# OPTIONS_GHC -fno-warn-unused-imports #-}
    -- for Data.Semigroup import, which becomes redundant under GHC 8.4
  
  module Diagrams.Core.Measure
    ( Measured (..)
    , Measure
    , fromMeasured
    , output
    , local
    , global
    , normalized
    , normalised
    , scaleLocal
    , atLeast
    , atMost
    ) where
  
  import           Control.Applicative
  import           Control.Lens
  import qualified Control.Monad.Reader as R
  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 }
    deriving (Typeable, Functor, Applicative, Monad, Additive, R.MonadReader (n,n,n))
  -- (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 :: 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 scaled so that they are interpreted relative to
  --   the size of the final rendered diagram.
  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 larger of two measures.
  atLeast :: Ord n => Measure n -> Measure n -> Measure n
  atLeast = liftA2 max
  
  -- | Calculate the smaller 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
  
  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
  
  