Skip to content

Instantly share code, notes, and snippets.

@hikari-no-yume
Created October 26, 2016 15:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save hikari-no-yume/7b54913242d79abc65c41977a6eef3a7 to your computer and use it in GitHub Desktop.
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
-- 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