{-# 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
..} = forall a. Num a => Integer -> a
fromInteger
			forall a b. (a -> b) -> a -> b
$   forall a. (Num a, Bits a) => a -> Int -> a
cutBits Integer
checkInteger Int
checkBitsInt
			forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a -> Int -> Int -> a
cutShiftBits Integer
nodeIdInteger Int
nodeBitsInt Int
checkBitsInt
			forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a -> Int -> Int -> a
cutShiftBits Integer
countInteger Int
countBitsInt (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt)
			forall a. Bits a => a -> a -> a
.|. forall a. (Num a, Bits a) => a -> Int -> Int -> a
cutShiftBits Integer
timeInteger Int
timeBitsInt (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt forall a. Num a => a -> a -> a
+ Int
countBitsInt)
		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
			checkBitsInt :: Int
checkBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCheckBits
			nodeBitsInt :: Int
nodeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confNodeBits
			timeBitsInt :: Int
timeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confTimeBits
			countBitsInt :: Int
countBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCountBits
			nodeIdInteger :: Integer
nodeIdInteger = forall a. Integral a => a -> Integer
toInteger Word256
flakeNodeId
			timeInteger :: Integer
timeInteger = forall a. Integral a => a -> Integer
toInteger Word256
flakeTime
			countInteger :: Integer
countInteger = forall a. Integral a => a -> Integer
toInteger Word256
flakeCount
			checkInteger :: Integer
checkInteger = Integer
nodeIdInteger forall a. Num a => a -> a -> a
+ Integer
timeInteger forall a. Num a => a -> a -> a
+ Integer
countInteger
	{-# INLINEABLE fromFlake #-}

	parseFish :: forall (m :: * -> *).
MonadFail m =>
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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Flakeish
			{ fishCheck :: Word256
fishCheck = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> a
cutBits Integer
n Int
checkBitsInt
			, fishNodeId :: Word256
fishNodeId = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n Int
checkBitsInt Int
nodeBitsInt
			, fishCount :: Word256
fishCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt) Int
countBitsInt
			, fishTime :: Word256
fishTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt forall a. Num a => a -> a -> a
+ Int
countBitsInt) Int
timeBitsInt
			}
		where
			n :: Integer
n = forall a. Integral a => a -> Integer
toInteger a
i
			checkBitsInt :: Int
checkBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCheckBits
			nodeBitsInt :: Int
nodeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confNodeBits
			timeBitsInt :: Int
timeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confTimeBits
			countBitsInt :: Int
countBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCountBits
	{-# INLINE parseFish #-}