on master help sign in
Merge pull request #5 from typeable/add-store-and-flags
7bf424bVille Tirronen
id.cabal+38−5
@@ -1,9 +1,30 @@
1cabal-version: 2.4
1cabal-version: 2.4
2
2
3name: id
3name: id
4−version: 0.1.0.0
4+version: 0.2.0.0
5license-file: LICENSE
5license-file: LICENSE
6
6
7+Flag cassava
8+ Description: Enable Postgresql support
9+ Default: True
10+ Manual: False
11+
12+
13+Flag postgres
14+ Description: Enable Postgresql support
15+ Default: True
16+ Manual: False
17+
18+Flag flat
19+ Description: Enable Flat serialization support
20+ Default: True
21+ Manual: False
22+
23+Flag store
24+ Description: Enable Data.Store serialization support
25+ Default: False
26+ Manual: False
27+
7library
28library
8 exposed-modules:
29 exposed-modules:
9 Data.Id
30 Data.Id
@@ -14,7 +35,6 @@ library
14 base >=4.12 && <5,
35 base >=4.12 && <5,
15 binary,
36 binary,
16 deepseq,
37 deepseq,
17− flat,
18 hashable,
38 hashable,
19 http-api-data,
39 http-api-data,
20 lens,
40 lens,
@@ -23,10 +43,23 @@ library
23 text,
43 text,
24 QuickCheck,
44 QuickCheck,
25 uuid,
45 uuid,
26− if !impl(ghcjs)
46+ if flag(postgres) && !impl(ghcjs)
27 build-depends:
47 build-depends:
28− cassava,
29− postgresql-simple,
48+ postgresql-simple
49+ cpp-options: -DUSE_POSTGRES
50+ if flag(cassava) && !impl(ghcjs)
51+ build-depends:
52+ cassava
53+ cpp-options: -DUSE_CASSAVA
54+ if flag(flat)
55+ build-depends:
56+ flat,
57+ cpp-options: -DUSE_FLAT
58+ if flag(store)
59+ build-depends:
60+ store,
61+ cpp-options: -DUSE_STORE
62+
30 hs-source-dirs:
63 hs-source-dirs:
31 src
64 src
32 default-language:
65 default-language:
src/Data/Id.hs+36−4
@@ -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
28+#ifdef USE_CASSAVA
29+import Data.Csv as Csv hiding(Name)
30+#endif
31+#ifdef USE_POSTGRES
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)
31#endif
34#endif
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(..))
41+#ifdef USE_FLAT
42+import Flat as F
43+#endif
44+#ifdef USE_STORE
45+import qualified Data.Store
46+#endif
38
47
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
53+#ifdef USE_POSTGRES
44 , PG.ToField, PG.FromField
54 , PG.ToField, PG.FromField
55+#endif
45#endif
56#endif
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
68
79
80+#ifdef USE_FLAT
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
85+#endif
86+
87+#ifdef USE_STORE
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
92+#endif
73
93
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
84
104
85#ifndef ghcjs_HOST_OS
105#ifndef ghcjs_HOST_OS
86
106
107+#ifdef USE_CASSAVA
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
90
111
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
114+#endif
93
115
94#endif
116#endif
95
117
@@ -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
141+#ifdef USE_POSTGRES
142+ , PG.ToField, PG.FromField
143+#endif
144+#ifdef USE_CASSAVA
119− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
145+ , Csv.ToField, Csv.FromField
146+#endif
120#endif
147#endif
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
184+#ifdef USE_POSTGRES
185+ , PG.ToField, PG.FromField
186+#endif
187+#ifdef USE_CASSAVA
157− , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
188+ , Csv.ToField, Csv.FromField
189+#endif
158#endif
190#endif
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