snowchecked 0.0.1.2 → 0.0.1.3

raw patch · 9 files changed

+53/−51 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• package.yaml +1/−1
• snowchecked.cabal +2/−2
• src/Data/Snowchecked.hs +6/−5
• src/Data/Snowchecked/Encoding/Class.hs +8/−8
• src/Data/Snowchecked/Encoding/Integral.hs +16/−16
• src/Data/Snowchecked/Encoding/Text.hs +8/−8
• src/Data/Snowchecked/Internal/Import.hs +7/−6
• stack.yaml +1/−1
• stack.yaml.lock +4/−4

@@ -1,5 +1,5 @@ name: snowchecked-version: 0.0.1.2+version: 0.0.1.3 github: robertfischer/hs-snowflake-checked license: Apache-2.0 author: Robert Fischer

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           snowchecked-version:        0.0.1.2+version:        0.0.1.3 synopsis:       A checksummed variation on Twitter's Snowflake UID generation algorithm description:    See the file ./README.md, which is included in the package and also on GitHub. category:       Data

@@ -25,6 +25,7 @@ import           Control.Monad.IO.Class           (MonadIO, liftIO) import           Data.Snowchecked.Internal.Import import           Data.Time.Clock.POSIX            (getPOSIXTime)+import GHC.Stack (HasCallStack)   currentTimestamp :: IO Word256@@ -34,19 +35,19 @@ {-# INLINE currentTimestamp #-}  currentTimestampBits :: Word8 -> IO Word256-currentTimestampBits n = (`cutBits` fromIntegral n) <$> currentTimestamp+currentTimestampBits n = (`cutBits` toInt n) <$> currentTimestamp {-# INLINE currentTimestampBits #-}  -- | Create a new generator. Takes a configuration and node id.  The node id may be any -- value that fits in a 'Word256', but it will be truncated to the number of bits specified -- in the provided configuration.-newSnowcheckedGen :: (MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen+newSnowcheckedGen :: (HasCallStack, MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen newSnowcheckedGen conf@SnowcheckedConfig{..} nodeId = liftIO $ do 	startTimeBits <- currentTimestampBits confTimeBits 	SnowcheckedGen <$> newMVar Flake 		{ flakeTime = startTimeBits 		, flakeCount = maxBound-		, flakeNodeId = cutBits nodeId confNodeBits+		, flakeNodeId = cutBits nodeId (toInt confNodeBits) 		, flakeConfig = conf 		} {-# INLINEABLE newSnowcheckedGen #-}@@ -68,7 +69,7 @@ {-# INLINEABLE snowcheckedConfigBitCount #-}  -- | Generates the next id.-nextFlake :: (MonadIO io) => SnowcheckedGen -> io Flake+nextFlake :: (HasCallStack, MonadIO io) => SnowcheckedGen -> io Flake nextFlake SnowcheckedGen{..} = liftIO $ modifyMVar genLastFlake mkNextFlake 	where 		-- TODO: Special case when confTimeBits is 0.@@ -85,7 +86,7 @@ 				else if confCountBits == 0 then 					threadDelay 1000 >> mkNextFlake flake 				else-					let nextCount = cutBits (flakeCount + 1) confCountBits in+					let nextCount = cutBits (flakeCount + 1) (toInt confCountBits) in 					if flakeCount < nextCount then 						let newFlake = flake { flakeCount = nextCount } 						in return (newFlake, newFlake)

@@ -16,12 +16,12 @@ {-| Is this 'Flakeish' valid under the given 'SnowcheckedConfig' settings? -} goodFish :: SnowcheckedConfig -> Flakeish -> Bool goodFish SnowcheckedConfig{..} Flakeish{..} =-		checkInteger == cutBits (nodeInteger + countInteger + timeInteger) confCheckBits+		checkInteger == cutBits (nodeInteger + countInteger + timeInteger) (toInt confCheckBits) 	where-		checkInteger = cutBits fishCheck confCheckBits-		nodeInteger = cutBits fishNodeId confNodeBits-		countInteger = cutBits fishCount confCountBits-		timeInteger = cutBits fishTime confTimeBits+		checkInteger = cutBits fishCheck (toInt confCheckBits)+		nodeInteger = cutBits fishNodeId (toInt confNodeBits)+		countInteger = cutBits fishCount (toInt confCountBits)+		timeInteger = cutBits fishTime (toInt confTimeBits) {-# INLINEABLE goodFish #-}  {-| The class of things that can be generated from and to a 'Flake'.@@ -33,9 +33,9 @@ 	parseFlake cfg@SnowcheckedConfig{..} a = parseFish cfg a >>= \fish@Flakeish{..} -> 		if goodFish cfg fish then 			return $ Flake-				{ flakeTime = cutBits fishTime confTimeBits-				, flakeCount = cutBits fishCount confCountBits-				, flakeNodeId = cutBits fishNodeId confNodeBits+				{ flakeTime = cutBits fishTime (toInt confTimeBits)+				, flakeCount = cutBits fishCount (toInt confCountBits)+				, flakeNodeId = cutBits fishNodeId (toInt confNodeBits) 				, flakeConfig = cfg 				} 		else

@@ -19,16 +19,16 @@  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)+			$   cutBits checkInteger checkBitsInt+			.|. cutShiftBits nodeIdInteger nodeBitsInt checkBitsInt+			.|. cutShiftBits countInteger countBitsInt (checkBitsInt + nodeBitsInt)+			.|. cutShiftBits timeInteger timeBitsInt (checkBitsInt + nodeBitsInt + countBitsInt) 		where 			SnowcheckedConfig{..} = flakeConfig-			checkBitsInteger = toInteger confCheckBits-			nodeBitsInteger = toInteger confNodeBits-			timeBitsInteger = toInteger confTimeBits-			countBitsInteger = toInteger confCountBits+			checkBitsInt = toInt confCheckBits+			nodeBitsInt = toInt confNodeBits+			timeBitsInt = toInt confTimeBits+			countBitsInt = toInt confCountBits 			nodeIdInteger = toInteger flakeNodeId 			timeInteger = toInteger flakeTime 			countInteger = toInteger flakeCount@@ -36,15 +36,15 @@ 	{-# 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+			{ fishCheck = fromIntegral $ cutBits n checkBitsInt+			, fishNodeId = fromIntegral $ shiftCutBits n checkBitsInt nodeBitsInt+			, fishCount = fromIntegral $ shiftCutBits n (checkBitsInt + nodeBitsInt) countBitsInt+			, fishTime = fromIntegral $ shiftCutBits n (checkBitsInt + nodeBitsInt + countBitsInt) timeBitsInt 			} 		where 			n = toInteger i-			checkBitsInteger = toInteger confCheckBits-			nodeBitsInteger = toInteger confNodeBits-			timeBitsInteger = toInteger confTimeBits-			countBitsInteger = toInteger confCountBits+			checkBitsInt = toInt confCheckBits+			nodeBitsInt = toInt confNodeBits+			timeBitsInt = toInt confTimeBits+			countBitsInt = toInt confCountBits 	{-# INLINE parseFish #-}

@@ -96,20 +96,20 @@ 	{-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-}  	parseFish SnowcheckedConfig{..} (Base16 raw) = 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+			{ fishCheck = fromIntegral $ cutBits n checkBitsInt+			, fishNodeId = fromIntegral $ shiftCutBits n checkBitsInt nodeBitsInt+			, fishCount = fromIntegral $ shiftCutBits n (checkBitsInt + nodeBitsInt) countBitsInt+			, fishTime = fromIntegral $ shiftCutBits n (checkBitsInt + nodeBitsInt + countBitsInt) timeBitsInt 			} 		where 			nibbles = catMaybes . T.foldr toNibbles [] $ toText raw 			n = L.foldr addNibbles 0 nibbles 			addNibbles nib total = toInteger nib + ( total `shiftL` 4 ) 			toNibbles ch lst = b ch : lst-			checkBitsInteger = toInteger confCheckBits-			nodeBitsInteger = toInteger confNodeBits-			timeBitsInteger = toInteger confTimeBits-			countBitsInteger = toInteger confCountBits+			checkBitsInt = toInt confCheckBits+			nodeBitsInt = toInt confNodeBits+			timeBitsInt = toInt confTimeBits+			countBitsInt = toInt confCountBits 	{-# INLINEABLE parseFish #-} 	{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 T.Text -> m Flakeish #-} 	{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 String -> m Flakeish #-}

@@ -14,17 +14,18 @@ import           Data.WideWord.Word256 import           Data.Word import           Numeric+import GHC.Stack (HasCallStack) -cutBits :: (Num a, Bits a, Integral bitCount) => a -> bitCount -> a-cutBits n bits = n .&. ((1 `shiftL` fromIntegral bits) - 1)+cutBits :: (HasCallStack, Num a, Bits a) => a -> Int -> a+cutBits n bits = n .&. ((1 `shiftL` bits) - 1) {-# INLINE cutBits #-} -cutShiftBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> cutBitCount -> shiftBitCount -> a-cutShiftBits n cutBitCount shiftBitCount = cutBits n cutBitCount `shiftL` fromIntegral shiftBitCount+cutShiftBits :: (HasCallStack, Num a, Bits a) => a -> Int -> Int -> a+cutShiftBits n cutBitCount shiftBitCount = cutBits n cutBitCount `shiftL` shiftBitCount {-# INLINE cutShiftBits #-} -shiftCutBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> shiftBitCount -> cutBitCount -> a-shiftCutBits n shiftBitCount = cutBits $ n `shiftR` fromIntegral shiftBitCount+shiftCutBits :: (HasCallStack, Num a, Bits a) => a -> Int -> Int -> a+shiftCutBits n shiftBitCount = cutBits $ n `shiftR` shiftBitCount {-# INLINE shiftCutBits #-}  toInt :: (Integral a) => a -> Int

@@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml-resolver: lts-19.15+resolver: lts-20.2  # User packages to be built. # Various formats can be used as shown in the example below.

@@ -6,7 +6,7 @@ packages: [] snapshots: - completed:-    size: 618952-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/15.yaml-    sha256: 82e5ccb47b068521de4055034e8aa278eab430b586881d9cc29ba8b382ce3253-  original: lts-19.15+    sha256: fc39d8afc97531d53d87b10abdef593bce503c0c1e46c2e9a84ebcbc78bf8470+    size: 648432+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/2.yaml+  original: lts-20.2