@@ -4,12 +4,9 @@
44{-# OPTIONS_GHC -Wno-orphans #-}
55
66module Data.Id
7− ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( Id, mkId, unId, randomId, 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,31 +18,24 @@ 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
24+import Data.UUID (UUID)
25+import qualified Data.UUID as UUID
3526import qualified Data.UUID.V4 as UUID.V4
36−#endif
37−#ifdef BACKEND
38−import Data.OpenApi
39−import Test.QuickCheck
40−#ifdef USE_CASSAVA
27+#ifndef ghcjs_HOST_OS
4128import Data.Csv as Csv hiding(Name)
42−#endif
4329#ifdef USE_POSTGRES
4430import Database.PostgreSQL.Simple.FromField as PG (FromField)
4531import Database.PostgreSQL.Simple.ToField as PG (ToField)
4632#endif
4733#endif
48−
34+import GHC.TypeLits
35+import Test.QuickCheck
36+import Text.ParserCombinators.ReadP
37+import Web.HttpApiData
38+import Web.PathPieces (PathPiece(..))
4939#ifdef USE_FLAT
5040import Flat as F
5141#endif
@@ -62,11 +52,8 @@ newtype Id t = Id { unId :: UUID }
6252 , PG.ToField, PG.FromField
6353#endif
6454#endif
65− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66−#ifdef BACKEND
67− , ToSchema, ToParamSchema
68−#endif
69− , FromHttpApiData, ToHttpApiData )
55+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
56+ , ToParamSchema, FromHttpApiData, ToHttpApiData )
7057
7158type role Id nominal
7259
@@ -76,14 +63,12 @@ mkId :: forall s. UUID -> Id s
7663mkId = coerce
7764{-# INLINE mkId #-}
7865
79−#ifdef USE_UUID
8066randomId :: forall s. IO (Id s)
8167randomId = coerce <$> UUID.V4.nextRandom
8268{-# INLINE randomId #-}
83−#endif
8469
8570instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
71+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
8772
8873instance KnownSymbol s => Read (Id s) where
8974 readsPrec _ = readP_to_S $ do
@@ -104,14 +89,12 @@ instance Data.Store.Store (Id s) where
10489 size = Data.Store.ConstSize 16
10590#endif
10691
107−#ifdef BACKEND
10892instance Arbitrary (Id t) where
10993 arbitrary = fmap Id $ UUID.fromWords
11094 <$> arbitrary
11195 <*> arbitrary
11296 <*> arbitrary
11397 <*> arbitrary
114−#endif
11598
11699instance PathPiece (Id t) where
117100 fromPathPiece = coerce . UUID.fromText
@@ -119,14 +102,12 @@ instance PathPiece (Id t) where
119102
120103#ifndef ghcjs_HOST_OS
121104
122−#ifdef USE_CASSAVA
123105instance Csv.FromField (Id tag) where
124106 parseField = parseField
125107 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
126108
127109instance Csv.ToField (Id tag) where
128110 toField = Csv.toField . UUID.toText . coerce
129−#endif
130111
131112#endif
132113
@@ -154,23 +135,12 @@ newtype IntId t = IntId { unIntId :: Integer }
154135 ( Eq, Ord, Binary
155136#ifndef ghcjs_HOST_OS
156137#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
138+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
168139#endif
169−#ifdef BACKEND
170− , ToSchema, ToParamSchema, Arbitrary
171140#endif
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
141+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
142+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
143+ , Num, Integral, Real, Enum )
174144
175145type role IntId nominal
176146
@@ -181,7 +151,7 @@ mkIntId = coerce
181151{-# INLINE mkIntId #-}
182152
183153instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
154+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
185155
186156instance KnownSymbol s => Read (IntId s) where
187157 readsPrec _ = readP_to_S $ do
@@ -205,23 +175,12 @@ newtype Name t = Name { unName :: Text }
205175 ( Eq, Ord, Binary
206176#ifndef ghcjs_HOST_OS
207177#ifdef USE_POSTGRES
208− , PG.ToField, PG.FromField
209−#endif
210−#ifdef USE_CASSAVA
211− , Csv.ToField, Csv.FromField
178+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
212179#endif
213180#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 )
181+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
182+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
183+ , IsString, Semigroup, Monoid )
225184
226185type role Name nominal
227186
@@ -232,17 +191,15 @@ mkName = coerce
232191{-# INLINE mkName #-}
233192
234193instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
194+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
236195
237196instance KnownSymbol s => Read (Name s) where
238197 readsPrec _ = readP_to_S $ do
239198 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240199 mkName <$> readS_to_P reads
241200
242−#ifdef BACKEND
243201instance Arbitrary (Name s) where
244202 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245−#endif
246203
247204-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248205-- You are forced to explicitly specify the phantom types you are converting