git.iko.soy/typeable/id
on master help sign in
Make flat and postgres optional, add optional store
7994085Ville Tirronen
id.cabal+30−3
compare with master
unifiedsplit
@@ -4,6 +4,22 @@ name: id
4version: 0.1.0.0
4version: 0.1.0.0
5license-file: LICENSE
5license-file: LICENSE
6
6
7+
8+Flag postgres
9+ Description: Enable Postgresql support
10+ Default: True
11+ Manual: False
12+
13+Flag flat
14+ Description: Enable Flat serialization support
15+ Default: True
16+ Manual: False
17+
18+Flag store
19+ Description: Enable Data.Store serialization support
20+ Default: False
21+ Manual: False
22+
7library
23library
8 exposed-modules:
24 exposed-modules:
9 Data.Id
25 Data.Id
@@ -14,7 +30,6 @@ library
14 base >=4.12 && <5,
30 base >=4.12 && <5,
15 binary,
31 binary,
16 deepseq,
32 deepseq,
17− flat,
18 hashable,
33 hashable,
19 http-api-data,
34 http-api-data,
20 lens,
35 lens,
@@ -23,10 +38,22 @@ library
23 text,
38 text,
24 QuickCheck,
39 QuickCheck,
25 uuid,
40 uuid,
41+ if flag(postgres) && !impl(ghcjs)
42+ build-depends:
43+ postgresql-simple
44+ cpp-options: -DUSE_POSTGRES
26 if !impl(ghcjs)
45 if !impl(ghcjs)
27 build-depends:
46 build-depends:
28− cassava,
47+ cassava
29− postgresql-simple,
48+ if flag(flat)
49+ build-depends:
50+ flat,
51+ cpp-options: -DUSE_FLAT
52+ if flag(store)
53+ build-depends:
54+ store,
55+ cpp-options: -DUSE_STORE
56+
30 hs-source-dirs:
57 hs-source-dirs:
31 src
58 src
32 default-language:
59 default-language:
src/Data/Id.hs+24−2
@@ -25,23 +25,32 @@ 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+import Data.Csv as Csv hiding(Name)
29+#ifdef USE_POSTGRES
28import Database.PostgreSQL.Simple.FromField as PG (FromField)
30import Database.PostgreSQL.Simple.FromField as PG (FromField)
29import Database.PostgreSQL.Simple.ToField as PG (ToField)
31import Database.PostgreSQL.Simple.ToField as PG (ToField)
30−import Data.Csv as Csv hiding(Name)
31#endif
32#endif
32−import Flat as F
33+#endif
33import GHC.TypeLits
34import GHC.TypeLits
34import Test.QuickCheck
35import Test.QuickCheck
35import Text.ParserCombinators.ReadP
36import Text.ParserCombinators.ReadP
36import Web.HttpApiData
37import Web.HttpApiData
37import Web.PathPieces (PathPiece(..))
38import Web.PathPieces (PathPiece(..))
39+#ifdef USE_FLAT
40+import Flat as F
41+#endif
42+#ifdef USE_STORE
43+import qualified Data.Store
44+#endif
38
45
39newtype Id t = Id { unId :: UUID }
46newtype Id t = Id { unId :: UUID }
40 deriving stock Data
47 deriving stock Data
41 deriving newtype
48 deriving newtype
42 ( Eq, Ord, Binary
49 ( Eq, Ord, Binary
43#ifndef ghcjs_HOST_OS
50#ifndef ghcjs_HOST_OS
51+#ifdef USE_POSTGRES
44 , PG.ToField, PG.FromField
52 , PG.ToField, PG.FromField
53+#endif
45#endif
54#endif
46 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
55 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
47 , ToParamSchema, FromHttpApiData, ToHttpApiData )
56 , ToParamSchema, FromHttpApiData, ToHttpApiData )
@@ -66,10 +75,19 @@ instance KnownSymbol s => Read (Id s) where
66 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
75 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
67 mkId <$> readS_to_P reads
76 mkId <$> readS_to_P reads
68
77
78+#ifdef USE_FLAT
69instance Flat (Id s) where
79instance Flat (Id s) where
70 encode = F.encode . UUID.toWords . coerce
80 encode = F.encode . UUID.toWords . coerce
71 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
81 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
72 size = F.size . UUID.toWords . coerce
82 size = F.size . UUID.toWords . coerce
83+#endif
84+
85+#ifdef USE_STORE
86+instance Data.Store.Store (Id s) where
87+ poke = Data.Store.poke . UUID.toWords . coerce
88+ peek = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> Data.Store.peek
89+ size = Data.Store.ConstSize 16
90+#endif
73
91
74instance Arbitrary (Id t) where
92instance Arbitrary (Id t) where
75 arbitrary = fmap Id $ UUID.fromWords
93 arbitrary = fmap Id $ UUID.fromWords
@@ -116,7 +134,9 @@ newtype IntId t = IntId { unIntId :: Integer }
116 deriving newtype
134 deriving newtype
117 ( Eq, Ord, Binary
135 ( Eq, Ord, Binary
118#ifndef ghcjs_HOST_OS
136#ifndef ghcjs_HOST_OS
137+#ifdef USE_POSTGRES
119 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
138 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
139+#endif
120#endif
140#endif
121 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
141 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
122 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
142 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
@@ -154,7 +174,9 @@ newtype Name t = Name { unName :: Text }
154 deriving newtype
174 deriving newtype
155 ( Eq, Ord, Binary
175 ( Eq, Ord, Binary
156#ifndef ghcjs_HOST_OS
176#ifndef ghcjs_HOST_OS
177+#ifdef USE_POSTGRES
157 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
178 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
179+#endif
158#endif
180#endif
159 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
181 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
160 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat
182 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat