{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} module Hercules.API.Id ( Id (..), idText, uncheckedCast, ) where import Control.DeepSeq (NFData) import Control.Lens ((?~)) import Data.Aeson import Data.Aeson.Types (toJSONKeyText) import Data.Function ((&)) import Data.Hashable (Hashable (..)) import Data.Swagger ( NamedSchema (NamedSchema), ParamSchema, SwaggerType (SwaggerString), ToParamSchema (..), ToSchema (..), format, paramSchemaToSchema, type_, ) import Data.Text (Text) import Data.UUID (UUID) import qualified Data.UUID as UUID import GHC.Generics (Generic) import Web.HttpApiData import Prelude newtype Id (a :: k) = Id {Id a -> UUID idUUID :: UUID} deriving ((forall x. Id a -> Rep (Id a) x) -> (forall x. Rep (Id a) x -> Id a) -> Generic (Id a) forall x. Rep (Id a) x -> Id a forall x. Id a -> Rep (Id a) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall k (a :: k) x. Rep (Id a) x -> Id a forall k (a :: k) x. Id a -> Rep (Id a) x $cto :: forall k (a :: k) x. Rep (Id a) x -> Id a $cfrom :: forall k (a :: k) x. Id a -> Rep (Id a) x Generic, Id a -> Id a -> Bool (Id a -> Id a -> Bool) -> (Id a -> Id a -> Bool) -> Eq (Id a) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall k (a :: k). Id a -> Id a -> Bool /= :: Id a -> Id a -> Bool $c/= :: forall k (a :: k). Id a -> Id a -> Bool == :: Id a -> Id a -> Bool $c== :: forall k (a :: k). Id a -> Id a -> Bool Eq, Eq (Id a) Eq (Id a) -> (Id a -> Id a -> Ordering) -> (Id a -> Id a -> Bool) -> (Id a -> Id a -> Bool) -> (Id a -> Id a -> Bool) -> (Id a -> Id a -> Bool) -> (Id a -> Id a -> Id a) -> (Id a -> Id a -> Id a) -> Ord (Id a) Id a -> Id a -> Bool Id a -> Id a -> Ordering Id a -> Id a -> Id a 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 forall k (a :: k). Eq (Id a) forall k (a :: k). Id a -> Id a -> Bool forall k (a :: k). Id a -> Id a -> Ordering forall k (a :: k). Id a -> Id a -> Id a min :: Id a -> Id a -> Id a $cmin :: forall k (a :: k). Id a -> Id a -> Id a max :: Id a -> Id a -> Id a $cmax :: forall k (a :: k). Id a -> Id a -> Id a >= :: Id a -> Id a -> Bool $c>= :: forall k (a :: k). Id a -> Id a -> Bool > :: Id a -> Id a -> Bool $c> :: forall k (a :: k). Id a -> Id a -> Bool <= :: Id a -> Id a -> Bool $c<= :: forall k (a :: k). Id a -> Id a -> Bool < :: Id a -> Id a -> Bool $c< :: forall k (a :: k). Id a -> Id a -> Bool compare :: Id a -> Id a -> Ordering $ccompare :: forall k (a :: k). Id a -> Id a -> Ordering $cp1Ord :: forall k (a :: k). Eq (Id a) Ord, Id a -> () (Id a -> ()) -> NFData (Id a) forall a. (a -> ()) -> NFData a forall k (a :: k). Id a -> () rnf :: Id a -> () $crnf :: forall k (a :: k). Id a -> () NFData) instance Hashable (Id a) where hashWithSalt :: Int -> Id a -> Int hashWithSalt Int s (Id UUID uuid) = let (Word32 a, Word32 b, Word32 c, Word32 d) = UUID -> (Word32, Word32, Word32, Word32) UUID.toWords UUID uuid in Int s Int -> Word32 -> Int forall a. Hashable a => Int -> a -> Int `hashWithSalt` Word32 a Int -> Word32 -> Int forall a. Hashable a => Int -> a -> Int `hashWithSalt` Word32 b Int -> Word32 -> Int forall a. Hashable a => Int -> a -> Int `hashWithSalt` Word32 c Int -> Word32 -> Int forall a. Hashable a => Int -> a -> Int `hashWithSalt` Word32 d idText :: Id a -> Text idText :: Id a -> Text idText = UUID -> Text UUID.toText (UUID -> Text) -> (Id a -> UUID) -> Id a -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Id a -> UUID forall k (a :: k). Id a -> UUID idUUID uncheckedCast :: Id a -> Id b uncheckedCast :: Id a -> Id b uncheckedCast (Id UUID s) = UUID -> Id b forall k (a :: k). UUID -> Id a Id UUID s instance Show (Id a) where showsPrec :: Int -> Id a -> ShowS showsPrec Int n = Int -> Text -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int n (Text -> ShowS) -> (Id a -> Text) -> Id a -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . Id a -> Text forall k (a :: k). Id a -> Text idText instance ToJSON (Id a) where toEncoding :: Id a -> Encoding toEncoding = Text -> Encoding forall a. ToJSON a => a -> Encoding toEncoding (Text -> Encoding) -> (Id a -> Text) -> Id a -> Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c . Id a -> Text forall k (a :: k). Id a -> Text idText toJSON :: Id a -> Value toJSON = Text -> Value forall a. ToJSON a => a -> Value toJSON (Text -> Value) -> (Id a -> Text) -> Id a -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . Id a -> Text forall k (a :: k). Id a -> Text idText instance FromJSON (Id a) where parseJSON :: Value -> Parser (Id a) parseJSON = (UUID -> Id a) -> Parser UUID -> Parser (Id a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap UUID -> Id a forall k (a :: k). UUID -> Id a Id (Parser UUID -> Parser (Id a)) -> (Value -> Parser UUID) -> Value -> Parser (Id a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser UUID forall a. FromJSON a => Value -> Parser a parseJSON instance ToJSONKey (Id a) where toJSONKey :: ToJSONKeyFunction (Id a) toJSONKey = (Id a -> Text) -> ToJSONKeyFunction (Id a) forall a. (a -> Text) -> ToJSONKeyFunction a toJSONKeyText Id a -> Text forall k (a :: k). Id a -> Text idText instance FromJSONKey (Id a) where fromJSONKey :: FromJSONKeyFunction (Id a) fromJSONKey = (Text -> Parser (Id a)) -> FromJSONKeyFunction (Id a) forall a. (Text -> Parser a) -> FromJSONKeyFunction a FromJSONKeyTextParser ((Text -> Parser (Id a)) -> FromJSONKeyFunction (Id a)) -> (Text -> Parser (Id a)) -> FromJSONKeyFunction (Id a) forall a b. (a -> b) -> a -> b $ \Text text -> case Text -> Maybe UUID UUID.fromText Text text of Just UUID x -> Id a -> Parser (Id a) forall (f :: * -> *) a. Applicative f => a -> f a pure (Id a -> Parser (Id a)) -> Id a -> Parser (Id a) forall a b. (a -> b) -> a -> b $ UUID -> Id a forall k (a :: k). UUID -> Id a Id UUID x Maybe UUID Nothing -> String -> Parser (Id a) forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Expected UUID" instance ToHttpApiData (Id a) where toUrlPiece :: Id a -> Text toUrlPiece = Id a -> Text forall k (a :: k). Id a -> Text idText instance FromHttpApiData (Id a) where parseUrlPiece :: Text -> Either Text (Id a) parseUrlPiece = (UUID -> Id a) -> Either Text UUID -> Either Text (Id a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap UUID -> Id a forall k (a :: k). UUID -> Id a Id (Either Text UUID -> Either Text (Id a)) -> (Text -> Either Text UUID) -> Text -> Either Text (Id a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Either Text UUID forall a. FromHttpApiData a => Text -> Either Text a parseUrlPiece instance ToSchema (Id a) where declareNamedSchema :: Proxy (Id a) -> Declare (Definitions Schema) NamedSchema declareNamedSchema = NamedSchema -> Declare (Definitions Schema) NamedSchema forall (f :: * -> *) a. Applicative f => a -> f a pure (NamedSchema -> Declare (Definitions Schema) NamedSchema) -> (Proxy (Id a) -> NamedSchema) -> Proxy (Id a) -> Declare (Definitions Schema) NamedSchema forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe Text -> Schema -> NamedSchema NamedSchema Maybe Text forall a. Maybe a Nothing (Schema -> NamedSchema) -> (Proxy (Id a) -> Schema) -> Proxy (Id a) -> NamedSchema forall b c a. (b -> c) -> (a -> b) -> a -> c . Proxy (Id a) -> Schema forall a. ToParamSchema a => Proxy a -> Schema paramSchemaToSchema instance ToParamSchema (Id a) where toParamSchema :: Proxy (Id a) -> ParamSchema t toParamSchema Proxy (Id a) _ = (forall a. Monoid a => a forall (t :: SwaggerKind *). ParamSchema t mempty :: ParamSchema t) ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t forall a b. a -> (a -> b) -> b & (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t))) -> ParamSchema t -> Identity (ParamSchema t) forall s a. HasType s a => Lens' s a type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t))) -> ParamSchema t -> Identity (ParamSchema t)) -> SwaggerType t -> ParamSchema t -> ParamSchema t forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ SwaggerType t forall (t :: SwaggerKind *). SwaggerType t SwaggerString ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t forall a b. a -> (a -> b) -> b & (Maybe Text -> Identity (Maybe Text)) -> ParamSchema t -> Identity (ParamSchema t) forall s a. HasFormat s a => Lens' s a format ((Maybe Text -> Identity (Maybe Text)) -> ParamSchema t -> Identity (ParamSchema t)) -> Text -> ParamSchema t -> ParamSchema t forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t ?~ Text "uuid"