@@ -25,23 +25,34 @@ import Data.UUID (UUID)
25import qualified Data.UUID as UUID
25import qualified Data.UUID as UUID
26import qualified Data.UUID.V4 as UUID.V4
26import qualified Data.UUID.V4 as UUID.V4
27#ifndef ghcjs_HOST_OS
27#ifndef ghcjs_HOST_OS
29+import Data.Csv as Csv hiding(Name)
28import Database.PostgreSQL.Simple.FromField as PG (FromField)
32import Database.PostgreSQL.Simple.FromField as PG (FromField)
29import Database.PostgreSQL.Simple.ToField as PG (ToField)
33import Database.PostgreSQL.Simple.ToField as PG (ToField)
30−import Data.Csv as Csv hiding(Name)
32−import Flat as F
35+#endif
33import GHC.TypeLits
36import GHC.TypeLits
34import Test.QuickCheck
37import Test.QuickCheck
35import Text.ParserCombinators.ReadP
38import Text.ParserCombinators.ReadP
36import Web.HttpApiData
39import Web.HttpApiData
37import Web.PathPieces (PathPiece(..))
40import Web.PathPieces (PathPiece(..))
45+import qualified Data.Store
39newtype Id t = Id { unId :: UUID }
48newtype Id t = Id { unId :: UUID }
40 deriving stock Data
49 deriving stock Data
41 deriving newtype
50 deriving newtype
42 ( Eq, Ord, Binary
51 ( Eq, Ord, Binary
43#ifndef ghcjs_HOST_OS
52#ifndef ghcjs_HOST_OS
44 , PG.ToField, PG.FromField
54 , PG.ToField, PG.FromField
46 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
57 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
47 , ToParamSchema, FromHttpApiData, ToHttpApiData )
58 , ToParamSchema, FromHttpApiData, ToHttpApiData )
@@ -66,10 +77,19 @@ instance KnownSymbol s => Read (Id s) where
66 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
77 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
67 mkId <$> readS_to_P reads
78 mkId <$> readS_to_P reads
69instance Flat (Id s) where
81instance Flat (Id s) where
70 encode = F.encode . UUID.toWords . coerce
82 encode = F.encode . UUID.toWords . coerce
71 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
83 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
72 size = F.size . UUID.toWords . coerce
84 size = F.size . UUID.toWords . coerce
88+instance Data.Store.Store (Id s) where
89+ poke = Data.Store.poke . UUID.toWords . coerce
90+ peek = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> Data.Store.peek
91+ size = Data.Store.ConstSize 16
74instance Arbitrary (Id t) where
94instance Arbitrary (Id t) where
75 arbitrary = fmap Id $ UUID.fromWords
95 arbitrary = fmap Id $ UUID.fromWords
@@ -84,12 +104,14 @@ instance PathPiece (Id t) where
85#ifndef ghcjs_HOST_OS
105#ifndef ghcjs_HOST_OS
87instance Csv.FromField (Id tag) where
108instance Csv.FromField (Id tag) where
88 parseField = parseField
109 parseField = parseField
89 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
110 >=> fmap mkId . maybe (fail "invalid UUID in CSV") pure . UUID.fromText
91instance Csv.ToField (Id tag) where
112instance Csv.ToField (Id tag) where
92 toField = Csv.toField . UUID.toText . coerce
113 toField = Csv.toField . UUID.toText . coerce
@@ -116,7 +138,12 @@ newtype IntId t = IntId { unIntId :: Integer }
116 deriving newtype
138 deriving newtype
117 ( Eq, Ord, Binary
139 ( Eq, Ord, Binary
118#ifndef ghcjs_HOST_OS
140#ifndef ghcjs_HOST_OS
142+ , PG.ToField, PG.FromField
119− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
145+ , Csv.ToField, Csv.FromField
121 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
148 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
122 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
149 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
@@ -154,7 +181,12 @@ newtype Name t = Name { unName :: Text }
154 deriving newtype
181 deriving newtype
155 ( Eq, Ord, Binary
182 ( Eq, Ord, Binary
156#ifndef ghcjs_HOST_OS
183#ifndef ghcjs_HOST_OS
185+ , PG.ToField, PG.FromField
157− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
188+ , Csv.ToField, Csv.FromField
159 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
191 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
160 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
192 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat