-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.UUID
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- = Overview
--
-- "Miso.UUID" provides a t'UUID' type, as defined in
-- <http://tools.ietf.org/html/rfc4122 RFC 4122>, backed by a
-- 'Miso.String.MisoString'. Its API mirrors @Data.UUID@ from the
-- <https://hackage.haskell.org/package/uuid uuid> package.
--
-- New v4 UUIDs are generated with the browser's
-- <https://developer.mozilla.org/en-US/docs/Web/API/Crypto/randomUUID crypto.randomUUID()>.
-- Parsing accepts the canonical @8-4-4-4-12@ hexadecimal form, in either
-- case, and normalizes it to lowercase.
--
-- = Quick start
--
-- @
-- import "Miso.UUID" (t'UUID')
-- import qualified "Miso.UUID" as UUID
--
-- -- Generate a fresh identifier
-- freshId :: IO t'UUID'
-- freshId = UUID.'nextRandom'
--
-- -- Parse one
-- parsed :: Maybe t'UUID'
-- parsed = UUID.'fromString' \"550e8400-e29b-41d4-a716-446655440000\"
--
-- -- Check for the nil UUID
-- isUnset :: t'UUID' -> Bool
-- isUnset = UUID.'null'
-- @
--
-- = Instances
--
-- t'UUID' can be converted to and from 'Miso.String.MisoString', JSON,
-- 'Miso.DSL.JSVal', and used as a route capture with "Miso.Router".
-- Its 'Show' and 'Read' instances use the unquoted @8-4-4-4-12@ form,
-- like @Data.UUID@.
----------------------------------------------------------------------------
module Miso.UUID
  ( -- ** Types
    UUID
    -- ** String conversion
  , toString
  , fromString
  , toText
  , fromText
  , toASCIIBytes
  , fromASCIIBytes
  , toLazyASCIIBytes
  , fromLazyASCIIBytes
    -- ** Binary conversion
  , toByteString
  , fromByteString
  , toWords
  , fromWords
  , toWords64
  , fromWords64
    -- ** Nil
  , null
  , nil
    -- ** Generation
  , nextRandom
  ) where
