{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module RON.UUID (
UUID (..),
UuidFields (..),
build,
buildX,
buildY,
split,
succValue,
zero,
pattern Zero,
getName,
liftName,
mkName,
mkScopedName,
decodeBase32,
encodeBase32,
) where
import RON.Prelude
import Data.Bits (shiftL, shiftR, (.|.))
import qualified Data.ByteString.Char8 as BSC
import Language.Haskell.TH.Syntax (Exp, Q, liftData)
import qualified Text.Show
import qualified RON.Base64 as Base64
import RON.Util.Word (pattern B00, pattern B0000, pattern B01,
pattern B10, pattern B11, Word2, Word4, Word60,
leastSignificant2, leastSignificant4,
leastSignificant60, safeCast)
data UUID = UUID
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
deriving (Typeable UUID
DataType
Constr
Typeable UUID
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UUID -> c UUID)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID)
-> (UUID -> Constr)
-> (UUID -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UUID))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UUID))
-> ((forall b. Data b => b -> b) -> UUID -> UUID)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r)
-> (forall u. (forall d. Data d => d -> u) -> UUID -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UUID -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID)
-> Data UUID
UUID -> DataType
UUID -> Constr
(forall b. Data b => b -> b) -> UUID -> UUID
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UUID -> c UUID
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UUID -> u
forall u. (forall d. Data d => d -> u) -> UUID -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UUID -> c UUID
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UUID)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UUID)
$cUUID :: Constr
$tUUID :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UUID -> m UUID
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID
gmapMp :: (forall d. Data d => d -> m d) -> UUID -> m UUID
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID
gmapM :: (forall d. Data d => d -> m d) -> UUID -> m UUID
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UUID -> m UUID
gmapQi :: Int -> (forall d. Data d => d -> u) -> UUID -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UUID -> u
gmapQ :: (forall d. Data d => d -> u) -> UUID -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UUID -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UUID -> r
gmapT :: (forall b. Data b => b -> b) -> UUID -> UUID
$cgmapT :: (forall b. Data b => b -> b) -> UUID -> UUID
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UUID)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UUID)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UUID)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UUID)
dataTypeOf :: UUID -> DataType
$cdataTypeOf :: UUID -> DataType
toConstr :: UUID -> Constr
$ctoConstr :: UUID -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UUID
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UUID -> c UUID
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UUID -> c UUID
$cp1Data :: Typeable UUID
Data, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, (forall x. UUID -> Rep UUID x)
-> (forall x. Rep UUID x -> UUID) -> Generic UUID
forall x. Rep UUID x -> UUID
forall x. UUID -> Rep UUID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UUID x -> UUID
$cfrom :: forall x. UUID -> Rep UUID x
Generic, Int -> UUID -> Int
UUID -> Int
(Int -> UUID -> Int) -> (UUID -> Int) -> Hashable UUID
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UUID -> Int
$chash :: UUID -> Int
hashWithSalt :: Int -> UUID -> Int
$chashWithSalt :: Int -> UUID -> Int
Hashable, Eq UUID
Eq UUID
-> (UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c< :: UUID -> UUID -> Bool
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
$cp1Ord :: Eq UUID
Ord)
instance Show UUID where
show :: UUID -> String
show UUID
this = ShowS
forall a s. (Show a, IsString s) => a -> s
show String
serialized
where
UUID Word64
x Word64
y = UUID
this
UuidFields{Word60
Word4
Word2
uuidOrigin :: UuidFields -> Word60
uuidVersion :: UuidFields -> Word2
uuidVariant :: UuidFields -> Word2
uuidValue :: UuidFields -> Word60
uuidVariety :: UuidFields -> Word4
uuidOrigin :: Word60
uuidVersion :: Word2
uuidVariant :: Word2
uuidValue :: Word60
uuidVariety :: Word4
..} = UUID -> UuidFields
split UUID
this
serialized :: String
serialized = case Word2
uuidVariant of
Word2
B00 -> String
unzipped
Word2
_ -> String
generic
unzipped :: String
unzipped = String
x' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
y'
variety :: String
variety = case Word4
uuidVariety of
Word4
B0000 -> String
""
Word4
_ -> Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word4 -> Word8
Base64.encodeLetter4 Word4
uuidVariety) Char -> ShowS
forall a. a -> [a] -> [a]
: String
"/"
x' :: String
x' = String
variety String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BSC.unpack (Word60 -> ByteString
Base64.encode60short Word60
uuidValue)
y' :: String
y' = case (Word2
uuidVersion, Word60
uuidOrigin) of
(Word2
B00, Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast -> Word64
0 :: Word64) -> String
""
(Word2, Word60)
_ -> Char
version Char -> ShowS
forall a. a -> [a] -> [a]
: ByteString -> String
BSC.unpack (Word60 -> ByteString
Base64.encode60short Word60
uuidOrigin)
generic :: String
generic = ByteString -> String
BSC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
Base64.encode64 Word64
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
Base64.encode64 Word64
y
version :: Char
version = case Word2
uuidVersion of
Word2
B00 -> Char
'$'
Word2
B01 -> Char
'%'
Word2
B10 -> Char
'+'
Word2
B11 -> Char
'-'
data UuidFields = UuidFields
{ UuidFields -> Word4
uuidVariety :: !Word4
, UuidFields -> Word60
uuidValue :: !Word60
, UuidFields -> Word2
uuidVariant :: !Word2
, UuidFields -> Word2
uuidVersion :: !Word2
, UuidFields -> Word60
uuidOrigin :: !Word60
}
deriving (UuidFields -> UuidFields -> Bool
(UuidFields -> UuidFields -> Bool)
-> (UuidFields -> UuidFields -> Bool) -> Eq UuidFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UuidFields -> UuidFields -> Bool
$c/= :: UuidFields -> UuidFields -> Bool
== :: UuidFields -> UuidFields -> Bool
$c== :: UuidFields -> UuidFields -> Bool
Eq, Int -> UuidFields -> ShowS
[UuidFields] -> ShowS
UuidFields -> String
(Int -> UuidFields -> ShowS)
-> (UuidFields -> String)
-> ([UuidFields] -> ShowS)
-> Show UuidFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UuidFields] -> ShowS
$cshowList :: [UuidFields] -> ShowS
show :: UuidFields -> String
$cshow :: UuidFields -> String
showsPrec :: Int -> UuidFields -> ShowS
$cshowsPrec :: Int -> UuidFields -> ShowS
Show)
split :: UUID -> UuidFields
split :: UUID -> UuidFields
split (UUID Word64
x Word64
y) = UuidFields :: Word4 -> Word60 -> Word2 -> Word2 -> Word60 -> UuidFields
UuidFields
{ uuidVariety :: Word4
uuidVariety = Word64 -> Word4
forall integral. Integral integral => integral -> Word4
leastSignificant4 (Word64 -> Word4) -> Word64 -> Word4
forall a b. (a -> b) -> a -> b
$ Word64
x Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
60
, uuidValue :: Word60
uuidValue = Word64 -> Word60
forall integral. Integral integral => integral -> Word60
leastSignificant60 Word64
x
, uuidVariant :: Word2
uuidVariant = Word64 -> Word2
forall integral. Integral integral => integral -> Word2
leastSignificant2 (Word64 -> Word2) -> Word64 -> Word2
forall a b. (a -> b) -> a -> b
$ Word64
y Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
62
, uuidVersion :: Word2
uuidVersion = Word64 -> Word2
forall integral. Integral integral => integral -> Word2
leastSignificant2 (Word64 -> Word2) -> Word64 -> Word2
forall a b. (a -> b) -> a -> b
$ Word64
y Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
60
, uuidOrigin :: Word60
uuidOrigin = Word64 -> Word60
forall integral. Integral integral => integral -> Word60
leastSignificant60 Word64
y
}
build :: UuidFields -> UUID
build :: UuidFields -> UUID
build UuidFields{Word60
Word4
Word2
uuidOrigin :: Word60
uuidVersion :: Word2
uuidVariant :: Word2
uuidValue :: Word60
uuidVariety :: Word4
uuidOrigin :: UuidFields -> Word60
uuidVersion :: UuidFields -> Word2
uuidVariant :: UuidFields -> Word2
uuidValue :: UuidFields -> Word60
uuidVariety :: UuidFields -> Word4
..} = Word64 -> Word64 -> UUID
UUID
(Word4 -> Word60 -> Word64
buildX Word4
uuidVariety Word60
uuidValue)
(Word2 -> Word2 -> Word60 -> Word64
buildY Word2
uuidVariant Word2
uuidVersion Word60
uuidOrigin)
buildX :: Word4 -> Word60 -> Word64
buildX :: Word4 -> Word60 -> Word64
buildX Word4
uuidVariety Word60
uuidValue =
(Word4 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word4
uuidVariety Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
60) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
uuidValue
buildY :: Word2 -> Word2 -> Word60 -> Word64
buildY :: Word2 -> Word2 -> Word60 -> Word64
buildY Word2
uuidVariant Word2
uuidVersion Word60
uuidOrigin
= (Word2 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word2
uuidVariant Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
62)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word2 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word2
uuidVersion Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
60)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
uuidOrigin
mkName
:: MonadFail m
=> ByteString
-> m UUID
mkName :: ByteString -> m UUID
mkName ByteString
nam = ByteString -> ByteString -> m UUID
forall (m :: * -> *).
MonadFail m =>
ByteString -> ByteString -> m UUID
mkScopedName ByteString
nam ByteString
""
liftName :: ByteString -> Q Exp
liftName :: ByteString -> Q Exp
liftName = ByteString -> Q UUID
forall (m :: * -> *). MonadFail m => ByteString -> m UUID
mkName (ByteString -> Q UUID) -> (UUID -> Q Exp) -> ByteString -> Q Exp
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> UUID -> Q Exp
forall a. Data a => a -> Q Exp
liftData
mkScopedName
:: MonadFail m
=> ByteString
-> ByteString
-> m UUID
mkScopedName :: ByteString -> ByteString -> m UUID
mkScopedName ByteString
scope ByteString
nam = do
Word60
scope' <- String -> ByteString -> Maybe Word60 -> m Word60
forall (m :: * -> *) a a.
(MonadFail m, Show a) =>
String -> a -> Maybe a -> m a
expectBase64x60 String
"UUID scope" ByteString
scope (Maybe Word60 -> m Word60) -> Maybe Word60 -> m Word60
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Word60
Base64.decode60 ByteString
scope
Word60
nam' <- String -> ByteString -> Maybe Word60 -> m Word60
forall (m :: * -> *) a a.
(MonadFail m, Show a) =>
String -> a -> Maybe a -> m a
expectBase64x60 String
"UUID name" ByteString
nam (Maybe Word60 -> m Word60) -> Maybe Word60 -> m Word60
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Word60
Base64.decode60 ByteString
nam
UUID -> m UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> m UUID) -> UUID -> m UUID
forall a b. (a -> b) -> a -> b
$ UuidFields -> UUID
build UuidFields :: Word4 -> Word60 -> Word2 -> Word2 -> Word60 -> UuidFields
UuidFields
{ uuidVariety :: Word4
uuidVariety = Word4
B0000
, uuidValue :: Word60
uuidValue = Word60
scope'
, uuidVariant :: Word2
uuidVariant = Word2
B00
, uuidVersion :: Word2
uuidVersion = Word2
B00
, uuidOrigin :: Word60
uuidOrigin = Word60
nam'
}
where
expectBase64x60 :: String -> a -> Maybe a -> m a
expectBase64x60 String
field a
input =
m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
(String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
field
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": expected a Base64-encoded 60-character string, got "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a s. (Show a, IsString s) => a -> s
show a
input)
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
getName
:: UUID
-> Maybe (ByteString, ByteString)
getName :: UUID -> Maybe (ByteString, ByteString)
getName UUID
uuid = case UUID -> UuidFields
split UUID
uuid of
UuidFields{uuidVariety :: UuidFields -> Word4
uuidVariety = Word4
B0000, uuidVariant :: UuidFields -> Word2
uuidVariant = Word2
B00, uuidVersion :: UuidFields -> Word2
uuidVersion = Word2
B00, Word60
uuidOrigin :: Word60
uuidValue :: Word60
uuidOrigin :: UuidFields -> Word60
uuidValue :: UuidFields -> Word60
..} ->
(ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
x, ByteString
y)
where
x :: ByteString
x = Word60 -> ByteString
Base64.encode60short Word60
uuidValue
y :: ByteString
y = case Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
uuidOrigin :: Word64 of
Word64
0 -> ByteString
""
Word64
_ -> Word60 -> ByteString
Base64.encode60short Word60
uuidOrigin
UuidFields
_ -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
zero :: UUID
zero :: UUID
zero = Word64 -> Word64 -> UUID
UUID Word64
0 Word64
0
pattern Zero :: UUID
pattern $bZero :: UUID
$mZero :: forall r. UUID -> (Void# -> r) -> (Void# -> r) -> r
Zero = UUID 0 0
succValue :: UUID -> UUID
succValue :: UUID -> UUID
succValue = UuidFields -> UUID
build (UuidFields -> UUID) -> (UUID -> UuidFields) -> UUID -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UuidFields -> UuidFields
go (UuidFields -> UuidFields)
-> (UUID -> UuidFields) -> UUID -> UuidFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> UuidFields
split where
go :: UuidFields -> UuidFields
go u :: UuidFields
u@UuidFields{Word60
uuidValue :: Word60
uuidValue :: UuidFields -> Word60
uuidValue} = UuidFields
u
{uuidValue :: Word60
uuidValue = if Word60
uuidValue Word60 -> Word60 -> Bool
forall a. Ord a => a -> a -> Bool
< Word60
forall a. Bounded a => a
maxBound then Word60 -> Word60
forall a. Enum a => a -> a
succ Word60
uuidValue else Word60
uuidValue}
encodeBase32 :: UUID -> FilePath
encodeBase32 :: UUID -> String
encodeBase32 (UUID Word64
x Word64
y) =
ByteString -> String
BSC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
Word64 -> ByteString
Base64.encode64base32short Word64
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
Base64.encode64base32short Word64
y
decodeBase32 :: FilePath -> Maybe UUID
decodeBase32 :: String -> Maybe UUID
decodeBase32 String
fp = do
let (String
x, String
dashy) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
fp
(String
"-", String
y) <- (String, String) -> Maybe (String, String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 String
dashy
Word64 -> Word64 -> UUID
UUID
(Word64 -> Word64 -> UUID)
-> Maybe Word64 -> Maybe (Word64 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Word64
Base64.decode64base32 (String -> ByteString
BSC.pack String
x)
Maybe (Word64 -> UUID) -> Maybe Word64 -> Maybe UUID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Word64
Base64.decode64base32 (String -> ByteString
BSC.pack String
y)