git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Type/Information.hs
90 lines 2.9 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 where
32 TypeInformation ::
33 { encode :: a -> Opaleye.PrimExpr
34 -- ^ How to encode a single Haskell value as a SQL expression.
35 , decode :: Hasql.Value x
36 -- ^ How to deserialize a single result back to Haskell.
37 , typeName :: String
38 -- ^ The name of the SQL type.
39 , out :: x -> a
40 -- ^ A final output function - usually this will just be 'id'. This is
41 -- needed to allow @TypeInformation@s to be coerced.
42 } -> TypeInformation a
45-- | Simultaneously map over how a type is both encoded and decoded, while
46-- retaining the name of the type. This operation is useful if you want to
47-- essentially @newtype@ another 'DBType'.
48--
49-- The mapping is required to be total. If you have a partial mapping, see
50-- 'parseTypeInformation'.
51mapTypeInformation :: ()
52 => (a -> b) -> (b -> a)
53 -> TypeInformation a -> TypeInformation b
54mapTypeInformation = parseTypeInformation . fmap pure
57-- | Apply a parser to 'TypeInformation'.
58--
59-- This can be used if the data stored in the database should only be subset of
60-- a given 'TypeInformation'. The parser is applied when deserializing rows
61-- returned - the encoder assumes that the input data is already in the
62-- appropriate form.
63--
64-- One example where this may be useful is with a database that stores data in
65-- some legacy encoding:
66--
67-- >>> import Data.Text (Text)
68--
69-- >>> data Color = Red | Green | Blue
70-- >>> :{
71-- instance DBType Color where
72-- typeInformation = parseTypeInformation parseLegacy toLegacy typeInformation
73-- where
74-- parseLegacy :: Text -> Either String Color
75-- parseLegacy "red" = Right Red
76-- parseLegacy "green" = Right Green
77-- parseLegacy _ = Left "Unexpected Color"
78-- toLegacy Red = "red"
79-- toLegacy Green = "green"
80-- :}
81parseTypeInformation :: ()
82 => (a -> Either String b) -> (b -> a)
83 -> TypeInformation a -> TypeInformation b
84parseTypeInformation to from TypeInformation {encode, decode, typeName, out} =
85 TypeInformation
86 { encode = encode . from
87 , decode = Hasql.refine (first Text.pack . to) (out <$> decode)
88 , typeName
89 , out = id
90 }