Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Contains general underlying monad for bidirectional TOML converion.
Synopsis
- data Codec r w c a = Codec {
- codecRead :: r a
- codecWrite :: c -> w a
- type BiCodec r w a = Codec r w a a
- dimap :: (Functor r, Functor w) => (c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
- dioptional :: (Alternative r, Applicative w) => Codec r w c a -> Codec r w (Maybe c) (Maybe a)
- (<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> a -> f x
- (.=) :: Codec r w field a -> (object -> field) -> Codec r w object a
Documentation
Monad for bidirectional conversion. Contains pair of functions:
- How to read value of type
a
from immutable environment contextr
? - How to store value of type
a
in stateful contextw
?
In practice instead of r
we will use some Reader Toml
and instead of w
we will
use State Toml
. This approach with the bunch of utility functions allows to
have single description for from/to Toml
conversion.
In practice this type will always be used in the following way:
typeBiCodec
r w a =Codec
r w a a
Type parameter c
if fictional. Here some trick is used. This trick is
implemented in codec and
described in more details in related blog post.
Codec | |
|
Instances
(Monad r, Monad w) => Monad (Codec r w c) Source # | |
(Functor r, Functor w) => Functor (Codec r w c) Source # | |
(Applicative r, Applicative w) => Applicative (Codec r w c) Source # | |
Defined in Toml.Bi.Monad | |
(Alternative r, Alternative w) => Alternative (Codec r w c) Source # | |
(MonadPlus r, MonadPlus w) => MonadPlus (Codec r w c) Source # | |
type BiCodec r w a = Codec r w a a Source #
Specialized version of Codec
data type. This type alias is used in practice.
:: (Functor r, Functor w) | |
=> (c -> d) | Mapper for consumer |
-> (a -> b) | Mapper for producer |
-> Codec r w d a | Source |
-> Codec r w c b |
This is an instance of Profunctor
for Codec
. But since there's no
Profunctor
type class in base
or package with no dependencies (and we don't want to bring extra dependencies) this instance is implemented as a single
top-level function.
Useful when you want to parse newtype
s. For example, if you had data type like this:
data Example = Example { foo :: Bool , bar :: Text }
toml bidirectional converter for this type will look like this:
exampleT :: TomlCodec Example exampleT = Example $ bool "foo" .= foo * str "bar" .= bar
Now if you change your time in the following way:
newtype Email = Email { unEmail :: Text } data Example = Example { foo :: Bool , bar :: Email }
you need to patch your toml parser like this:
exampleT :: TomlCodec Example exampleT = Example $ bool "foo" .= foo * dimap unEmail Email (str "bar") .= bar
dioptional :: (Alternative r, Applicative w) => Codec r w c a -> Codec r w (Maybe c) (Maybe a) Source #
Bidirectional converter for Maybe smth
values.
(<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> a -> f x infixl 3 Source #
Alternative instance for function arrow but without empty
.