{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE UndecidableInstances  #-}
module Wavefront.Types where

import Data.Kind
import Data.Text (Text)
import Numeric.Natural
import qualified Rank2

data OBJ v = OBJ {
    objLocations :: v Location
  , objTexCoords :: v TexCoord
  , objNormals   :: v Normal
  , objPoints    :: v (Element Point)
  , objLines     :: v (Element Line)
  , objFaces     :: v (Element Face)
  , objMtlLibs   :: v Text
  }

type ForThisOBJ (c :: * -> Constraint) v =
        ( c (v Location)
        , c (v TexCoord)
        , c (v Normal)
        , c (v (Element Point))
        , c (v (Element Line))
        , c (v (Element Face))
        , c (v Text) )

type ForAllOBJ (c :: * -> Constraint) =
        ( c Location
        , c TexCoord
        , c Normal
        , c (Element Point)
        , c (Element Line)
        , c (Element Face)
        , c Text
        )

deriving instance ForThisOBJ Eq v => Eq (OBJ v)
deriving instance ForThisOBJ Show v => Show (OBJ v)

instance Rank2.Functor OBJ where
    f <$> obj = obj
        { objLocations = f (objLocations obj)
        , objTexCoords = f (objTexCoords obj)
        , objNormals   = f (objNormals obj)
        , objPoints    = f (objPoints obj)
        , objLines     = f (objLines obj)
        , objFaces     = f (objFaces obj)
        , objMtlLibs   = f (objMtlLibs obj)
        }

class Rank2.Functor g => Payload c g where
    mapPayload :: proxy c -> (forall a. c a => p a -> q a) -> g p -> g q

instance ForAllOBJ c => Payload c OBJ where
    mapPayload _ f obj = obj
        { objLocations = f (objLocations obj)
        , objTexCoords = f (objTexCoords obj)
        , objNormals   = f (objNormals obj)
        , objPoints    = f (objPoints obj)
        , objLines     = f (objLines obj)
        , objFaces     = f (objFaces obj)
        , objMtlLibs   = f (objMtlLibs obj)
        }



-- | A location is a 4-floating vector. You can access to its components by
-- pattern matching on them:
--
-- > let Location x y z w = Location 1 2 3 4
--
-- That type is strict and unboxed.
data Location = Location {
    locX :: {-# UNPACK #-} !Float
  , locY :: {-# UNPACK #-} !Float
  , locZ :: {-# UNPACK #-} !Float
  , locW :: {-# UNPACK #-} !Float
  } deriving (Eq,Ord,Show)

-- | A texture coordinate is a 3D-floating vector. You can access to its
-- components by pattern matching on them:
--
-- > let TexCoord r s t = TexCoord 0.1 0.2 0.3
--
-- That type is strcit and unboxed.
data TexCoord = TexCoord {
    texcoordR :: {-# UNPACK #-} !Float
  , texcoordS :: {-# UNPACK #-} !Float
  , texcoordT :: {-# UNPACK #-} !Float
  } deriving (Eq,Ord,Show)


-- | A normal is a 3-floating vector. You can access to its components by
-- pattern matching on them:
--
-- > let Normal nx ny nz = Normal 0.1 0.2 0.3
--
-- That type is strict and unboxed.
data Normal = Normal {
    norX :: {-# UNPACK #-} !Float
  , norY :: {-# UNPACK #-} !Float
  , norZ :: {-# UNPACK #-} !Float
  } deriving (Eq,Ord,Show)

-- | A point is a single index that references the locations. It’s a canonical
-- type that truly represents a polygonal point.
data Point = Point {
    pointLocIndex :: {-# UNPACK #-} !Int
  } deriving (Eq,Ord,Show)

-- | A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references
-- the locations and @vti@ indexes the texture coordinates. If @vti ==
-- 'Nothing'@, then that 'LineIndex' doesn’t have texture coordinates
-- associated with.
data LineIndex = LineIndex {
    lineLocIndex      :: {-# UNPACK #-} !Int
  , lineTexCoordIndex :: !(Maybe Int)
  } deriving (Eq,Ord,Show)

-- | A line gathers two line indices accessible by pattern matching or
-- 'lineIndexA' and 'lineIndexB'.
data Line = Line {
    lineIndexA :: LineIndex
  , lineIndexB :: LineIndex
  } deriving (Eq,Ord,Show)

-- | A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face
-- that indexes the locations with @vi@, the texture coordinates with @vti@ and
-- the normals with @vni@. An index set to 'Nothing' means /no information/.
-- That is, if @vni == 'Nothing'@, then that 'FaceIndex' doesn’t have a normal
-- associated with.
data FaceIndex = FaceIndex {
    faceLocIndex      :: {-# UNPACK #-} !Int
  , faceTexCoordIndex :: !(Maybe Int)
  , faceNorIndex      :: !(Maybe Int)
  } deriving (Eq,Ord,Show)

-- | A face gathers several 'FaceIndex' to build up faces. It has a least three
-- vertices
data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Ord,Show)

pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
pattern Triangle a b c = Face a b c []

pattern Quad :: FaceIndex -> FaceIndex -> FaceIndex -> FaceIndex -> Face
pattern Quad a b c d = Face a b c [d]

-- | An element holds a value along with the user-defined object’s name (if
-- any), the associated groups, the used material and the smoothing group the
-- element belongs to (if any). Those values can be used to sort the data per
-- object or per group and to lookup materials.
data Element a = Element {
    elObject         :: Maybe Text
  , elGroups         :: [Text]
  , elMtl            :: Maybe (Int,Text) -- Size of stack of mtllibs, mtlname
  , elSmoothingGroup :: Natural
  , elValue          :: a
  } deriving (Eq,Ord,Show,Functor)