@@ -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,24 +21,31 @@ 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+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
2635import qualified Data.UUID.V4 as UUID.V4
27−#ifndef ghcjs_HOST_OS
36+#endif
37+#ifdef BACKEND
38+import Data.OpenApi
39+import Test.QuickCheck
40+#ifdef USE_CASSAVA
2841import Data.Csv as Csv hiding(Name)
42+#endif
2943#ifdef USE_POSTGRES
3044import Database.PostgreSQL.Simple.FromField as PG (FromField)
3145import Database.PostgreSQL.Simple.ToField as PG (ToField)
3246#endif
3347#endif
34−import GHC.TypeLits
35−import Test.QuickCheck
36−import Text.ParserCombinators.ReadP
37−import Web.HttpApiData
38−import Web.PathPieces (PathPiece(..))
48+
3949#ifdef USE_FLAT
4050import Flat as F
4151#endif
@@ -52,8 +62,11 @@ newtype Id t = Id { unId :: UUID }
5262 , PG.ToField, PG.FromField
5363#endif
5464#endif
55− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
56− , ToParamSchema, FromHttpApiData, ToHttpApiData )
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66+#ifdef BACKEND
67+ , ToSchema, ToParamSchema
68+#endif
69+ , FromHttpApiData, ToHttpApiData )
5770
5871type role Id nominal
5972
@@ -63,12 +76,14 @@ mkId :: forall s. UUID -> Id s
6376mkId = coerce
6477{-# INLINE mkId #-}
6578
79+#ifdef USE_UUID
6680randomId :: forall s. IO (Id s)
6781randomId = coerce <$> UUID.V4.nextRandom
6882{-# INLINE randomId #-}
83+#endif
6984
7085instance KnownSymbol s => Show (Id s) where
71− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
7287
7388instance KnownSymbol s => Read (Id s) where
7489 readsPrec _ = readP_to_S $ do
@@ -89,12 +104,14 @@ instance Data.Store.Store (Id s) where
89104 size = Data.Store.ConstSize 16
90105#endif
91106
107+#ifdef BACKEND
92108instance Arbitrary (Id t) where
93109 arbitrary = fmap Id $ UUID.fromWords
94110 <$> arbitrary
95111 <*> arbitrary
96112 <*> arbitrary
97113 <*> arbitrary
114+#endif
98115
99116instance PathPiece (Id t) where
100117 fromPathPiece = coerce . UUID.fromText
@@ -102,12 +119,14 @@ instance PathPiece (Id t) where
102119
103120#ifndef ghcjs_HOST_OS
104121
122+#ifdef USE_CASSAVA
105123instance Csv.FromField (Id tag) where
106124 parseField = parseField
107125 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
108126
109127instance Csv.ToField (Id tag) where
110128 toField = Csv.toField . UUID.toText . coerce
129+#endif
111130
112131#endif
113132
@@ -135,12 +154,23 @@ newtype IntId t = IntId { unIntId :: Integer }
135154 ( Eq, Ord, Binary
136155#ifndef ghcjs_HOST_OS
137156#ifdef USE_POSTGRES
138− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
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
139168#endif
169+#ifdef BACKEND
170+ , ToSchema, ToParamSchema, Arbitrary
140171#endif
141− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
142− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
143− , Num, Integral, Real, Enum )
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
144174
145175type role IntId nominal
146176
@@ -151,7 +181,7 @@ mkIntId = coerce
151181{-# INLINE mkIntId #-}
152182
153183instance KnownSymbol s => Show (IntId s) where
154− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
184+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
155185
156186instance KnownSymbol s => Read (IntId s) where
157187 readsPrec _ = readP_to_S $ do
@@ -175,12 +205,23 @@ newtype Name t = Name { unName :: Text }
175205 ( Eq, Ord, Binary
176206#ifndef ghcjs_HOST_OS
177207#ifdef USE_POSTGRES
178− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
208+ , PG.ToField, PG.FromField
209+#endif
210+#ifdef USE_CASSAVA
211+ , Csv.ToField, Csv.FromField
179212#endif
180213#endif
181− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
182− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
183− , 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 )
184225
185226type role Name nominal
186227
@@ -191,15 +232,17 @@ mkName = coerce
191232{-# INLINE mkName #-}
192233
193234instance KnownSymbol s => Show (Name s) where
194− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
195236
196237instance KnownSymbol s => Read (Name s) where
197238 readsPrec _ = readP_to_S $ do
198239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
199240 mkName <$> readS_to_P reads
200241
242+#ifdef BACKEND
201243instance Arbitrary (Name s) where
202244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
203246
204247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
205248-- You are forced to explicitly specify the phantom types you are converting