-----------------------------------------------------------------------------
import           Control.Monad ((<=<))
import           Data.Bifunctor (first)
import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
import           Data.Bool (bool)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import           Data.Char (digitToInt, intToDigit, isHexDigit, isSpace, toLower)
import           Data.List (intercalate)
import qualified Data.List as List
import qualified Data.Text as T
import           Data.Word (Word32, Word64)
import           Prelude hiding (null)
-----------------------------------------------------------------------------
import           Miso.DSL (FromJSVal (..), ToJSVal (..), jsg, (#))
import           Miso.JSON (FromJSON (..), ToJSON (..))
import qualified Miso.JSON as JSON
import           Miso.Router (Router (..), capture, toPath)
import           Miso.String (FromMisoString (..), MisoString, ToMisoString (..), fromMisoString)
import           Miso.Util.Parser (ParseError)
import qualified Miso.Util.Parser as Parser
-----------------------------------------------------------------------------
-- | A universally unique identifier, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
newtype UUID = UUID MisoString
  deriving (UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
/= :: UUID -> UUID -> Bool
Eq, 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
$ccompare :: UUID -> UUID -> Ordering
compare :: UUID -> UUID -> Ordering
$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
>= :: UUID -> UUID -> Bool
$cmax :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
min :: UUID -> UUID -> UUID
Ord)
-----------------------------------------------------------------------------
instance Show UUID where
  showsPrec :: Int -> UUID -> ShowS
showsPrec Int
_ = [Char] -> ShowS
showString ([Char] -> ShowS) -> (UUID -> [Char]) -> UUID -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> [Char]
toString
-----------------------------------------------------------------------------
instance Read UUID where
  readsPrec :: Int -> ReadS UUID
readsPrec Int
_ [Char]
str =
    case [Char] -> Maybe UUID
fromString (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
36 [Char]
s) of
      Maybe UUID
Nothing -> []
      Just UUID
u -> [(UUID
u, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
36 [Char]
s)]
    where
      s :: [Char]
s = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
str
-----------------------------------------------------------------------------
parse :: MisoString -> Either (ParseError UUID Char) UUID
parse :: Text -> Either (ParseError UUID Char) UUID
parse =
  Parser Char UUID -> [Char] -> Either (ParseError UUID Char) UUID
forall token a.
Parser token a -> [token] -> Either (ParseError a token) a
Parser.parse
    ( Text -> UUID
UUID
        (Text -> UUID) -> ([Char] -> Text) -> [Char] -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall str. ToMisoString str => str -> Text
toMisoString
        ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower
        ([Char] -> UUID) -> ParserT () [Char] [] [Char] -> Parser Char UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParserT () [Char] [] Char)
-> [Char] -> ParserT () [Char] [] [Char]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Char -> Bool) -> ParserT () [Char] [] Char
forall a r. (a -> Bool) -> ParserT r [a] [] a
Parser.satisfy ((Char -> Bool) -> ParserT () [Char] [] Char)
-> (Char -> Char -> Bool) -> Char -> ParserT () [Char] [] Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> (Char -> Bool) -> Bool -> Char -> Bool
forall a. a -> a -> Bool -> a
bool Char -> Bool
isHexDigit (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (Bool -> Char -> Bool) -> (Char -> Bool) -> Char -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')) [Char]
nilPattern
        Parser Char UUID -> ParserT () [Char] [] () -> Parser Char UUID
forall a b.
ParserT () [Char] [] a
-> ParserT () [Char] [] b -> ParserT () [Char] [] a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT () [Char] [] ()
forall r a. ParserT r [a] [] ()
Parser.endOfInput
    )
    ([Char] -> Either (ParseError UUID Char) UUID)
-> (Text -> [Char]) -> Text -> Either (ParseError UUID Char) UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a. FromMisoString a => Text -> a
fromMisoString
-----------------------------------------------------------------------------
nilPattern :: String
nilPattern :: [Char]
nilPattern = [Char]
"00000000-0000-0000-0000-000000000000"
-----------------------------------------------------------------------------
-- | Convert a t'UUID' to its @8-4-4-4-12@ string form, in lowercase.
toString :: UUID -> String
toString :: UUID -> [Char]
toString = Text -> [Char]
forall a. FromMisoString a => Text -> a
fromMisoString (Text -> [Char]) -> (UUID -> Text) -> UUID -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
forall str. ToMisoString str => str -> Text
toMisoString
-----------------------------------------------------------------------------
-- | Parse a t'UUID' from its @8-4-4-4-12@ string form.
fromString :: String -> Maybe UUID
fromString :: [Char] -> Maybe UUID
fromString = (ParseError UUID Char -> Maybe UUID)
-> (UUID -> Maybe UUID)
-> Either (ParseError UUID Char) UUID
-> Maybe UUID
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe UUID -> ParseError UUID Char -> Maybe UUID
forall a b. a -> b -> a
const Maybe UUID
forall a. Maybe a
Nothing) UUID -> Maybe UUID
forall a. a -> Maybe a
Just (Either (ParseError UUID Char) UUID -> Maybe UUID)
-> ([Char] -> Either (ParseError UUID Char) UUID)
-> [Char]
-> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either (ParseError UUID Char) UUID
parse (Text -> Either (ParseError UUID Char) UUID)
-> ([Char] -> Text) -> [Char] -> Either (ParseError UUID Char) UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall str. ToMisoString str => str -> Text
toMisoString
-----------------------------------------------------------------------------
-- | Like 'toString', but to t'T.Text'.
toText :: UUID -> T.Text
toText :: UUID -> Text
toText = Text -> Text
forall a. FromMisoString a => Text -> a
fromMisoString (Text -> Text) -> (UUID -> Text) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
forall str. ToMisoString str => str -> Text
toMisoString
-----------------------------------------------------------------------------
-- | Like 'fromString', but from t'T.Text'.
fromText :: T.Text -> Maybe UUID
fromText :: Text -> Maybe UUID
fromText = [Char] -> Maybe UUID
fromString ([Char] -> Maybe UUID) -> (Text -> [Char]) -> Text -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
-----------------------------------------------------------------------------
-- | Like 'toString', but to an ASCII-encoded strict 'B8.ByteString'.
toASCIIBytes :: UUID -> B8.ByteString
toASCIIBytes :: UUID -> ByteString
toASCIIBytes = [Char] -> ByteString
B8.pack ([Char] -> ByteString) -> (UUID -> [Char]) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> [Char]
toString
-----------------------------------------------------------------------------
-- | Like 'fromString', but from an ASCII-encoded strict 'B8.ByteString'.
fromASCIIBytes :: B8.ByteString -> Maybe UUID
fromASCIIBytes :: ByteString -> Maybe UUID
fromASCIIBytes = [Char] -> Maybe UUID
fromString ([Char] -> Maybe UUID)
-> (ByteString -> [Char]) -> ByteString -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B8.unpack
-----------------------------------------------------------------------------
-- | Like 'toString', but to an ASCII-encoded lazy 'BL.ByteString'.
toLazyASCIIBytes :: UUID -> BL.ByteString
toLazyASCIIBytes :: UUID -> ByteString
toLazyASCIIBytes = [Char] -> ByteString
BL8.pack ([Char] -> ByteString) -> (UUID -> [Char]) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> [Char]
toString
-----------------------------------------------------------------------------
-- | Like 'fromString', but from an ASCII-encoded lazy 'BL.ByteString'.
fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
fromLazyASCIIBytes :: ByteString -> Maybe UUID
fromLazyASCIIBytes = [Char] -> Maybe UUID
fromString ([Char] -> Maybe UUID)
-> (ByteString -> [Char]) -> ByteString -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BL8.unpack
-----------------------------------------------------------------------------
-- | Encode a t'UUID' as 16 bytes, in network byte order.
toByteString :: UUID -> BL.ByteString
toByteString :: UUID -> ByteString
toByteString UUID
u =
  [Word8] -> ByteString
