@@ -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,31 +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
26+import Data.UUID.Types (UUID)
27+import qualified Data.UUID.Types as UUID
28+import GHC.TypeLits
29+import Prelude as P
30+import Text.ParserCombinators.ReadP
31+import Web.HttpApiData
32+import Web.PathPieces (PathPiece(..))
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
40+#ifdef USE_CASSAVA
41+import Data.Csv as Csv hiding(Name)
42+#endif
43+#ifdef USE_POSTGRES
2744import Database.PostgreSQL.Simple.FromField as PG (FromField)
2845import Database.PostgreSQL.Simple.ToField as PG (ToField)
29−import Data.Csv as Csv hiding(Name)
3046#endif
47+#endif
48+
49+#ifdef USE_FLAT
3150import Flat as F
32−import GHC.TypeLits
33−import Test.QuickCheck
34−import Web.HttpApiData
35−import Web.PathPieces (PathPiece(..))
51+#endif
52+#ifdef USE_STORE
53+import qualified Data.Store
54+#endif
3655
3756newtype Id t = Id { unId :: UUID }
3857 deriving stock Data
3958 deriving newtype
4059 ( Eq, Ord, Binary
4160#ifndef ghcjs_HOST_OS
61+#ifdef USE_POSTGRES
4262 , PG.ToField, PG.FromField
4363#endif
44− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
45− , ToParamSchema, FromHttpApiData, ToHttpApiData )
64+#endif
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66+#ifdef BACKEND
67+ , ToSchema, ToParamSchema
68+#endif
69+ , FromHttpApiData, ToHttpApiData )
4670
4771type role Id nominal
4872
@@ -52,20 +76,42 @@ mkId :: forall s. UUID -> Id s
5276mkId = coerce
5377{-# INLINE mkId #-}
5478
79+#ifdef USE_UUID
80+randomId :: forall s. IO (Id s)
81+randomId = coerce <$> UUID.V4.nextRandom
82+{-# INLINE randomId #-}
83+#endif
84+
5585instance KnownSymbol s => Show (Id s) where
56− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
87+
88+instance KnownSymbol s => Read (Id s) where
89+ readsPrec _ = readP_to_S $ do
90+ _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
91+ mkId <$> readS_to_P reads
5792
93+#ifdef USE_FLAT
5894instance Flat (Id s) where
5995 encode = F.encode . UUID.toWords . coerce
6096 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
6197 size = F.size . UUID.toWords . coerce
98+#endif
99+
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
62106
107+#ifdef BACKEND
63108instance Arbitrary (Id t) where
64109 arbitrary = fmap Id $ UUID.fromWords
65110 <$> arbitrary
66111 <*> arbitrary
67112 <*> arbitrary
68113 <*> arbitrary
114+#endif
69115
70116instance PathPiece (Id t) where
71117 fromPathPiece = coerce . UUID.fromText
@@ -73,12 +119,14 @@ instance PathPiece (Id t) where
73119
74120#ifndef ghcjs_HOST_OS
75121
122+#ifdef USE_CASSAVA
76123instance Csv.FromField (Id tag) where
77124 parseField = parseField
78125 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
79126
80127instance Csv.ToField (Id tag) where
81128 toField = Csv.toField . UUID.toText . coerce
129+#endif
82130
83131#endif
84132
@@ -105,11 +153,24 @@ newtype IntId t = IntId { unIntId :: Integer }
105153 deriving newtype
106154 ( Eq, Ord, Binary
107155#ifndef ghcjs_HOST_OS
108− , 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
109165#endif
110− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
111− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
112− , Num, Integral, Real, Enum )
166+#ifdef USE_STORE
167+ , Data.Store.Store
168+#endif
169+#ifdef BACKEND
170+ , ToSchema, ToParamSchema, Arbitrary
171+#endif
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
113174
114175type role IntId nominal
115176
@@ -120,7 +181,12 @@ mkIntId = coerce
120181{-# INLINE mkIntId #-}
121182
122183instance KnownSymbol s => Show (IntId s) where
123− 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
124190
125191-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
126192-- You are forced to explicitly specify the phantom types you are converting
@@ -138,11 +204,24 @@ newtype Name t = Name { unName :: Text }
138204 deriving newtype
139205 ( Eq, Ord, Binary
140206#ifndef ghcjs_HOST_OS
141− , 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
142213#endif
143− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
144− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
145− , 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 )
146225
147226type role Name nominal
148227
@@ -153,10 +232,17 @@ mkName = coerce
153232{-# INLINE mkName #-}
154233
155234instance KnownSymbol s => Show (Name s) where
156− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
157236
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
158243instance Arbitrary (Name s) where
159244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
160246
161247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
162248-- You are forced to explicitly specify the phantom types you are converting