{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Octane.Type.Initialization
  ( Initialization(..)
  , getInitialization
  , putInitialization
  ) where

import qualified Control.DeepSeq as DeepSeq
import qualified Data.Binary.Bits.Get as BinaryBit
import qualified Data.Binary.Bits.Put as BinaryBit
import qualified Data.Default.Class as Default
import qualified Data.OverloadedRecords.TH as OverloadedRecords
import qualified Data.Set as Set
import qualified Data.Text as StrictText
import qualified GHC.Generics as Generics
import qualified Octane.Data as Data
import qualified Octane.Type.Int8 as Int8
import qualified Octane.Type.Vector as Vector

-- | Information about a new instance of a class.
--
-- This cannot be an instance of 'Data.Binary.Bits.BinaryBit' because it
-- requires out-of-band information (the class name) to decode.
data Initialization = Initialization
  { initializationLocation :: Maybe (Vector.Vector Int)
    -- ^ The instance's initial position.
  , initializationRotation :: Maybe (Vector.Vector Int8.Int8)
    -- ^ The instance's initial rotation.
  } deriving (Eq, Generics.Generic, Show)

$(OverloadedRecords.overloadedRecord Default.def ''Initialization)

instance DeepSeq.NFData Initialization

-- | Gets the 'Initialization' for a given class.
getInitialization :: StrictText.Text -> BinaryBit.BitGet Initialization
getInitialization className = do
  location <-
    if Set.member className Data.classesWithLocation
      then fmap Just Vector.getIntVector
      else pure Nothing
  rotation <-
    if Set.member className Data.classesWithRotation
      then fmap Just Vector.getInt8Vector
      else pure Nothing
  pure
    Initialization
    {initializationLocation = location, initializationRotation = rotation}

-- | Puts the 'Initialization'. Note that unlike 'getInitialization', this does
-- not require the class name.
putInitialization :: Initialization -> BinaryBit.BitPut ()
putInitialization initialization = do
  case #location initialization of
    Nothing -> pure ()
    Just x -> Vector.putIntVector x
  case #rotation initialization of
    Nothing -> pure ()
    Just x -> Vector.putInt8Vector x