@@ -0,0 +1,42 @@
1+module Data.Id
2+ ( Id(..)
3+ , coerceId
4+ ) where
5+
6+import Control.DeepSeq (NFData)
7+import Data.Aeson (FromJSON, ToJSON)
8+import Data.Binary (Binary)
9+import Data.Coerce (coerce)
10+import Data.Hashable (Hashable)
11+import Data.UUID (UUID)
12+import qualified Data.UUID as UUID
13+import Database.PostgreSQL.Simple.FromField (FromField)
14+import Database.PostgreSQL.Simple.ToField (ToField)
15+import GHC.Generics (Generic)
16+import Test.QuickCheck (Arbitrary)
17+import Yesod.Core (PathPiece(..))
18+
19+
20+newtype Id (t :: k) = Id { unId :: UUID }
21+ deriving
22+ ( Eq, Ord, Generic, Read, Show, ToField, FromField, PathPiece, FromJSON
23+ , ToJSON, NFData, Hashable)
24+
25+type role Id nominal
26+
27+instance Binary (Id t) where
28+
29+instance PathPiece UUID.UUID where
30+ fromPathPiece = UUID.fromText
31+ toPathPiece = UUID.toText
32+
33+-- | This is a more \"explicit\" 'coerce' specifically for 'Id'.
34+-- You are forced to explicitly specify the phantom types you are converting
35+-- via the @TypeApplications@ compiler extension.
36+coerceId :: forall a b. Id (Ambiguous a) -> Id (Ambiguous b)
37+coerceId = coerce
38+{-# INLINE coerceId #-}
39+
40+-- https://kcsongor.github.io/ambiguous-tags/
41+type family Ambiguous (a :: k) :: j where
42+ Ambiguous x = x