git.iko.soy/rel8
on 0857ffb help sign in
rel8/src/Rel8/Type/Information.hs
85 lines 2.6 kB history raw
1{-# language GADTs #-}
2{-# language NamedFieldPuns #-}
3{-# language StandaloneKindSignatures #-}
5module Rel8.Type.Information
6 ( TypeInformation(..)
7 , mapTypeInformation
8 , parseTypeInformation
9 )
10where
12-- base
13import Data.Bifunctor ( first )
14import Data.Kind ( Type )
15import Prelude
17-- hasql
18import qualified Hasql.Decoders as Hasql
20-- opaleye
21import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
23-- text
24import qualified Data.Text as Text
27-- | @TypeInformation@ describes how to encode and decode a Haskell type to and
28-- from database queries. The @typeName@ is the name of the type in the
29-- database, which is used to accurately type literals.
30type TypeInformation :: Type -> Type
31data TypeInformation a = TypeInformation
32 { encode :: a -> Opaleye.PrimExpr
33 -- ^ How to encode a single Haskell value as a SQL expression.
34 , decode :: Hasql.Value a
35 -- ^ How to deserialize a single result back to Haskell.
36 , typeName :: String
37 -- ^ The name of the SQL type.
38 }
41-- | Simultaneously map over how a type is both encoded and decoded, while
42-- retaining the name of the type. This operation is useful if you want to
43-- essentially @newtype@ another 'DBType'.
44--
45-- The mapping is required to be total. If you have a partial mapping, see
46-- 'parseTypeInformation'.
47mapTypeInformation :: ()
48 => (a -> b) -> (b -> a)
49 -> TypeInformation a -> TypeInformation b
50mapTypeInformation = parseTypeInformation . fmap pure
53-- | Apply a parser to 'TypeInformation'.
54--
55-- This can be used if the data stored in the database should only be subset of
56-- a given 'TypeInformation'. The parser is applied when deserializing rows
57-- returned - the encoder assumes that the input data is already in the
58-- appropriate form.
59--
60-- One example where this may be useful is with a database that stores data in
61-- some legacy encoding:
62--
63-- >>> import Data.Text (Text)
64--
65-- >>> data Color = Red | Green | Blue
66-- >>> :{
67-- instance DBType Color where
68-- typeInformation = parseTypeInformation parseLegacy toLegacy typeInformation
69-- where
70-- parseLegacy :: Text -> Either String Color
71-- parseLegacy "red" = Right Red
72-- parseLegacy "green" = Right Green
73-- parseLegacy _ = Left "Unexpected Color"
74-- toLegacy Red = "red"
75-- toLegacy Green = "green"
76-- :}
77parseTypeInformation :: ()
78 => (a -> Either String b) -> (b -> a)
79 -> TypeInformation a -> TypeInformation b
80parseTypeInformation to from TypeInformation {encode, decode, typeName} =
81 TypeInformation
82 { encode = encode . from
83 , decode = Hasql.refine (first Text.pack . to) decode
84 , typeName
85 }