snowchecked 0.0.1.3 → 0.0.2.0

raw patch · 13 files changed

+220/−184 lines, 13 filesdep +unliftioPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unliftio

API changes (from Hackage documentation)

Files

• README.md +1/−3
• package.yaml +3/−2
• snowchecked.cabal +3/−2
• src/Data/Snowchecked.hs +30/−19
• src/Data/Snowchecked/Encoding/ByteString.hs +1/−3
• src/Data/Snowchecked/Encoding/ByteString/Lazy.hs +2/−3
• src/Data/Snowchecked/Encoding/Text.hs +54/−85
• src/Data/Snowchecked/Internal/Import.hs +4/−4
• test/Gens.hs +33/−4
• test/Integer.hs +6/−5
• test/Spec.hs +52/−42
• test/String.hs +8/−6
• test/Text.hs +23/−6

@@ -19,9 +19,7 @@ This implementation allows the number of bits in the id to range from 0 bits to 255^4 bits. The default configuration uses 64 bits, with 40 bits used for time, 10 bits used for the counter, 8 bits used for the node id, and 6 bits for the checksum. The odds of a false positive on the checksum is `1/(2^checkbits)`, so the odds of a false positive in the default configuration-is ~1.5%. This configuration can generate 1024 UIDs per millisecond per node: the 1025th request in a given millisecond-will cause a pause in the thread for one millisecond, and then the counter will reset to 0. (If you need more UID throughput-than that, then create more generators with distinct node ids.)+is ~1.5%.   ## Encoding 

@@ -1,10 +1,10 @@ name: snowchecked-version: 0.0.1.3+version: 0.0.2.0 github: robertfischer/hs-snowflake-checked license: Apache-2.0 author: Robert Fischer maintainer: smokejumperit@gmail.com-copyright: 2021 Robert Fischer+copyright: 2021-2023 Robert Fischer  extra-source-files:   - LICENSE@@ -75,6 +75,7 @@     dependencies:       - snowchecked       - hedgehog+      - unliftio      ghc-options:       - -threaded

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           snowchecked-version:        0.0.1.3+version:        0.0.2.0 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@@ -13,7 +13,7 @@ bug-reports:    https://github.com/robertfischer/hs-snowflake-checked/issues author:         Robert Fischer maintainer:     smokejumperit@gmail.com-copyright:      2021 Robert Fischer+copyright:      2021-2023 Robert Fischer license:        Apache-2.0 license-file:   LICENSE build-type:     Simple@@ -78,5 +78,6 @@     , text >=1.2.4.1     , text-conversions >=0.3.1     , time >=1.9.3+    , unliftio     , wide-word >=0.1.1.2   default-language: Haskell2010

