@@ -4,39 +4,35 @@
4{-# OPTIONS_GHC -Wno-orphans #-}
4{-# OPTIONS_GHC -Wno-orphans #-}
6module Data.Id
6module Data.Id
7− ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, nilId
8− , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
8+ , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId
9− , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
9+ , Name, mkName, unName, unsafeNameTagConvert, coerceName
10−#ifdef USE_UUID
10+#ifdef USE_LENS
11− , randomId
11+ , _Id, _IntId, _Name
16import Control.DeepSeq (NFData)
16import Control.DeepSeq (NFData)
17import Control.Lens
18import Control.Lens
18import Control.Monad
20import Control.Monad
19import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
21import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
20import Data.Binary (Binary)
22import Data.Binary (Binary)
21import Data.Coerce (coerce)
23import Data.Coerce (coerce)
22import Data.Data
24import Data.Data
23import Data.Hashable (Hashable)
25import Data.Hashable (Hashable)
26+import Data.Int (Int64)
24import Data.String
30import Data.String
25import Data.Text as T
31import Data.Text as T
26−import Data.UUID.Types (UUID)
32+import Data.UUID (UUID)
27−import qualified Data.UUID.Types as UUID
33+import qualified Data.UUID as UUID
30−import Text.ParserCombinators.ReadP
31−import Web.HttpApiData
32−import Web.PathPieces (PathPiece(..))
35import qualified Data.UUID.V4 as UUID.V4
34import qualified Data.UUID.V4 as UUID.V4
36−#endif
35+#ifndef ghcjs_HOST_OS
39−import Test.QuickCheck
40#ifdef USE_CASSAVA
36#ifdef USE_CASSAVA
41import Data.Csv as Csv hiding(Name)
37import Data.Csv as Csv hiding(Name)
@@ -45,13 +41,20 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
45import Database.PostgreSQL.Simple.ToField as PG (ToField)
41import Database.PostgreSQL.Simple.ToField as PG (ToField)
48−
44+import GHC.TypeLits
45+import Test.QuickCheck
46+import Text.ParserCombinators.ReadP
47+import Web.HttpApiData
48+import Web.PathPieces (PathPiece(..))
49#ifdef USE_FLAT
49#ifdef USE_FLAT
50import Flat as F
50import Flat as F
52#ifdef USE_STORE
52#ifdef USE_STORE
53import qualified Data.Store
53import qualified Data.Store
56+import Rel8 (DBType(..))
56newtype Id t = Id { unId :: UUID }
59newtype Id t = Id { unId :: UUID }
57 deriving stock Data
60 deriving stock Data
@@ -61,29 +64,28 @@ newtype Id t = Id { unId :: UUID }
61#ifdef USE_POSTGRES
64#ifdef USE_POSTGRES
62 , PG.ToField, PG.FromField
65 , PG.ToField, PG.FromField
65 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
71 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
66−#ifdef BACKEND
72+#ifdef USE_OPENAPI
67 , ToSchema, ToParamSchema
73 , ToSchema, ToParamSchema
69 , FromHttpApiData, ToHttpApiData )
75 , FromHttpApiData, ToHttpApiData )
71type role Id nominal
77type role Id nominal
75mkId :: forall s. UUID -> Id s
79mkId :: forall s. UUID -> Id s
76mkId = coerce
80mkId = coerce
77{-# INLINE mkId #-}
81{-# INLINE mkId #-}
80randomId :: forall s. IO (Id s)
83randomId :: forall s. IO (Id s)
81randomId = coerce <$> UUID.V4.nextRandom
84randomId = coerce <$> UUID.V4.nextRandom
82{-# INLINE randomId #-}
85{-# INLINE randomId #-}
85instance KnownSymbol s => Show (Id s) where
87instance 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
88instance KnownSymbol s => Read (Id s) where
90instance KnownSymbol s => Read (Id s) where
89 readsPrec _ = readP_to_S $ do
91 readsPrec _ = readP_to_S $ do
@@ -104,14 +106,12 @@ instance Data.Store.Store (Id s) where
104 size = Data.Store.ConstSize 16
106 size = Data.Store.ConstSize 16
108instance Arbitrary (Id t) where
109instance Arbitrary (Id t) where
109 arbitrary = fmap Id $ UUID.fromWords
110 arbitrary = fmap Id $ UUID.fromWords
110 <$> arbitrary
111 <$> arbitrary
111 <*> arbitrary
112 <*> arbitrary
112 <*> arbitrary
113 <*> arbitrary
113 <*> arbitrary
114 <*> arbitrary
116instance PathPiece (Id t) where
116instance PathPiece (Id t) where
117 fromPathPiece = coerce . UUID.fromText
117 fromPathPiece = coerce . UUID.fromText
@@ -148,7 +148,7 @@ type family Ambiguous (a :: k) :: j where
148 Ambiguous x = x
148 Ambiguous x = x
150----------------- IntId
150----------------- IntId
151−newtype IntId t = IntId { unIntId :: Integer }
151+newtype IntId t = IntId Int64
152 deriving stock Data
152 deriving stock Data
153 deriving newtype
153 deriving newtype
154 ( Eq, Ord, Binary
154 ( Eq, Ord, Binary
@@ -159,29 +159,35 @@ newtype IntId t = IntId { unIntId :: Integer }
159#ifdef USE_CASSAVA
159#ifdef USE_CASSAVA
160 , Csv.ToField, Csv.FromField
160 , Csv.ToField, Csv.FromField
163#ifdef USE_FLAT
162#ifdef USE_FLAT
166#ifdef USE_STORE
165#ifdef USE_STORE
167 , Data.Store.Store
166 , Data.Store.Store
169−#ifdef BACKEND
168+#ifdef USE_REL8
170− , ToSchema, ToParamSchema, Arbitrary
169+ , DBType
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
174+ , ToSchema, ToParamSchema
176+ , FromHttpApiData, ToHttpApiData, PathPiece, Arbitrary
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
177+ , Num, Integral, Real, Enum )
175type role IntId nominal
179type role IntId nominal
179mkIntId :: forall s. Integer -> IntId s
181mkIntId :: forall s. Integer -> IntId s
180−mkIntId = coerce
182+mkIntId = fromInteger
181{-# INLINE mkIntId #-}
183{-# INLINE mkIntId #-}
185+unIntId :: IntId s -> Integer
186+unIntId (IntId i) = fromIntegral i
187+{-# INLINE unIntId #-}
183instance KnownSymbol s => Show (IntId s) where
189instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
190+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
186instance KnownSymbol s => Read (IntId s) where
192instance KnownSymbol s => Read (IntId s) where
187 readsPrec _ = readP_to_S $ do
193 readsPrec _ = readP_to_S $ do
@@ -210,39 +216,39 @@ newtype Name t = Name { unName :: Text }
210#ifdef USE_CASSAVA
216#ifdef USE_CASSAVA
211 , Csv.ToField, Csv.FromField
217 , Csv.ToField, Csv.FromField
214#ifdef USE_FLAT
219#ifdef USE_FLAT
217#ifdef USE_STORE
222#ifdef USE_STORE
218 , Data.Store.Store
223 , Data.Store.Store
220−#ifdef BACKEND
225+#ifdef USE_REL8
229+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
221 , ToSchema, ToParamSchema
231 , ToSchema, ToParamSchema
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
233+ , FromHttpApiData, ToHttpApiData, PathPiece
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
234+ , IsString, Semigroup, Monoid )
226type role Name nominal
236type role Name nominal
230mkName :: forall s. Text -> Name s
238mkName :: forall s. Text -> Name s
231mkName = coerce
239mkName = coerce
232{-# INLINE mkName #-}
240{-# INLINE mkName #-}
234instance KnownSymbol s => Show (Name s) where
242instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
243+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
237instance KnownSymbol s => Read (Name s) where
245instance KnownSymbol s => Read (Name s) where
238 readsPrec _ = readP_to_S $ do
246 readsPrec _ = readP_to_S $ do
239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
247 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240 mkName <$> readS_to_P reads
248 mkName <$> readS_to_P reads
243instance Arbitrary (Name s) where
250instance Arbitrary (Name s) where
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
251 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
253-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248-- You are forced to explicitly specify the phantom types you are converting
254-- You are forced to explicitly specify the phantom types you are converting
@@ -253,3 +259,9 @@ coerceName = coerce
253{-# INLINE coerceName #-}
259{-# INLINE coerceName #-}
254unsafeNameTagConvert = coerce
260unsafeNameTagConvert = coerce
255{-# INLINE unsafeNameTagConvert #-}
261{-# INLINE unsafeNameTagConvert #-}