{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}

module Model.Movement 
 ( module Linear.Metric -- for Metric class
 , module Linear.Vector -- for Additive class
 , R
 , Pnt, Vel, Acc
 , pnt, vel, acc
 , pntX, pntY
 , pntMid
 , pntDst
 , pntDrv
 , pntInc
 , velDrv
 , velInc
)
where

-- Global import.

import GHC.TypeLits
import Linear.Vector
import Linear.Metric

import qualified Linear.V2 as V    


{- Base types. -}

-- Type of real numbers.
type R = Double

-- Type of vectors.    
type Vector = V.V2

-- Vector constructor.
vector :: a -> a -> Vector a
vector = V.V2


{- Kinematics characteristics. -}

{-
    Type of derivative.    
    
    The motivation behind using a type like D is that
    it is possible to implement the three basic movement
    characteristics as it's instances: point, velocity
    and acceleration. So, it solves a code duplication
    problem.
-}
newtype D (r :: Nat) (u :: * -> *) a = D { fromD :: (u a) }
    deriving (Functor, Applicative, Additive, Metric)

-- Derives an increment of some characteristic.
derive :: (Functor u, Num a) => a -> D (r + 1) u a -> D r u a
derive dt du = D $ dt *^ (fromD du)

-- Increments characteristics.
increment ::
    (Additive u, Num a) =>
        a -> D (r + 1) u a -> D r u a -> D r u a
            
increment dt du u = derive dt du ^+^ u

-- Constructs derivative from vector.
vecD :: a -> a -> D r Vector a
vecD x = D . vector x

-- Coordinates accessors.
vecDx :: D r Vector a -> a
vecDx (D (V.V2 x _)) = x

vecDy :: D r Vector a -> a
vecDy (D (V.V2 _ y)) = y

-- Special show function for D-vector.
showD :: Show a => String -> D r Vector a -> String
showD name d =
    name ++ "(" ++ (show $ vecDx d) ++ ", " ++ (show $ vecDy d) ++ ")"  


-- Types of point, velocity and acceleration.

type Pnt = D 0 Vector
type Vel = D 1 Vector
type Acc = D 2 Vector

-- Contructor of Pnt.
pnt :: Num a => a -> a -> Pnt a
pnt = vecD

-- Contructor of Vel.
vel :: Num a => a -> a -> Vel a
vel = vecD

-- Contructor of Acc.
acc :: Num a => a -> a -> Acc a
acc = vecD

-- Show instances.
instance Show a => Show (Pnt a) where
    show = showD "Pnt"
    
instance Show a => Show (Vel a) where
    show = showD "Vel"

instance Show a => Show (Acc a) where
    show = showD "Acc"


{- Utility functions for Pnt. -}

-- Returns point's X coordinate.
pntX :: Pnt a -> a
pntX = vecDx

-- Returns point's Y coordinate.
pntY :: Pnt a -> a
pntY = vecDy

-- Returns a  middle point.
pntMid :: Floating a => Pnt a -> Pnt a -> Pnt a
pntMid x y = x ^+^ y ^/ 2

-- Returns a distance between points.
pntDst :: Floating a => Pnt a -> Pnt a -> a
pntDst = distance


{- Derivation functions -}

-- For point.

pntDrv :: Num a => a -> Vel a -> Pnt a
pntDrv = derive

pntInc :: Num a => a -> Vel a -> Pnt a -> Pnt a
pntInc = increment


-- For velocity.

velDrv :: Num a => a -> Acc a -> Vel a
velDrv = derive

velInc :: Num a => a -> Acc a -> Vel a -> Vel a
velInc = increment

