Integral.hs

{-# 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{..} = fromInteger
			$   cutBits checkInteger checkBitsInteger
			.|. cutShiftBits nodeIdInteger nodeBitsInteger checkBitsInteger
			.|. cutShiftBits countInteger countBitsInteger (checkBitsInteger + nodeBitsInteger)
			.|. cutShiftBits timeInteger timeBitsInteger (checkBitsInteger + nodeBitsInteger + countBitsInteger)
		where
			SnowcheckedConfig{..} = flakeConfig
			checkBitsInteger = toInteger confCheckBits
			nodeBitsInteger = toInteger confNodeBits
			timeBitsInteger = toInteger confTimeBits
			countBitsInteger = toInteger confCountBits
			nodeIdInteger = toInteger flakeNodeId
			timeInteger = toInteger flakeTime
			countInteger = toInteger flakeCount
			checkInteger = nodeIdInteger + timeInteger + countInteger
	{-# INLINEABLE fromFlake #-}

	parseFish SnowcheckedConfig{..} i = return $ Flakeish
			{ fishCheck = fromIntegral $ cutBits n checkBitsInteger
			, fishNodeId = fromIntegral $ shiftCutBits n checkBitsInteger nodeBitsInteger
			, fishCount = fromIntegral $ shiftCutBits n (checkBitsInteger + nodeBitsInteger) countBitsInteger
			, fishTime = fromIntegral $ shiftCutBits n (checkBitsInteger + nodeBitsInteger + countBitsInteger) timeBitsInteger
			}
		where
			n = toInteger i
			checkBitsInteger = toInteger confCheckBits
			nodeBitsInteger = toInteger confNodeBits
			timeBitsInteger = toInteger confTimeBits
			countBitsInteger = toInteger confCountBits
	{-# INLINE parseFish #-}