mirror of
https://github.com/typeable/id.git
synced 2024-09-11 13:26:02 +03:00
Added id package (#4799)
* Added id package * Updated comments * renamed morphId to coerceId
This commit is contained in:
commit
23cc500b9b
33
id.cabal
Normal file
33
id.cabal
Normal file
@ -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
|
42
src/Data/Id.hs
Normal file
42
src/Data/Id.hs
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user