{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Conversions from native Haskell values
-- to values in the swarm language.
module Swarm.Game.Value where

import Control.Lens (view)
import Data.Int (Int32)
import Linear (V2 (..))
import Swarm.Game.Entity
import Swarm.Game.Location
import Swarm.Game.Robot
import Swarm.Language.Direction
import Swarm.Language.Value

-- * Patterns

type VRect = Value
pattern VRect :: Integer -> Integer -> Integer -> Integer -> VRect
pattern $bVRect :: Integer -> Integer -> Integer -> Integer -> VRect
$mVRect :: forall {r}.
VRect
-> (Integer -> Integer -> Integer -> Integer -> r)
-> ((# #) -> r)
-> r
VRect x1 y1 x2 y2 = VPair (VPair (VInt x1) (VInt y1)) (VPair (VInt x2) (VInt y2))

-- * Conversions

-- | Conversion from native Haskell types
-- to their swarm-lang equivalents, useful for
-- implementing swarm
-- <https://github.com/swarm-game/swarm/wiki/Commands-Cheat-Sheet commands>
-- in Haskell.
class Valuable a where
  asValue :: a -> Value

instance Valuable Int32 where
  asValue :: Int32 -> VRect
asValue = Integer -> VRect
VInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Valuable Int where
  asValue :: Int -> VRect
asValue = Integer -> VRect
VInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance (Valuable a) => Valuable (V2 a) where
  asValue :: V2 a -> VRect
asValue (V2 a
x a
y) = forall a. Valuable a => a -> VRect
asValue (a
x, a
y)

instance (Valuable a, Valuable b) => Valuable (a, b) where
  asValue :: (a, b) -> VRect
asValue (a
x, b
y) = VRect -> VRect -> VRect
VPair (forall a. Valuable a => a -> VRect
asValue a
x) (forall a. Valuable a => a -> VRect
asValue b
y)

instance Valuable Location where
  asValue :: Location -> VRect
asValue (Location Int32
x Int32
y) = forall a. Valuable a => a -> VRect
asValue (Int32
x, Int32
y)

instance Valuable Entity where
  asValue :: Entity -> VRect
asValue = EntityName -> VRect
VText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity EntityName
entityName

instance Valuable Robot where
  asValue :: Robot -> VRect
asValue = Int -> VRect
VRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Robot Int
robotID

instance Valuable Direction where
  asValue :: Direction -> VRect
asValue = Direction -> VRect
VDir

instance (Valuable a) => Valuable (Maybe a) where
  asValue :: Maybe a -> VRect
asValue Maybe a
Nothing = Bool -> VRect -> VRect
VInj Bool
False VRect
VUnit
  asValue (Just a
x) = Bool -> VRect -> VRect
VInj Bool
True forall a b. (a -> b) -> a -> b
$ forall a. Valuable a => a -> VRect
asValue a
x

instance (Valuable a, Valuable b) => Valuable (Either a b) where
  asValue :: Either a b -> VRect
asValue (Left a
x) = Bool -> VRect -> VRect
VInj Bool
False forall a b. (a -> b) -> a -> b
$ forall a. Valuable a => a -> VRect
asValue a
x
  asValue (Right b
x) = Bool -> VRect -> VRect
VInj Bool
True forall a b. (a -> b) -> a -> b
$ forall a. Valuable a => a -> VRect
asValue b
x