module Rattletrap.Type.Version where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Monad as Monad

data Version = Version
  { Version -> U32
major :: U32.U32,
    Version -> U32
minor :: U32.U32,
    Version -> Maybe U32
patch :: Maybe U32.U32
  }
  deriving (Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

atLeast :: Int -> Int -> Int -> Version -> Bool
atLeast :: Int -> Int -> Int -> Version -> Bool
atLeast Int
m Int
n Int
p Version
v =
  (U32 -> Word32
U32.toWord32 (Version -> U32
major Version
v) forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
    Bool -> Bool -> Bool
&& (U32 -> Word32
U32.toWord32 (Version -> U32
minor Version
v) forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    Bool -> Bool -> Bool
&& (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 U32 -> Word32
U32.toWord32 (Version -> Maybe U32
patch Version
v) forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

bytePut :: Version -> BytePut.BytePut
bytePut :: Version -> BytePut
bytePut Version
x =
  U32 -> BytePut
U32.bytePut (Version -> U32
major Version
x)
    forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Version -> U32
minor Version
x)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      U32 -> BytePut
U32.bytePut
      (Version -> Maybe U32
patch Version
x)

byteGet :: ByteGet.ByteGet Version
byteGet :: ByteGet Version
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Version" forall a b. (a -> b) -> a -> b
$ do
  U32
major <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"major" ByteGet U32
U32.byteGet
  U32
minor <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"minor" ByteGet U32
U32.byteGet
  Maybe U32
patch <-
    forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"patch" forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe
        (U32 -> Word32
U32.toWord32 U32
major forall a. Ord a => a -> a -> Bool
>= Word32
868 Bool -> Bool -> Bool
&& U32 -> Word32
U32.toWord32 U32
minor forall a. Ord a => a -> a -> Bool
>= Word32
18)
        ByteGet U32
U32.byteGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Version {U32
major :: U32
major :: U32
major, U32
minor :: U32
minor :: U32
minor, Maybe U32
patch :: Maybe U32
patch :: Maybe U32
patch}