{-# 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 { forall n a. Measured n a -> (n, n, n) -> a
unmeasure :: (n,n,n) -> a }
  deriving (Typeable, 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
<$ :: forall a b. a -> Measured n b -> Measured n a
$c<$ :: forall n a b. a -> Measured n b -> Measured n a
fmap :: forall a b. (a -> b) -> Measured n a -> Measured n b
$cfmap :: forall n a b. (a -> b) -> Measured n a -> Measured n b
Functor, 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
<* :: forall a b. Measured n a -> Measured n b -> Measured n a
$c<* :: forall n a b. Measured n a -> Measured n b -> Measured n a
*> :: forall a b. Measured n a -> Measured n b -> Measured n b
$c*> :: forall n a b. Measured n a -> Measured n b -> Measured n b
liftA2 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> Measured n a
$cpure :: forall n a. a -> Measured n a
Applicative, 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 :: forall a. a -> Measured n a
$creturn :: forall n a. a -> Measured n a
>> :: forall a b. Measured n a -> Measured n b -> Measured n b
$c>> :: forall n a b. Measured n a -> Measured n b -> Measured n b
>>= :: forall a 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
Monad, 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 :: forall a b c.
(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 :: forall a.
(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 :: forall a.
Num a =>
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
^-^ :: forall a. Num 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
^+^ :: forall a. Num 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 :: forall a. Num a => Measured n a
$czero :: forall n a. Num a => Measured n a
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 :: forall n a. Num n => 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 :: forall n. n -> Measure n
output = 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 :: forall n. Num n => n -> Measure n
local n
x = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views forall s t a b. Field1 s t a b => Lens s t a b
_1 (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 :: forall n. Num n => n -> Measure n
global n
x = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views forall s t a b. Field2 s t a b => Lens s t a b
_2 (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 :: forall n. Num n => n -> Measure n
normalized n
x = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views forall s t a b. Field3 s t a b => Lens s t a b
_3 (forall a. Num a => a -> a -> a
*n
x)

-- | Just like 'normalized' but spelt properly.
normalised :: Num n => n -> Measure n
normalised :: forall n. Num n => n -> Measure n
normalised n
x = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views forall s t a b. Field3 s t a b => Lens s t a b
_3 (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 :: forall n a. Num n => n -> Measured n a -> Measured n a
scaleLocal n
s = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local (forall s t a b. Field1 s t a b => Lens s t a b
_1 forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ n
s)

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

-- | Calculate the smaller of two measures.
atMost :: Ord n => Measure n -> Measure n -> Measure n
atMost :: forall n. Ord n => Measure n -> Measure n -> Measure n
atMost = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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
(+) = forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f 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 b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)

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

instance Fractional a => Fractional (Measured n a) where
  / :: 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 forall a. Fractional a => a -> a -> a
(/)
  recip :: Measured n a -> Measured n a
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip

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

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

instance Semigroup a => Semigroup (Measured n a) where
  <> :: 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 forall a. Semigroup a => a -> a -> a
(<>)

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

instance Distributive (Measured n) where
  distribute :: forall (f :: * -> *) a.
Functor f =>
f (Measured n a) -> Measured n (f a)
distribute f (Measured n a)
a = forall n a. ((n, n, n) -> a) -> Measured n a
Measured forall a b. (a -> b) -> a -> b
$ \(n, n, n)
x -> 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 :: forall a. (Rep (Measured n) -> a) -> Measured n a
tabulate = forall n a. ((n, n, n) -> a) -> Measured n a
Measured
  index :: forall a. Measured n a -> Rep (Measured n) -> a
index    = forall n a. Measured n a -> (n, n, n) -> a
unmeasure

instance Profunctor Measured where
  lmap :: forall a b c. (a -> b) -> Measured b c -> Measured a c
lmap a -> b
f (Measured (b, b, b) -> c
m) = forall n a. ((n, n, n) -> a) -> Measured n a
Measured 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 :: forall b c a. (b -> c) -> Measured a b -> Measured a c
rmap b -> c
f (Measured (a, a, a) -> b
m) = forall n a. ((n, n, n) -> a) -> Measured n a
Measured forall a b. (a -> b) -> a -> b
$ b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a, a) -> b
m