Created
October 26, 2016 15:18
-
-
Save hikari-no-yume/7b54913242d79abc65c41977a6eef3a7 to your computer and use it in GitHub Desktop.
CUADs are an alternative to UUIDs I created for a project which didn't get finished
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- UUIDs are terrible, and I couldn't get the `uuid` package to work on Haste | |
-- So here's something similar that I like more | |
-- CUAD: Cute, Unique And iDentifying | |
-- (new backronym thanks to those lovely three Irenes) | |
-- A quad (see what I did there?) of four 32-bit words | |
-- Canon text representation is 4 hex words separated by dashes | |
-- e.g. 01234567-89abcdef-deadbeef-abad1dea | |
-- Like UUIDv4, these should be random (probabilistically unique) | |
-- Unlike UUIDv4, these have 2^6x as much randomness (128 bits, not 122) | |
module CUAD | |
( CUAD, | |
toString, | |
fromString | |
) where | |
import Data.Char (isHexDigit, digitToInt, intToDigit, isSpace) | |
import Data.List (unfoldr) | |
import Data.Word (Word32) | |
data CUAD = CUAD Word32 Word32 Word32 Word32 | |
deriving (Ord, Eq) | |
chunksOf :: Int -> [a] -> [[a]] | |
chunksOf _ [] = [] | |
chunksOf n xs = fxs : chunksOf n sxs | |
where (fxs, sxs) = splitAt n xs | |
-- The string length of a 32-bit hex word | |
wordLength :: Int | |
wordLength = 8 | |
-- The string length of a full CUAD | |
cuadLength :: Int | |
cuadLength = wordLength * 4 + 3 | |
fromString :: String -> Maybe CUAD | |
fromString str | |
| all isValidWord wordStrings = Just cuad | |
| otherwise = Nothing | |
where | |
wordStrings = chunksOf (wordLength + 1) ('-' : str) | |
w1:w2:w3:w4:[] = map (\('-':word) -> readWord word) wordStrings | |
cuad = CUAD w1 w2 w3 w4 | |
readWord :: String -> Word32 | |
readWord = foldl (\acc digit -> acc * 16 + (fromIntegral $ digitToInt digit)) 0 | |
showWord :: Word32 -> String | |
showWord num = reverse $ unfoldr f (num, 0) | |
where | |
f (num, digitCount) | |
| num > 0 || digitCount < wordLength = | |
let digit = intToDigit $ fromIntegral $ num `mod` 16 | |
num' = num `div` 16 | |
digitCount' = digitCount + 1 | |
in Just (digit, (num', digitCount')) | |
| otherwise = Nothing | |
isValidWord :: String -> Bool | |
isValidWord ('-':hex) = all isHexDigit hex && length hex == wordLength | |
isValidWord _ = False | |
toString :: CUAD -> String | |
toString (CUAD w1 w2 w3 w4) = showWord w1 ++ '-' : showWord w2 ++ '-' : showWord w3 ++ '-' : showWord w4 | |
instance Read CUAD where | |
readsPrec _ str = case maybeCuad of | |
Just cuad -> [(cuad, rem)] | |
Nothing -> [] | |
where | |
unpaddedStr = dropWhile isSpace str | |
(cuadStr, rem) = splitAt cuadLength unpaddedStr | |
maybeCuad = fromString cuadStr | |
instance Show CUAD where | |
show = toString |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment