@@ -7,9 +7,6 @@ module Data.Id
7 ( Id, mkId, unId, 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
@@ -21,52 +18,32 @@ 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
28−import GHC.TypeLits
26+#ifndef ghcjs_HOST_OS
30−import Text.ParserCombinators.ReadP
31−import Web.HttpApiData
32−import Web.PathPieces (PathPiece(..))
35−import qualified Data.UUID.V4 as UUID.V4
39−import Test.QuickCheck
41−import Data.Csv as Csv hiding(Name)
44import Database.PostgreSQL.Simple.FromField as PG (FromField)
27import Database.PostgreSQL.Simple.FromField as PG (FromField)
45import Database.PostgreSQL.Simple.ToField as PG (ToField)
28import Database.PostgreSQL.Simple.ToField as PG (ToField)
29+import Data.Csv as Csv hiding(Name)
50import Flat as F
31import Flat as F
51−#endif
32+import GHC.TypeLits
52−#ifdef USE_STORE
33+import Test.QuickCheck
53−import qualified Data.Store
34+import Text.ParserCombinators.ReadP
54−#endif
35+import Web.HttpApiData
36+import Web.PathPieces (PathPiece(..))
56newtype Id t = Id { unId :: UUID }
38newtype Id t = Id { unId :: UUID }
57 deriving stock Data
39 deriving stock Data
58 deriving newtype
40 deriving newtype
59 ( Eq, Ord, Binary
41 ( Eq, Ord, Binary
60#ifndef ghcjs_HOST_OS
42#ifndef ghcjs_HOST_OS
62 , PG.ToField, PG.FromField
43 , PG.ToField, PG.FromField
65− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey
45+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
67− , ToSchema, ToParamSchema
69− , FromHttpApiData, ToHttpApiData )
46+ , ToParamSchema, FromHttpApiData, ToHttpApiData )
71type role Id nominal
48type role Id nominal
@@ -76,42 +53,25 @@ mkId :: forall s. UUID -> Id s
76mkId = coerce
53mkId = coerce
77{-# INLINE mkId #-}
54{-# INLINE mkId #-}
80−randomId :: forall s. IO (Id s)
81−randomId = coerce <$> UUID.V4.nextRandom
82−{-# INLINE randomId #-}
85instance KnownSymbol s => Show (Id s) where
56instance KnownSymbol s => Show (Id s) where
86− show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> P.show v
57+ show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
88instance KnownSymbol s => Read (Id s) where
59instance KnownSymbol s => Read (Id s) where
89 readsPrec _ = readP_to_S $ do
60 readsPrec _ = readP_to_S $ do
90 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
61 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
91 mkId <$> readS_to_P reads
62 mkId <$> readS_to_P reads
94instance Flat (Id s) where
64instance Flat (Id s) where
95 encode = F.encode . UUID.toWords . coerce
65 encode = F.encode . UUID.toWords . coerce
96 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
66 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
97 size = F.size . UUID.toWords . coerce
67 size = F.size . UUID.toWords . coerce
101−instance Data.Store.Store (Id s) where
102− poke = Data.Store.poke . UUID.toWords . coerce
103− peek = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> Data.Store.peek
104− size = Data.Store.ConstSize 16
108instance Arbitrary (Id t) where
69instance Arbitrary (Id t) where
109 arbitrary = fmap Id $ UUID.fromWords
70 arbitrary = fmap Id $ UUID.fromWords
110 <$> arbitrary
71 <$> arbitrary
111 <*> arbitrary
72 <*> arbitrary
112 <*> arbitrary
73 <*> arbitrary
113 <*> arbitrary
74 <*> arbitrary
116instance PathPiece (Id t) where
76instance PathPiece (Id t) where
117 fromPathPiece = coerce . UUID.fromText
77 fromPathPiece = coerce . UUID.fromText
@@ -119,14 +79,12 @@ instance PathPiece (Id t) where
120#ifndef ghcjs_HOST_OS
80#ifndef ghcjs_HOST_OS
123instance Csv.FromField (Id tag) where
82instance Csv.FromField (Id tag) where
124 parseField = parseField
83 parseField = parseField
125 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
84 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
127instance Csv.ToField (Id tag) where
86instance Csv.ToField (Id tag) where
128 toField = Csv.toField . UUID.toText . coerce
87 toField = Csv.toField . UUID.toText . coerce
@@ -153,24 +111,11 @@ newtype IntId t = IntId { unIntId :: Integer }
153 deriving newtype
111 deriving newtype
154 ( Eq, Ord, Binary
112 ( Eq, Ord, Binary
155#ifndef ghcjs_HOST_OS
113#ifndef ghcjs_HOST_OS
157− , PG.ToField, PG.FromField
160− , Csv.ToField, Csv.FromField
114+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
170− , ToSchema, ToParamSchema, Arbitrary
172− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
116+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
117+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
173− , ToHttpApiData, PathPiece, Num, Integral, Real, Enum )
118+ , Num, Integral, Real, Enum )
175type role IntId nominal
120type role IntId nominal
@@ -181,12 +126,7 @@ mkIntId = coerce
181{-# INLINE mkIntId #-}
126{-# INLINE mkIntId #-}
183instance KnownSymbol s => Show (IntId s) where
128instance KnownSymbol s => Show (IntId s) where
184− show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> P.show v
129+ show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
186−instance KnownSymbol s => Read (IntId s) where
187− readsPrec _ = readP_to_S $ do
188− _ <- string ("IntId-" <> symbolVal (Proxy @s) <> "-")
189− mkIntId <$> readS_to_P reads
191-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
131-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
192-- You are forced to explicitly specify the phantom types you are converting
132-- You are forced to explicitly specify the phantom types you are converting
@@ -204,24 +144,11 @@ newtype Name t = Name { unName :: Text }
204 deriving newtype
144 deriving newtype
205 ( Eq, Ord, Binary
145 ( Eq, Ord, Binary
206#ifndef ghcjs_HOST_OS
146#ifndef ghcjs_HOST_OS
208− , PG.ToField, PG.FromField
211− , Csv.ToField, Csv.FromField
147+ , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
221− , ToSchema, ToParamSchema
223− , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, FromHttpApiData
149+ , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
150+ , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
224− , ToHttpApiData, PathPiece, IsString, Semigroup, Monoid )
151+ , IsString, Semigroup, Monoid )
226type role Name nominal
153type role Name nominal
@@ -232,17 +159,10 @@ mkName = coerce
232{-# INLINE mkName #-}
159{-# INLINE mkName #-}
234instance KnownSymbol s => Show (Name s) where
161instance KnownSymbol s => Show (Name s) where
235− show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> P.show v
162+ show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
237−instance KnownSymbol s => Read (Name s) where
238− readsPrec _ = readP_to_S $ do
239− _ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
240− mkName <$> readS_to_P reads
243instance Arbitrary (Name s) where
164instance Arbitrary (Name s) where
244 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
165 arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
247-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
167-- | This is a more \"explicit\" 'coerce' specifically for 'Name'.
248-- You are forced to explicitly specify the phantom types you are converting
168-- You are forced to explicitly specify the phantom types you are converting