{-# LANGUAGE DeriveDataTypeable #-}

module Data.Int128 (
    -- * Definition
    Int128 -- Opaque
    -- * Construction
  , int128
    -- * Destruction
  , int128MS64
  , int128LS64
  ) where

import Data.Bits
import Data.Data
import Data.Ix
import Data.Word
import Foreign
import GHC.Generics

import qualified Data.WideWord.Int128 as WW

import Codec.Borsh.Internal.Util.ByteSwap (ByteSwap(..))

{-------------------------------------------------------------------------------
  Definition, construction, destruction
-------------------------------------------------------------------------------}

-- | Signed 128-bit word
--
-- Implementation note: this currently relies on the implementation of the
-- [wide-word](https://hackage.haskell.org/package/wide-word) package, with some
-- additional instances. However, the use of @wide-word@ is not part of the
-- public API of the @borsh@ package.
newtype Int128 = Int128 WW.Int128
  deriving stock Typeable Int128
Int128 -> DataType
Int128 -> Constr
(forall b. Data b => b -> b) -> Int128 -> Int128
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) -> Int128 -> u
forall u. (forall d. Data d => d -> u) -> Int128 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int128
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int128 -> c Int128
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int128)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int128)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Int128 -> m Int128
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int128 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Int128 -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Int128 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Int128 -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Int128 -> r
gmapT :: (forall b. Data b => b -> b) -> Int128 -> Int128
$cgmapT :: (forall b. Data b => b -> b) -> Int128 -> Int128
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int128)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Int128)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int128)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Int128)
dataTypeOf :: Int128 -> DataType
$cdataTypeOf :: Int128 -> DataType
toConstr :: Int128 -> Constr
$ctoConstr :: Int128 -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int128
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Int128
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int128 -> c Int128
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Int128 -> c Int128
Data
  deriving newtype (
      Eq Int128
Int128
Int -> Int128
Int128 -> Bool
Int128 -> Int
Int128 -> Maybe Int
Int128 -> Int128
Int128 -> Int -> Bool
Int128 -> Int -> Int128
Int128 -> Int128 -> Int128
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Int128 -> Int
$cpopCount :: Int128 -> Int
rotateR :: Int128 -> Int -> Int128
$crotateR :: Int128 -> Int -> Int128
rotateL :: Int128 -> Int -> Int128
$crotateL :: Int128 -> Int -> Int128
unsafeShiftR :: Int128 -> Int -> Int128
$cunsafeShiftR :: Int128 -> Int -> Int128
shiftR :: Int128 -> Int -> Int128
$cshiftR :: Int128 -> Int -> Int128
unsafeShiftL :: Int128 -> Int -> Int128
$cunsafeShiftL :: Int128 -> Int -> Int128
shiftL :: Int128 -> Int -> Int128
$cshiftL :: Int128 -> Int -> Int128
isSigned :: Int128 -> Bool
$cisSigned :: Int128 -> Bool
bitSize :: Int128 -> Int
$cbitSize :: Int128 -> Int
bitSizeMaybe :: Int128 -> Maybe Int
$cbitSizeMaybe :: Int128 -> Maybe Int
testBit :: Int128 -> Int -> Bool
$ctestBit :: Int128 -> Int -> Bool
complementBit :: Int128 -> Int -> Int128
$ccomplementBit :: Int128 -> Int -> Int128
clearBit :: Int128 -> Int -> Int128
$cclearBit :: Int128 -> Int -> Int128
setBit :: Int128 -> Int -> Int128
$csetBit :: Int128 -> Int -> Int128
bit :: Int -> Int128
$cbit :: Int -> Int128
zeroBits :: Int128
$czeroBits :: Int128
rotate :: Int128 -> Int -> Int128
$crotate :: Int128 -> Int -> Int128
shift :: Int128 -> Int -> Int128
$cshift :: Int128 -> Int -> Int128
complement :: Int128 -> Int128
$ccomplement :: Int128 -> Int128
xor :: Int128 -> Int128 -> Int128
$cxor :: Int128 -> Int128 -> Int128
.|. :: Int128 -> Int128 -> Int128
$c.|. :: Int128 -> Int128 -> Int128
.&. :: Int128 -> Int128 -> Int128
$c.&. :: Int128 -> Int128 -> Int128
Bits
    , Int128
forall a. a -> a -> Bounded a
maxBound :: Int128
$cmaxBound :: Int128
minBound :: Int128
$cminBound :: Int128
Bounded
    , Int -> Int128
Int128 -> Int
Int128 -> [Int128]
Int128 -> Int128
Int128 -> Int128 -> [Int128]
Int128 -> Int128 -> Int128 -> [Int128]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Int128 -> Int128 -> Int128 -> [Int128]
$cenumFromThenTo :: Int128 -> Int128 -> Int128 -> [Int128]
enumFromTo :: Int128 -> Int128 -> [Int128]
$cenumFromTo :: Int128 -> Int128 -> [Int128]
enumFromThen :: Int128 -> Int128 -> [Int128]
$cenumFromThen :: Int128 -> Int128 -> [Int128]
enumFrom :: Int128 -> [Int128]
$cenumFrom :: Int128 -> [Int128]
fromEnum :: Int128 -> Int
$cfromEnum :: Int128 -> Int
toEnum :: Int -> Int128
$ctoEnum :: Int -> Int128
pred :: Int128 -> Int128
$cpred :: Int128 -> Int128
succ :: Int128 -> Int128
$csucc :: Int128 -> Int128
Enum
    , Int128 -> Int128 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int128 -> Int128 -> Bool
$c/= :: Int128 -> Int128 -> Bool
== :: Int128 -> Int128 -> Bool
$c== :: Int128 -> Int128 -> Bool
Eq
    , Bits Int128
Int128 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Int128 -> Int
$ccountTrailingZeros :: Int128 -> Int
countLeadingZeros :: Int128 -> Int
$ccountLeadingZeros :: Int128 -> Int
finiteBitSize :: Int128 -> Int
$cfiniteBitSize :: Int128 -> Int
FiniteBits
    , forall x. Rep Int128 x -> Int128
forall x. Int128 -> Rep Int128 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
to :: forall x. Rep Int128 x -> Int128
$cto :: forall x. Rep Int128 x -> Int128
from :: forall x. Int128 -> Rep Int128 x
$cfrom :: forall x. Int128 -> Rep Int128 x
Generic
    , Enum Int128
Real Int128
Int128 -> Integer
Int128 -> Int128 -> (Int128, Int128)
Int128 -> Int128 -> Int128
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Int128 -> Integer
$ctoInteger :: Int128 -> Integer
divMod :: Int128 -> Int128 -> (Int128, Int128)
$cdivMod :: Int128 -> Int128 -> (Int128, Int128)
quotRem :: Int128 -> Int128 -> (Int128, Int128)
$cquotRem :: Int128 -> Int128 -> (Int128, Int128)
mod :: Int128 -> Int128 -> Int128
$cmod :: Int128 -> Int128 -> Int128
div :: Int128 -> Int128 -> Int128
$cdiv :: Int128 -> Int128 -> Int128
rem :: Int128 -> Int128 -> Int128
$crem :: Int128 -> Int128 -> Int128
quot :: Int128 -> Int128 -> Int128
$cquot :: Int128 -> Int128 -> Int128
Integral
    , Ord Int128
(Int128, Int128) -> Int
(Int128, Int128) -> [Int128]
(Int128, Int128) -> Int128 -> Bool
(Int128, Int128) -> Int128 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Int128, Int128) -> Int
$cunsafeRangeSize :: (Int128, Int128) -> Int
rangeSize :: (Int128, Int128) -> Int
$crangeSize :: (Int128, Int128) -> Int
inRange :: (Int128, Int128) -> Int128 -> Bool
$cinRange :: (Int128, Int128) -> Int128 -> Bool
unsafeIndex :: (Int128, Int128) -> Int128 -> Int
$cunsafeIndex :: (Int128, Int128) -> Int128 -> Int
index :: (Int128, Int128) -> Int128 -> Int
$cindex :: (Int128, Int128) -> Int128 -> Int
range :: (Int128, Int128) -> [Int128]
$crange :: (Int128, Int128) -> [Int128]
Ix
    , Integer -> Int128
