@@ -4,9 +4,12 @@
4{-# OPTIONS_GHC -Wno-orphans #-}
4{-# OPTIONS_GHC -Wno-orphans #-}
6module Data.Id
6module Data.Id
7− ( Id, mkId, unId, randomId, unsafeIdTagConvert, coerceId, _Id, nilId
7+ ( Id, mkId, unId, unsafeIdTagConvert, coerceId, _Id, nilId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
8 , IntId, mkIntId, unIntId, unsafeIntIdTagConvert, coerceIntId, _IntId
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
9 , Name, mkName, unName, unsafeNameTagConvert, coerceName, _Name
@@ -18,13 +21,22 @@ import Data.Binary (Binary)
18import Data.Coerce (coerce)
21import Data.Coerce (coerce)
19import Data.Data
22import Data.Data
20import Data.Hashable (Hashable)
23import Data.Hashable (Hashable)
22import Data.String
24import Data.String
23import Data.Text as T
25import Data.Text as T
24−import Data.UUID (UUID)
26+import Data.UUID.Types (UUID)
25−import qualified Data.UUID as UUID
27+import qualified Data.UUID.Types as UUID
30+import Text.ParserCombinators.ReadP
31+import Web.HttpApiData
32+import Web.PathPieces (PathPiece(..))
26import qualified Data.UUID.V4 as UUID.V4
35import qualified Data.UUID.V4 as UUID.V4
27−#ifndef ghcjs_HOST_OS
36+#endif
39+import Test.QuickCheck
28#ifdef USE_CASSAVA
40#ifdef USE_CASSAVA
29import Data.Csv as Csv hiding(Name)
41import Data.Csv as Csv hiding(Name)
@@ -33,11 +45,7 @@ import Database.PostgreSQL.Simple.FromField as PG (FromField)
33import Database.PostgreSQL.Simple.ToField as PG (ToField)
45import Database.PostgreSQL.Simple.ToField as PG (ToField)
36−import GHC.TypeLits
48+
37−import Test.QuickCheck
38−import Text.ParserCombinators.ReadP
39−import Web.HttpApiData
40−import Web.PathPieces (PathPiece(..))
41#ifdef USE_FLAT
49#ifdef USE_FLAT
42import Flat as F
50import Flat as F
@@ -54,8 +62,11 @@ newtype Id t = Id { unId :: UUID }
54 , PG.ToField, PG.FromField
62 , PG.ToField, PG.FromField
57− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
65+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
67+ , ToSchema, ToParamSchema
58− , ToParamSchema, FromHttpApiData, ToHttpApiData )
69+ , FromHttpApiData, ToHttpApiData )
60type role Id nominal
71type role Id nominal
@@ -65,12 +76,14 @@ mkId :: forall s. UUID -> Id s
65mkId = coerce
76mkId = coerce
66{-# INLINE mkId #-}
77{-# INLINE mkId #-}
68randomId :: forall s. IO (Id s)
80randomId :: forall s. IO (Id s)
69randomId = coerce <$> UUID.V4.nextRandom
81randomId = coerce <$> UUID.V4.nextRandom
70{-# INLINE randomId #-}
82{-# INLINE randomId #-}
72instance KnownSymbol s => Show (Id s) where
85instance KnownSymbol s => Show (Id s) where
73− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
86+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
75instance KnownSymbol s => Read (Id s) where
88instance KnownSymbol s => Read (Id s) where
76 readsPrec _ = readP_to_S $ do
89 readsPrec _ = readP_to_S $ do
@@ -91,12 +104,14 @@ instance Data.Store.Store (Id s) where
91 size = Data.Store.ConstSize 16
104 size = Data.Store.ConstSize 16
94instance Arbitrary (Id t) where
108instance Arbitrary (Id t) where
95 arbitrary = fmap Id $ UUID.fromWords
109 arbitrary = fmap Id $ UUID.fromWords
96 <$> arbitrary
110 <$> arbitrary
97 <*> arbitrary
111 <*> arbitrary
98 <*> arbitrary
112 <*> arbitrary
99 <*> arbitrary
113 <*> arbitrary
101instance PathPiece (Id t) where
116instance PathPiece (Id t) where
102 fromPathPiece = coerce . UUID.fromText
117 fromPathPiece = coerce . UUID.fromText
@@ -145,9 +160,17 @@ newtype IntId t = IntId { unIntId :: Integer }
145 , Csv.ToField, Csv.FromField
160 , Csv.ToField, Csv.FromField
170+ , ToSchema, ToParamSchema, Arbitrary
148− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
172+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
149− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
150− , Num, Integral, Real, Enum )
173+ , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
152type role IntId nominal
175type role IntId nominal
@@ -158,7 +181,7 @@ mkIntId = coerce
158{-# INLINE mkIntId #-}
181{-# INLINE mkIntId #-}
160instance KnownSymbol s => Show (IntId s) where
183instance KnownSymbol s => Show (IntId s) where
161− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
184+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
163instance KnownSymbol s => Read (IntId s) where
186instance KnownSymbol s => Read (IntId s) where
164 readsPrec _ = readP_to_S $ do
187 readsPrec _ = readP_to_S $ do
@@ -188,9 +211,17 @@ newtype Name t = Name { unName :: Text }
188 , Csv.ToField, Csv.FromField
211 , Csv.ToField, Csv.FromField
221+ , ToSchema, ToParamSchema
191− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
223+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
192− , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
193− , IsString, Semigroup, Monoid )
224+ , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
195type role Name nominal
226type role Name nominal
@@ -201,15 +232,17 @@ mkName = coerce
201{-# INLINE mkName #-}
232{-# INLINE mkName #-}
203instance KnownSymbol s => Show (Name s) where
234instance KnownSymbol s => Show (Name s) where
204− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
235+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
206instance KnownSymbol s => Read (Name s) where
237instance KnownSymbol s => Read (Name s) where
207 readsPrec _ = readP_to_S $ do
238 readsPrec _ = readP_to_S $ do
208 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
239 _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
209 mkName <$> readS_to_P reads
240 mkName <$> readS_to_P reads
211instance Arbitrary (Name s) where
243instance Arbitrary (Name s) where
212 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
214-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
215-- You are forced to explicitly specify the phantom types you are converting
248-- You are forced to explicitly specify the phantom types you are converting