{-# 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 { Measured n a -> (n, n, n) -> a
unmeasure :: (n,n,n) -> a }
  deriving (Typeable, a -> Measured n b -> Measured n a
(a -> b) -> Measured n a -> Measured n b
(forall a b. (a -> b) -> Measured n a -> Measured n b)
-> (forall a b. a -> Measured n b -> Measured n a)
-> Functor (Measured n)
forall a b. a -> Measured n b -> Measured n a
forall a b. (a -> b) -> Measured n a -> Measured n b
forall n a b. a -> Measured n b -> Measured n a
forall n a b. (a -> b) -> Measured n a -> Measured n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Measured n b -> Measured n a
$c<$ :: forall n a b. a -> Measured n b -> Measured n a
fmap :: (a -> b) -> Measured n a -> Measured n b
$cfmap :: forall n a b. (a -> b) -> Measured n a -> Measured n b
Functor, Functor (Measured n)
a -> Measured n a
Functor (Measured n)
-> (forall a. a -> Measured n a)
-> (forall a b.
    Measured n (a -> b) -> Measured n a -> Measured n b)
-> (forall a b c.
    (a -> b -> c) -> Measured n a -> Measured n b -> Measured n c)
-> (forall a b. Measured n a -> Measured n b -> Measured n b)
-> (forall a b. Measured n a -> Measured n b -> Measured n a)
-> Applicative (Measured n)
Measured n a -> Measured n b -> Measured n b
Measured n a -> Measured n b -> Measured n a
Measured n (a -> b) -> Measured n a -> Measured n b
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall n. Functor (Measured n)
forall a. a -> Measured n a
forall n a. a -> Measured n a
forall a b. Measured n a -> Measured n b -> Measured n a
forall a b. Measured n a -> Measured n b -> Measured n b
forall a b. Measured n (a -> b) -> Measured n a -> Measured n b
forall n a b. Measured n a -> Measured n b -> Measured n a
forall n a b. Measured n a -> Measured n b -> Measured n b
forall n a b. Measured n (a -> b) -> Measured n a -> Measured n b
forall a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall n a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Measured n a -> Measured n b -> Measured n a
$c<* :: forall n a b. Measured n a -> Measured n b -> Measured n a
*> :: Measured n a -> Measured n b -> Measured n b
$c*> :: forall n a b. Measured n a -> Measured n b -> Measured n b
liftA2 :: (a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
$cliftA2 :: forall n a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
<*> :: Measured n (a -> b) -> Measured n a -> Measured n b
$c<*> :: forall n a b. Measured n (a -> b) -> Measured n a -> Measured n b
pure :: a -> Measured n a
$cpure :: forall n a. a -> Measured n a
$cp1Applicative :: forall n. Functor (Measured n)
Applicative, Applicative (Measured n)
a -> Measured n a
Applicative (Measured n)
-> (forall a b.
    Measured n a -> (a -> Measured n b) -> Measured n b)
-> (forall a b. Measured n a -> Measured n b -> Measured n b)
-> (forall a. a -> Measured n a)
-> Monad (Measured n)
Measured n a -> (a -> Measured n b) -> Measured n b
Measured n a -> Measured n b -> Measured n b
forall n. Applicative (Measured n)
forall a. a -> Measured n a
forall n a. a -> Measured n a
forall a b. Measured n a -> Measured n b -> Measured n b
forall a b. Measured n a -> (a -> Measured n b) -> Measured n b
forall n a b. Measured n a -> Measured n b -> Measured n b
forall n a b. Measured n a -> (a -> Measured n b) -> Measured n b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Measured n a
$creturn :: forall n a. a -> Measured n a
>> :: Measured n a -> Measured n b -> Measured n b
$c>> :: forall n a b. Measured n a -> Measured n b -> Measured n b
>>= :: Measured n a -> (a -> Measured n b) -> Measured n b
$c>>= :: forall n a b. Measured n a -> (a -> Measured n b) -> Measured n b
$cp1Monad :: forall n. Applicative (Measured n)
Monad, Functor (Measured n)
Measured n a
a -> Measured n a -> Measured n a -> Measured n a
Functor (Measured n)
-> (forall a. Num a => Measured n a)
-> (forall a.
    Num a =>
    Measured n a -> Measured n a -> Measured n a)
-> (forall a.
    Num a =>
    Measured n a -> Measured n a -> Measured n a)
-> (forall a.
    Num a =>
    a -> Measured n a -> Measured n a -> Measured n a)
-> (forall a.
    (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a)
-> (forall a b c.
    (a -> b -> c) -> Measured n a -> Measured n b -> Measured n c)
-> Additive (Measured n)
Measured n a -> Measured n a -> Measured n a
Measured n a -> Measured n a -> Measured n a
(a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall n. Functor (Measured n)
forall a. Num a => Measured n a
forall a.
Num a =>
a -> Measured n a -> Measured n a -> Measured n a
forall a. Num a => Measured n a -> Measured n a -> Measured n a
forall a.
(a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall n a. Num a => Measured n a
forall n a.
Num a =>
a -> Measured n a -> Measured n a -> Measured n a
forall n a. Num a => Measured n a -> Measured n a -> Measured n a
forall n a.
(a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall n a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
forall (f :: * -> *).
Functor f
-> (forall a. Num a => f a)
-> (forall a. Num a => f a -> f a -> f a)
-> (forall a. Num a => f a -> f a -> f a)
-> (forall a. Num a => a -> f a -> f a -> f a)
-> (forall a. (a -> a -> a) -> f a -> f a -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Additive f
liftI2 :: (a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
$cliftI2 :: forall n a b c.
(a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
liftU2 :: (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
$cliftU2 :: forall n a.
(a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
lerp :: a -> Measured n a -> Measured n a -> Measured n a
$clerp :: forall n a.
Num a =>
a -> Measured n a -> Measured n a -> Measured n a
^-^ :: Measured n a -> Measured n a -> Measured n a
$c^-^ :: forall n a. Num a => Measured n a -> Measured n a -> Measured n a
^+^ :: Measured n a -> Measured n a -> Measured n a
$c^+^ :: forall n a. Num a => Measured n a -> Measured n a -> Measured n a
zero :: Measured n a
$czero :: forall n a. Num a => Measured n a
$cp1Additive :: forall n. Functor (Measured n)
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 :: n -> n -> Measured n a -> a
fromMeasured n
g n
n (Measured (n, n, n) -> a
m) = (n, n, n) -> a
m (n
1,n
g,n
n)

-- | Output units don't change.
output :: n -> Measure n
output :: n -> Measure n
output = n -> Measure n
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Local units are scaled by the average scale of a transform.
local :: Num n => n -> Measure n
local :: n -> Measure n
local n
x = LensLike' (Const n) (n, n, n) n -> (n -> n) -> Measure n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (n, n, n) n
forall s t a b. Field1 s t a b => Lens s t a b
_1 (n -> n -> n
forall a. Num a => a -> a -> a
*n
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 :: n -> Measure n
global n
x = LensLike' (Const n) (n, n, n) n -> (n -> n) -> Measure n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (n, n, n) n
forall s t a b. Field2 s t a b => Lens s t a b
_2 (n -> n -> n
forall a. Num a => a -> a -> a
*n
x)

-- | Normalized units get scaled so that one normalized unit is the size of the
--   final diagram.
normalized :: Num n => n -> Measure n
normalized :: n -> Measure n
normalized n
x = LensLike' (Const n) (n, n, n) n -> (n -> n) -> Measure n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (n, n, n) n
forall s t a b. Field3 s t a b => Lens s t a b
_3 (n -> n -> n
forall a. Num a => a -> a -> a
*n
x)

-- | Just like 'normalized' but spelt properly.
normalised :: Num n => n -> Measure n
normalised :: n -> Measure n
normalised n
x = LensLike' (Const n) (n, n, n) n -> (n -> n) -> Measure n
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const n) (n, n, n) n
forall s t a b. Field3 s t a b => Lens s t a b
_3 (n -> n -> n
forall a. Num a => a -> a -> a
*n
x)

-- | Scale the local units of a 'Measured' thing.
scaleLocal :: Num n => n -> Measured n a -> Measured n a
scaleLocal :: n -> Measured n a -> Measured n a
scaleLocal n
s = ((n, n, n) -> (n, n, n)) -> Measured n a -> Measured n a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local ((n -> Identity n) -> (n, n, n) -> Identity (n, n, n)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((n -> Identity n) -> (n, n, n) -> Identity (n, n, n))
-> n -> (n, n, n) -> (n, n, n)
forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ n
s)

-- | Calculate the smaller of two measures.
atLeast :: Ord n => Measure n -> Measure n -> Measure n
atLeast :: Measure n -> Measure n -> Measure n
atLeast = (n -> n -> n) -> Measure n -> Measure n -> Measure n
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 n -> n -> n
forall a. Ord a => a -> a -> a
max

-- | Calculate the larger of two measures.
atMost :: Ord n => Measure n -> Measure n -> Measure n
atMost :: Measure n -> Measure n -> Measure n
atMost = (n -> n -> n) -> Measure n -> Measure n -> Measure n
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 n -> n -> n
forall a. Ord a => a -> a -> a
min

instance Num a => Num (Measured n a) where
  + :: Measured n a -> Measured n a -> Measured n a
(+) = Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^)
  (-) = Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^-^)
  * :: Measured n a -> Measured n a -> Measured n a
(*) = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)

  fromInteger :: Integer -> Measured n a
fromInteger = a -> Measured n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Measured n a) -> (Integer -> a) -> Integer -> Measured n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  abs :: Measured n a -> Measured n a
abs         = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: Measured n a -> Measured n a
signum      = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum

instance Fractional a => Fractional (Measured n a) where
  / :: Measured n a -> Measured n a -> Measured n a
(/)   = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
  recip :: Measured n a -> Measured n a
recip = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip

  fromRational :: Rational -> Measured n a
fromRational = a -> Measured n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Measured n a) -> (Rational -> a) -> Rational -> Measured n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

instance Floating a => Floating (Measured n a) where
  pi :: Measured n a
pi      = a -> Measured n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
  exp :: Measured n a -> Measured n a
exp     = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
  sqrt :: Measured n a -> Measured n a
sqrt    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
  log :: Measured n a -> Measured n a
log     = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
  ** :: Measured n a -> Measured n a -> Measured n a
(**)    = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
  logBase :: Measured n a -> Measured n a -> Measured n a
logBase = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase
  sin :: Measured n a -> Measured n a
sin     = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
  tan :: Measured n a -> Measured n a
tan     = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tan
  cos :: Measured n a -> Measured n a
cos     = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
  asin :: Measured n a -> Measured n a
asin    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
  atan :: Measured n a -> Measured n a
atan    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
  acos :: Measured n a -> Measured n a
acos    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
  sinh :: Measured n a -> Measured n a
sinh    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
  tanh :: Measured n a -> Measured n a
tanh    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tanh
  cosh :: Measured n a -> Measured n a
cosh    = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
  asinh :: Measured n a -> Measured n a
asinh   = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
  atanh :: Measured n a -> Measured n a
atanh   = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
  acosh :: Measured n a -> Measured n a
acosh   = (a -> a) -> Measured n a -> Measured n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh

instance Semigroup a => Semigroup (Measured n a) where
  <> :: Measured n a -> Measured n a -> Measured n a
(<>) = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (Measured n a) where
  mempty :: Measured n a
mempty  = a -> Measured n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mappend :: Measured n a -> Measured n a -> Measured n a
mappend = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

instance Distributive (Measured n) where
  distribute :: f (Measured n a) -> Measured n (f a)
distribute f (Measured n a)
a = ((n, n, n) -> f a) -> Measured n (f a)
forall n a. ((n, n, n) -> a) -> Measured n a
Measured (((n, n, n) -> f a) -> Measured n (f a))
-> ((n, n, n) -> f a) -> Measured n (f a)
forall a b. (a -> b) -> a -> b
$ \(n, n, n)
x -> (Measured n a -> a) -> f (Measured n a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Measured (n, n, n) -> a
m) -> (n, n, n) -> a
m (n, n, n)
x) f (Measured n a)
a

instance Representable (Measured n) where
  type Rep (Measured n) = (n,n,n)
  tabulate :: (Rep (Measured n) -> a) -> Measured n a
tabulate = (Rep (Measured n) -> a) -> Measured n a
forall n a. ((n, n, n) -> a) -> Measured n a
Measured
  index :: Measured n a -> Rep (Measured n) -> a
index    = Measured n a -> Rep (Measured n) -> a
forall n a. Measured n a -> (n, n, n) -> a
unmeasure

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