@@ -4,39 +4,35 @@
44{-# OPTIONS_GHC -Wno-orphans #-}
55
66module Data.Id
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
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
1212#endif
1313 )
1414 where
1515
1616import Control.DeepSeq (NFData)
17+#ifdef USE_LENS
1718import Control.Lens
19+#endif
1820import Control.Monad
1921import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
2022import Data.Binary (Binary)
2123import Data.Coerce (coerce)
2224import Data.Data
2325import Data.Hashable (Hashable)
26+import Data.Int (Int64)
27+#ifdef USE_OPENAPI
28+import Data.OpenApi
29+#endif
2430import Data.String
2531import 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
32+import Data.UUID (UUID)
33+import qualified Data.UUID as UUID
3534import qualified Data.UUID.V4 as UUID.V4
36−#endif
37−#ifdef BACKEND
38−import Data.OpenApi
39−import Test.QuickCheck
35+#ifndef ghcjs_HOST_OS
4036#ifdef USE_CASSAVA
4137import Data.Csv as Csv hiding(Name)
4238#endif
@@ -45,13 +41,20 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
4541import Database.PostgreSQL.Simple.ToField as PG (ToField)
4642#endif
4743#endif
48−
44+import GHC.TypeLits
45+import Test.QuickCheck
46+import Text.ParserCombinators.ReadP
47+import Web.HttpApiData
48+import Web.PathPieces (PathPiece(..))
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
5558
5659newtype Id t = Id { unId :: UUID }
5760 deriving stock Data
@@ -61,29 +64,28 @@ newtype Id t = Id { unId :: UUID }
6164#ifdef USE_POSTGRES
6265 , PG.ToField, PG.FromField
6366#endif
67+#ifdef USE_REL8
68+ , DBType
69+#endif
6470#endif
6571 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66−#ifdef BACKEND
72+#ifdef USE_OPENAPI
6773 , ToSchema, ToParamSchema
6874#endif
6975 , FromHttpApiData, ToHttpApiData )
7076
7177type role Id nominal
7278
73−makePrisms ''Id
74−
7579mkId :: forall s. UUID -> Id s
7680mkId = coerce
7781{-# INLINE mkId #-}
7882
79−#ifdef USE_UUID
8083randomId :: forall s. IO (Id s)
8184randomId = coerce <$> UUID.V4.nextRandom
8285{-# INLINE randomId #-}
83−#endif
8486
8587instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
88+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
8789
8890instance KnownSymbol s => Read (Id s) where
8991 readsPrec _ = readP_to_S $ do
@@ -104,14 +106,12 @@ instance Data.Store.Store (Id s) where
104106 size = Data.Store.ConstSize 16
105107#endif
106108
107−#ifdef BACKEND
108109instance Arbitrary (Id t) where
109110 arbitrary = fmap Id $ UUID.fromWords
110111 <$> arbitrary
111112 <*> arbitrary
112113 <*> arbitrary
113114 <*> 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 { unIntId :: Integer }
151+newtype IntId t = IntId { unIntId :: Int64 }
152152 deriving stock Data
153153 deriving newtype
154154 ( Eq, Ord, Binary
@@ -159,29 +159,31 @@ newtype IntId t = IntId { unIntId :: Integer }
159159#ifdef USE_CASSAVA
160160 , Csv.ToField, Csv.FromField
161161#endif
162−#endif
163162#ifdef USE_FLAT
164163 , Flat
165164#endif
166165#ifdef USE_STORE
167166 , Data.Store.Store
168167#endif
169−#ifdef BACKEND
170− , ToSchema, ToParamSchema, Arbitrary
168+#ifdef USE_REL8
169+ , DBType
171170#endif
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
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 )
174178
175179type role IntId nominal
176180
177−makePrisms ''IntId
178−
179181mkIntId :: forall s. Integer -> IntId s
180−mkIntId = coerce
182+mkIntId = fromInteger
181183{-# INLINE mkIntId #-}
182184
183185instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
186+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
185187
186188instance KnownSymbol s => Read (IntId s) where
187189 readsPrec _ = readP_to_S $ do
@@ -210,39 +212,39 @@ newtype Name t = Name { unName :: Text }
210212#ifdef USE_CASSAVA
211213 , Csv.ToField, Csv.FromField
212214#endif
213−#endif
214215#ifdef USE_FLAT
215216 , Flat
216217#endif
217218#ifdef USE_STORE
218219 , Data.Store.Store
219220#endif
220−#ifdef BACKEND
221+#ifdef USE_REL8
222+ , DBType
223+#endif
224+#endif
225+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
226+#ifdef USE_OPENAPI
221227 , ToSchema, ToParamSchema
222228#endif
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
229+ , FromHttpApiData, ToHttpApiData, PathPiece
230+ , IsString, Semigroup, Monoid )
225231
226232type role Name nominal
227233
228−makePrisms ''Name
229−
230234mkName :: forall s. Text -> Name s
231235mkName = coerce
232236{-# INLINE mkName #-}
233237
234238instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
239+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
236240
237241instance KnownSymbol s => Read (Name s) where
238242 readsPrec _ = readP_to_S $ do
239243 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240244 mkName <$> readS_to_P reads
241245
242−#ifdef BACKEND
243246instance Arbitrary (Name s) where
244247 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
245−#endif
246248
247249-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248250-- You are forced to explicitly specify the phantom types you are converting
@@ -253,3 +255,9 @@ coerceName = coerce
253255{-# INLINE coerceName #-}
254256unsafeNameTagConvert = coerce
255257{-# INLINE unsafeNameTagConvert #-}
258+
259+#ifdef USE_LENS
260+makePrisms ''Id
261+makePrisms ''IntId
262+makePrisms ''Name
263+#endif