@@ -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 { unIntId :: 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,31 @@ 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 #-}
183instance KnownSymbol s => Show (IntId s) where
185instance 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
186instance KnownSymbol s => Read (IntId s) where
188instance KnownSymbol s => Read (IntId s) where
187 readsPrec _ = readP_to_S $ do
189 readsPrec _ = readP_to_S $ do
@@ -210,39 +212,39 @@ newtype Name t = Name { unName :: Text }
210#ifdef USE_CASSAVA
212#ifdef USE_CASSAVA
211 , Csv.ToField, Csv.FromField
213 , Csv.ToField, Csv.FromField
214#ifdef USE_FLAT
215#ifdef USE_FLAT
217#ifdef USE_STORE
218#ifdef USE_STORE
218 , Data.Store.Store
219 , Data.Store.Store
220−#ifdef BACKEND
221+#ifdef USE_REL8
225+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
221 , ToSchema, ToParamSchema
227 , ToSchema, ToParamSchema
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
229+ , FromHttpApiData, ToHttpApiData, PathPiece
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
230+ , IsString, Semigroup, Monoid )
226type role Name nominal
232type role Name nominal
230mkName :: forall s. Text -> Name s
234mkName :: forall s. Text -> Name s
231mkName = coerce
235mkName = coerce
232{-# INLINE mkName #-}
236{-# INLINE mkName #-}
234instance KnownSymbol s => Show (Name s) where
238instance 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
237instance KnownSymbol s => Read (Name s) where
241instance KnownSymbol s => Read (Name s) where
238 readsPrec _ = readP_to_S $ do
242 readsPrec _ = readP_to_S $ do
239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
243 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240 mkName <$> readS_to_P reads
244 mkName <$> readS_to_P reads
243instance Arbitrary (Name s) where
246instance Arbitrary (Name s) where
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
247 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
249-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248-- You are forced to explicitly specify the phantom types you are converting
250-- You are forced to explicitly specify the phantom types you are converting
@@ -253,3 +255,9 @@ coerceName = coerce
253{-# INLINE coerceName #-}
255{-# INLINE coerceName #-}
254unsafeNameTagConvert = coerce
256unsafeNameTagConvert = coerce
255{-# INLINE unsafeNameTagConvert #-}
257{-# INLINE unsafeNameTagConvert #-}