@@ -4,35 +4,39 @@
44{-# OPTIONS_GHC -Wno-orphans #-}
55
66module Data.Id
7− ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, nilId
8− , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId
9− , Name, mkName, unName, unsafeNameTagConvert, coerceName
10−#ifdef USE_LENS
11− , _Id, _IntId, _Name
7+ ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
8+ , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
9+ , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
10+#ifdef USE_UUID
11+ , randomId
1212#endif
1313 )
1414 where
1515
1616import Control.DeepSeq (NFData)
17−#ifdef USE_LENS
1817import Control.Lens
19−#endif
2018import Control.Monad
2119import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
2220import Data.Binary (Binary)
2321import Data.Coerce (coerce)
2422import Data.Data
2523import Data.Hashable (Hashable)
26−import Data.Int (Int64)
27−#ifdef USE_OPENAPI
28−import Data.OpenApi
29−#endif
3024import Data.String
3125import Data.Text as T
32−import Data.UUID (UUID)
33−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
3435import qualified Data.UUID.V4 as UUID.V4
35−#ifndef ghcjs_HOST_OS
36+#endif
37+#ifdef BACKEND
38+import Data.OpenApi
39+import Test.QuickCheck
3640#ifdef USE_CASSAVA
3741import Data.Csv as Csv hiding(Name)
3842#endif
@@ -41,20 +45,13 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
4145import Database.PostgreSQL.Simple.ToField as PG (ToField)
4246#endif
4347#endif
44−import GHC.TypeLits
45−import Test.QuickCheck
46−import Text.ParserCombinators.ReadP
47−import Web.HttpApiData
48−import Web.PathPieces (PathPiece(..))
48+
4949#ifdef USE_FLAT
5050import Flat as F
5151#endif
5252#ifdef USE_STORE
5353import qualified Data.Store
5454#endif
55−#ifdef USE_REL8
56−import Rel8 (DBType(..))
57−#endif
5855
5956newtype Id t = Id { unId :: UUID }
6057 deriving stock Data
@@ -64,28 +61,29 @@ newtype Id t = Id { unId :: UUID }
6461#ifdef USE_POSTGRES
6562 , PG.ToField, PG.FromField
6663#endif
67−#ifdef USE_REL8
68− , DBType
69−#endif
7064#endif
7165 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
72−#ifdef USE_OPENAPI
66+#ifdef BACKEND
7367 , ToSchema, ToParamSchema
7468#endif
7569 , FromHttpApiData, ToHttpApiData )
7670
7771type role Id nominal
7872
73+makePrisms ''Id
74+
7975mkId :: forall s. UUID -> Id s
8076mkId = coerce
8177{-# INLINE mkId #-}
8278
79+#ifdef USE_UUID
8380randomId :: forall s. IO (Id s)
8481randomId = coerce <$> UUID.V4.nextRandom
8582{-# INLINE randomId #-}
83+#endif
8684
8785instance KnownSymbol s => Show (Id s) where
88− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
8987
9088instance KnownSymbol s => Read (Id s) where
9189 readsPrec _ = readP_to_S $ do
@@ -106,12 +104,14 @@ instance Data.Store.Store (Id s) where
106104 size = Data.Store.ConstSize 16
107105#endif
108106
107+#ifdef BACKEND
109108instance Arbitrary (Id t) where
110109 arbitrary = fmap Id $ UUID.fromWords
111110 <$> arbitrary
112111 <*> arbitrary
113112 <*> arbitrary
114113 <*> arbitrary
114+#endif
115115
116116instance PathPiece (Id t) where
117117 fromPathPiece = coerce . UUID.fromText
@@ -148,7 +148,7 @@ type family Ambiguous (a :: k) :: j where
148148 Ambiguous x = x
149149
150150----------------- IntId
151−newtype IntId t = IntId Int64
151+newtype IntId t = IntId { unIntId :: Integer }
152152 deriving stock Data
153153 deriving newtype
154154 ( Eq, Ord, Binary
@@ -159,35 +159,29 @@ newtype IntId t = IntId Int64
159159#ifdef USE_CASSAVA
160160 , Csv.ToField, Csv.FromField
161161#endif
162+#endif
162163#ifdef USE_FLAT
163164 , Flat
164165#endif
165166#ifdef USE_STORE
166167 , Data.Store.Store
167168#endif
168−#ifdef USE_REL8
169− , DBType
169+#ifdef BACKEND
170+ , ToSchema, ToParamSchema, Arbitrary
170171#endif
171−#endif
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
173−#ifdef USE_OPENAPI
174− , ToSchema, ToParamSchema
175−#endif
176− , FromHttpApiData, ToHttpApiData, PathPiece, Arbitrary
177− , Num, Integral, Real, Enum )
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
178174
179175type role IntId nominal
180176
177+makePrisms ''IntId
178+
181179mkIntId :: forall s. Integer -> IntId s
182−mkIntId = fromInteger
180+mkIntId = coerce
183181{-# INLINE mkIntId #-}
184182
185−unIntId :: IntId s -> Integer
186−unIntId (IntId i) = fromIntegral i
187−{-# INLINE unIntId #-}
188−
189183instance KnownSymbol s => Show (IntId s) where
190− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
184+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
191185
192186instance KnownSymbol s => Read (IntId s) where
193187 readsPrec _ = readP_to_S $ do
@@ -216,39 +210,39 @@ newtype Name t = Name { unName :: Text }
216210#ifdef USE_CASSAVA
217211 , Csv.ToField, Csv.FromField
218212#endif
213+#endif
219214#ifdef USE_FLAT
220215 , Flat
221216#endif
222217#ifdef USE_STORE
223218 , Data.Store.Store
224219#endif
225−#ifdef USE_REL8
226− , DBType
227−#endif
228−#endif
229− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
230−#ifdef USE_OPENAPI
220+#ifdef BACKEND
231221 , ToSchema, ToParamSchema
232222#endif
233− , FromHttpApiData, ToHttpApiData, PathPiece
234− , IsString, Semigroup, Monoid )
223+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
224+ , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
235225
236226type role Name nominal
237227
228+makePrisms ''Name
229+
238230mkName :: forall s. Text -> Name s
239231mkName = coerce
240232{-# INLINE mkName #-}
241233
242234instance KnownSymbol s => Show (Name s) where
243− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
244236
245237instance KnownSymbol s => Read (Name s) where
246238 readsPrec _ = readP_to_S $ do
247239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
248240 mkName <$> readS_to_P reads
249241
242+#ifdef BACKEND
250243instance Arbitrary (Name s) where
251244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245+#endif
252246
253247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
254248-- You are forced to explicitly specify the phantom types you are converting
@@ -259,9 +253,3 @@ coerceName = coerce
259253{-# INLINE coerceName #-}
260254unsafeNameTagConvert = coerce
261255{-# INLINE unsafeNameTagConvert #-}
262−
263−#ifdef USE_LENS
264−makePrisms ''Id
265−makePrisms ''IntId
266−makePrisms ''Name
267−#endif