@@ -7,6 +7,9 @@ module Data.Id
77 ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
88 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
99 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
10+#ifdef USE_UUID
11+ , randomId
12+#endif
1013 )
1114 where
1215
@@ -18,32 +21,52 @@ import Data.Binary (Binary)
1821import Data.Coerce (coerce)
1922import Data.Data
2023import Data.Hashable (Hashable)
21−import Data.OpenApi
2224import Data.String
2325import Data.Text as T
24−import Data.UUID (UUID)
25−import qualified Data.UUID as UUID
26−#ifndef ghcjs_HOST_OS
27−import Database.PostgreSQL.Simple.FromField as PG (FromField)
28−import Database.PostgreSQL.Simple.ToField as PG (ToField)
29−import Data.Csv as Csv hiding(Name)
30−#endif
31−import Flat as F
26+import Data.UUID.Types (UUID)
27+import qualified Data.UUID.Types as UUID
3228import GHC.TypeLits
33−import Test.QuickCheck
29+import Prelude as P
3430import Text.ParserCombinators.ReadP
3531import Web.HttpApiData
3632import Web.PathPieces (PathPiece(..))
3733
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
40+#ifdef USE_CASSAVA
41+import Data.Csv as Csv hiding(Name)
42+#endif
43+#ifdef USE_POSTGRES
44+import Database.PostgreSQL.Simple.FromField as PG (FromField)
45+import Database.PostgreSQL.Simple.ToField as PG (ToField)
46+#endif
47+#endif
48+
49+#ifdef USE_FLAT
50+import Flat as F
51+#endif
52+#ifdef USE_STORE
53+import qualified Data.Store
54+#endif
55+
3856newtype Id t = Id { unId :: UUID }
3957 deriving stock Data
4058 deriving newtype
4159 ( Eq, Ord, Binary
4260#ifndef ghcjs_HOST_OS
61+#ifdef USE_POSTGRES
4362 , PG.ToField, PG.FromField
4463#endif
45− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
46− , ToParamSchema, FromHttpApiData, ToHttpApiData )
64+#endif
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66+#ifdef BACKEND
67+ , ToSchema, ToParamSchema
68+#endif
69+ , FromHttpApiData, ToHttpApiData )
4770
4871type role Id nominal
4972
@@ -53,25 +76,42 @@ mkId :: forall s. UUID -> Id s
5376mkId = coerce
5477{-# INLINE mkId #-}
5578
79+#ifdef USE_UUID
80+randomId :: forall s. IO (Id s)
81+randomId = coerce <$> UUID.V4.nextRandom
82+{-# INLINE randomId #-}
83+#endif
84+
5685instance KnownSymbol s => Show (Id s) where
57− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
5887
5988instance KnownSymbol s => Read (Id s) where
6089 readsPrec _ = readP_to_S $ do
6190 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
6291 mkId <$> readS_to_P reads
6392
93+#ifdef USE_FLAT
6494instance Flat (Id s) where
6595 encode = F.encode . UUID.toWords . coerce
6696 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
6797 size = F.size . UUID.toWords . coerce
98+#endif
6899
100+#ifdef USE_STORE
101+instance Data.Store.Store (Id s) where
102+ poke = Data.Store.poke . UUID.toWords . coerce
103+ peek = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> Data.Store.peek
104+ size = Data.Store.ConstSize 16
105+#endif
106+
107+#ifdef BACKEND
69108instance Arbitrary (Id t) where
70109 arbitrary = fmap Id $ UUID.fromWords
71110 <$> arbitrary
72111 <*> arbitrary
73112 <*> arbitrary
74113 <*> arbitrary
114+#endif
75115
76116instance PathPiece (Id t) where
77117 fromPathPiece = coerce . UUID.fromText
@@ -79,12 +119,14 @@ instance PathPiece (Id t) where
79119
80120#ifndef ghcjs_HOST_OS
81121
122+#ifdef USE_CASSAVA
82123instance Csv.FromField (Id tag) where
83124 parseField = parseField
84125 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
85126
86127instance Csv.ToField (Id tag) where
87128 toField = Csv.toField . UUID.toText . coerce
129+#endif
88130
89131#endif
90132
@@ -111,11 +153,24 @@ newtype IntId t = IntId { unIntId :: Integer }
111153 deriving newtype
112154 ( Eq, Ord, Binary
113155#ifndef ghcjs_HOST_OS
114− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
156+#ifdef USE_POSTGRES
157+ , PG.ToField, PG.FromField
158+#endif
159+#ifdef USE_CASSAVA
160+ , Csv.ToField, Csv.FromField
161+#endif
162+#endif
163+#ifdef USE_FLAT
164+ , Flat
165+#endif
166+#ifdef USE_STORE
167+ , Data.Store.Store
115168#endif
116− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
117− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
118− , Num, Integral, Real, Enum )
169+#ifdef BACKEND
170+ , ToSchema, ToParamSchema, Arbitrary
171+#endif
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
119174
120175type role IntId nominal
121176
@@ -126,7 +181,12 @@ mkIntId = coerce
126181{-# INLINE mkIntId #-}
127182
128183instance KnownSymbol s => Show (IntId s) where
129− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
184+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
185+
186+instance KnownSymbol s => Read (IntId s) where
187+ readsPrec _ = readP_to_S $ do
188+ _ <- string ("IntId-" <> symbolVal (Proxy @s) <> "-")
189+ mkIntId <$> readS_to_P reads
130190
131191-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
132192-- You are forced to explicitly specify the phantom types you are converting
@@ -144,11 +204,24 @@ newtype Name t = Name { unName :: Text }
144204 deriving newtype
145205 ( Eq, Ord, Binary
146206#ifndef ghcjs_HOST_OS
147− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
207+#ifdef USE_POSTGRES
208+ , PG.ToField, PG.FromField
209+#endif
210+#ifdef USE_CASSAVA
211+ , Csv.ToField, Csv.FromField
212+#endif
148213#endif
149− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
150− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
151− , IsString, Semigroup, Monoid )
214+#ifdef USE_FLAT
215+ , Flat
216+#endif
217+#ifdef USE_STORE
218+ , Data.Store.Store
219+#endif
220+#ifdef BACKEND
221+ , ToSchema, ToParamSchema
222+#endif
223+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
224+ , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
152225
153226type role Name nominal
154227
@@ -159,10 +232,17 @@ mkName = coerce
159232{-# INLINE mkName #-}
160233
161234instance KnownSymbol s => Show (Name s) where
162− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
163236
237+instance KnownSymbol s => Read (Name s) where
238+ readsPrec _ = readP_to_S $ do
239+ _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240+ mkName <$> readS_to_P reads
241+
242+#ifdef BACKEND
164243instance Arbitrary (Name s) where
165244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
166246
167247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
168248-- You are forced to explicitly specify the phantom types you are converting