module Toml.Bi.Monad
( Codec (..)
, BiCodec
, dimap
, dioptional
, diwrap
, dimatch
, (<!>)
, (.=)
) where
import Control.Applicative (Alternative (..), optional)
import Control.Monad (MonadPlus (..))
import Data.Coerce (Coercible, coerce)
data Codec r w c a = Codec
{
Codec r w c a -> r a
codecRead :: r a
, Codec r w c a -> c -> w a
codecWrite :: c -> w a
}
type BiCodec r w a = Codec r w a a
instance (Functor r, Functor w) => Functor (Codec r w c) where
fmap :: (a -> b) -> Codec r w c a -> Codec r w c b
fmap :: (a -> b) -> Codec r w c a -> Codec r w c b
fmap f :: a -> b
f codec :: Codec r w c a
codec = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r b
codecRead = a -> b
f (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec r w c a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c a
codec
, codecWrite :: c -> w b
codecWrite = (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (w a -> w b) -> (c -> w a) -> c -> w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec r w c a -> c -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c a
codec
}
{-# INLINE fmap #-}
instance (Applicative r, Applicative w) => Applicative (Codec r w c) where
pure :: a -> Codec r w c a
pure :: a -> Codec r w c a
pure a :: a
a = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r a
codecRead = a -> r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
, codecWrite :: c -> w a
codecWrite = \_ -> a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
}
{-# INLINE pure #-}
(<*>) :: Codec r w c (a -> b) -> Codec r w c a -> Codec r w c b
codecf :: Codec r w c (a -> b)
codecf <*> :: Codec r w c (a -> b) -> Codec r w c a -> Codec r w c b
<*> codeca :: Codec r w c a
codeca = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r b
codecRead = Codec r w c (a -> b) -> r (a -> b)
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c (a -> b)
codecf r (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec r w c a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c a
codeca
, codecWrite :: c -> w b
codecWrite = \c :: c
c -> Codec r w c (a -> b) -> c -> w (a -> b)
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c (a -> b)
codecf c
c w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec r w c a -> c -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c a
codeca c
c
}
{-# INLINE (<*>) #-}
instance (Monad r, Monad w) => Monad (Codec r w c) where
(>>=) :: Codec r w c a -> (a -> Codec r w c b) -> Codec r w c b
codec :: Codec r w c a
codec >>= :: Codec r w c a -> (a -> Codec r w c b) -> Codec r w c b
>>= f :: a -> Codec r w c b
f = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r b
codecRead = Codec r w c a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c a
codec r a -> (a -> r b) -> r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> Codec r w c b -> r b
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead (a -> Codec r w c b
f a
a)
, codecWrite :: c -> w b
codecWrite = \c :: c
c -> Codec r w c a -> c -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c a
codec c
c w a -> (a -> w b) -> w b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> Codec r w c b -> c -> w b
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite (a -> Codec r w c b
f a
a) c
c
}
{-# INLINE (>>=) #-}
instance (Alternative r, Alternative w) => Alternative (Codec r w c) where
empty :: Codec r w c a
empty :: Codec r w c a
empty = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r a
codecRead = r a
forall (f :: * -> *) a. Alternative f => f a
empty
, codecWrite :: c -> w a
codecWrite = \_ -> w a
forall (f :: * -> *) a. Alternative f => f a
empty
}
{-# INLINE empty #-}
(<|>) :: Codec r w c a -> Codec r w c a -> Codec r w c a
codec1 :: Codec r w c a
codec1 <|> :: Codec r w c a -> Codec r w c a -> Codec r w c a
<|> codec2 :: Codec r w c a
codec2 = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r a
codecRead = Codec r w c a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c a
codec1 r a -> r a -> r a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Codec r w c a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w c a
codec2
, codecWrite :: c -> w a
codecWrite = \c :: c
c -> Codec r w c a -> c -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c a
codec1 c
c w a -> w a -> w a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Codec r w c a -> c -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w c a
codec2 c
c
}
{-# INLINE (<|>) #-}
instance (MonadPlus r, MonadPlus w) => MonadPlus (Codec r w c) where
mzero :: Codec r w c a
mzero = Codec r w c a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mzero #-}
mplus :: Codec r w c a -> Codec r w c a -> Codec r w c a
mplus = Codec r w c a -> Codec r w c a -> Codec r w c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
{-# INLINE mplus #-}
infixl 3 <!>
(<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> (a -> f x)
f :: a -> f x
f <!> :: (a -> f x) -> (a -> f x) -> a -> f x
<!> g :: a -> f x
g = \a :: a
a -> a -> f x
f a
a f x -> f x -> f x
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f x
g a
a
{-# INLINE (<!>) #-}
dimap
:: (Functor r, Functor w)
=> (c -> d)
-> (a -> b)
-> Codec r w d a
-> Codec r w c b
dimap :: (c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
dimap f :: c -> d
f g :: a -> b
g codec :: Codec r w d a
codec = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r b
codecRead = a -> b
g (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec r w d a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w d a
codec
, codecWrite :: c -> w b
codecWrite = (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g (w a -> w b) -> (c -> w a) -> c -> w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec r w d a -> d -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w d a
codec (d -> w a) -> (c -> d) -> c -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
f
}
{-# INLINE dimap #-}
dioptional
:: (Alternative r, Applicative w)
=> Codec r w c a
-> Codec r w (Maybe c) (Maybe a)
dioptional :: Codec r w c a -> Codec r w (Maybe c) (Maybe a)
dioptional Codec{..} = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r (Maybe a)
codecRead = r a -> r (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional r a
codecRead
, codecWrite :: Maybe c -> w (Maybe a)
codecWrite = (c -> w a) -> Maybe c -> w (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse c -> w a
codecWrite
}
{-# INLINE dioptional #-}
diwrap
:: forall b a r w .
(Coercible a b, Functor r, Functor w)
=> BiCodec r w a
-> BiCodec r w b
diwrap :: BiCodec r w a -> BiCodec r w b
diwrap = (b -> a) -> (a -> b) -> BiCodec r w a -> BiCodec r w b
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
dimap b -> a
forall a b. Coercible a b => a -> b
coerce a -> b
forall a b. Coercible a b => a -> b
coerce
{-# INLINE diwrap #-}
dimatch
:: (Functor r, Alternative w)
=> (c -> Maybe d)
-> (a -> b)
-> Codec r w d a
-> Codec r w c b
dimatch :: (c -> Maybe d) -> (a -> b) -> Codec r w d a -> Codec r w c b
dimatch match :: c -> Maybe d
match ctor :: a -> b
ctor codec :: Codec r w d a
codec = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
{ codecRead :: r b
codecRead = a -> b
ctor (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec r w d a -> r a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec r w d a
codec
, codecWrite :: c -> w b
codecWrite = \c :: c
c -> case c -> Maybe d
match c
c of
Nothing -> w b
forall (f :: * -> *) a. Alternative f => f a
empty
Just d :: d
d -> a -> b
ctor (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec r w d a -> d -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w d a
codec d
d
}
{-# INLINE dimatch #-}
infixl 5 .=
(.=) :: Codec r w field a -> (object -> field) -> Codec r w object a
codec :: Codec r w field a
codec .= :: Codec r w field a -> (object -> field) -> Codec r w object a
.= getter :: object -> field
getter = Codec r w field a
codec { codecWrite :: object -> w a
codecWrite = Codec r w field a -> field -> w a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec r w field a
codec (field -> w a) -> (object -> field) -> object -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. object -> field
getter }
{-# INLINE (.=) #-}