@@ -20,12 +20,10 @@ , uniqueFlakeCount ) where -import           Control.Concurrent               (threadDelay) import           Control.Concurrent.MVar 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@@ -35,18 +33,21 @@ {-# INLINE currentTimestamp #-}  currentTimestampBits :: Word8 -> IO Word256-currentTimestampBits n = (`cutBits` toInt n) <$> currentTimestamp+currentTimestampBits n = +	if n == 0 then+		return 0+	else+		(`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 :: (HasCallStack, MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen-newSnowcheckedGen conf@SnowcheckedConfig{..} nodeId = liftIO $ do-	startTimeBits <- currentTimestampBits confTimeBits+newSnowcheckedGen :: (MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen+newSnowcheckedGen conf@SnowcheckedConfig{..} nodeId = liftIO $ 	SnowcheckedGen <$> newMVar Flake-		{ flakeTime = startTimeBits-		, flakeCount = maxBound+		{ flakeTime = 0+		, flakeCount = 0 		, flakeNodeId = cutBits nodeId (toInt confNodeBits) 		, flakeConfig = conf 		}@@ -65,35 +66,45 @@ 		] 	where 		foldFunc :: Word8 -> Word32 -> Word32-		foldFunc nxt memo = memo + toWord32 nxt+		foldFunc nxt = (+ toWord32 nxt) {-# INLINEABLE snowcheckedConfigBitCount #-}  -- | Generates the next id.-nextFlake :: (HasCallStack, MonadIO io) => SnowcheckedGen -> io Flake+nextFlake :: (MonadIO io) => SnowcheckedGen -> io Flake nextFlake SnowcheckedGen{..} = liftIO $ modifyMVar genLastFlake mkNextFlake 	where-		-- TODO: Special case when confTimeBits is 0. 		-- TODO: Track the number of flakes generated and error out if we've exhausted them. 		mkNextFlake flake@Flake{..} = 			let SnowcheckedConfig{..} = flakeConfig in 			currentTimestampBits confTimeBits >>= \currentTimeBits -> 				if flakeTime < currentTimeBits then+					let newFlake = flake { +						flakeTime = currentTimeBits, +						flakeCount = 0 +					} in return (newFlake, newFlake)+				else if confTimeBits == 0 then 					let newFlake = flake-						{ flakeTime = currentTimeBits-						, flakeCount = 0+						{ flakeTime = 0+						, flakeCount = flakeCount + 1 						} 					in return (newFlake, newFlake) 				else if confCountBits == 0 then-					threadDelay 1000 >> mkNextFlake flake+					let newFlake = flake+						{ flakeTime = flakeTime + 1+						, flakeCount = 0+						}+					in return (newFlake, newFlake) 				else 					let nextCount = cutBits (flakeCount + 1) (toInt confCountBits) in-					if flakeCount < nextCount then-						let newFlake = flake { flakeCount = nextCount }+					if nextCount == 0 then+						let newFlake = flake+							{ flakeTime = flakeTime + 1+							, flakeCount = 0+							} 						in return (newFlake, newFlake) 					else-						-- The count wrapped and we need to wait for the time to change.-						-- This assumes that the next millisecond will give us a new time.-						threadDelay 1000 >> mkNextFlake flake+						let newFlake = flake { flakeCount = nextCount }+						in return (newFlake, newFlake) {-# INLINEABLE nextFlake #-} {-# SPECIALIZE nextFlake :: SnowcheckedGen -> IO Flake #-} 

@@ -13,9 +13,7 @@ 	) where  import           Data.ByteString-import           Data.ByteString.Lazy                      (fromStrict,-                                                            toStrict)-import           Data.Snowchecked.Encoding.ByteString.Lazy+import           Data.Snowchecked.Encoding.ByteString.Lazy () import           Data.Snowchecked.Encoding.Class  instance IsFlake ByteString where

