{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans      #-}
{-|
 This module provides a generalized conversion function between a
 'Flake' and all members of the typeclass 'Integral'.  It is specialized
 for the 'Integer', 'Word32', and 'Word64' types. It is marked as
 incoherent due to the constraint being no smaller than the instance type,
 so it is undecidable.
-}

module Data.Snowchecked.Encoding.Integral
	( module Data.Snowchecked.Encoding.Class
	) where

import           Data.Snowchecked.Encoding.Class
import           Data.Snowchecked.Internal.Import

instance {-# INCOHERENT #-} (Integral a) => IsFlake a where
	fromFlake :: Flake -> a
fromFlake Flake{Word256
SnowcheckedConfig
flakeConfig :: Flake -> SnowcheckedConfig
flakeNodeId :: Flake -> Word256
flakeCount :: Flake -> Word256
flakeTime :: Flake -> Word256
flakeConfig :: SnowcheckedConfig
flakeNodeId :: Word256
flakeCount :: Word256
flakeTime :: Word256
..} = Integer -> a
forall a. Num a => Integer -> a
fromInteger
			(Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$   Integer -> Integer -> Integer
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Integer
checkInteger Integer
checkBitsInteger
			Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> cutBitCount -> shiftBitCount -> a
cutShiftBits Integer
nodeIdInteger Integer
nodeBitsInteger Integer
checkBitsInteger
			Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> cutBitCount -> shiftBitCount -> a
cutShiftBits Integer
countInteger Integer
countBitsInteger (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger)
			Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> cutBitCount -> shiftBitCount -> a
cutShiftBits Integer
timeInteger Integer
timeBitsInteger (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
countBitsInteger)
		where
			SnowcheckedConfig{Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
..} = SnowcheckedConfig
flakeConfig
			checkBitsInteger :: Integer
checkBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCheckBits
			nodeBitsInteger :: Integer
nodeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confNodeBits
			timeBitsInteger :: Integer
timeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confTimeBits
			countBitsInteger :: Integer
countBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCountBits
			nodeIdInteger :: Integer
nodeIdInteger = Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger Word256
flakeNodeId
			timeInteger :: Integer
timeInteger = Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger Word256
flakeTime
			countInteger :: Integer
countInteger = Word256 -> Integer
forall a. Integral a => a -> Integer
toInteger Word256
flakeCount
			checkInteger :: Integer
checkInteger = Integer
nodeIdInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
timeInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
countInteger
	{-# INLINEABLE fromFlake #-}

	parseFish :: SnowcheckedConfig -> a -> m Flakeish
parseFish SnowcheckedConfig{Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
..} a
i = Flakeish -> m Flakeish
forall (m :: * -> *) a. Monad m => a -> m a
return (Flakeish -> m Flakeish) -> Flakeish -> m Flakeish
forall a b. (a -> b) -> a -> b
$ Flakeish :: Word256 -> Word256 -> Word256 -> Word256 -> Flakeish
Flakeish
			{ fishCheck :: Word256
fishCheck = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Integer
n Integer
checkBitsInteger
			, fishNodeId :: Word256
fishNodeId = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n Integer
checkBitsInteger Integer
nodeBitsInteger
			, fishCount :: Word256
fishCount = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger) Integer
countBitsInteger
			, fishTime :: Word256
fishTime = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
countBitsInteger) Integer
timeBitsInteger
			}
		where
			n :: Integer
n = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i
			checkBitsInteger :: Integer
checkBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCheckBits
			nodeBitsInteger :: Integer
nodeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confNodeBits
			timeBitsInteger :: Integer
timeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confTimeBits
			countBitsInteger :: Integer
countBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCountBits
	{-# INLINE parseFish #-}