git.iko.soy/typeable/id
on master help sign in
Switch to the new Id type (#4864)
5ac64beYuras
id.cabal+2
compare with master
unifiedsplit
@@ -13,7 +13,9 @@ library
13 base ^>=4.12.0.0,
13 base ^>=4.12.0.0,
14 binary,
14 binary,
15 deepseq,
15 deepseq,
16+ QuickCheck,
16 hashable,
17 hashable,
18+ lens,
17 postgresql-simple,
19 postgresql-simple,
18 uuid,
20 uuid,
19 yesod-core,
21 yesod-core,
src/Data/Id.hs+14−1
@@ -1,11 +1,14 @@
1+{-# LANGUAGE TemplateHaskell #-}
1{-# OPTIONS_GHC -Wno-orphans #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
2
3
3module Data.Id
4module Data.Id
4 ( Id(..)
5 ( Id(..)
5 , coerceId
6 , coerceId
7+ , _Id
6 ) where
8 ) where
7
9
8import Control.DeepSeq (NFData)
10import Control.DeepSeq (NFData)
11+import Control.Lens
9import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
12import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
10import Data.Binary (Binary)
13import Data.Binary (Binary)
11import Data.Coerce (coerce)
14import Data.Coerce (coerce)
@@ -15,22 +18,32 @@ import qualified Data.UUID as UUID
15import Database.PostgreSQL.Simple.FromField (FromField)
18import Database.PostgreSQL.Simple.FromField (FromField)
16import Database.PostgreSQL.Simple.ToField (ToField)
19import Database.PostgreSQL.Simple.ToField (ToField)
17import GHC.Generics (Generic)
20import GHC.Generics (Generic)
21+import Test.QuickCheck
18import Yesod.Core (PathPiece(..))
22import Yesod.Core (PathPiece(..))
19
23
20
24
21−newtype Id (t :: k) = Id { unId :: UUID }
25+newtype Id t = Id { unId :: UUID }
22 deriving
26 deriving
23 ( Eq, Ord, Generic, Read, Show, ToField, FromField, PathPiece, FromJSON
27 ( Eq, Ord, Generic, Read, Show, ToField, FromField, PathPiece, FromJSON
24 , ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey)
28 , ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey)
25
29
26type role Id nominal
30type role Id nominal
27
31
32+instance Arbitrary (Id t) where
33+ arbitrary = fmap Id $ UUID.fromWords
34+ <$> arbitrary
35+ <*> arbitrary
36+ <*> arbitrary
37+ <*> arbitrary
38+
28instance Binary (Id t) where
39instance Binary (Id t) where
29
40
30instance PathPiece UUID.UUID where
41instance PathPiece UUID.UUID where
31 fromPathPiece = UUID.fromText
42 fromPathPiece = UUID.fromText
32 toPathPiece = UUID.toText
43 toPathPiece = UUID.toText
33
44
45+makePrisms ''Id
46+
34-- | This is a more \"explicit\" 'coerce' specifically for 'Id'.
47-- | This is a more \"explicit\" 'coerce' specifically for 'Id'.
35-- You are forced to explicitly specify the phantom types you are converting
48-- You are forced to explicitly specify the phantom types you are converting
36-- via the @TypeApplications@ compiler extension.
49-- via the @TypeApplications@ compiler extension.