{-# 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,
    -- * Name
    getName,
    liftName,
    mkName,
    mkScopedName,
    -- * Base32 encoding, suitable for file names
    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)

-- | Universally unique identifier of anything
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)

-- | RON-Text-encoding
instance Show UUID where
    -- showsPrec a (UUID x y) =
    --     showParen (a >= 11) $
    --     showString "UUID 0x" . showHex x . showString " 0x" . showHex y
    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
'-'

-- | UUID split in parts
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 into parts
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 UUID from parts
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)

-- | Build former 64 bits of UUID from parts
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

-- | Build latter 64 bits of UUID from parts
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

-- | Make an unscoped (unqualified) name
mkName
    :: MonadFail m
    => ByteString  -- ^ name, max 10 Base64 letters
    -> 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
""

-- | Contruct a UUID name in compile-time
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
-- TODO(2019-01-11, cblp) typed splice

-- | Make a scoped (qualified) name
mkScopedName
    :: MonadFail m
    => ByteString  -- ^ scope, max 10 Base64 letters
    -> ByteString  -- ^ local name, max 10 Base64 letters
    -> 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

-- | Convert UUID to a name
getName
    :: UUID
    -> Maybe (ByteString, ByteString)
        -- ^ @(scope, name)@ for a scoped name; @(name, "")@ for a global name
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

-- | UUID with all zero fields
zero :: UUID
zero :: UUID
zero = Word64 -> Word64 -> UUID
UUID Word64
0 Word64
0

-- | UUID with all zero fields
pattern Zero :: UUID
pattern $bZero :: UUID
$mZero :: forall r. UUID -> (Void# -> r) -> (Void# -> r) -> r
Zero = UUID 0 0

-- | Increment field 'uuidValue' of a UUID
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}

-- | Encode a UUID to a Base32 string
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

-- | Decode a UUID from a Base32 string
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)