Convert.hs

{-# LANGUAGE FlexibleInstances, TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedLabels #-}
module Network.SC2.LowLevel.Convert where

import Network.SC2.LowLevel.Types
import qualified Proto.S2clientprotocol.Common as C
import qualified Proto.S2clientprotocol.Sc2api as A
import qualified Proto.S2clientprotocol.Raw as R
import Data.ProtoLens (defMessage)
import qualified Network.SC2.Constants.Units as Units
import Lens.Labels.Unwrapped ()
import Control.Lens
import Data.Coerce


convertRace :: Race' a -> C.Race
convertRace Terran = C.Terran
convertRace Zerg = C.Zerg
convertRace Protoss = C.Protoss
convertRace (Random _) = C.Random

convertRaceBack :: C.Race -> a -> Race' a
convertRaceBack C.Terran = const Terran
convertRaceBack C.Zerg = const Zerg
convertRaceBack C.Protoss = const Protoss
convertRaceBack C.Random = Random

convertPlayer :: Player (Race' a) -> A.PlayerSetup
convertPlayer Observer = defMessage & #type' .~ A.Observer
convertPlayer (Participant r) = defMessage & #type' .~ A.Participant & #race .~ convertRace r --A.playerSetup (Just A.Participant) (Just (convertRace r)) Nothing
convertPlayer (Computer r d) = defMessage & #type' .~ A.Computer & #race .~ convertRace r & #difficulty .~ d--A.playerSetup (Just A.Computer) (Just (convertRace r)) (Just d)

class ConvertProto a where
  type Unproto a
  convertTo :: Unproto a -> a
  convertFrom :: a -> Maybe (Unproto a)

instance ConvertProto C.PointI where
  type Unproto C.PointI = (Int, Int)
  convertTo (x, y) = defMessage & #x .~ fromIntegral x & #y .~ fromIntegral y 
  convertFrom p = (,) <$> (fromIntegral <$> p^. #maybe'x) <*> (fromIntegral <$> p^. #maybe'y)--(fromIntegral p^.x, fromIntegral p^.y)

instance ConvertProto C.RectangleI where
  type Unproto C.RectangleI = ((Int, Int), (Int, Int))
  convertTo (a, b) = defMessage & #p0 .~ (convertTo a) & #p1 .~ (convertTo b) 
  convertFrom r = (,) <$> (convertFrom =<< r^. #maybe'p0) <*> (convertFrom =<< r^. #maybe'p1)

instance ConvertProto C.Point2D where
  type Unproto C.Point2D = Point
  convertTo (x, y) = defMessage & #x .~ x & #y .~ y 
  convertFrom p = (,) <$> p^. #maybe'x <*>  p^. #maybe'y

instance ConvertProto C.Size2DI where
  type Unproto C.Size2DI = (Int, Int)
  convertTo (x, y) = defMessage & #x .~ fromIntegral x & #y .~ fromIntegral y 
  convertFrom sz = (,) <$> (fromIntegral <$> sz^. #maybe'x) <*> (fromIntegral <$> sz^. #maybe'y)

instance ConvertProto C.ImageData where
  type Unproto C.ImageData = ImageData
  convertTo (ImageData bits size dat) = defMessage & #bitsPerPixel .~ fromIntegral bits & #size .~ convertTo size & #data' .~ dat
  convertFrom i = ImageData <$> (fromIntegral <$> i^. #maybe'bitsPerPixel) <*> (convertFrom =<< i^. #maybe'size) <*> i^. #maybe'data'

instance ConvertProto R.Unit where
  type Unproto R.Unit = Unit
  convertTo _ = error "Why are you converting Unit back to proto"
  convertFrom m = Just Unit {tag = tag', unitType = unitType', alliance = alliance', owner = owner'} where
    tag' = UnitID (m ^. #tag) 
    unitType' = Units.fromInt (m ^. #unitType)
    alliance' = m ^. #alliance
    owner' = PlayerID $fromIntegral (m ^. #owner)

instance ConvertProto R.ActionRawUnitCommand'Target where
  type Unproto R.ActionRawUnitCommand'Target = Target
  convertTo (TargetPoint p) = R.ActionRawUnitCommand'TargetWorldSpacePos (convertTo p)
  convertTo (TargetUnit u) = R.ActionRawUnitCommand'TargetUnitTag (coerce u)
  convertFrom = error "ConvertFrom ActionRawUnitCommand'Target TODO" -- TODO