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