BL.pack [ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
n) | Word64
w <- [Word64
hi, Word64
lo], Int
n <- [Int
56, Int
48 .. Int
0] ]
    where
      (Word64
hi, Word64
lo) = UUID -> (Word64, Word64)
toWords64 UUID
u
-----------------------------------------------------------------------------
-- | Decode a t'UUID' from 16 bytes, in network byte order. Returns
-- 'Nothing' if the input is not exactly 16 bytes long.
fromByteString :: BL.ByteString -> Maybe UUID
fromByteString :: ByteString -> Maybe UUID
fromByteString ByteString
bs
  | [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = UUID -> Maybe UUID
forall a. a -> Maybe a
Just (Word64 -> Word64 -> UUID
fromWords64 ([Word8] -> Word64
word [Word8]
hi) ([Word8] -> Word64
word [Word8]
lo))
  | Bool
otherwise = Maybe UUID
forall a. Maybe a
Nothing
    where
      bytes :: [Word8]
bytes = ByteString -> [Word8]
BL.unpack ByteString
bs
      ([Word8]
hi, [Word8]
lo) = Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
8 [Word8]
bytes
      word :: [Word8] -> Word64
word = (Word64 -> Word8 -> Word64) -> Word64 -> [Word8] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Word64
acc Word8
b -> Word64
acc Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word64
0
-----------------------------------------------------------------------------
-- | Convert a t'UUID' to four 32-bit words, most significant first.
toWords :: UUID -> (Word32, Word32, Word32, Word32)
toWords :: UUID -> (Word32, Word32, Word32, Word32)
toWords UUID
u =
  ( Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
hi Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
  , Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
hi
  , Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
lo Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
  , Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
lo
  ) where
      (Word64
hi, Word64
lo) = UUID -> (Word64, Word64)
toWords64 UUID
u
-----------------------------------------------------------------------------
-- | Build a t'UUID' from four 32-bit words, most significant first.
fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
a Word32
b Word32
c Word32
d = Word64 -> Word64 -> UUID
fromWords64 (Word32 -> Word32 -> Word64
forall {a} {a} {a}.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
join Word32
a Word32
b) (Word32 -> Word32 -> Word64
forall {a} {a} {a}.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
join Word32
c Word32
d)
  where
    join :: a -> a -> a
join a
x a
y = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
-----------------------------------------------------------------------------
-- | Convert a t'UUID' to two 64-bit words, most significant first.
toWords64 :: UUID -> (Word64, Word64)
toWords64 :: UUID -> (Word64, Word64)
toWords64 UUID
u = ([Char] -> Word64
word [Char]
hi, [Char] -> Word64
word [Char]
lo)
  where
    ([Char]
hi, [Char]
lo) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
16 ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (UUID -> [Char]
toString UUID
u))
    word :: [Char] -> Word64
word = (Word64 -> Char -> Word64) -> Word64 -> [Char] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Word64
acc Char
c -> Word64
acc Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)) Word64
0
-----------------------------------------------------------------------------
-- | Build a t'UUID' from two 64-bit words, most significant first.
fromWords64 :: Word64 -> Word64 -> UUID
fromWords64 :: Word64 -> Word64 -> UUID
fromWords64 Word64
hi Word64
lo = Text -> UUID
UUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall str. ToMisoString str => str -> Text
toMisoString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" [[Char]
a, [Char]
b, [Char]
c, [Char]
d, [Char]
e]
  where
    hex :: a -> [Char]
