{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -fno-warn-unused-imports       #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Core.Query
-- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- The @Query@ module defines a type for \"queries\" on diagrams, which
-- are functions from points in a vector space to some monoid.
--
-----------------------------------------------------------------------------

module Diagrams.Core.Query
  ( Query (..)
  ) where

import           Control.Applicative
import           Control.Lens
import           Data.Semigroup
import           Data.Distributive
import           Data.Functor.Rep
import           Data.Profunctor
import           Data.Profunctor.Sieve
import           Data.Profunctor.Closed
import qualified Data.Profunctor.Rep    as P

import           Linear.Affine
import           Linear.Vector

import           Diagrams.Core.HasOrigin
import           Diagrams.Core.Transform
import           Diagrams.Core.V

------------------------------------------------------------------------
-- Queries
------------------------------------------------------------------------

-- | A query is a function that maps points in a vector space to
--   values in some monoid. Queries naturally form a monoid, with
--   two queries being combined pointwise.
--
--   The idea for annotating diagrams with monoidal queries came from
--   the graphics-drawingcombinators package,
--   <http://hackage.haskell.org/package/graphics-drawingcombinators>.
newtype Query v n m = Query { forall (v :: * -> *) n m. Query v n m -> Point v n -> m
runQuery :: Point v n -> m }
  deriving (forall a b. a -> Query v n b -> Query v n a
forall a b. (a -> b) -> Query v n a -> Query v n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (v :: * -> *) n a b. a -> Query v n b -> Query v n a
forall (v :: * -> *) n a b. (a -> b) -> Query v n a -> Query v n b
<$ :: forall a b. a -> Query v n b -> Query v n a
$c<$ :: forall (v :: * -> *) n a b. a -> Query v n b -> Query v n a
fmap :: forall a b. (a -> b) -> Query v n a -> Query v n b
$cfmap :: forall (v :: * -> *) n a b. (a -> b) -> Query v n a -> Query v n b
Functor, forall a. a -> Query v n a
forall a b. Query v n a -> Query v n b -> Query v n a
forall a b. Query v n a -> Query v n b -> Query v n b
forall a b. Query v n (a -> b) -> Query v n a -> Query v n b
forall a b c.
(a -> b -> c) -> Query v n a -> Query v n b -> Query v 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 (v :: * -> *) n. Functor (Query v n)
forall (v :: * -> *) n a. a -> Query v n a
forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n a
forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n b
forall (v :: * -> *) n a b.
Query v n (a -> b) -> Query v n a -> Query v n b
forall (v :: * -> *) n a b c.
(a -> b -> c) -> Query v n a -> Query v n b -> Query v n c
<* :: forall a b. Query v n a -> Query v n b -> Query v n a
$c<* :: forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n a
*> :: forall a b. Query v n a -> Query v n b -> Query v n b
$c*> :: forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n b
liftA2 :: forall a b c.
(a -> b -> c) -> Query v n a -> Query v n b -> Query v n c
$cliftA2 :: forall (v :: * -> *) n a b c.
(a -> b -> c) -> Query v n a -> Query v n b -> Query v n c
<*> :: forall a b. Query v n (a -> b) -> Query v n a -> Query v n b
$c<*> :: forall (v :: * -> *) n a b.
Query v n (a -> b) -> Query v n a -> Query v n b
pure :: forall a. a -> Query v n a
$cpure :: forall (v :: * -> *) n a. a -> Query v n a
Applicative, forall a. a -> Query v n a
forall a b. Query v n a -> Query v n b -> Query v n b
forall a b. Query v n a -> (a -> Query v n b) -> Query v 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
forall (v :: * -> *) n. Applicative (Query v n)
forall (v :: * -> *) n a. a -> Query v n a
forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n b
forall (v :: * -> *) n a b.
Query v n a -> (a -> Query v n b) -> Query v n b
return :: forall a. a -> Query v n a
$creturn :: forall (v :: * -> *) n a. a -> Query v n a
>> :: forall a b. Query v n a -> Query v n b -> Query v n b
$c>> :: forall (v :: * -> *) n a b.
Query v n a -> Query v n b -> Query v n b
>>= :: forall a b. Query v n a -> (a -> Query v n b) -> Query v n b
$c>>= :: forall (v :: * -> *) n a b.
Query v n a -> (a -> Query v n b) -> Query v n b
Monad, NonEmpty (Query v n m) -> Query v n m
Query v n m -> Query v n m -> Query v n m
forall b. Integral b => b -> Query v n m -> Query v n m
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (v :: * -> *) n m.
Semigroup m =>
NonEmpty (Query v n m) -> Query v n m
forall (v :: * -> *) n m.
Semigroup m =>
Query v n m -> Query v n m -> Query v n m
forall (v :: * -> *) n m b.
(Semigroup m, Integral b) =>
b -> Query v n m -> Query v n m
stimes :: forall b. Integral b => b -> Query v n m -> Query v n m
$cstimes :: forall (v :: * -> *) n m b.
(Semigroup m, Integral b) =>
b -> Query v n m -> Query v n m
sconcat :: NonEmpty (Query v n m) -> Query v n m
$csconcat :: forall (v :: * -> *) n m.
Semigroup m =>
NonEmpty (Query v n m) -> Query v n m
<> :: Query v n m -> Query v n m -> Query v n m
$c<> :: forall (v :: * -> *) n m.
Semigroup m =>
Query v n m -> Query v n m -> Query v n m
Semigroup, Query v n m
[Query v n m] -> Query v n m
Query v n m -> Query v n m -> Query v n m
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {v :: * -> *} {n} {m}. Monoid m => Semigroup (Query v n m)
forall (v :: * -> *) n m. Monoid m => Query v n m
forall (v :: * -> *) n m. Monoid m => [Query v n m] -> Query v n m
forall (v :: * -> *) n m.
Monoid m =>
Query v n m -> Query v n m -> Query v n m
mconcat :: [Query v n m] -> Query v n m
$cmconcat :: forall (v :: * -> *) n m. Monoid m => [Query v n m] -> Query v n m
mappend :: Query v n m -> Query v n m -> Query v n m
$cmappend :: forall (v :: * -> *) n m.
Monoid m =>
Query v n m -> Query v n m -> Query v n m
mempty :: Query v n m
$cmempty :: forall (v :: * -> *) n m. Monoid m => Query v n m
Monoid)

instance Distributive (Query v n) where
  distribute :: forall (f :: * -> *) a.
Functor f =>
f (Query v n a) -> Query v n (f a)
distribute f (Query v n a)
a = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall a b. (a -> b) -> a -> b
$ \Point v n
p -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Query Point v n -> a
q) -> Point v n -> a
q Point v n
p) f (Query v n a)
a

