@@ -4,9 +4,12 @@
44{-# OPTIONS_GHC -Wno-orphans #-}
55
66module Data.Id
7− ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( 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,14 +21,22 @@ import Data.Binary (Binary)
1821import Data.Coerce (coerce)
1922import Data.Data
2023import Data.Hashable (Hashable)
21−import Data.Int (Int64)
22−import Data.OpenApi
2324import Data.String
2425import Data.Text as T
25−import Data.UUID (UUID)
26−import qualified Data.UUID as UUID
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
2735import qualified Data.UUID.V4 as UUID.V4
28−#ifndef ghcjs_HOST_OS
36+#endif
37+#ifdef BACKEND
38+import Data.OpenApi
39+import Test.QuickCheck
2940#ifdef USE_CASSAVA
3041import Data.Csv as Csv hiding(Name)
3142#endif
@@ -34,20 +45,13 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
3445import Database.PostgreSQL.Simple.ToField as PG (ToField)
3546#endif
3647#endif
37−import GHC.TypeLits
38−import Test.QuickCheck
39−import Text.ParserCombinators.ReadP
40−import Web.HttpApiData
41−import Web.PathPieces (PathPiece(..))
48+
4249#ifdef USE_FLAT
4350import Flat as F
4451#endif
4552#ifdef USE_STORE
4653import qualified Data.Store
4754#endif
48−#ifdef USE_REL8
49−import Rel8 (DBType(..))
50−#endif
5155
5256newtype Id t = Id { unId :: UUID }
5357 deriving stock Data
@@ -57,12 +61,12 @@ newtype Id t = Id { unId :: UUID }
5761#ifdef USE_POSTGRES
5862 , PG.ToField, PG.FromField
5963#endif
60−#ifdef USE_REL8
61− , DBType
6264#endif
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66+#ifdef BACKEND
67+ , ToSchema, ToParamSchema
6368#endif
64− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
65− , ToParamSchema, FromHttpApiData, ToHttpApiData )
69+ , FromHttpApiData, ToHttpApiData )
6670
6771type role Id nominal
6872
@@ -72,12 +76,14 @@ mkId :: forall s. UUID -> Id s
7276mkId = coerce
7377{-# INLINE mkId #-}
7478
79+#ifdef USE_UUID
7580randomId :: forall s. IO (Id s)
7681randomId = coerce <$> UUID.V4.nextRandom
7782{-# INLINE randomId #-}
83+#endif
7884
7985instance KnownSymbol s => Show (Id s) where
80− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
8187
8288instance KnownSymbol s => Read (Id s) where
8389 readsPrec _ = readP_to_S $ do
@@ -98,12 +104,14 @@ instance Data.Store.Store (Id s) where
98104 size = Data.Store.ConstSize 16
99105#endif
100106
107+#ifdef BACKEND
101108instance Arbitrary (Id t) where
102109 arbitrary = fmap Id $ UUID.fromWords
103110 <$> arbitrary
104111 <*> arbitrary
105112 <*> arbitrary
106113 <*> arbitrary
114+#endif
107115
108116instance PathPiece (Id t) where
109117 fromPathPiece = coerce . UUID.fromText
@@ -140,7 +148,7 @@ type family Ambiguous (a :: k) :: j where
140148 Ambiguous x = x
141149
142150----------------- IntId
143−newtype IntId t = IntId { unIntId :: Int64 }
151+newtype IntId t = IntId { unIntId :: Integer }
144152 deriving stock Data
145153 deriving newtype
146154 ( Eq, Ord, Binary
@@ -151,30 +159,29 @@ newtype IntId t = IntId { unIntId :: Int64 }
151159#ifdef USE_CASSAVA
152160 , Csv.ToField, Csv.FromField
153161#endif
162+#endif
154163#ifdef USE_FLAT
155164 , Flat
156165#endif
157166#ifdef USE_STORE
158167 , Data.Store.Store
159168#endif
160−#ifdef USE_REL8
161− , DBType
162−#endif
169+#ifdef BACKEND
170+ , ToSchema, ToParamSchema, Arbitrary
163171#endif
164− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
165− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Arbitrary
166− , Num, Integral, Real, Enum )
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
167174
168175type role IntId nominal
169176
170177makePrisms ''IntId
171178
172179mkIntId :: forall s. Integer -> IntId s
173−mkIntId = fromInteger
180+mkIntId = coerce
174181{-# INLINE mkIntId #-}
175182
176183instance KnownSymbol s => Show (IntId s) where
177− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
184+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
178185
179186instance KnownSymbol s => Read (IntId s) where
180187 readsPrec _ = readP_to_S $ do
@@ -203,19 +210,18 @@ newtype Name t = Name { unName :: Text }
203210#ifdef USE_CASSAVA
204211 , Csv.ToField, Csv.FromField
205212#endif
213+#endif
206214#ifdef USE_FLAT
207215 , Flat
208216#endif
209217#ifdef USE_STORE
210218 , Data.Store.Store
211219#endif
212−#ifdef USE_REL8
213− , DBType
214−#endif
220+#ifdef BACKEND
221+ , ToSchema, ToParamSchema
215222#endif
216− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
217− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece
218− , IsString, Semigroup, Monoid )
223+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
224+ , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
219225
220226type role Name nominal
221227
@@ -226,15 +232,17 @@ mkName = coerce
226232{-# INLINE mkName #-}
227233
228234instance KnownSymbol s => Show (Name s) where
229− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
230236
231237instance KnownSymbol s => Read (Name s) where
232238 readsPrec _ = readP_to_S $ do
233239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
234240 mkName <$> readS_to_P reads
235241
242+#ifdef BACKEND
236243instance Arbitrary (Name s) where
237244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
238246
239247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
240248-- You are forced to explicitly specify the phantom types you are converting