{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnboxedTuples #-}

{-|
Module      : Data.Ulid
Description : Another ULID implementation with tight memory representation
Copyright   : (c) 2023 Keito Kajitani
License     : MIT
Maintainer  : Keito Kajitani <ijaketak@gmail.com>

This module exposes the data type `Ulid` and related functions.
The data type `Ulid` consumes only 128-bit.
-}
module Data.Ulid
  ( Ulid
  , nil
  , getUlid
  , randomUlidM
  , genUlid
  , showUlid
  , readUlid
  ) where

import Control.DeepSeq (NFData (..))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.Binary (Binary (get, put))
import Data.Binary.Get (getWord64be)
import Data.Binary.Put (putWord64be)
import Data.Bits (Bits (..), FiniteBits (..), shiftL)
import Data.Char (toUpper)
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Ix (Ix)
import Data.List (genericTake)
import Data.Maybe (fromJust)
import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
import Data.Word (Word64)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable (..))
import GHC.Base (Int (..))
import GHC.Enum (predError, succError)
import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#)
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)
import System.Random (Random(..), RandomGen(..), uniform)
import System.Random.Stateful (StatefulGen(..), Uniform(..))

data Ulid = Ulid {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
  deriving (Typeable Ulid
Ulid -> DataType
Ulid -> Constr
(forall b. Data b => b -> b) -> Ulid -> Ulid
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) -> Ulid -> u
forall u. (forall d. Data d => d -> u) -> Ulid -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ulid
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ulid -> c Ulid
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ulid)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ulid)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ulid -> m Ulid
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ulid -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ulid -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ulid -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ulid -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ulid -> r
gmapT :: (forall b. Data b => b -> b) -> Ulid -> Ulid
$cgmapT :: (forall b. Data b => b -> b) -> Ulid -> Ulid
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ulid)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ulid)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ulid)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ulid)
dataTypeOf :: Ulid -> DataType
$cdataTypeOf :: Ulid -> DataType
toConstr :: Ulid -> Constr
$ctoConstr :: Ulid -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ulid
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ulid
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ulid -> c Ulid
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ulid -> c Ulid
Data, Ulid -> Ulid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ulid -> Ulid -> Bool
$c/= :: Ulid -> Ulid -> Bool
== :: Ulid -> Ulid -> Bool
$c== :: Ulid -> Ulid -> Bool
Eq, Ord Ulid
(Ulid, Ulid) -> Int
(Ulid, Ulid) -> [Ulid]
(Ulid, Ulid) -> Ulid -> Bool
(Ulid, Ulid) -> Ulid -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Ulid, Ulid) -> Int
$cunsafeRangeSize :: (Ulid, Ulid) -> Int
rangeSize :: (Ulid, Ulid) -> Int
$crangeSize :: (Ulid, Ulid) -> Int
inRange :: (Ulid, Ulid) -> Ulid -> Bool
$cinRange :: (Ulid, Ulid) -> Ulid -> Bool
unsafeIndex :: (Ulid, Ulid) -> Ulid -> Int
$cunsafeIndex :: (Ulid, Ulid) -> Ulid -> Int
index :: (Ulid, Ulid) -> Ulid -> Int
$cindex :: (Ulid, Ulid) -> Ulid -> Int
range :: (Ulid, Ulid) -> [Ulid]
$crange :: (Ulid, Ulid) -> [Ulid]
Ix, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Ulid -> m Exp
forall (m :: * -> *). Quote m => Ulid -> Code m Ulid
liftTyped :: forall (m :: * -> *). Quote m => Ulid -> Code m Ulid
$cliftTyped :: forall (m :: * -> *). Quote m => Ulid -> Code m Ulid
lift :: forall (m :: * -> *). Quote m => Ulid -> m Exp
$clift :: forall (m :: * -> *). Quote m => Ulid -> m Exp
Lift, Eq Ulid
Ulid -> Ulid -> Bool
Ulid -> Ulid -> Ordering
Ulid -> Ulid -> Ulid
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 :: Ulid -> Ulid -> Ulid
$cmin :: Ulid -> Ulid -> Ulid
max :: Ulid -> Ulid -> Ulid
$cmax :: Ulid -> Ulid -> Ulid
>= :: Ulid -> Ulid -> Bool
$c>= :: Ulid -> Ulid -> Bool
> :: Ulid -> Ulid -> Bool
$c> :: Ulid -> Ulid -> Bool
<= :: Ulid -> Ulid -> Bool
$c<= :: Ulid -> Ulid -> Bool
< :: Ulid -> Ulid -> Bool
$c< :: Ulid -> Ulid -> Bool
compare :: Ulid -> Ulid -> Ordering
$ccompare :: Ulid -> Ulid -> Ordering
Ord, forall x. Rep Ulid x -> Ulid
forall x. Ulid -> Rep Ulid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ulid x -> Ulid
$cfrom :: forall x. Ulid -> Rep Ulid x
Generic)

instance Hashable Ulid where
  hashWithSalt :: Int -> Ulid -> Int
hashWithSalt Int
s (Ulid Word64
wh Word64
wl) = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
wh forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
wl

-- | big endian order
instance Binary Ulid where
  put :: Ulid -> Put
put (Ulid Word64
wh Word64
wl) = Word64 -> Put
putWord64be Word64
wh forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
wl
  get :: Get Ulid
get = Word64 -> Word64 -> Ulid
Ulid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64be

-- | @random = uniform@
instance Random Ulid where
  random :: forall g. RandomGen g => g -> (Ulid, g)
random = forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform
  randomR :: forall g. RandomGen g => (Ulid, Ulid) -> g -> (Ulid, g)
randomR (Ulid, Ulid)
_ = forall a g. (Random a, RandomGen g) => g -> (a, g)
random -- range is ignored

-- | generates 128-bit random entropy, may be irregular as ULID
instance Uniform Ulid where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Ulid
uniformM g
gen = do
    Word64
w0 <- forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
gen
    Word64
w1 <- forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
gen
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Ulid
Ulid Word64
w0 Word64
w1