hex a
w = [ Int -> Char
intToDigit (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xf)) | Int
n <- [Int
60, Int
56 .. Int
0] ]
    ([Char]
a, [Char]
r1) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
8 (Word64 -> [Char]
forall {a}. (Integral a, Bits a) => a -> [Char]
hex Word64
hi [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall {a}. (Integral a, Bits a) => a -> [Char]
hex Word64
lo)
    ([Char]
b, [Char]
r2) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
r1
    ([Char]
c, [Char]
r3) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
r2
    ([Char]
d, [Char]
e) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
r3
-----------------------------------------------------------------------------
-- | The nil UUID, as defined in <http://tools.ietf.org/html/rfc4122 RFC 4122>.
--  It is a UUID of all zeros.
nil :: UUID
nil :: UUID
nil = Text -> UUID
UUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall str. ToMisoString str => str -> Text
toMisoString [Char]
nilPattern
-----------------------------------------------------------------------------
-- | Returns True if the passed-in UUID is the 'nil' UUID.
null :: UUID -> Bool
null :: UUID -> Bool
null = (UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
nil)
-----------------------------------------------------------------------------
instance ToMisoString UUID where
  toMisoString :: UUID -> Text
toMisoString (UUID Text
s) = Text
s
-----------------------------------------------------------------------------
instance FromMisoString UUID where
  fromMisoStringEither :: Text -> Either [Char] UUID
fromMisoStringEither = (ParseError UUID Char -> [Char])
-> Either (ParseError UUID Char) UUID -> Either [Char] UUID
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError UUID Char -> [Char]
forall a. Show a => a -> [Char]
show (Either (ParseError UUID Char) UUID -> Either [Char] UUID)
-> (Text -> Either (ParseError UUID Char) UUID)
-> Text
-> Either [Char] UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either (ParseError UUID Char) UUID
parse
-----------------------------------------------------------------------------
instance ToJSON UUID where
  toJSON :: UUID -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (UUID -> Text) -> UUID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
forall str. ToMisoString str => str -> Text
toMisoString
-----------------------------------------------------------------------------
instance FromJSON UUID where
  parseJSON :: Value -> Parser UUID
parseJSON = ([Char] -> Parser UUID)
-> (UUID -> Parser UUID) -> Either [Char] UUID -> Parser UUID
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser UUID
forall a. HasCallStack => [Char] -> Parser a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail UUID -> Parser UUID
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] UUID -> Parser UUID)
-> (Text -> Either [Char] UUID) -> Text -> Parser UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] UUID
forall t. FromMisoString t => Text -> Either [Char] t
fromMisoStringEither (Text -> Parser UUID)
-> (Value -> Parser Text) -> Value -> Parser UUID
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON
-----------------------------------------------------------------------------
instance ToJSVal UUID where
  toJSVal :: UUID -> IO JSVal
toJSVal = Text -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Text -> IO JSVal) -> (UUID -> Text) -> UUID -> IO JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
forall str. ToMisoString str => str -> Text
toMisoString
-----------------------------------------------------------------------------
instance FromJSVal UUID where
  fromJSVal :: JSVal -> IO (Maybe UUID)
fromJSVal = (Maybe Value -> Maybe UUID) -> IO (Maybe Value) -> IO (Maybe UUID)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> Parser UUID) -> Value -> Maybe UUID
forall a b. (a -> Parser b) -> a -> Maybe b
JSON.parseMaybe Value -> Parser UUID
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Maybe UUID) -> Maybe Value -> Maybe UUID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO (Maybe Value) -> IO (Maybe UUID))
-> (JSVal -> IO (Maybe Value)) -> JSVal -> IO (Maybe UUID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> IO (Maybe Value)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal
-----------------------------------------------------------------------------
instance Router UUID where
  fromRoute :: UUID -> [Token]
fromRoute = Token -> [Token]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> [Token]) -> (UUID -> Token) -> UUID -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Token
toPath (Text -> Token) -> (UUID -> Text) -> UUID -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
forall str. ToMisoString str => str -> Text
toMisoString
  routeParser :: RouteParser UUID
routeParser = RouteParser UUID
forall value. FromMisoString value => RouteParser value
capture
-----------------------------------------------------------------------------
-- | Generate a v4 'UUID' using a cryptographically secure random number generator.
nextRandom :: IO UUID
nextRandom :: IO UUID
nextRandom = Text -> UUID
UUID (Text -> UUID) -> IO Text -> IO UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> IO Text
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Text) -> IO JSVal -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text -> IO JSVal
jsg Text
"crypto" IO JSVal -> Text -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> Text -> args -> IO JSVal
# Text
"randomUUID") ())
-----------------------------------------------------------------------------