on master help sign in
Make flat and postgres optional, add optional store
commit79940855816ccb16cf98a325f4457663c9d6b4c3 authorVille Tirronen <ville@typeable.io> dateThu 28 Jul 2022, 12:21 (4 years ago) parent0ff950b
2 files changed+54−5
id.cabal+30−3 src/Data/Id.hs+24−2
id.cabal+30−3
@@ -4,6 +4,22 @@ name: id
44version: 0.1.0.0
55license-file: LICENSE
66
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+
723library
824 exposed-modules:
925 Data.Id
@@ -14,7 +30,6 @@ library
1430 base >=4.12 && <5,
1531 binary,
1632 deepseq,
17− flat,
1833 hashable,
1934 http-api-data,
2035 lens,
@@ -23,10 +38,22 @@ library
2338 text,
2439 QuickCheck,
2540 uuid,
41+ if flag(postgres) && !impl(ghcjs)
42+ build-depends:
43+ postgresql-simple
44+ cpp-options: -DUSE_POSTGRES
2645 if !impl(ghcjs)
2746 build-depends:
28− cassava,
29− postgresql-simple,
47+ cassava
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+
3057 hs-source-dirs:
3158 src
3259 default-language:
src/Data/Id.hs+24−2
@@ -25,23 +25,32 @@ import Data.UUID (UUID)
2525import qualified Data.UUID as UUID
2626import qualified Data.UUID.V4 as UUID.V4
2727#ifndef ghcjs_HOST_OS
28+import Data.Csv as Csv hiding(Name)
29+#ifdef USE_POSTGRES
2830import Database.PostgreSQL.Simple.FromField as PG (FromField)
2931import Database.PostgreSQL.Simple.ToField as PG (ToField)
30−import Data.Csv as Csv hiding(Name)
3132#endif
32−import Flat as F
33+#endif
3334import GHC.TypeLits
3435import Test.QuickCheck
3536import Text.ParserCombinators.ReadP
3637import Web.HttpApiData
3738import 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
3845
3946newtype Id t = Id { unId :: UUID }
4047 deriving stock Data
4148 deriving newtype
4249 ( Eq, Ord, Binary
4350#ifndef ghcjs_HOST_OS
51+#ifdef USE_POSTGRES
4452 , PG.ToField, PG.FromField
53+#endif
4554#endif
4655 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
4756 , ToParamSchema, FromHttpApiData, ToHttpApiData )
@@ -66,10 +75,19 @@ instance KnownSymbol s => Read (Id s) where
6675 _ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
6776 mkId <$> readS_to_P reads
6877
78+#ifdef USE_FLAT
6979instance Flat (Id s) where
7080 encode = F.encode . UUID.toWords . coerce
7181 decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
7282 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
7391
7492instance Arbitrary (Id t) where
7593 arbitrary = fmap Id $ UUID.fromWords
@@ -116,7 +134,9 @@ newtype IntId t = IntId { unIntId :: Integer }
116134 deriving newtype
117135 ( Eq, Ord, Binary
118136#ifndef ghcjs_HOST_OS
137+#ifdef USE_POSTGRES
119138 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
139+#endif
120140#endif
121141 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
122142 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat, Arbitrary
@@ -154,7 +174,9 @@ newtype Name t = Name { unName :: Text }
154174 deriving newtype
155175 ( Eq, Ord, Binary
156176#ifndef ghcjs_HOST_OS
177+#ifdef USE_POSTGRES
157178 , PG.ToField, PG.FromField, Csv.ToField, Csv.FromField
179+#endif
158180#endif
159181 , FromJSON, ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey, ToSchema
160182 , ToParamSchema, FromHttpApiData, ToHttpApiData, PathPiece, Flat