{-# LANGUAGE DeriveGeneric #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Tick (
  TickNumber (..),
  addTicks,
  formatTicks,
) where

import Data.Aeson (FromJSON, ToJSON (..))
import Data.Aeson qualified as A
import Data.Bits (Bits (..))
import Data.Int (Int64)
import Data.List (intersperse)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..))
import Swarm.Util.JSON (optionsUnwrapUnary)
import Swarm.Util.WindowedCounter (Offsettable (..))
import Text.Printf

-- | A newtype representing a count of ticks (typically since the
--   start of a game).
newtype TickNumber = TickNumber {TickNumber -> Int64
getTickNumber :: Int64}
  deriving (TickNumber -> TickNumber -> Bool
(TickNumber -> TickNumber -> Bool)
-> (TickNumber -> TickNumber -> Bool) -> Eq TickNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickNumber -> TickNumber -> Bool
== :: TickNumber -> TickNumber -> Bool
$c/= :: TickNumber -> TickNumber -> Bool
/= :: TickNumber -> TickNumber -> Bool
Eq, Eq TickNumber
Eq TickNumber =>
(TickNumber -> TickNumber -> Ordering)
-> (TickNumber -> TickNumber -> Bool)
-> (TickNumber -> TickNumber -> Bool)
-> (TickNumber -> TickNumber -> Bool)
-> (TickNumber -> TickNumber -> Bool)
-> (TickNumber -> TickNumber -> TickNumber)
-> (TickNumber -> TickNumber -> TickNumber)
-> Ord TickNumber
TickNumber -> TickNumber -> Bool
TickNumber -> TickNumber -> Ordering
TickNumber -> TickNumber -> TickNumber
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 :: TickNumber -> TickNumber -> Ordering
compare :: TickNumber -> TickNumber -> Ordering
$c< :: TickNumber -> TickNumber -> Bool
< :: TickNumber -> TickNumber -> Bool
$c<= :: TickNumber -> TickNumber -> Bool
<= :: TickNumber -> TickNumber -> Bool
$c> :: TickNumber -> TickNumber -> Bool
> :: TickNumber -> TickNumber -> Bool
$c>= :: TickNumber -> TickNumber -> Bool
>= :: TickNumber -> TickNumber -> Bool
$cmax :: TickNumber -> TickNumber -> TickNumber
max :: TickNumber -> TickNumber -> TickNumber
$cmin :: TickNumber -> TickNumber -> TickNumber
min :: TickNumber -> TickNumber -> TickNumber
Ord, Int -> TickNumber -> ShowS
[TickNumber] -> ShowS
TickNumber -> String
(Int -> TickNumber -> ShowS)
-> (TickNumber -> String)
-> ([TickNumber] -> ShowS)
-> Show TickNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickNumber -> ShowS
showsPrec :: Int -> TickNumber -> ShowS
$cshow :: TickNumber -> String
show :: TickNumber -> String
$cshowList :: [TickNumber] -> ShowS
showList :: [TickNumber] -> ShowS
Show, ReadPrec [TickNumber]
ReadPrec TickNumber
Int -> ReadS TickNumber
ReadS [TickNumber]
(Int -> ReadS TickNumber)
-> ReadS [TickNumber]
-> ReadPrec TickNumber
-> ReadPrec [TickNumber]
-> Read TickNumber
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TickNumber
readsPrec :: Int -> ReadS TickNumber
$creadList :: ReadS [TickNumber]
readList :: ReadS [TickNumber]
$creadPrec :: ReadPrec TickNumber
readPrec :: ReadPrec TickNumber
$creadListPrec :: ReadPrec [TickNumber]
readListPrec :: ReadPrec [TickNumber]
Read, (forall x. TickNumber -> Rep TickNumber x)
-> (forall x. Rep TickNumber x -> TickNumber) -> Generic TickNumber
forall x. Rep TickNumber x -> TickNumber
forall x. TickNumber -> Rep TickNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TickNumber -> Rep TickNumber x
from :: forall x. TickNumber -> Rep TickNumber x
$cto :: forall x. Rep TickNumber x -> TickNumber
to :: forall x. Rep TickNumber x -> TickNumber
Generic)

-- | Add an offset to a 'TickNumber'.
addTicks :: Int -> TickNumber -> TickNumber
addTicks :: Int -> TickNumber -> TickNumber
addTicks Int
i (TickNumber Int64
n) = Int64 -> TickNumber
TickNumber (Int64 -> TickNumber) -> Int64 -> TickNumber
forall a b. (a -> b) -> a -> b
$ Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

-- | Format a ticks count as a hexadecimal clock.
formatTicks :: Bool -> TickNumber -> String
formatTicks :: Bool -> TickNumber -> String
formatTicks Bool
showTicks (TickNumber Int64
t) =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse
      String
":"
      [ String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
"%x" (Int64
t Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
20)
      , String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" ((Int64
t Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. ((Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1))
      , String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" ((Int64
t Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. ((Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1))
      ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Bool
showTicks then [String
".", String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
"%x" (Int64
t Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. ((Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1))] else []

instance ToJSON TickNumber where
  toJSON :: TickNumber -> Value
toJSON = Options -> TickNumber -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
optionsUnwrapUnary

instance FromJSON TickNumber where
  parseJSON :: Value -> Parser TickNumber
parseJSON = Options -> Value -> Parser TickNumber
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
optionsUnwrapUnary

instance Offsettable TickNumber where
  offsetBy :: Int -> TickNumber -> TickNumber
offsetBy = Int -> TickNumber -> TickNumber
addTicks

instance Pretty TickNumber where
  pretty :: forall ann. TickNumber -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (TickNumber -> String) -> TickNumber -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TickNumber -> String
formatTicks Bool
True