-- | @nil = minBound@
nil :: Ulid
nil :: Ulid
nil = forall a. Bounded a => a
minBound

-- | Generates 'POSIXTime' and random entropy, then combines it into one 'Ulid'.
--
-- @
-- getUlid gen = do
--   t <- liftIO getPOSIXTime
--   randomUlidM t gen
-- @
getUlid :: (MonadIO m, StatefulGen g m) => g -> m Ulid
getUlid :: forall (m :: * -> *) g. (MonadIO m, StatefulGen g m) => g -> m Ulid
getUlid g
gen = do
  POSIXTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  forall g (m :: * -> *). StatefulGen g m => POSIXTime -> g -> m Ulid
randomUlidM POSIXTime
t g
gen

randomUlidM :: StatefulGen g m => POSIXTime -> g -> m Ulid
randomUlidM :: forall g (m :: * -> *). StatefulGen g m => POSIXTime -> g -> m Ulid
randomUlidM POSIXTime
p g
gen = do
  Word16
eh <- forall g (m :: * -> *). StatefulGen g m => g -> m Word16
uniformWord16 g
gen
  Word64
el <- forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
gen
  let t :: Word64
t = (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ POSIXTime
p forall a. Num a => a -> a -> a
* POSIXTime
1000) forall a. Bits a => a -> Int -> a
`shiftL` Int
16
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Ulid
Ulid (Word64
t forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
eh) Word64
el

genUlid :: RandomGen g => POSIXTime -> g -> (Ulid, g)
genUlid :: forall g. RandomGen g => POSIXTime -> g -> (Ulid, g)
genUlid POSIXTime
p g
gen =
  let t :: Word64
t = (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ POSIXTime
p forall a. Num a => a -> a -> a
* POSIXTime
1000) forall a. Bits a => a -> Int -> a
`shiftL` Int
16
      (Word16
eh, g
gen1) = forall g. RandomGen g => g -> (Word16, g)
genWord16 g
gen
      (Word64
el, g
gen2) = forall g. RandomGen g => g -> (Word64, g)
genWord64 g
gen1
   in (Word64 -> Word64 -> Ulid
Ulid (Word64
t forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
eh) Word64
el, g
gen2)

instance Show Ulid where
  showsPrec :: Int -> Ulid -> ShowS
showsPrec Int
_ = String -> ShowS
showString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ulid -> Text
showUlid

instance Read Ulid where
  readsPrec :: Int -> ReadS Ulid
readsPrec Int
_ = forall {a}. Maybe (a, Text) -> [(a, String)]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Ulid, Text)
readUlid' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
   where
    f :: Maybe (a, Text) -> [(a, String)]
f Maybe (a, Text)
mu = case Maybe (a, Text)
mu of
      Maybe (a, Text)
Nothing -> []
      Just (a
u, Text
t) -> [(a
u, Text -> String
T.unpack Text
t)]

-- | Uses upper case.
showUlid :: Ulid -> T.Text
showUlid :: Ulid -> Text
showUlid (Ulid Word64
hi Word64
lo) = Text
s3 forall a. Semigroup a => a -> a -> a
<> Text
s2 forall a. Semigroup a => a -> a -> a
<> Text
s1
 where
  n1 :: Word64
n1 = Word64
lo forall a. Bits a => a -> a -> a
.&. (forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
60)
  n2 :: Word64
