-- |
-- Module: M.Position
-- Description: Minecraft position encoding
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Implements the packed integer Position format used by Minecraft Java Edition,
-- including encoding and decoding of 3D coordinates into a compact Int64
-- representation.
module M.Position
  ( Position (..),
    encodeposition,
    decodeposition,
    posapply,
    posapplyv,
  )
where

import Control.DeepSeq
import Data.Bits
import Data.Data
import Data.Hashable
import Data.Int
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)
import Linear
import M.Pack

-- | Deserialized position representation
newtype Position = Position {Position -> V3 Int32
getposition :: V3 Int32}
  deriving stock ((forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Position -> Rep Position x
from :: forall x. Position -> Rep Position x
$cto :: forall x. Rep Position x -> Position
to :: forall x. Rep Position x -> Position
Generic, Typeable, Typeable Position
Typeable Position =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Position -> c Position)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Position)
-> (Position -> Constr)
-> (Position -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Position))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position))
-> ((forall b. Data b => b -> b) -> Position -> Position)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall u. (forall d. Data d => d -> u) -> Position -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Position -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> Data Position
Position -> Constr
Position -> DataType
(forall b. Data b => b -> b) -> Position -> Position
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
forall u. (forall d. Data d => d -> u) -> Position -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
$ctoConstr :: Position -> Constr
toConstr :: Position -> Constr
$cdataTypeOf :: Position -> DataType
dataTypeOf :: Position -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cgmapT :: (forall b. Data b => b -> b) -> Position -> Position
gmapT :: (forall b. Data b => b -> b) -> Position -> Position
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
Data, (forall (m :: * -> *). Quote m => Position -> m Exp)
-> (forall (m :: * -> *). Quote m => Position -> Code m Position)
-> Lift Position
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Position -> m Exp
forall (m :: * -> *). Quote m => Position -> Code m Position
$clift :: forall (m :: * -> *). Quote m => Position -> m Exp
lift :: forall (m :: * -> *). Quote m => Position -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
liftTyped :: forall (m :: * -> *). Quote m => Position -> Code m Position
Lift)
  deriving anyclass (Eq Position
Eq Position =>
(Int -> Position -> Int) -> (Position -> Int) -> Hashable Position
Int -> Position -> Int
Position -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Position -> Int
hashWithSalt :: Int -> Position -> Int
$chash :: Position -> Int
hash :: Position -> Int
Hashable, Position -> ()
(Position -> ()) -> NFData Position
forall a. (a -> ()) -> NFData a
$crnf :: Position -> ()
rnf :: Position -> ()
NFData)
  deriving newtype (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq, Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$c< :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show, ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
(Int -> ReadS Position)
-> ReadS [Position]
-> ReadPrec Position
-> ReadPrec [Position]
-> Read Position
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Position
readsPrec :: Int -> ReadS Position
$creadList :: ReadS [Position]
readList :: ReadS [Position]
$creadPrec :: ReadPrec Position
readPrec :: ReadPrec Position
$creadListPrec :: ReadPrec [Position]
readListPrec :: ReadPrec [Position]
Read)

fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

-- | encode a 'Position' into a packed Int64
encodeposition :: Position -> Int64
encodeposition :: Position -> Int64
encodeposition (Position (V3 Int32
x Int32
y Int32
z))
  | Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0x1FFFFF = String -> Int64
forall a. HasCallStack => String -> a
error String
"Position: X out of bounds"
  | Int32
y Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0xFFF = String -> Int64
forall a. HasCallStack => String -> a
error String
"Position: Y out of bounds"
  | Int32
z Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0x1FFFFF = String -> Int64
forall a. HasCallStack => String -> a
error String
"Position: Z out of bounds"
  | Bool
otherwise =
      ((Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fi Int32
x Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0x3FFFFFF) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
38)
        Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|. ((Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fi Int32
z Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0x3FFFFFF) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
12)
        Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|. (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fi Int32
y Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xFFF)
{-# INLINEABLE encodeposition #-}

-- | decode a packed Int64 into a 'Position'
decodeposition :: Int64 -> Position
decodeposition :: Int64 -> Position
decodeposition Int64
n = V3 Int32 -> Position
Position (Int32 -> Int32 -> Int32 -> V3 Int32
forall a. a -> a -> a -> V3 a
V3 Int32
x Int32
y Int32
z)
  where
    x :: Int32
x = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fi (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.>>. Int
38
    y :: Int32
y = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fi (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ (Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
52) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.>>. Int
52
    z :: Int32
z = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fi (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ (Int64
n Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
26) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.>>. Int
38
{-# INLINEABLE decodeposition #-}

-- Instances for Pack and Unpack
instance Pack Position where
  pack :: Position -> Builder
pack = Int64 -> Builder
forall a. Pack a => a -> Builder
pack (Int64 -> Builder) -> (Position -> Int64) -> Position -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int64
encodeposition
  {-# INLINE pack #-}

instance Unpack Position where
  unpack :: forall (st :: ZeroBitType) r. Parser st r Position
unpack = Int64 -> Position
decodeposition (Int64 -> Position) -> (Int64 -> Int64) -> Int64 -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fi (Int64 -> Position)
-> ParserT st r ParseError Int64
-> ParserT st r ParseError Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Int64
  {-# INLINE unpack #-}

-- | apply a function to the x, y, and z components of a 'Position'
posapply :: (Int32 -> Int32) -> Position -> Position
posapply :: (Int32 -> Int32) -> Position -> Position
posapply Int32 -> Int32
f (Position (V3 Int32
x Int32
y Int32
z)) = V3 Int32 -> Position
Position (Int32 -> Int32 -> Int32 -> V3 Int32
forall a. a -> a -> a -> V3 a
V3 (Int32 -> Int32
f Int32
x) (Int32 -> Int32
f Int32
y) (Int32 -> Int32
f Int32
z))
{-# INLINE posapply #-}

-- | apply a function to the x, y, and z components of a 'Position'
posapplyv :: (V3 Int32 -> V3 Int32) -> Position -> Position
posapplyv :: (V3 Int32 -> V3 Int32) -> Position -> Position
posapplyv V3 Int32 -> V3 Int32
f (Position V3 Int32
v) = V3 Int32 -> Position
Position (V3 Int32 -> V3 Int32
f V3 Int32
v)
{-# INLINE posapplyv #-}