@@ -20,8 +20,7 @@ integerToBS = pack . mkBytes 	where 		mkBytes 0 = mempty-		mkBytes n-			= fromIntegral n+		mkBytes n = fromIntegral n 			: mkBytes (n `shiftR` 8) {-# INLINE integerToBS #-} @@ -29,7 +28,7 @@ bsToInteger = foldr mkInteger 0 	where 		mkInteger :: Word8 -> Integer -> Integer-		mkInteger nxt memo = memo `shiftL` 8 .|. toInteger nxt+		mkInteger nxt memo = (memo `shiftL` 8) .|. toInteger nxt {-# INLINE bsToInteger #-}  instance IsFlake ByteString where

@@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeApplications     #-} {-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NamedFieldPuns       #-} {-# OPTIONS_GHC -Wno-orphans      #-} {-|  This module provides a generalized conversion function between a@@ -19,97 +21,64 @@ -}  module Data.Snowchecked.Encoding.Text-	( module Data.Snowchecked.Encoding.Class-	, module Data.Text.Conversions-	) where+  ( module Data.Snowchecked.Encoding.Class+  , module Data.Text.Conversions+  ) where -import           Control.Applicative                       ((<|>))-import qualified Data.ByteString.Lazy                      as LBS import qualified Data.List                                 as L-import           Data.Maybe                                (catMaybes)-import           Data.Snowchecked.Encoding.ByteString.Lazy ()+import           Data.Maybe                                (fromMaybe)+import           Data.Snowchecked.Encoding.Integral import           Data.Snowchecked.Encoding.Class import           Data.Snowchecked.Internal.Import import qualified Data.Text                                 as T import           Data.Text.Conversions-import           Text.Read                                 (readMaybe)---- | Convert a hex value to a character.------   WARNING: This function returns the null character ('\0') if you pass in a value > 15.-c :: Word8 -> Char-c 0  = '0'-c 1  = '1'-c 2  = '2'-c 3  = '3'-c 4  = '4'-c 5  = '5'-c 6  = '6'-c 7  = '7'-c 8  = '8'-c 9  = '9'-c 10 = 'a'-c 11 = 'b'-c 12 = 'c'-c 13 = 'd'-c 14 = 'e'-c 15 = 'f'-c _  = '\0'-{-# INLINE c #-}---- | Converts a character to a hex value (if there is one).-b :: Char -> Maybe Word8-b ch = readMaybe [ch] <|> chLookup-	where-		chLookup = case ch of-			'A' -> Just 10-			'a' -> Just 10-			'B' -> Just 11-			'b' -> Just 11-			'C' -> Just 12-			'c' -> Just 12-			'D' -> Just 13-			'd' -> Just 13-			'E' -> Just 14-			'e' -> Just 14-			'F' -> Just 15-			'f' -> Just 15-			_   -> Nothing-{-# INLINE b #-}---- | Converts a byte to two hex characters: low nibble and then high nibble.-byteToHex :: Word8 -> (Char,Char)-byteToHex w8 = (c lowNibble, c highNibble)-	where-		lowNibble = cutBits w8 4-		highNibble = shiftCutBits w8 4 4-{-# INLINE byteToHex #-}+import Data.Snowchecked (snowcheckedConfigBitCount)+import Data.Ratio ((%))+import Data.Char (isHexDigit)  instance {-# INCOHERENT #-} (ToText a, FromText a) => IsFlake (Base16 a) where-	fromFlake flake = Base16 $ convertText str-		where-			str = LBS.foldr bytesToChars [] $ fromFlake flake-			bytesToChars w8 rest =-				let (lowC, highC) = byteToHex w8 in lowC : highC : rest-	{-# INLINEABLE fromFlake #-}-	{-# SPECIALIZE fromFlake :: Flake -> Base16 String #-}-	{-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-}+  fromFlake flake@Flake{flakeConfig} = Base16 $ convertText str+    where+      hexLength = ceiling $+        snowcheckedConfigBitCount flakeConfig % 4+      pad0 str' = +        if L.length str' < hexLength then+          pad0 ('0':str')+        else+          str'+      str = pad0 $ showHex (fromFlake @Integer flake) ""+  {-# INLINEABLE fromFlake #-}+  {-# SPECIALIZE fromFlake :: Flake -> Base16 String #-}+  {-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-} -	parseFish SnowcheckedConfig{..} (Base16 raw) = return $ Flakeish-			{ 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-			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 #-}+  parseFish SnowcheckedConfig{..} (Base16 raw) = +    calculateN >>= \n ->+      return $ Flakeish+        { 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+      str = convertText @_ @String raw+      cleaned = +        L.dropWhile ('0' ==) .+        L.filter isHexDigit $+        fromMaybe str (L.stripPrefix "0x" str)+      calculateN = fst <$> findBestResult (readHex @Integer cleaned)+      findBestResult [] = fail "Could not find any results"+      findBestResult (this@(_,""):_) = return this+      findBestResult [onlyResult] = return onlyResult+      findBestResult (this@(_,nRest):others) =+        findBestResult others >>= \other@(_, mRest) ->+          if L.length nRest < L.length mRest then+            return this+          else+            return other+      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,16 @@ import           Data.WideWord.Word256 import           Data.Word import           Numeric-import GHC.Stack (HasCallStack) -cutBits :: (HasCallStack, Num a, Bits a) => a -> Int -> a+cutBits :: (Num a, Bits a) => a -> Int -> a cutBits n bits = n .&. ((1 `shiftL` bits) - 1) {-# INLINE cutBits #-} -cutShiftBits :: (HasCallStack, Num a, Bits a) => a -> Int -> Int -> a+cutShiftBits :: (Num a, Bits a) => a -> Int -> Int -> a cutShiftBits n cutBitCount shiftBitCount = cutBits n cutBitCount `shiftL` shiftBitCount {-# INLINE cutShiftBits #-} -shiftCutBits :: (HasCallStack, Num a, Bits a) => a -> Int -> Int -> a+shiftCutBits :: (Num a, Bits a) => a -> Int -> Int -> a shiftCutBits n shiftBitCount = cutBits $ n `shiftR` shiftBitCount {-# INLINE shiftCutBits #-} @@ -39,3 +38,4 @@ toWord32 :: (Integral a) => a -> Word32 toWord32 = fromIntegral @_ @Word32 {-# INLINE toWord32 #-}+

@@ -1,7 +1,11 @@ {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}  module Gens (module Gens) where +import           Data.Snowchecked.Encoding.Text+import           Data.Snowchecked.Encoding.Integral+import           Data.Text                      (Text) import           Control.Monad          (unless, void) import           Control.Monad.IO.Class (MonadIO) import           Data.List              (nub)@@ -13,6 +17,19 @@ import           Hedgehog.Main          (defaultMain) import qualified Hedgehog.Range         as Range +genBytes :: (MonadGen m) => m [Word8]+genBytes = strip0 <$>+    Gen.list +      (Range.linear 1 (fromIntegral $ maxBound @Word8))+      genWord8+  where+    strip0 lst = +      case lst of+        [] -> [0]+        [0] -> [0]+        (0:rest) -> strip0 rest+        _ -> lst+ genWord8 :: (MonadGen m) => m Word8 genWord8 = Gen.word8 $ Range.linear (minBound @Word8) (maxBound @Word8) @@ -21,10 +38,10 @@  genConfig :: (MonadGen m) => m SnowcheckedConfig genConfig = SnowcheckedConfig-		<$> Gen.integral (Range.linear 2 (maxBound @Word8))-		<*> Gen.integral (Range.linear 2 (maxBound @Word8))-		<*> Gen.integral (Range.linear 2 (maxBound @Word8))-		<*> Gen.integral (Range.linear 2 (maxBound @Word8))+		<$> Gen.integral (Range.linear 4 (maxBound @Word8))+		<*> Gen.integral (Range.linear 0 (maxBound @Word8))+		<*> Gen.integral (Range.linear 0 (maxBound @Word8))+		<*> Gen.integral (Range.linear 0 (maxBound @Word8))  forAllFlake :: (MonadIO m) => PropertyT m Flake forAllFlake = forAll genConfig >>= forAllFlake'@@ -33,3 +50,15 @@ forAllFlake' cfg = do 	nodeId <- forAll genWord256 	newSnowcheckedGen cfg nodeId >>= nextFlake++annotateFlakeString :: (MonadTest m) => Flake -> m ()+annotateFlakeString = annotateShow . fromFlake @(Base16 String)++annotateFlakeText :: (MonadTest m) => Flake -> m ()+annotateFlakeText = annotateShow . fromFlake @(Base16 Text)++annotateFlakeInteger :: (MonadTest m) => Flake -> m ()+annotateFlakeInteger = annotateShow . fromFlake @Integer++instance MonadFail (Either String) where+  fail = Left

@@ -13,8 +13,9 @@  prop_flakeToIntegerToFlake :: Property prop_flakeToIntegerToFlake = property $ do-		cfg <- forAll genConfig-		flake <- forAllFlake' cfg-		let value = fromFlake @Integer flake-		let result = parseFlake cfg value -		result === Just flake+    cfg <- forAll genConfig+    flake <- forAllFlake' cfg+    let value = fromFlake @Integer flake+    annotateShow value+    let result = parseFlake cfg value +    result === Just flake

@@ -1,11 +1,13 @@ {-# LANGUAGE RecordWildCards  #-} {-# LANGUAGE TemplateHaskell  #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-}  import           Control.Monad          (unless, void) import           Control.Monad.IO.Class (MonadIO) import           Data.List              (nub) import           Data.Snowchecked+import           Data.Snowchecked.Encoding.Integral import           Data.WideWord.Word256 import           Data.Word import           Gens@@ -21,53 +23,61 @@ import qualified Word64  main :: IO ()-main = do-		recheck (Size 4) (Seed 14462958355020818941 14776761114051845121) prop_generatesUniqueValues-		recheck (Size 8) (Seed 11763301661976410488 14055395789257366631) prop_generatesUniqueValues-		recheck (Size 14) (Seed 6771904241892528611 8532317410904456029) prop_generatesUniqueValues-		recheck (Size 14) (Seed 4790609826115340731 8375105224114527375) prop_generatesUniqueValues-		defaultMain-			[ checkParallel $$(discover)-			, Integer.tests-			, Word32.tests-			, Word64.tests-			, Text.tests-			, String.tests-			]+main =+  defaultMain+    [ checkParallel $$(discover)+    , Integer.tests+    , Word32.tests+    , Word64.tests+    , Text.tests+    , String.tests+    ] +prop_confGenerationWorks :: Property+prop_confGenerationWorks = property $+  void (forAll genConfig)++uniqueGenerationProperty :: (SnowcheckedConfig -> SnowcheckedConfig) -> Property+uniqueGenerationProperty nudge = +  property $ do+    cfg <- nudge <$> forAll genConfig+    flakeGen <- forAll genWord256 >>= newSnowcheckedGen cfg+    let flakeCount = min 4096 (fromIntegral $ uniqueFlakeCount cfg)+    lst <- forAll $ Gen.list (Range.linear 2 flakeCount) (pure ())+    resultLst <- mapM (const $ nextFlake flakeGen) lst+    resultLst === nub resultLst+ prop_generatesUniqueValues :: Property-prop_generatesUniqueValues = property $ do-	lst <- forAll $ Gen.list (Range.linear 2 8192) (return ())-	cfg <- forAll genConfig-	unless ( uniqueFlakeCount cfg > toInteger (length lst) ) discard-	nodeId <- forAll genWord256-	flakeGen <- newSnowcheckedGen cfg nodeId-	resultLst <- mapM (\_ -> nextFlake flakeGen) lst-	resultLst === nub resultLst+prop_generatesUniqueValues = uniqueGenerationProperty id  prop_flakeCanBeNFed :: Property-prop_flakeCanBeNFed = property $ do-	flake <- forAllFlake-	void $ evalNF flake+prop_flakeCanBeNFed = property $+  forAllFlake >>= void . evalNF  prop_generatesUniqueValuesWithZeroCheckBits :: Property-prop_generatesUniqueValuesWithZeroCheckBits = property $ do-	lst <- forAll $ Gen.list (Range.linear 2 1024) (return ())-	cfgBase <- forAll genConfig-	let cfg = cfgBase { confCheckBits = 0 }-	unless ( uniqueFlakeCount cfg > toInteger (length lst) ) discard-	nodeId <- forAll genWord256-	flakeGen <- newSnowcheckedGen cfg nodeId-	resultLst <- mapM (\_ -> nextFlake flakeGen) lst-	resultLst === nub resultLst+prop_generatesUniqueValuesWithZeroCheckBits =+  uniqueGenerationProperty (\cfg -> cfg { confCheckBits = 0 })  prop_generatesUniqueValuesWithZeroNodeIdBits :: Property-prop_generatesUniqueValuesWithZeroNodeIdBits = property $ do-	lst <- forAll $ Gen.list (Range.linear 2 1024) (return ())-	cfgBase <- forAll genConfig-	let cfg = cfgBase { confNodeBits = 0 }-	unless ( uniqueFlakeCount cfg > toInteger (length lst) ) discard-	nodeId <- forAll genWord256-	flakeGen <- newSnowcheckedGen cfg nodeId-	resultLst <- mapM (\_ -> nextFlake flakeGen) lst-	resultLst === nub resultLst+prop_generatesUniqueValuesWithZeroNodeIdBits = +  uniqueGenerationProperty (\cfg -> cfg { confNodeBits = 0 })++prop_generatesUniqueValuesWithZeroCountBits :: Property+prop_generatesUniqueValuesWithZeroCountBits = +  uniqueGenerationProperty (\cfg -> cfg { confCountBits = 0 })++prop_monotonicallyIncreasing :: Property+prop_monotonicallyIncreasing = property $ do+    cfg <- forAll genConfig+    let flakeCount = min 1024 (fromIntegral $ uniqueFlakeCount cfg)+    lst <- forAll $ Gen.list (Range.linear 2 flakeCount) (return ())+    nodeId <- forAll genWord256+    flakeGen <- newSnowcheckedGen cfg nodeId+    resultLst <- mapM (\_ -> nextFlake flakeGen) lst+    checkResults resultLst+  where+    checkResults [] = success+    checkResults [_] = success+    checkResults (a:b:rest) = do+      diff a (<) b+      checkResults (b:rest)

@@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell     #-} {-# LANGUAGE TypeApplications    #-} -module String (tests) where+module String (module String) where  import           Data.Snowchecked import           Data.Snowchecked.Encoding.Text@@ -14,8 +14,10 @@  prop_flakeToStringToFlake :: Property prop_flakeToStringToFlake = property $ do-		cfg <- forAll genConfig-		flake <- forAllFlake' cfg-		let (value::Base16 String) = fromFlake flake-		let result = parseFlake cfg value-		result === Just flake+    cfg <- forAll genConfig+    flake <- forAllFlake' cfg+    annotateFlakeInteger flake+    let value = fromFlake @(Base16 String) flake+    annotateShow value+    let (result::Either String Flake) = parseFlake cfg value+    result === Right flake

@@ -2,21 +2,38 @@ {-# LANGUAGE TemplateHaskell     #-} {-# LANGUAGE TypeApplications    #-} -module Text (tests) where+module Text (module Text) where +import           Control.Monad.IO.Class (MonadIO) import           Data.Snowchecked import           Data.Snowchecked.Encoding.Text import           Data.Text                      (Text) import           Gens import           Hedgehog+import Data.Bits (shiftR)+import Data.Ratio ( (%) )+import qualified Data.Text as T+import qualified Hedgehog.Gen           as Gen  tests :: IO Bool tests = checkParallel $$(discover)  prop_flakeToStrictTextToFlake :: Property prop_flakeToStrictTextToFlake = property $ do-		cfg <- forAll genConfig-		flake <- forAllFlake' cfg-		let (value::Base16 Text) = fromFlake flake-		let result = parseFlake cfg value-		result === Just flake+    cfg <- forAll genConfig+    flake <- forAllFlake' cfg+    annotateFlakeInteger flake+    let value = fromFlake @(Base16 Text) flake+    annotateShow value+    let result = parseFlake cfg value+    result === Just flake++prop_flakeToStrictTextHasRightLength :: Property+prop_flakeToStrictTextHasRightLength = property $ do+    cfg <- forAll genConfig+    flake <- forAllFlake' cfg+    annotateFlakeInteger flake+    let Base16 value = fromFlake @(Base16 Text) flake+    T.length value === hexDigitCount (snowcheckedConfigBitCount cfg)+  where+    hexDigitCount = ceiling . ( % 4 )