From 23cc500b9bcb2d93149fbc7fe039eed0c2c25fc4 Mon Sep 17 00:00:00 2001
From: iko <ilyakooo0@gmail.com>
Date: Mon, 27 Jul 2020 22:33:37 +0300
Subject: [PATCH] Added id package (#4799)

* Added id package

* Updated comments

* renamed morphId to coerceId
---
 Setup.hs       |  2 ++
 id.cabal       | 33 +++++++++++++++++++++++++++++++++
 src/Data/Id.hs | 42 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 77 insertions(+)
 create mode 100644 Setup.hs
 create mode 100644 id.cabal
 create mode 100644 src/Data/Id.hs

diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/id.cabal b/id.cabal
new file mode 100644
index 0000000..06c83bb
--- /dev/null
+++ b/id.cabal
@@ -0,0 +1,33 @@
+cabal-version: 2.4
+
+name: id
+version: 0.1.0.0
+
+library
+  exposed-modules:
+    Data.Id
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+    aeson,
+    base ^>=4.12.0.0,
+    binary,
+    deepseq,
+    hashable,
+    postgresql-simple,
+    QuickCheck,
+    uuid,
+    yesod-core,
+  hs-source-dirs:
+    src
+  default-language:
+    Haskell2010
+  default-extensions:
+    AllowAmbiguousTypes
+    DeriveGeneric
+    GeneralizedNewtypeDeriving
+    PolyKinds
+    RankNTypes
+    RoleAnnotations
+    TypeApplications
+    TypeFamilies
diff --git a/src/Data/Id.hs b/src/Data/Id.hs
new file mode 100644
index 0000000..c23e62f
--- /dev/null
+++ b/src/Data/Id.hs
@@ -0,0 +1,42 @@
+module Data.Id
+  ( Id(..)
+  , coerceId
+  ) where
+
+import           Control.DeepSeq (NFData)
+import           Data.Aeson (FromJSON, ToJSON)
+import           Data.Binary (Binary)
+import           Data.Coerce (coerce)
+import           Data.Hashable (Hashable)
+import           Data.UUID (UUID)
+import qualified Data.UUID as UUID
+import           Database.PostgreSQL.Simple.FromField (FromField)
+import           Database.PostgreSQL.Simple.ToField (ToField)
+import           GHC.Generics (Generic)
+import           Test.QuickCheck (Arbitrary)
+import           Yesod.Core (PathPiece(..))
+
+
+newtype Id (t :: k) = Id { unId :: UUID }
+  deriving
+  ( Eq, Ord, Generic, Read, Show, ToField, FromField, PathPiece, FromJSON
+  , ToJSON, NFData, Hashable)
+
+type role Id nominal
+
+instance Binary (Id t) where
+
+instance PathPiece UUID.UUID where
+  fromPathPiece = UUID.fromText
+  toPathPiece = UUID.toText
+
+-- | This is a more \"explicit\" 'coerce' specifically for 'Id'.
+-- You are forced to explicitly specify the phantom types you are converting
+-- via the @TypeApplications@ compiler extension.
+coerceId :: forall a b. Id (Ambiguous a) -> Id (Ambiguous b)
+coerceId = coerce
+{-# INLINE coerceId #-}
+
+-- https://kcsongor.github.io/ambiguous-tags/
+type family Ambiguous (a :: k) :: j where
+  Ambiguous x = x