Int128 -> Int128
Int128 -> Int128 -> Int128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Int128
$cfromInteger :: Integer -> Int128
signum :: Int128 -> Int128
$csignum :: Int128 -> Int128
abs :: Int128 -> Int128
$cabs :: Int128 -> Int128
negate :: Int128 -> Int128
$cnegate :: Int128 -> Int128
* :: Int128 -> Int128 -> Int128
$c* :: Int128 -> Int128 -> Int128
- :: Int128 -> Int128 -> Int128
$c- :: Int128 -> Int128 -> Int128
+ :: Int128 -> Int128 -> Int128
$c+ :: Int128 -> Int128 -> Int128
Num
    , Eq Int128
Int128 -> Int128 -> Bool
Int128 -> Int128 -> Ordering
Int128 -> Int128 -> Int128
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
min :: Int128 -> Int128 -> Int128
$cmin :: Int128 -> Int128 -> Int128
max :: Int128 -> Int128 -> Int128
$cmax :: Int128 -> Int128 -> Int128
>= :: Int128 -> Int128 -> Bool
$c>= :: Int128 -> Int128 -> Bool
> :: Int128 -> Int128 -> Bool
$c> :: Int128 -> Int128 -> Bool
<= :: Int128 -> Int128 -> Bool
$c<= :: Int128 -> Int128 -> Bool
< :: Int128 -> Int128 -> Bool
$c< :: Int128 -> Int128 -> Bool
compare :: Int128 -> Int128 -> Ordering
$ccompare :: Int128 -> Int128 -> Ordering
Ord
    , ReadPrec [Int128]
