module Bio.Protein.Metric
    ( Metricable (..)
    ) where

import           Data.Kind                      ( Type )
import           Data.Monoid                    ( First (..) )
import           Control.Lens
import           Bio.Utils.Geometry             ( V3R
                                                , R
                                                )
import qualified Bio.Utils.Geometry            as G

class Metricable m where
    type ReturnMetric m :: Type
    distance :: Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R
    angle    :: Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R
    dihedral :: Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R

instance Metricable (First V3R) where
    type ReturnMetric (First V3R) = First R
    distance :: forall a.
Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (ReturnMetric (First V3R)) a R
distance Getting (First V3R) a V3R
x Getting (First V3R) a V3R
y     R -> Const (ReturnMetric (First V3R)) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
G.distance forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
x) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
y)
    angle :: forall a.
Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (ReturnMetric (First V3R)) a R
angle    Getting (First V3R) a V3R
x Getting (First V3R) a V3R
y Getting (First V3R) a V3R
z   R -> Const (ReturnMetric (First V3R)) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ V3R -> V3R -> R
G.angle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
y) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
z forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
y)
    dihedral :: forall a.
Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (First V3R) a V3R
-> Getting (ReturnMetric (First V3R)) a R
dihedral Getting (First V3R) a V3R
x Getting (First V3R) a V3R
y Getting (First V3R) a V3R
z Getting (First V3R) a V3R
w R -> Const (ReturnMetric (First V3R)) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ V3R -> V3R -> V3R -> V3R -> R
G.dihedral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
x) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
y) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
z) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a
aa forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First V3R) a V3R
w)

instance Metricable V3R where
    type ReturnMetric V3R = R
    distance :: forall a.
Getting V3R a V3R
-> Getting V3R a V3R -> Getting (ReturnMetric V3R) a R
distance Getting V3R a V3R
x Getting V3R a V3R
y R -> Const (ReturnMetric V3R) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
G.distance (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
x) (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
y)
    angle :: forall a.
Getting V3R a V3R
-> Getting V3R a V3R
-> Getting V3R a V3R
-> Getting (ReturnMetric V3R) a R
angle Getting V3R a V3R
x Getting V3R a V3R
y Getting V3R a V3R
z R -> Const (ReturnMetric V3R) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ V3R -> V3R -> R
G.angle (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
x forall a. Num a => a -> a -> a
- a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
y) (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
z forall a. Num a => a -> a -> a
- a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
y)
    dihedral :: forall a.
Getting V3R a V3R
-> Getting V3R a V3R
-> Getting V3R a V3R
-> Getting V3R a V3R
-> Getting (ReturnMetric V3R) a R
dihedral Getting V3R a V3R
x Getting V3R a V3R
y Getting V3R a V3R
z Getting V3R a V3R
w R -> Const (ReturnMetric V3R) R
_ a
aa = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ V3R -> V3R -> V3R -> V3R -> R
G.dihedral (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
x) (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
y) (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
z) (a
aa forall s a. s -> Getting a s a -> a
^. Getting V3R a V3R
w)