git.iko.soy/typeable/id
on master help sign in
swap
aa466ff3 ahead, 1 behind
id.cabal+20−5
since splitsnapshots
unifiedsplit
@@ -23,6 +23,12 @@ flag store
23 default: False
23 default: False
24 manual: False
24 manual: False
25
25
26+flag uuid-impl
27+ description: Include some functions with extra dependencies.
28+ Disable to reduce dependencies.
29+ default: True
30+ manual: False
31+
26library
32library
27 exposed-modules: Data.Id
33 exposed-modules: Data.Id
28 build-depends:
34 build-depends:
@@ -33,17 +39,26 @@ library
33 , hashable
39 , hashable
34 , http-api-data
40 , http-api-data
35 , lens
41 , lens
36− , openapi3
37 , path-pieces
42 , path-pieces
38− , QuickCheck
39 , text
43 , text
40− , uuid >=1.3.9
44+ , uuid-types
45+ if flag(uuid-impl)
46+ build-depends:
47+ , uuid >=1.3.9
48+ cpp-options: -DUSE_UUID
49+
50+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
51+ build-depends:
52+ , openapi3
53+ , QuickCheck
54+
55+ cpp-options: -DBACKEND
41
56
42− if (flag(postgres) && !(impl(ghcjs) || arch(javascript)))
57+ if (flag(postgres) && !(impl(ghcjs) || arch(javascript) || arch(wasm32)))
43 build-depends: postgresql-simple
58 build-depends: postgresql-simple
44 cpp-options: -DUSE_POSTGRES
59 cpp-options: -DUSE_POSTGRES
45
60
46− if (flag(cassava) && !(impl(ghcjs) || arch(javascript)))
61+ if (flag(cassava) && !(impl(ghcjs) || arch(javascript) || arch(wasm32)))
47 build-depends: cassava
62 build-depends: cassava
48 cpp-options: -DUSE_CASSAVA
63 cpp-options: -DUSE_CASSAVA
49
64
src/Data/Id.hs+34−17
@@ -4,9 +4,12 @@
4{-# OPTIONS_GHC -Wno-orphans #-}
4{-# OPTIONS_GHC -Wno-orphans #-}
5
5
6module Data.Id
6module Data.Id
7− ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
10+#ifdef USE_UUID
11+ , randomId
12+#endif
10 )
13 )
11 where
14 where
12
15
@@ -18,19 +21,22 @@ import Data.Binary (Binary)
18import Data.Coerce (coerce)
21import Data.Coerce (coerce)
19import Data.Data
22import Data.Data
20import Data.Hashable (Hashable)
23import Data.Hashable (Hashable)
21−import Data.OpenApi
22import Data.String
24import Data.String
23import Data.Text as T
25import Data.Text as T
24−import Data.UUID (UUID)
26+import Data.UUID.Types (UUID)
25−import qualified Data.UUID as UUID
27+import qualified Data.UUID.Types as UUID
26−import qualified Data.UUID.V4 as UUID.V4
27import GHC.TypeLits
28import GHC.TypeLits
28import Prelude as P
29import Prelude as P
29−import Test.QuickCheck
30import Text.ParserCombinators.ReadP
30import Text.ParserCombinators.ReadP
31import Web.HttpApiData
31import Web.HttpApiData
32import Web.PathPieces (PathPiece(..))
32import Web.PathPieces (PathPiece(..))
33
33
34+#ifdef USE_UUID
35+import qualified Data.UUID.V4 as UUID.V4
36+#endif
37+#ifdef BACKEND
38+import Data.OpenApi
39+import Test.QuickCheck
34#ifdef USE_CASSAVA
40#ifdef USE_CASSAVA
35import Data.Csv as Csv hiding(Name)
41import Data.Csv as Csv hiding(Name)
36#endif
42#endif
@@ -38,6 +44,7 @@ import Data.Csv as Csv hiding(Name)
38import Database.PostgreSQL.Simple.FromField as PG (FromField)
44import Database.PostgreSQL.Simple.FromField as PG (FromField)
39import Database.PostgreSQL.Simple.ToField as PG (ToField)
45import Database.PostgreSQL.Simple.ToField as PG (ToField)
40#endif
46#endif
47+#endif
41
48
42#ifdef USE_FLAT
49#ifdef USE_FLAT
43import Flat as F
50import Flat as F
@@ -55,9 +62,11 @@ newtype Id t = Id { unId :: UUID }
55 , PG.ToField, PG.FromField
62 , PG.ToField, PG.FromField
56#endif
63#endif
57#endif
64#endif
58− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66+#ifdef BACKEND
67+ , ToSchema, ToParamSchema
68+#endif
59− , ToParamSchema, FromHttpApiData, ToHttpApiData
69+ , FromHttpApiData, ToHttpApiData )
60− )
61
70
62type role Id nominal
71type role Id nominal
63
72
@@ -67,9 +76,11 @@ mkId :: forall s. UUID -> Id s
67mkId = coerce
76mkId = coerce
68{-# INLINE mkId #-}
77{-# INLINE mkId #-}
69
78
79+#ifdef USE_UUID
70randomId :: forall s. IO (Id s)
80randomId :: forall s. IO (Id s)
71randomId = coerce <$> UUID.V4.nextRandom
81randomId = coerce <$> UUID.V4.nextRandom
72{-# INLINE randomId #-}
82{-# INLINE randomId #-}
83+#endif
73
84
74instance KnownSymbol s => Show (Id s) where
85instance KnownSymbol s => Show (Id s) where
75 show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
86 show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
@@ -93,12 +104,14 @@ instance Data.Store.Store (Id s) where
93 size = Data.Store.ConstSize 16
104 size = Data.Store.ConstSize 16
94#endif
105#endif
95
106
107+#ifdef BACKEND
96instance Arbitrary (Id t) where
108instance Arbitrary (Id t) where
97 arbitrary = fmap Id $ UUID.fromWords
109 arbitrary = fmap Id $ UUID.fromWords
98 <$> arbitrary
110 <$> arbitrary
99 <*> arbitrary
111 <*> arbitrary
100 <*> arbitrary
112 <*> arbitrary
101 <*> arbitrary
113 <*> arbitrary
114+#endif
102
115
103instance PathPiece (Id t) where
116instance PathPiece (Id t) where
104 fromPathPiece = coerce . UUID.fromText
117 fromPathPiece = coerce . UUID.fromText
@@ -153,10 +166,11 @@ newtype IntId t = IntId { unIntId :: Integer }
153#ifdef USE_STORE
166#ifdef USE_STORE
154 , Data.Store.Store
167 , Data.Store.Store
155#endif
168#endif
169+#ifdef BACKEND
156− , ToSchema, ToParamSchema, Arbitrary, FromJSON, ToJSON, NFData, Hashable
170+ , ToSchema, ToParamSchema, Arbitrary
171+#endif
157− , FromJSONKey, ToJSONKey, FromHttpApiData, ToHttpApiData, PathPiece, Num
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
158− , Integral, Real, Enum
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
159− )
160
174
161type role IntId nominal
175type role IntId nominal
162
176
@@ -203,10 +217,11 @@ newtype Name t = Name { unName :: Text }
203#ifdef USE_STORE
217#ifdef USE_STORE
204 , Data.Store.Store
218 , Data.Store.Store
205#endif
219#endif
220+#ifdef BACKEND
221+ , ToSchema, ToParamSchema
222+#endif
206− , ToSchema, ToParamSchema, FromJSON, ToJSON, NFData, Hashable, FromJSONKey
223+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
207− , ToJSONKey, FromHttpApiData, ToHttpApiData, PathPiece, IsString, Semigroup
224+ , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
208− , Monoid
209− )
210
225
211type role Name nominal
226type role Name nominal
212
227
@@ -224,8 +239,10 @@ instance KnownSymbol s => Read (Name s) where
224 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
225 mkName <$> readS_to_P reads
240 mkName <$> readS_to_P reads
226
241
242+#ifdef BACKEND
227instance Arbitrary (Name s) where
243instance Arbitrary (Name s) where
228 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
229
246
230-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
231-- You are forced to explicitly specify the phantom types you are converting
248-- You are forced to explicitly specify the phantom types you are converting