instance Representable (Query v n) where
  type Rep (Query v n) = Point v n
  tabulate :: forall a. (Rep (Query v n) -> a) -> Query v n a
tabulate = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query
  index :: forall a. Query v n a -> Rep (Query v n) -> a
index    = forall (v :: * -> *) n m. Query v n m -> Point v n -> m
runQuery

instance Functor v => Profunctor (Query v) where
  lmap :: forall a b c. (a -> b) -> Query v b c -> Query v a c
lmap a -> b
f (Query Point v b -> c
q) = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall a b. (a -> b) -> a -> b
$ \Point v a
p -> Point v b -> c
q (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Point v a
p)
  rmap :: forall b c a. (b -> c) -> Query v a b -> Query v a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Functor v => Cosieve (Query v) (Point v) where
  cosieve :: forall a b. Query v a b -> Point v a -> b
cosieve = forall (v :: * -> *) n m. Query v n m -> Point v n -> m
runQuery

instance Functor v => Closed (Query v) where
  closed :: forall a b x. Query v a b -> Query v (x -> a) (x -> b)
closed (Query Point v a -> b
fab) = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall a b. (a -> b) -> a -> b
$ \Point v (x -> a)
fxa x
x -> Point v a -> b
fab (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ x
x) Point v (x -> a)
fxa)

instance Functor v => Costrong (Query v) where
  unfirst :: forall a d b. Query v (a, d) (b, d) -> Query v a b
unfirst (Query Point v (a, d) -> (b, d)
f) = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query Point v a -> b
f'
    where f' :: Point v a -> b
f' Point v a
fa = b
b where (b
b, d
d) = Point v (a, d) -> (b, d)
f ((\a
a -> (a
a, d
d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v a
fa)
  unsecond :: forall d a b. Query v (d, a) (d, b) -> Query v a b
unsecond (Query Point v (d, a) -> (d, b)
f) = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query Point v a -> b
f'
    where f' :: Point v a -> b
f' Point v a
fa = b
b where (d
d, b
b) = Point v (d, a) -> (d, b)
f ((,) d
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v a
fa)

instance Functor v => P.Corepresentable (Query v) where
  type Corep (Query v) = Point v
  cotabulate :: forall d c. (Corep (Query v) d -> c) -> Query v d c
cotabulate = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query

-- | Setter over the input point of a query.
queryPoint :: Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n')
queryPoint :: forall (v' :: * -> *) n' m (v :: * -> *) n.
Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n')
queryPoint = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \Point v n -> Point v' n'
f (Query Point v' n' -> m
q) -> forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall a b. (a -> b) -> a -> b
$ Point v' n' -> m
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point v n -> Point v' n'
f

instance Wrapped (Query v n m) where
  type Unwrapped (Query v n m) = Point v n -> m
  _Wrapped' :: Iso' (Query v n m) (Unwrapped (Query v n m))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (v :: * -> *) n m. Query v n m -> Point v n -> m
runQuery forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query

instance Rewrapped (Query v a m) (Query v' a' m')

type instance V (Query v n m) = v
type instance N (Query v n m) = n

instance (Additive v, Num n) => HasOrigin (Query v n m) where
  moveOriginTo :: Point (V (Query v n m)) (N (Query v n m))
-> Query v n m -> Query v n m
moveOriginTo (P V (Query v n m) (N (Query v n m))
u) = forall (v' :: * -> *) n' m (v :: * -> *) n.
Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n')
queryPoint forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V (Query v n m) (N (Query v n m))
u)

instance (Additive v, Num n) => Transformable (Query v n m) where
  transform :: Transformation (V (Query v n m)) (N (Query v n m))
-> Query v n m -> Query v n m
transform Transformation (V (Query v n m)) (N (Query v n m))
t = forall (v' :: * -> *) n' m (v :: * -> *) n.
Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n')
queryPoint forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply (forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv Transformation (V (Query v n m)) (N (Query v n m))
t)