git.iko.soy/typeable/id
on master help sign in
Added id package (#4799)
23cc500iko
Setup.hsnew file+2
compare with master
unifiedsplit
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
id.cabalnew file+33
@@ -0,0 +1,33 @@
1+cabal-version: 2.4
2+
3+name: id
4+version: 0.1.0.0
5+
6+library
7+ exposed-modules:
8+ Data.Id
9+ -- other-modules:
10+ -- other-extensions:
11+ build-depends:
12+ aeson,
13+ base ^>=4.12.0.0,
14+ binary,
15+ deepseq,
16+ hashable,
17+ postgresql-simple,
18+ QuickCheck,
19+ uuid,
20+ yesod-core,
21+ hs-source-dirs:
22+ src
23+ default-language:
24+ Haskell2010
25+ default-extensions:
26+ AllowAmbiguousTypes
27+ DeriveGeneric
28+ GeneralizedNewtypeDeriving
29+ PolyKinds
30+ RankNTypes
31+ RoleAnnotations
32+ TypeApplications
33+ TypeFamilies
src/Data/Id.hsnew file+42
@@ -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