@@ -7,9 +7,6 @@ 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
1310 )
1411 where
1512
@@ -21,52 +18,32 @@ import Data.Binary (Binary)
2118import Data.Coerce (coerce)
2219import Data.Data
2320import Data.Hashable (Hashable)
21+import Data.OpenApi
2422import Data.String
2523import Data.Text as T
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
24+import Data.UUID (UUID)
25+import qualified Data.UUID as UUID
26+#ifndef ghcjs_HOST_OS
4427import Database.PostgreSQL.Simple.FromField as PG (FromField)
4528import Database.PostgreSQL.Simple.ToField as PG (ToField)
29+import Data.Csv as Csv hiding(Name)
4630#endif
47−#endif
48−
49−#ifdef USE_FLAT
5031import Flat as F
51−#endif
52−#ifdef USE_STORE
53−import qualified Data.Store
54−#endif
32+import GHC.TypeLits
33+import Test.QuickCheck
34+import Text.ParserCombinators.ReadP
35+import Web.HttpApiData
36+import Web.PathPieces (PathPiece(..))
5537
5638newtype Id t = Id { unId :: UUID }
5739 deriving stock Data
5840 deriving newtype
5941 ( Eq, Ord, Binary
6042#ifndef ghcjs_HOST_OS
61−#ifdef USE_POSTGRES
6243 , PG.ToField, PG.FromField
6344#endif
64−#endif
65− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66−#ifdef BACKEND
67− , ToSchema, ToParamSchema
68−#endif
69− , FromHttpApiData, ToHttpApiData )
45+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
46+ , ToParamSchema, FromHttpApiData, ToHttpApiData )
7047
7148type role Id nominal
7249
@@ -76,42 +53,25 @@ mkId :: forall s. UUID -> Id s
7653mkId = coerce
7754{-# INLINE mkId #-}
7855
79−#ifdef USE_UUID
80−randomId :: forall s. IO (Id s)
81−randomId = coerce <$> UUID.V4.nextRandom
82−{-# INLINE randomId #-}
83−#endif
84−
8556instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
57+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
8758
8859instance KnownSymbol s => Read (Id s) where
8960 readsPrec _ = readP_to_S $ do
9061 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
9162 mkId <$> readS_to_P reads
9263
93−#ifdef USE_FLAT
9464instance Flat (Id s) where
9565 encode = F.encode . UUID.toWords . coerce
9666 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
9767 size = F.size . UUID.toWords . coerce
98−#endif
9968
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
10869instance Arbitrary (Id t) where
10970 arbitrary = fmap Id $ UUID.fromWords
11071 <$> arbitrary
11172 <*> arbitrary
11273 <*> arbitrary
11374 <*> arbitrary
114−#endif
11575
11676instance PathPiece (Id t) where
11777 fromPathPiece = coerce . UUID.fromText
@@ -119,14 +79,12 @@ instance PathPiece (Id t) where
11979
12080#ifndef ghcjs_HOST_OS
12181
122−#ifdef USE_CASSAVA
12382instance Csv.FromField (Id tag) where
12483 parseField = parseField
12584 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
12685
12786instance Csv.ToField (Id tag) where
12887 toField = Csv.toField . UUID.toText . coerce
129−#endif
13088
13189#endif
13290
@@ -153,24 +111,11 @@ newtype IntId t = IntId { unIntId :: Integer }
153111 deriving newtype
154112 ( Eq, Ord, Binary
155113#ifndef ghcjs_HOST_OS
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
114+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
168115#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 )
116+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
117+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
118+ , Num, Integral, Real, Enum )
174119
175120type role IntId nominal
176121
@@ -181,12 +126,7 @@ mkIntId = coerce
181126{-# INLINE mkIntId #-}
182127
183128instance KnownSymbol s => Show (IntId s) where
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
129+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
190130
191131-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
192132-- You are forced to explicitly specify the phantom types you are converting
@@ -204,24 +144,11 @@ newtype Name t = Name { unName :: Text }
204144 deriving newtype
205145 ( Eq, Ord, Binary
206146#ifndef ghcjs_HOST_OS
207−#ifdef USE_POSTGRES
208− , PG.ToField, PG.FromField
209−#endif
210−#ifdef USE_CASSAVA
211− , Csv.ToField, Csv.FromField
212−#endif
147+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
213148#endif
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 )
149+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
150+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
151+ , IsString, Semigroup, Monoid )
225152
226153type role Name nominal
227154
@@ -232,17 +159,10 @@ mkName = coerce
232159{-# INLINE mkName #-}
233160
234161instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
162+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
236163
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
243164instance Arbitrary (Name s) where
244165 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245−#endif
246166
247167-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248168-- You are forced to explicitly specify the phantom types you are converting