{-# LANGUAGE CPP #-}

module Control.Monad.UUID where

import Control.Monad.Trans
import Data.Type.Equality
import HPrelude

#if defined(javascript_HOST_ARCH)
import GHC.JS.Prim
import Data.UUID.Types (UUID, fromText)
#else
import System.Random
import Data.UUID.Types (UUID, fromWords64)
#endif

class (Monad m) => MonadUUID m where
  generateV4 :: m UUID
  default generateV4 :: (MonadTrans t, m ~ t n, MonadUUID n) => m UUID
  generateV4 = n UUID -> t n UUID
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n UUID
forall (m :: * -> *). MonadUUID m => m UUID
generateV4

#if defined(javascript_HOST_ARCH)

foreign import javascript unsafe "js_crypto_random_uuid" js_crypto_random_uuid :: IO JSVal

instance MonadUUID IO where
  generateV4 = fromMaybe (panic "Failed to generate UUID") . fromText . toS . fromJSString <$> js_crypto_random_uuid
#else
instance MonadUUID IO where
  generateV4 :: IO UUID
generateV4 = Word64 -> Word64 -> UUID
fromWords64 (Word64 -> Word64 -> UUID) -> IO Word64 -> IO (Word64 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO IO (Word64 -> UUID) -> IO Word64 -> IO UUID
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
#endif