@@ -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,22 +18,14 @@ import Data.Binary (Binary)
2118import Data.Coerce (coerce)
2219import Data.Data
2320import Data.Hashable (Hashable)
21+import Data.Int (Int64)
22+import Data.OpenApi
2423import Data.String
2524import 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
25+import Data.UUID (UUID)
26+import qualified Data.UUID as UUID
3527import qualified Data.UUID.V4 as UUID.V4
36−#endif
37−#ifdef BACKEND
38−import Data.OpenApi
39−import Test.QuickCheck
28+#ifndef ghcjs_HOST_OS
4029#ifdef USE_CASSAVA
4130import Data.Csv as Csv hiding(Name)
4231#endif
@@ -45,13 +34,20 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
4534import Database.PostgreSQL.Simple.ToField as PG (ToField)
4635#endif
4736#endif
48−
37+import GHC.TypeLits
38+import Test.QuickCheck
39+import Text.ParserCombinators.ReadP
40+import Web.HttpApiData
41+import Web.PathPieces (PathPiece(..))
4942#ifdef USE_FLAT
5043import Flat as F
5144#endif
5245#ifdef USE_STORE
5346import qualified Data.Store
5447#endif
48+#ifdef USE_REL8
49+import Rel8 (DBType(..))
50+#endif
5551
5652newtype Id t = Id { unId :: UUID }
5753 deriving stock Data
@@ -61,12 +57,12 @@ newtype Id t = Id { unId :: UUID }
6157#ifdef USE_POSTGRES
6258 , PG.ToField, PG.FromField
6359#endif
60+#ifdef USE_REL8
61+ , DBType
6462#endif
65− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66−#ifdef BACKEND
67− , ToSchema, ToParamSchema
6863#endif
69− , FromHttpApiData, ToHttpApiData )
64+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
65+ , ToParamSchema, FromHttpApiData, ToHttpApiData )
7066
7167type role Id nominal
7268
@@ -76,14 +72,12 @@ mkId :: forall s. UUID -> Id s
7672mkId = coerce
7773{-# INLINE mkId #-}
7874
79−#ifdef USE_UUID
8075randomId :: forall s. IO (Id s)
8176randomId = coerce <$> UUID.V4.nextRandom
8277{-# INLINE randomId #-}
83−#endif
8478
8579instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
80+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
8781
8882instance KnownSymbol s => Read (Id s) where
8983 readsPrec _ = readP_to_S $ do
@@ -104,14 +98,12 @@ instance Data.Store.Store (Id s) where
10498 size = Data.Store.ConstSize 16
10599#endif
106100
107−#ifdef BACKEND
108101instance Arbitrary (Id t) where
109102 arbitrary = fmap Id $ UUID.fromWords
110103 <$> arbitrary
111104 <*> arbitrary
112105 <*> arbitrary
113106 <*> arbitrary
114−#endif
115107
116108instance PathPiece (Id t) where
117109 fromPathPiece = coerce . UUID.fromText
@@ -148,7 +140,7 @@ type family Ambiguous (a :: k) :: j where
148140 Ambiguous x = x
149141
150142----------------- IntId
151−newtype IntId t = IntId { unIntId :: Integer }
143+newtype IntId t = IntId { unIntId :: Int64 }
152144 deriving stock Data
153145 deriving newtype
154146 ( Eq, Ord, Binary
@@ -159,29 +151,30 @@ newtype IntId t = IntId { unIntId :: Integer }
159151#ifdef USE_CASSAVA
160152 , Csv.ToField, Csv.FromField
161153#endif
162−#endif
163154#ifdef USE_FLAT
164155 , Flat
165156#endif
166157#ifdef USE_STORE
167158 , Data.Store.Store
168159#endif
169−#ifdef BACKEND
170− , ToSchema, ToParamSchema, Arbitrary
160+#ifdef USE_REL8
161+ , DBType
162+#endif
171163#endif
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
164+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
165+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Arbitrary
166+ , Num, Integral, Real, Enum )
174167
175168type role IntId nominal
176169
177170makePrisms ''IntId
178171
179172mkIntId :: forall s. Integer -> IntId s
180−mkIntId = coerce
173+mkIntId = fromInteger
181174{-# INLINE mkIntId #-}
182175
183176instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
177+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
185178
186179instance KnownSymbol s => Read (IntId s) where
187180 readsPrec _ = readP_to_S $ do
@@ -210,18 +203,19 @@ newtype Name t = Name { unName :: Text }
210203#ifdef USE_CASSAVA
211204 , Csv.ToField, Csv.FromField
212205#endif
213−#endif
214206#ifdef USE_FLAT
215207 , Flat
216208#endif
217209#ifdef USE_STORE
218210 , Data.Store.Store
219211#endif
220−#ifdef BACKEND
221− , ToSchema, ToParamSchema
212+#ifdef USE_REL8
213+ , DBType
214+#endif
222215#endif
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
216+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
217+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece
218+ , IsString, Semigroup, Monoid )
225219
226220type role Name nominal
227221
@@ -232,17 +226,15 @@ mkName = coerce
232226{-# INLINE mkName #-}
233227
234228instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
229+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
236230
237231instance KnownSymbol s => Read (Name s) where
238232 readsPrec _ = readP_to_S $ do
239233 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240234 mkName <$> readS_to_P reads
241235
242−#ifdef BACKEND
243236instance Arbitrary (Name s) where
244237 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245−#endif
246238
247239-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248240-- You are forced to explicitly specify the phantom types you are converting