ReadPrec Int128
Int -> ReadS Int128
ReadS [Int128]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Int128]
$creadListPrec :: ReadPrec [Int128]
readPrec :: ReadPrec Int128
$creadPrec :: ReadPrec Int128
readList :: ReadS [Int128]
$creadList :: ReadS [Int128]
readsPrec :: Int -> ReadS Int128
$creadsPrec :: Int -> ReadS Int128
Read
    , Num Int128
Ord Int128
Int128 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Int128 -> Rational
$ctoRational :: Int128 -> Rational
Real
    , Int -> Int128 -> ShowS
[Int128] -> ShowS
Int128 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Int128] -> ShowS
$cshowList :: [Int128] -> ShowS
show :: Int128 -> String
$cshow :: Int128 -> String
showsPrec :: Int -> Int128 -> ShowS
$cshowsPrec :: Int -> Int128 -> ShowS
Show
    , Ptr Int128 -> IO Int128
Ptr Int128 -> Int -> IO Int128
Ptr Int128 -> Int -> Int128 -> IO ()
Ptr Int128 -> Int128 -> IO ()
Int128 -> Int
forall b. Ptr b -> Int -> IO Int128
forall b. Ptr b -> Int -> Int128 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Int128 -> Int128 -> IO ()
$cpoke :: Ptr Int128 -> Int128 -> IO ()
peek :: Ptr Int128 -> IO Int128
$cpeek :: Ptr Int128 -> IO Int128
pokeByteOff :: forall b. Ptr b -> Int -> Int128 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Int128 -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Int128
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Int128
pokeElemOff :: Ptr Int128 -> Int -> Int128 -> IO ()
$cpokeElemOff :: Ptr Int128 -> Int -> Int128 -> IO ()
peekElemOff :: Ptr Int128 -> Int -> IO Int128
$cpeekElemOff :: Ptr Int128 -> Int -> IO Int128
alignment :: Int128 -> Int
$calignment :: Int128 -> Int
sizeOf :: Int128 -> Int
$csizeOf :: Int128 -> Int
Storable
    )

-- | Construct an 'Int128'
int128 ::
     Word64 -- ^ Most significant bits
  -> Word64 -- ^ Least significant bits
  -> Int128
int128 :: Word64 -> Word64 -> Int128
int128 Word64
hi Word64
lo = Int128 -> Int128
Int128 (Word64 -> Word64 -> Int128
WW.Int128 Word64
hi Word64
lo)

-- | Get the most significant 64 bits from an 'Int128'
int128MS64 :: Int128 -> Word64
int128MS64 :: Int128 -> Word64
int128MS64 (Int128 (WW.Int128 Word64
hi Word64
_)) = Word64
hi

-- | Get the least significant 64 bits from an 'Int128'
int128LS64 :: Int128 -> Word64
int128LS64 :: Int128 -> Word64
int128LS64 (Int128 (WW.Int128 Word64
_ Word64
lo)) = Word64
lo

{-------------------------------------------------------------------------------
  Instances
-------------------------------------------------------------------------------}

instance ByteSwap Int128 where
  byteSwap :: Int128 -> Int128
byteSwap (Int128 (WW.Int128 Word64
hi Word64
lo)) =
      Int128 -> Int128
Int128 forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Int128
WW.Int128 (Word64 -> Word64
byteSwap64 Word64
lo) (Word64 -> Word64
byteSwap64 Word64
hi)