n2 = ((Word64
hi forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. (Word64
lo forall a. Bits a => a -> Int -> a
`shiftR` Int
60)) forall a. Bits a => a -> a -> a
.&. (forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
60)
  n3 :: Word64
n3 = (Word64
hi forall a. Bits a => a -> Int -> a
`shiftR` Int
56) forall a. Bits a => a -> a -> a
.&. (forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
  s1 :: Text
s1 = forall i. Integral i => Int -> i -> Text
encode Int
12 Word64
n1
  s2 :: Text
s2 = forall i. Integral i => Int -> i -> Text
encode Int
12 Word64
n2
  s3 :: Text
s3 = forall i. Integral i => Int -> i -> Text
encode Int
2 Word64
n3

-- | case-insensitive
readUlid :: T.Text -> Maybe Ulid
readUlid :: Text -> Maybe Ulid
readUlid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Ulid, Text)
readUlid'

readUlid' :: T.Text -> Maybe (Ulid, T.Text)
readUlid' :: Text -> Maybe (Ulid, Text)
readUlid' Text
t = do
  (Word64
b1, Text
t1) <- forall i. Integral i => Int -> Text -> Maybe (i, Text)
decode Int
2 Text
t
  (Word64
b2, Text
t2) <- forall i. Integral i => Int -> Text -> Maybe (i, Text)
decode Int
12 Text
t1
  (Word64
b3, Text
t3) <- forall i. Integral i => Int -> Text -> Maybe (i, Text)
decode Int
12 Text
t2
  let nh1 :: Word64
nh1 = (Word64
b1 forall a. Bits a => a -> Int -> a
`shiftL` Int
56) forall a. Bits a => a -> a -> a
.&. ((forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
      nh2 :: Word64
nh2 = (Word64
b2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4) forall a. Bits a => a -> a -> a
.&. (forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
      nl1 :: Word64
nl1 = (Word64
b2 forall a. Bits a => a -> Int -> a
`shiftL` Int
60) forall a. Bits a => a -> a -> a
.&. ((forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> Int -> a
`shiftL` Int
60)
      nl2 :: Word64
nl2 = Word64
b3 forall a. Bits a => a -> a -> a
.&. (forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ Word64
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
60)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Ulid
Ulid (Word64
nh1 forall a. Bits a => a -> a -> a
.|. Word64
nh2) (Word64
nl1 forall a. Bits a => a -> a -> a
.|. Word64
nl2), Text
t3)


-- Following code are stolen from ulid-0.3.2.0.

-- | >>> decode 5 "0003V"
-- [(123,"")]
decode
  :: Integral i
  => Int  -- ^ Overall length of input Text
  -> T.Text  -- ^ Base 32 encoded Text
  -> Maybe (i, T.Text)  -- ^ Possible parses
decode :: forall i. Integral i => Int -> Text -> Maybe (i, Text)
decode Int
width Text
str  | Text -> Int
T.length Text
str forall a. Ord a => a -> a -> Bool
>= Int
width   = let
                      (Text
crock, Text
remainder) = Int -> Text -> (Text, Text)
T.splitAt Int
width Text
str
                    in case forall i. Integral i => Text -> Maybe i
decodePlain Text
crock of
                        Maybe i
Nothing -> forall a. Maybe a
Nothing
                        Just i
c  -> forall a. a -> Maybe a
Just (i
c, Text
remainder)
                  | Bool
otherwise             = forall a. Maybe a
Nothing

-- | >>> encode 5 (-123)
-- "0003V"
--
-- | >>> encode (-5) (-123)
-- ""
encode
  :: Integral i
  => Int  -- ^ Overall length of resulting Text
  -> i  -- ^ Natural number to encode
  -> T.Text  -- ^ 0 padded, Douglas Crockford's base 32 encoded Text
encode :: forall i. Integral i => Int -> i -> Text
encode Int
width =
  Int -> Text -> Text
leftpad (forall i. Integral i => i -> i
clampZero Int
width) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> Text
encodePlain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> i
clampZero

-- | Decodes a Crockford base 32 encoded `Text` into an natural number,
-- if possible. Returns `Nothing` if the `Text` is not a valid encoded value.
decodePlain :: Integral i => T.Text -> Maybe i
decodePlain :: forall i. Integral i => Text -> Maybe i
decodePlain Text
base32text = do
  [i]
numbers <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall i. Integral i => Char -> Maybe i
decodeChar forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
base32text
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall n. Integral n => n -> [n] -> n
unDigits i
32 [i]
numbers

-- Encodes an natural number into a Text,
-- using Douglas Crockford's base 32 encoding.
-- Returns `Nothing` if number is negative.
encodePlain :: Integral i => i -> T.Text
encodePlain :: forall i. Integral i => i -> Text
encodePlain =
  String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i. Integral i => i -> Char
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => n -> n -> [n]
digits i
32

-- Source: https://stackoverflow.com/a/29153602
-- The safety for m > length was removed, because that should never happen.
-- If it does, it should crash.
leftpad :: Int -> T.Text -> T.Text
leftpad :: Int -> Text -> Text
leftpad Int
m Text
xs =
  Int -> Text -> Text
T.replicate (Int
m forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
xs) Text
"0" forall a. Semigroup a => a -> a -> a
<> Text
xs

-- Converts all negative numbers to 0
clampZero :: Integral i => i -> i
clampZero :: forall i. Integral i => i -> i
clampZero i
x =
  if i
x forall a. Ord a => a -> a -> Bool
< i
0
  then i
0
  else i
x

-- | Decode a character to its corresponding integer
decodeChar :: Integral i => Char -> Maybe i
decodeChar :: forall i. Integral i => Char -> Maybe i
decodeChar Char
c = case Char -> Char
toUpper Char
c of
    Char
'0' -> forall a. a -> Maybe a
Just i
0
    Char
'O' -> forall a. a -> Maybe a
Just i
0
    Char
'1' -> forall a. a -> Maybe a
Just i
1
    Char
'I' -> forall a. a -> Maybe a
Just i
1
    Char
'L' -> forall a. a -> Maybe a
Just i
1
    Char
'2' -> forall a. a -> Maybe a
Just i
2
    Char
'3' -> forall a. a -> Maybe a
Just i
3
    Char
'4' -> forall a. a -> Maybe a
Just i
4
    Char
'5' -> forall a. a -> Maybe a
Just i
5
    Char
'6' -> forall a. a -> Maybe a
Just i
6
    Char
'7' -> forall a. a -> Maybe a
Just i
7
    Char
'8' -> forall a. a -> Maybe a
Just i
8
    Char
'9' -> forall a. a -> Maybe a
Just i
9
    Char
'A' -> forall a. a -> Maybe a
Just i
10
    Char
'B' -> forall a. a -> Maybe a
Just i
11
    Char
'C' -> forall a. a -> Maybe a
Just i
12
    Char
'D' -> forall a. a -> Maybe a
Just i
13
    Char
'E' -> forall a. a -> Maybe a
Just i
14
    Char
'F' -> forall a. a -> Maybe a
Just i
15
    Char
'G' -> forall a. a -> Maybe a
Just i
16
    Char
'H' -> forall a. a -> Maybe a
Just i
17
    Char
'J' -> forall a. a -> Maybe a
Just i
18
    Char
'K' -> forall a. a -> Maybe a
Just i
19
    Char
'M' -> forall a. a -> Maybe a
Just i
20
    Char
'N' -> forall a. a -> Maybe a
Just i
21
    Char
'P' -> forall a. a -> Maybe a
Just i
22
    Char
'Q' -> forall a. a -> Maybe a
Just i
23
    Char
'R' -> forall a. a -> Maybe a
Just i
24
    Char
'S' -> forall a. a -> Maybe a
Just i
25
    Char
'T' -> forall a. a -> Maybe a
Just i
26
    Char
'V' -> forall a. a -> Maybe a
Just i
27
    Char
'W' -> forall a. a -> Maybe a
Just i
28
    Char
'X' -> forall a. a -> Maybe a
Just i
29
    Char
'Y' -> forall a. a -> Maybe a
Just i
30
    Char
'Z' -> forall a. a -> Maybe a
Just i
31
    Char
_ -> forall a. Maybe a
Nothing

-- Encode an integer to its corresponding character
encodeChar :: Integral i => i -> Char
encodeChar :: forall i. Integral i => i -> Char
encodeChar i
i = case i
i of
  i
0  -> Char
'0'
  i
1  -> Char
'1'
  i
2  -> Char
'2'
  i
3  -> Char
'3'
  i
4  -> Char
'4'
  i
5  -> Char
'5'
  i
6  -> Char
'6'
  i
7  -> Char
'7'
  i
8  -> Char
'8'
  i
9  -> Char
'9'
  i
10 -> Char
'A'
  i
11 -> Char
'B'
  i
12 -> Char
'C'
  i
13 -> Char
'D'
  i
14 -> Char
'E'
  i
15 -> Char
'F'
  i
16 -> Char
'G'
  i
17 -> Char
'H'
  i
18 -> Char
'J'
  i
19 -> Char
'K'
  i
20 -> Char
'M'
  i
21 -> Char
'N'
  i
22 -> Char
'P'
  i
23 -> Char
'Q'
  i
24 -> Char
'R'
  i
25 -> Char
'S'
  i
26 -> Char
'T'
  i
27 -> Char
'V'
  i
28 -> Char
'W'
  i
29 -> Char
'X'
  i
30 -> Char
'Y'
  i
31 -> Char
'Z'
  i
_  -> Char
'0'

-- Returns the digits of a positive integer as a Maybe list, in reverse order
-- or Nothing if a zero or negative base is given
-- This is slightly more efficient than in forward order.
mDigitsRev :: Integral n
           => n         -- The base to use.
           -> n         -- The number to convert to digit form.
           -> Maybe [n] -- Nothing or Just the digits of the number
                        -- in list form, in reverse.
mDigitsRev :: forall n. Integral n => n -> n -> Maybe [n]
mDigitsRev n
base n
i = if n
base forall a. Ord a => a -> a -> Bool
< n
1
  then forall a. Maybe a
Nothing -- We do not support zero or negative bases
  else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Integral n => n -> n -> [n]
dr n
base n
i
 where
  dr :: t -> t -> [t]
dr t
_ t
0 = []
  dr t
b t
x = case n
base of
    n
1 -> forall i a. Integral i => i -> [a] -> [a]
genericTake t
x forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat t
1
    n
_ -> let (t
rest, t
lastDigit) = forall a. Integral a => a -> a -> (a, a)
quotRem t
x t
b
          in t
lastDigit forall a. a -> [a] -> [a]
: t -> t -> [t]
dr t
b t
rest

-- Returns the digits of a positive integer as a list, in reverse order.
-- Throws an error if given a zero or negative base.
digitsRev :: Integral n
          => n   -- The base to use.
          -> n   -- The number to convert to digit from.
          -> [n] -- The digits of the number in list from, in reverse.
digitsRev :: forall n. Integral n => n -> n -> [n]
digitsRev n
base = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => n -> n -> Maybe [n]
mDigitsRev n
base

-- Returns the digits of a positive integer as a list.
-- Throws an error if given a zero or negative base.
digits :: Integral n
       => n   -- The base to use (typically 10).
       -> n   -- The number to convert to digit form.
       -> [n] -- Either Nothing or the digits of the number in list form.
digits :: forall n. Integral n => n -> n -> [n]
digits n
base = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => n -> n -> [n]
digitsRev n
base

-- Takes a list of digits, and converts them back into a positive integer.
unDigits :: Integral n
         => n   -- The base to use.
         -> [n] -- The digits of the number in list form.
         -> n   -- The original number.
unDigits :: forall n. Integral n => n -> [n] -> n
unDigits n
base = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ n
a n
b -> n
a forall a. Num a => a -> a -> a
* n
base forall a. Num a => a -> a -> a
+ n
b) n
0


-- Following code are stolen from wide-word-0.1.5.0

instance Bounded Ulid where
  minBound :: Ulid
minBound = Ulid
zeroWord128
  maxBound :: Ulid
maxBound = Word64 -> Word64 -> Ulid
Ulid forall a. Bounded a => a
maxBound forall a. Bounded a => a
maxBound

instance Enum Ulid where
  succ :: Ulid -> Ulid
succ = Ulid -> Ulid
succ128
  pred :: Ulid -> Ulid
pred = Ulid -> Ulid
pred128
  toEnum :: Int -> Ulid
toEnum = Int -> Ulid
toEnum128
  fromEnum :: Ulid -> Int
fromEnum = Ulid -> Int
fromEnum128

instance Bits Ulid where
  .&. :: Ulid -> Ulid -> Ulid
(.&.) = Ulid -> Ulid -> Ulid
and128
  .|. :: Ulid -> Ulid -> Ulid
(.|.) = Ulid -> Ulid -> Ulid
or128
  xor :: Ulid -> Ulid -> Ulid
xor = Ulid -> Ulid -> Ulid
xor128
  complement :: Ulid -> Ulid
complement = Ulid -> Ulid
complement128
  shiftL :: Ulid -> Int -> Ulid
shiftL = Ulid -> Int -> Ulid
shiftL128
  unsafeShiftL :: Ulid -> Int -> Ulid
unsafeShiftL = Ulid -> Int -> Ulid
shiftL128
  shiftR :: Ulid -> Int -> Ulid
shiftR = Ulid -> Int -> Ulid
shiftR128
  unsafeShiftR :: Ulid -> Int -> Ulid
unsafeShiftR = Ulid -> Int -> Ulid
shiftR128
  rotateL :: Ulid -> Int -> Ulid
rotateL = Ulid -> Int -> Ulid
rotateL128
  rotateR :: Ulid -> Int -> Ulid
rotateR = Ulid -> Int -> Ulid
rotateR128

  bitSize :: Ulid -> Int
bitSize Ulid
_ = Int
128
  bitSizeMaybe :: Ulid -> Maybe Int
bitSizeMaybe Ulid
_ = forall a. a -> Maybe a
Just Int
128
  isSigned :: Ulid -> Bool
isSigned Ulid
_ = Bool
False

  testBit :: Ulid -> Int -> Bool
testBit = Ulid -> Int -> Bool
testBit128
  bit :: Int -> Ulid
bit = Int -> Ulid
bit128

  popCount :: Ulid -> Int
popCount = Ulid -> Int
popCount128

instance FiniteBits Ulid where
  finiteBitSize :: Ulid -> Int
finiteBitSize Ulid
_ = Int
128
  countLeadingZeros :: Ulid -> Int
countLeadingZeros = Ulid -> Int
countLeadingZeros128
  countTrailingZeros :: Ulid -> Int
countTrailingZeros = Ulid -> Int
countTrailingZeros128

instance Storable Ulid where
  sizeOf :: Ulid -> Int
sizeOf Ulid
w = Int# -> Int
I# (Ulid -> Int#
sizeOf128# Ulid
w)
  alignment :: Ulid -> Int
alignment Ulid
w = Int# -> Int
I# (Ulid -> Int#
alignment128# Ulid
w)
  peek :: Ptr Ulid -> IO Ulid
peek = Ptr Ulid -> IO Ulid
peek128
  peekElemOff :: Ptr Ulid -> Int -> IO Ulid
peekElemOff = Ptr Ulid -> Int -> IO Ulid
peekElemOff128
  poke :: Ptr Ulid -> Ulid -> IO ()
poke = Ptr Ulid -> Ulid -> IO ()
poke128
  pokeElemOff :: Ptr Ulid -> Int -> Ulid -> IO ()
pokeElemOff = Ptr Ulid -> Int -> Ulid -> IO ()
pokeElemOff128

instance NFData Ulid where
  rnf :: Ulid -> ()
rnf = forall a b c. (a -> b -> c) -> b -> a -> c
flip seq :: forall a b. a -> b -> b
seq ()

instance Prim Ulid where
  sizeOf# :: Ulid -> Int#
sizeOf#         = Ulid -> Int#
sizeOf128#
  alignment# :: Ulid -> Int#
alignment#      = Ulid -> Int#
alignment128#
  indexByteArray# :: ByteArray# -> Int# -> Ulid
indexByteArray# = ByteArray# -> Int# -> Ulid
indexByteArray128#
  readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Ulid #)
readByteArray#  = forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Ulid #)
readByteArray128#
  writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Ulid -> State# s -> State# s
writeByteArray# = forall s.
MutableByteArray# s -> Int# -> Ulid -> State# s -> State# s
writeByteArray128#
  setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Ulid -> State# s -> State# s
setByteArray#   = forall s.
MutableByteArray# s -> Int# -> Int# -> Ulid -> State# s -> State# s
setByteArray128#
  indexOffAddr# :: Addr# -> Int# -> Ulid
indexOffAddr#   = Addr# -> Int# -> Ulid
indexOffAddr128#
  readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Ulid #)
readOffAddr#    = forall s. Addr# -> Int# -> State# s -> (# State# s, Ulid #)
readOffAddr128#
  writeOffAddr# :: forall s. Addr# -> Int# -> Ulid -> State# s -> State# s
writeOffAddr#   = forall s. Addr# -> Int# -> Ulid -> State# s -> State# s
writeOffAddr128#
  setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Ulid -> State# s -> State# s
setOffAddr#     = forall s. Addr# -> Int# -> Int# -> Ulid -> State# s -> State# s
setOffAddr128#
  {-# INLINE sizeOf# #-}
  {-# INLINE alignment# #-}
  {-# INLINE indexByteArray# #-}
  {-# INLINE readByteArray# #-}
  {-# INLINE writeByteArray# #-}
  {-# INLINE setByteArray# #-}
  {-# INLINE indexOffAddr# #-}
  {-# INLINE readOffAddr# #-}
  {-# INLINE writeOffAddr# #-}
  {-# INLINE setOffAddr# #-}

-- -----------------------------------------------------------------------------
-- Functions for `Enum` instance.

succ128 :: Ulid -> Ulid
succ128 :: Ulid -> Ulid
succ128 (Ulid Word64
a1 Word64
a0)
  | Word64
a0 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound = if Word64
a1 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound
                     then forall a. String -> a
succError String
"Ulid"
                     else Word64 -> Word64 -> Ulid
Ulid (forall a. Enum a => a -> a
succ Word64
a1) Word64
0
  | Bool
otherwise = Word64 -> Word64 -> Ulid
Ulid Word64
a1 (forall a. Enum a => a -> a
succ Word64
a0)


pred128 :: Ulid -> Ulid
pred128 :: Ulid -> Ulid
pred128 (Ulid Word64
a1 Word64
a0)
  | Word64
a0 forall a. Eq a => a -> a -> Bool
== Word64
0 = if Word64
a1 forall a. Eq a => a -> a -> Bool
== Word64
0
              then forall a. String -> a
predError String
"Ulid"
              else Word64 -> Word64 -> Ulid
Ulid (forall a. Enum a => a -> a
pred Word64
a1) forall a. Bounded a => a
maxBound
  | Bool
otherwise = Word64 -> Word64 -> Ulid
Ulid Word64
a1 (forall a. Enum a => a -> a
pred Word64
a0)


{-# INLINABLE toEnum128 #-}
toEnum128 :: Int -> Ulid
toEnum128 :: Int -> Ulid
toEnum128 Int
i = Word64 -> Word64 -> Ulid
Ulid Word64
0 (forall a. Enum a => Int -> a
toEnum Int
i)

{-# INLINABLE fromEnum128 #-}
fromEnum128 :: Ulid -> Int
fromEnum128 :: Ulid -> Int
fromEnum128 (Ulid Word64
_ Word64
a0) = forall a. Enum a => a -> Int
fromEnum Word64
a0

-- -----------------------------------------------------------------------------
-- Functions for `Bits` instance.

{-# INLINABLE and128 #-}
and128 :: Ulid -> Ulid -> Ulid
and128 :: Ulid -> Ulid -> Ulid
and128 (Ulid Word64
a1 Word64
a0) (Ulid Word64
b1 Word64
b0) = Word64 -> Word64 -> Ulid
Ulid (Word64
a1 forall a. Bits a => a -> a -> a
.&. Word64
b1) (Word64
a0 forall a. Bits a => a -> a -> a
.&. Word64
b0)

{-# INLINABLE or128 #-}
or128 :: Ulid -> Ulid -> Ulid
or128 :: Ulid -> Ulid -> Ulid
or128 (Ulid Word64
a1 Word64
a0) (Ulid Word64
b1 Word64
b0) = Word64 -> Word64 -> Ulid
Ulid (Word64
a1 forall a. Bits a => a -> a -> a
.|. Word64
b1) (Word64
a0 forall a. Bits a => a -> a -> a
.|. Word64
b0)

{-# INLINABLE xor128 #-}
xor128 :: Ulid -> Ulid -> Ulid
xor128 :: Ulid -> Ulid -> Ulid
xor128 (Ulid Word64
a1 Word64
a0) (Ulid Word64
b1 Word64
b0) = Word64 -> Word64 -> Ulid
Ulid (forall a. Bits a => a -> a -> a
xor Word64
a1 Word64
b1) (forall a. Bits a => a -> a -> a
xor Word64
a0 Word64
b0)

{-# INLINABLE complement128 #-}
complement128 :: Ulid -> Ulid
complement128 :: Ulid -> Ulid
complement128 (Ulid Word64
a1 Word64
a0) = Word64 -> Word64 -> Ulid
Ulid (forall a. Bits a => a -> a
complement Word64
a1) (forall a. Bits a => a -> a
complement Word64
a0)

-- Probably not worth inlining this.
shiftL128 :: Ulid -> Int -> Ulid
shiftL128 :: Ulid -> Int -> Ulid
shiftL128 w :: Ulid
w@(Ulid Word64
a1 Word64
a0) Int
s
  | Int
s forall a. Eq a => a -> a -> Bool
== Int
0 = Ulid
w
  | Int
s forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = Ulid
zeroWord128
  | Int
s forall a. Ord a => a -> a -> Bool
< Int
0 = Ulid -> Int -> Ulid
shiftR128 Ulid
w (forall a. Num a => a -> a
negate Int
s)
  | Int
s forall a. Ord a => a -> a -> Bool
>= Int
128 = Ulid
zeroWord128
  | Int
s forall a. Eq a => a -> a -> Bool
== Int
64 = Word64 -> Word64 -> Ulid
Ulid Word64
a0 Word64
0
  | Int
s forall a. Ord a => a -> a -> Bool
> Int
64 = Word64 -> Word64 -> Ulid
Ulid (Word64
a0 forall a. Bits a => a -> Int -> a
`shiftL` (Int
s forall a. Num a => a -> a -> a
- Int
64)) Word64
0
  | Bool
otherwise =
      Word64 -> Word64 -> Ulid
Ulid Word64
s1 Word64
s0
      where
        s0 :: Word64
s0 = Word64
a0 forall a. Bits a => a -> Int -> a
`shiftL` Int
s
        s1 :: Word64
s1 = Word64
a1 forall a. Bits a => a -> Int -> a
`shiftL` Int
s forall a. Num a => a -> a -> a
+ Word64
a0 forall a. Bits a => a -> Int -> a
`shiftR` (Int
64 forall a. Num a => a -> a -> a
- Int
s)

-- Probably not worth inlining this.
shiftR128 :: Ulid -> Int -> Ulid
shiftR128 :: Ulid -> Int -> Ulid
shiftR128 w :: Ulid
w@(Ulid Word64
a1 Word64
a0) Int
s
  | Int
s forall a. Eq a => a -> a -> Bool
== Int
0 = Ulid
w
  | Int
s forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = Ulid
zeroWord128
  | Int
s forall a. Ord a => a -> a -> Bool
< Int
0 = Ulid -> Int -> Ulid
shiftL128 Ulid
w (forall a. Num a => a -> a
negate Int
s)
  | Int
s forall a. Ord a => a -> a -> Bool
>= Int
128 = Ulid
zeroWord128
  | Int
s forall a. Eq a => a -> a -> Bool
== Int
64 = Word64 -> Word64 -> Ulid
Ulid Word64
0 Word64
a1
  | Int
s forall a. Ord a => a -> a -> Bool
> Int
64 = Word64 -> Word64 -> Ulid
Ulid Word64
0 (Word64
a1 forall a. Bits a => a -> Int -> a
`shiftR` (Int
s forall a. Num a => a -> a -> a
- Int
64))
  | Bool
otherwise =
      Word64 -> Word64 -> Ulid
Ulid Word64
s1 Word64
s0
      where
        s1 :: Word64
s1 = Word64
a1 forall a. Bits a => a -> Int -> a
`shiftR` Int
s
        s0 :: Word64
s0 = Word64
a0 forall a. Bits a => a -> Int -> a
`shiftR` Int
s forall a. Num a => a -> a -> a
+ Word64
a1 forall a. Bits a => a -> Int -> a
`shiftL` (Int
64 forall a. Num a => a -> a -> a
- Int
s)

rotateL128 :: Ulid -> Int -> Ulid
rotateL128 :: Ulid -> Int -> Ulid
rotateL128 w :: Ulid
w@(Ulid Word64
a1 Word64
a0) Int
r
  | Int
r forall a. Eq a => a -> a -> Bool
== Int
0 = Ulid
w
  | Int
r forall a. Ord a => a -> a -> Bool
< Int
0 = Ulid -> Int -> Ulid
rotateL128 Ulid
w (Int
128 forall a. Num a => a -> a -> a
- (forall a. Num a => a -> a
abs Int
r forall a. Integral a => a -> a -> a
`mod` Int
128))
  | Int
r forall a. Ord a => a -> a -> Bool
>= Int
128 = Ulid -> Int -> Ulid
rotateL128 Ulid
w (Int
r forall a. Integral a => a -> a -> a
`mod` Int
128)
  | Int
r forall a. Eq a => a -> a -> Bool
== Int
64 = Word64 -> Word64 -> Ulid
Ulid Word64
a0 Word64
a1
  | Int
r forall a. Ord a => a -> a -> Bool
> Int
64 = Ulid -> Int -> Ulid
rotateL128 (Word64 -> Word64 -> Ulid
Ulid Word64
a0 Word64
a1) (Int
r forall a. Integral a => a -> a -> a
`mod` Int
64)
  | Bool
otherwise =
      Word64 -> Word64 -> Ulid
Ulid Word64
s1 Word64
s0
      where
        s0 :: Word64
s0 = Word64
a0 forall a. Bits a => a -> Int -> a
`shiftL` Int
r forall a. Num a => a -> a -> a
+ Word64
a1 forall a. Bits a => a -> Int -> a
`shiftR` (Int
64 forall a. Num a => a -> a -> a
- Int
r)
        s1 :: Word64
s1 = Word64
a1 forall a. Bits a => a -> Int -> a
`shiftL` Int
r forall a. Num a => a -> a -> a
+ Word64
a0 forall a. Bits a => a -> Int -> a
`shiftR` (Int
64 forall a. Num a => a -> a -> a
- Int
r)

rotateR128 :: Ulid -> Int -> Ulid
rotateR128 :: Ulid -> Int -> Ulid
rotateR128 w :: Ulid
w@(Ulid Word64
a1 Word64
a0) Int
r
  | Int
r forall a. Eq a => a -> a -> Bool
== Int
0 = Ulid
w
  | Int
r forall a. Ord a => a -> a -> Bool
< Int
0 = Ulid -> Int -> Ulid
rotateR128 Ulid
w (Int
128 forall a. Num a => a -> a -> a
- (forall a. Num a => a -> a
abs Int
r forall a. Integral a => a -> a -> a
`mod` Int
128))
  | Int
r forall a. Ord a => a -> a -> Bool
>= Int
128 = Ulid -> Int -> Ulid
rotateR128 Ulid
w (Int
r forall a. Integral a => a -> a -> a
`mod` Int
128)
  | Int
r forall a. Eq a => a -> a -> Bool
== Int
64 = Word64 -> Word64 -> Ulid
Ulid Word64
a0 Word64
a1
  | Int
r forall a. Ord a => a -> a -> Bool
> Int
64 = Ulid -> Int -> Ulid
rotateR128 (Word64 -> Word64 -> Ulid
Ulid Word64
a0 Word64
a1) (Int
r forall a. Integral a => a -> a -> a
`mod` Int
64)
  | Bool
otherwise =
      Word64 -> Word64 -> Ulid
Ulid Word64
s1 Word64
s0
      where
        s0 :: Word64
s0 = Word64
a0 forall a. Bits a => a -> Int -> a
`shiftR` Int
r forall a. Num a => a -> a -> a
+ Word64
a1 forall a. Bits a => a -> Int -> a
`shiftL` (Int
64 forall a. Num a => a -> a -> a
- Int
r)
        s1 :: Word64
s1 = Word64
a1 forall a. Bits a => a -> Int -> a
`shiftR` Int
r forall a. Num a => a -> a -> a
+ Word64
a0 forall a. Bits a => a -> Int -> a
`shiftL` (Int
64 forall a. Num a => a -> a -> a
- Int
r)

testBit128 :: Ulid -> Int -> Bool
testBit128 :: Ulid -> Int -> Bool
testBit128 (Ulid Word64
a1 Word64
a0) Int
i
  | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
  | Int
i forall a. Ord a => a -> a -> Bool
>= Int
128 = Bool
False
  | Int
i forall a. Ord a => a -> a -> Bool
>= Int
64 = forall a. Bits a => a -> Int -> Bool
testBit Word64
a1 (Int
i forall a. Num a => a -> a -> a
- Int
64)
  | Bool
otherwise = forall a. Bits a => a -> Int -> Bool
testBit Word64
a0 Int
i

bit128 :: Int -> Ulid
bit128 :: Int -> Ulid
bit128 Int
indx
  | Int
indx forall a. Ord a => a -> a -> Bool
< Int
0 = Ulid
zeroWord128
  | Int
indx forall a. Ord a => a -> a -> Bool
>= Int
128 = Ulid
zeroWord128
  | Bool
otherwise = Ulid -> Int -> Ulid
shiftL128 Ulid
oneWord128 Int
indx

popCount128 :: Ulid -> Int
popCount128 :: Ulid -> Int
popCount128 (Ulid Word64
a1 Word64
a0) = forall a. Bits a => a -> Int
popCount Word64
a1 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int
popCount Word64
a0

-- -----------------------------------------------------------------------------
-- Functions for `FiniteBits` instance.

countLeadingZeros128 :: Ulid -> Int
countLeadingZeros128 :: Ulid -> Int
countLeadingZeros128 (Ulid Word64
a1 Word64
a0) =
  case forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
a1 of
    Int
64 -> Int
64 forall a. Num a => a -> a -> a
+  forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
a0
    Int
res -> Int
res

countTrailingZeros128 :: Ulid -> Int
countTrailingZeros128 :: Ulid -> Int
countTrailingZeros128 (Ulid Word64
a1 Word64
a0) =
  case forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
a0 of
    Int
64 -> Int
64 forall a. Num a => a -> a -> a
+ forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
a1
    Int
res -> Int
res

-- -----------------------------------------------------------------------------
-- Functions for `Storable` instance.

peek128 :: Ptr Ulid -> IO Ulid
peek128 :: Ptr Ulid -> IO Ulid
peek128 Ptr Ulid
ptr =
  Word64 -> Word64 -> Ulid
Ulid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) Int
index1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) Int
index0

peekElemOff128 :: Ptr Ulid -> Int -> IO Ulid
peekElemOff128 :: Ptr Ulid -> Int -> IO Ulid
peekElemOff128 Ptr Ulid
ptr Int
idx =
  Word64 -> Word64 -> Ulid
Ulid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) (Int
idx2 forall a. Num a => a -> a -> a
+ Int
index1)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) (Int
idx2 forall a. Num a => a -> a -> a
+ Int
index0)
  where idx2 :: Int
idx2 = Int
2 forall a. Num a => a -> a -> a
* Int
idx

poke128 :: Ptr Ulid -> Ulid -> IO ()
poke128 :: Ptr Ulid -> Ulid -> IO ()
poke128 Ptr Ulid
ptr (Ulid Word64
a1 Word64
a0) =
  forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) Int
index1 Word64
a1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) Int
index0 Word64
a0

pokeElemOff128 :: Ptr Ulid -> Int -> Ulid -> IO ()
pokeElemOff128 :: Ptr Ulid -> Int -> Ulid -> IO ()
pokeElemOff128 Ptr Ulid
ptr Int
idx (Ulid Word64
a1 Word64
a0) = do
  let idx2 :: Int
idx2 = Int
2 forall a. Num a => a -> a -> a
* Int
idx
  forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) (Int
idx2 forall a. Num a => a -> a -> a
+ Int
index0) Word64
a0
  forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Ulid
ptr) (Int
idx2 forall a. Num a => a -> a -> a
+ Int
index1) Word64
a1

-- -----------------------------------------------------------------------------
-- Functions for `Prim` instance.

{-# INLINE sizeOf128# #-}
sizeOf128# :: Ulid -> Int#
sizeOf128# :: Ulid -> Int#
sizeOf128# Ulid
_ = Int#
2# Int# -> Int# -> Int#
*# forall a. Prim a => a -> Int#
sizeOf# (Word64
0 :: Word64)

{-# INLINE alignment128# #-}
alignment128# :: Ulid -> Int#
alignment128# :: Ulid -> Int#
alignment128# Ulid
_ = Int#
2# Int# -> Int# -> Int#
*# forall a. Prim a => a -> Int#
alignment# (Word64
0 :: Word64)

{-# INLINE indexByteArray128# #-}
indexByteArray128# :: ByteArray# -> Int# -> Ulid
indexByteArray128# :: ByteArray# -> Int# -> Ulid
indexByteArray128# ByteArray#
arr# Int#
i# =
  let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#
      x :: Word64
x = forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1)
      y :: Word64
y = forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0)
  in Word64 -> Word64 -> Ulid
Ulid Word64
x Word64
y

{-# INLINE readByteArray128# #-}
readByteArray128# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ulid #)
readByteArray128# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Ulid #)
readByteArray128# MutableByteArray# s
arr# Int#
i# =
  \State# s
s0 -> case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1) State# s
s0 of
    (# State# s
s1, Word64
x #) -> case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0) State# s
s1 of
      (# State# s
s2, Word64
y #) -> (# State# s
s2, Word64 -> Word64 -> Ulid
Ulid Word64
x Word64
y #)
  where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#

{-# INLINE writeByteArray128# #-}
writeByteArray128# :: MutableByteArray# s -> Int# -> Ulid -> State# s -> State# s
writeByteArray128# :: forall s.
MutableByteArray# s -> Int# -> Ulid -> State# s -> State# s
writeByteArray128# MutableByteArray# s
arr# Int#
i# (Ulid Word64
a Word64
b) =
  \State# s
s0 -> case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1) Word64
a State# s
s0 of
    State# s
s1 -> case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0) Word64
b State# s
s1 of
      State# s
s2 -> State# s
s2
  where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#

{-# INLINE setByteArray128# #-}
setByteArray128# :: MutableByteArray# s -> Int# -> Int# -> Ulid -> State# s -> State# s
setByteArray128# :: forall s.
MutableByteArray# s -> Int# -> Int# -> Ulid -> State# s -> State# s
setByteArray128# = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
defaultSetByteArray#

{-# INLINE indexOffAddr128# #-}
indexOffAddr128# :: Addr# -> Int# -> Ulid
indexOffAddr128# :: Addr# -> Int# -> Ulid
indexOffAddr128# Addr#
addr# Int#
i# =
  let i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#
      x :: Word64
x = forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1)
      y :: Word64
y = forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0)
  in Word64 -> Word64 -> Ulid
Ulid Word64
x Word64
y

{-# INLINE readOffAddr128# #-}
readOffAddr128# :: Addr# -> Int# -> State# s -> (# State# s, Ulid #)
readOffAddr128# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Ulid #)
readOffAddr128# Addr#
addr# Int#
i# =
  \State# s
s0 -> case forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1) State# s
s0 of
    (# State# s
s1, Word64
x #) -> case forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0) State# s
s1 of
      (# State# s
s2, Word64
y #) -> (# State# s
s2, Word64 -> Word64 -> Ulid
Ulid Word64
x Word64
y #)
  where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#

{-# INLINE writeOffAddr128# #-}
writeOffAddr128# :: Addr# -> Int# -> Ulid -> State# s -> State# s
writeOffAddr128# :: forall s. Addr# -> Int# -> Ulid -> State# s -> State# s
writeOffAddr128# Addr#
addr# Int#
i# (Ulid Word64
a Word64
b) =
  \State# s
s0 -> case forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index1) Word64
a State# s
s0 of
    State# s
s1 -> case forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# (Int#
i2# Int# -> Int# -> Int#
+# Int -> Int#
unInt Int
index0) Word64
b State# s
s1 of
      State# s
s2 -> State# s
s2
  where i2# :: Int#
i2# = Int#
2# Int# -> Int# -> Int#
*# Int#
i#

{-# INLINE setOffAddr128# #-}
setOffAddr128# :: Addr# -> Int# -> Int# -> Ulid -> State# s -> State# s
setOffAddr128# :: forall s. Addr# -> Int# -> Int# -> Ulid -> State# s -> State# s
setOffAddr128# = forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
defaultSetOffAddr#

-- -----------------------------------------------------------------------------
-- Other functions.

unInt :: Int -> Int#
unInt :: Int -> Int#
unInt (I# Int#
i#) = Int#
i#

-- -----------------------------------------------------------------------------
-- Constants.

zeroWord128 :: Ulid
zeroWord128 :: Ulid
zeroWord128 = Word64 -> Word64 -> Ulid
Ulid Word64
0 Word64
0

oneWord128 :: Ulid
oneWord128 :: Ulid
oneWord128 = Word64 -> Word64 -> Ulid
Ulid Word64
0 Word64
1

-- Use these indices to get the peek/poke ordering endian correct.
index0, index1 :: Int
#if WORDS_BIGENDIAN
index0 = 1
index1 = 0
#else
index0 :: Int
index0 = Int
0
index1 :: Int
index1 = Int
1
#endif