git.iko.soy/rel8
on master help sign in
Add Rel8.Type.JSONEncoded, Rel8.Type.JSONBEncoded, Rel8.Type.ReadShow
commit8fefc24e2fe62c8adc8a2d79463d4cf1bc182f0a authorOllie Charles <ollie@ocharles.org.uk> dateTue 23 Mar 2021, 15:14 (6 years ago) parent06f67cf
5 files changed+121−3
compare with master
unifiedsplit
rel8.cabal+3 src/Rel8.hs+6−3 src/Rel8/Type/JSONBEncoded.hs+31 src/Rel8/Type/JSONEncoded.hs+38 src/Rel8/Type/ReadShow.hs+43
rel8.cabal+3
@@ -151,9 +151,12 @@ library
151151 Rel8.Type.Array1D
152152 Rel8.Type.Eq
153153 Rel8.Type.Information
154+ Rel8.Type.JSONEncoded
155+ Rel8.Type.JSONBEncoded
154156 Rel8.Type.Monoid
155157 Rel8.Type.Num
156158 Rel8.Type.Ord
159+ Rel8.Type.ReadShow
157160 Rel8.Type.Semigroup
158161 Rel8.Type.String
159162 Rel8.Type.Sum
src/Rel8.hs+6−3
@@ -19,11 +19,11 @@ module Rel8
1919
2020 -- *** Deriving-via helpers
2121 -- **** @JSONEncoded@
22− -- , JSONEncoded(..)
23− -- , JSONBEncoded(..)
22+ , JSONEncoded(..)
23+ , JSONBEncoded(..)
2424
2525 -- **** @ReadShow@
26− -- , ReadShow(..)
26+ , ReadShow(..)
2727
2828 -- *** @TypeInformation@
2929 , TypeInformation(..)
@@ -284,6 +284,9 @@ import Rel8.Table.Ord
284284import Rel8.Table.Order
285285import Rel8.Expr.Serialize
286286import Rel8.Table.Insert
287+import Rel8.Type.JSONEncoded
288+import Rel8.Type.JSONBEncoded
289+import Rel8.Type.ReadShow
287290
288291
289292-- $setup
src/Rel8/Type/JSONBEncoded.hsnew file+31
@@ -0,0 +1,31 @@
1+module Rel8.Type.JSONBEncoded ( JSONBEncoded(..) ) where
2+
3+-- aeson
4+import Data.Aeson ( FromJSON, ToJSON, parseJSON, toJSON )
5+import Data.Aeson.Types ( parseEither )
6+
7+-- base
8+import Data.Bifunctor ( first )
9+import Prelude
10+
11+-- hasql
12+import qualified Hasql.Decoders as Hasql
13+
14+-- rel8
15+import Rel8.Type ( DBType(..) )
16+import Rel8.Type.Information ( TypeInformation(..) )
17+
18+-- text
19+import Data.Text ( pack )
20+
21+
22+-- | Like 'JSONEncoded', but works for @jsonb@ columns.
23+newtype JSONBEncoded a = JSONBEncoded { fromJSONBEncoded :: a }
24+
25+
26+instance (FromJSON a, ToJSON a) => DBType (JSONBEncoded a) where
27+ typeInformation = TypeInformation
28+ { encode = encode typeInformation . toJSON . fromJSONBEncoded
29+ , decode = Hasql.refine (first pack . fmap JSONBEncoded . parseEither parseJSON) Hasql.jsonb
30+ , typeName = "jsonb"
31+ }
src/Rel8/Type/JSONEncoded.hsnew file+38
@@ -0,0 +1,38 @@
1+module Rel8.Type.JSONEncoded ( JSONEncoded(..) ) where
2+
3+-- aeson
4+import Data.Aeson ( FromJSON, ToJSON, parseJSON, toJSON )
5+import Data.Aeson.Types ( parseEither )
6+
7+-- base
8+import Prelude
9+
10+-- rel8
11+import Rel8.Type ( DBType(..) )
12+import Rel8.Type.Information ( parseTypeInformation )
13+
14+
15+-- | A deriving-via helper type for column types that store a Haskell value
16+-- using a JSON encoding described by @aeson@'s 'ToJSON' and 'FromJSON' type
17+-- classes.
18+--
19+-- The declaration:
20+--
21+-- >>> import Data.Aeson
22+--
23+-- >>> :{
24+-- data Pet = Pet { petName :: String, petAge :: Int }
25+-- deriving (Generic, ToJSON, FromJSON)
26+-- deriving PrimitiveType via JSONEncoded Pet
27+-- :}
28+--
29+-- will allow you to store @Pet@ values in a single SQL column (stored as
30+-- @json@ values).
31+newtype JSONEncoded a = JSONEncoded { fromJSONEncoded :: a }
32+
33+
34+instance (FromJSON a, ToJSON a) => DBType (JSONEncoded a) where
35+ typeInformation = parseTypeInformation f g typeInformation
36+ where
37+ f = fmap JSONEncoded . parseEither parseJSON
38+ g = toJSON . fromJSONEncoded
src/Rel8/Type/ReadShow.hsnew file+43
@@ -0,0 +1,43 @@
1+module Rel8.Type.ReadShow ( ReadShow(..) ) where
2+
3+-- base
4+import Prelude
5+import Text.Read ( readEither )
6+
7+-- rel8
8+import Rel8.Type ( DBType( typeInformation ) )
9+import Rel8.Type.Information ( parseTypeInformation )
10+
11+-- text
12+import qualified Data.Text as Text
13+
14+
15+-- | A deriving-via helper type for column types that store a Haskell value
16+-- using a Haskell's 'Read' and 'Show' type classes.
17+--
18+-- The declaration:
19+--
20+-- >>> :{
21+-- data Color = Red | Green | Blue
22+-- deriving (Read, Show)
23+-- deriving PrimitiveType via ReadShow Color
24+-- :}
25+--
26+-- will allow you to store @Color@ values in a single SQL column (stored as
27+-- @text@).
28+newtype ReadShow a = ReadShow { fromReadShow :: a }
29+
30+
31+-- | The 'PrimitiveType' instance for 'ReadShow' allows you to serialize a type using
32+-- Haskell's 'Read' and 'Show' instances:
33+--
34+-- @
35+-- data Color = Red | Green | Blue
36+-- deriving (Read, Show)
37+-- deriving PrimitiveType via ReadShow Color
38+-- @
39+instance (Read a, Show a) => DBType (ReadShow a) where
40+ typeInformation = parseTypeInformation parser printer typeInformation
41+ where
42+ parser = fmap ReadShow . readEither . Text.unpack
43+ printer = Text.pack . show . fromReadShow