Return 'TomlState ()' in codecWrite

src/Toml/Codec/Combinator/Common.hs

@@ -60,10 +60,10 @@ match BiMap{..} key = Codec input output
         Nothing     -> Failure [KeyNotFound key]
         Just anyVal -> whenLeftBiMapError key (backward anyVal) pure
 
-    output :: a -> TomlState a
+    output :: a -> TomlState ()
     output a = do
         anyVal <- eitherToTomlState $ forward a
-        a <$ modify (insertKeyAnyVal key anyVal)
+        modify (insertKeyAnyVal key anyVal)
 
 {- | Throw error on 'Left', or perform a given action with 'Right'.
 

src/Toml/Codec/Combinator/List.hs

@@ -65,6 +65,7 @@ module Toml.Codec.Combinator.List
     ) where
 
 import Control.Monad.State (gets, modify)
+import Data.Foldable (traverse_)
 import Data.List.NonEmpty (NonEmpty (..), toList)
 import Validation (Validation (..))
 
@@ -80,6 +81,7 @@ import Toml.Type.Key (Key)
 import Toml.Type.TOML (TOML (..), insertTableArrays)
 
 import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List.NonEmpty as NonEmpty
 
 
 {- | Codec for list of values. Takes converter for single value and
@@ -159,9 +161,7 @@ list codec key = Codec
         Failure [TableArrayNotFound errKey]
             | errKey == key -> pure []
         Failure errs -> Failure errs
-    , codecWrite = \case
-        [] -> pure []
-        l@(x:xs) -> l <$ codecWrite nonEmptyCodec (x :| xs)
+    , codecWrite = traverse_ (codecWrite nonEmptyCodec) . NonEmpty.nonEmpty
     }
   where
     nonEmptyCodec :: TomlCodec (NonEmpty a)
@@ -213,7 +213,7 @@ nonEmpty codec key = Codec input output
 
 
     -- adds all TOML objects to the existing list if there are some
-    output :: NonEmpty a -> TomlState (NonEmpty a)
+    output :: NonEmpty a -> TomlState ()
     output as = do
         let tomls = fmap (execTomlCodec codec) as
         mTables <- gets $ HashMap.lookup key . tomlTableArrays
@@ -222,4 +222,4 @@ nonEmpty codec key = Codec input output
                 Nothing       -> tomls
                 Just oldTomls -> oldTomls <> tomls
 
-        as <$ modify (insertTableArrays key newTomls)
+        modify (insertTableArrays key newTomls)

src/Toml/Codec/Combinator/Map.hs

@@ -347,7 +347,7 @@ internalMap emptyMap toListMap fromListMap keyCodec valCodec key = Codec input o
             v <- codecRead valCodec toml
             pure (k, v)
 
-    output :: map -> TomlState map
+    output :: map -> TomlState ()
     output dict = do
         let tomls = fmap
                 (\(k, v) -> execTomlCodec keyCodec k <> execTomlCodec valCodec v)
@@ -363,7 +363,7 @@ internalMap emptyMap toListMap fromListMap keyCodec valCodec key = Codec input o
                 Just (t :| ts) ->
                     insertTableArrays key $ t :| (ts ++ tomls)
 
-        dict <$ modify updateAction
+        modify updateAction
 
 internalTableMap
     :: forall map k v
@@ -391,12 +391,12 @@ internalTableMap emptyMap toListMap fromListMap keyBiMap valCodec tableName =
                 whenLeftBiMapError key (forward keyBiMap key) $ \k ->
                     (k,) <$> codecRead (valCodec key) toml
 
-    output :: map -> TomlState map
+    output :: map -> TomlState ()
     output m = do
         mTable <- gets $ Prefix.lookup tableName . tomlTables
         let toml = fromMaybe mempty mTable
         let (_, newToml) = unTomlState updateMapTable toml
-        m <$ modify (insertTable tableName newToml)
+        modify (insertTable tableName newToml)
       where
         updateMapTable :: TomlState ()
         updateMapTable = forM_ (toListMap m) $ \(k, v) -> case backward keyBiMap k of

src/Toml/Codec/Combinator/Table.hs

@@ -87,9 +87,9 @@ table codec key = Codec input output
         Nothing   -> Failure [TableNotFound key]
         Just toml -> handleTableErrors codec key toml
 
-    output :: a -> TomlState a
+    output :: a -> TomlState ()
     output a = do
         mTable <- gets $ Prefix.lookup key . tomlTables
         let toml = fromMaybe mempty mTable
         let (_, newToml) = unTomlState (codecWrite codec a) toml
-        a <$ modify (insertTable key newToml)
+        modify (insertTable key newToml)

src/Toml/Codec/Di.hs

@@ -21,6 +21,7 @@ module Toml.Codec.Di
 
 import Control.Applicative (Alternative (..))
 import Data.Coerce (Coercible, coerce)
+import Data.Foldable (traverse_)
 
 import Toml.Codec.Types (Codec (..), TomlCodec, (<!>))
 
@@ -78,7 +79,7 @@ dimap
     -> TomlCodec b  -- ^ Target 'Codec' object
 dimap f g codec = Codec
     { codecRead  = fmap g . codecRead codec
-    , codecWrite = fmap g . codecWrite codec . f
+    , codecWrite = codecWrite codec . f
     }
 {-# INLINE dimap #-}
 
@@ -108,7 +109,7 @@ dioptional
     -> TomlCodec (Maybe a)
 dioptional Codec{..} = Codec
     { codecRead  = fmap Just . codecRead <!> \_ -> pure Nothing
-    , codecWrite = traverse codecWrite
+    , codecWrite = traverse_ codecWrite
     }
 {-# INLINE dioptional #-}
 
@@ -184,7 +185,7 @@ dimatch match ctor codec = Codec
     { codecRead = fmap ctor . codecRead codec
     , codecWrite = \c -> case match c of
         Nothing -> empty
-        Just d  -> ctor <$> codecWrite codec d
+        Just d  -> codecWrite codec d
     }
 {-# INLINE dimatch #-}
 

src/Toml/Codec/Types.hs

@@ -49,54 +49,50 @@ import Toml.Type (TOML (..))
 type TomlEnv a = TOML -> Validation [TomlDecodeError] a
 
 
-{- | Specialied 'Codec' type alias for bidirectional TOML serialization. Keeps
+{- | Specialized 'Codec' type alias for bidirectional TOML serialization. Keeps
 'TOML' object as both environment and state.
 
 @since 0.5.0
 -}
 type TomlCodec a = Codec a a
 
-{- | Monad for bidirectional conversion. Contains pair of functions:
+{- | Monad for bidirectional conversion. Contains a pair of functions:
 
-1. How to read value of type @o@ (out) from immutable environment context
+1. How to read a value of type @o@ (out) from an immutable environment context
 ('TomlEnv')?
-2. How to store a value of type @i@ (in) in stateful context ('TomlState') and
-return a value of type @o@?
+2. How to store a value of type @i@ (in) in a stateful context ('TomlState')?
 
-This approach with the bunch of utility functions allows to
-have single description for from/to @TOML@ conversion.
+This approach, along with a bunch of utility functions, allows us to
+have a single description for @TOML@ serialization + deserialization.
 
 In practice this type will always be used in the following way:
 
 @
 type 'TomlCodec' a = 'Codec' a a
 @
 
-Type parameter @i@ if fictional. Here some trick is used. This trick is
-implemented in the [codec](http://hackage.haskell.org/package/codec) package and
-described in more details in related blog post:
+However, we need to represent @i@ separately from @o@ in order to implement
+instances like 'Alternative', which requires the type parameter to be covariant,
+but @i@ is contravariant. This trick is inspired by the
+[codec](http://hackage.haskell.org/package/codec) package and
+described in more details in this blog post:
 <https://blog.poisson.chat/posts/2016-10-12-bidirectional-serialization.html>.
 
 @since 0.0.0
 -}
 data Codec i o = Codec
     { -- | Extract value of type @o@ from monadic context 'TomlEnv'.
       codecRead  :: TomlEnv o
-
-      {- | Store value of type @i@ inside monadic context 'TomlState' and
-      returning value of type @o@. Type of this function actually should be
-      @o -> TomlState ()@ but with such type it's impossible to have 'Monad'
-      and other instances.
-      -}
-    , codecWrite :: i -> TomlState o
+      -- | Store value of type @i@ inside monadic context 'TomlState'.
+    , codecWrite :: i -> TomlState ()
     }
 
 -- | @since 0.0.0
 instance Functor (Codec i) where
     fmap :: (oA -> oB) -> Codec i oA -> Codec i oB
     fmap f codec = Codec
         { codecRead  = fmap f . codecRead codec
-        , codecWrite = fmap f . codecWrite codec
+        , codecWrite = codecWrite codec
         }
     {-# INLINE fmap #-}
 
@@ -105,14 +101,14 @@ instance Applicative (Codec i) where
     pure :: o -> Codec i o
     pure a = Codec
         { codecRead  = \_ -> Success a
-        , codecWrite = \_ -> pure a
+        , codecWrite = \_ -> pure ()
         }
     {-# INLINE pure #-}
 
     (<*>) :: Codec i (oA -> oB) -> Codec i oA -> Codec i oB
     codecf <*> codeca = Codec
         { codecRead  = liftA2 (<*>) (codecRead codecf) (codecRead codeca)
-        , codecWrite = \c -> codecWrite codecf c <*> codecWrite codeca c
+        , codecWrite = \c -> codecWrite codecf c *> codecWrite codeca c
         }
     {-# INLINE (<*>) #-}
 
@@ -138,16 +134,15 @@ f <!> g = \a -> f a <|> g a
 {-# INLINE (<!>) #-}
 
 {- | Mutable context for TOML conversion.
-We are introducing our own implemetation of state with 'MonadState' instance due
-to some limitation in the design connected to the usage of State.
+We are introducing our own implementation of state with 'MonadState' instance due
+to some limitations in the design connected to the usage of State.
 
 This newtype is equivalent to the following transformer:
 
 @
 MaybeT (State TOML)
 @
 
-
 @since 1.3.0.0
 -}
 newtype TomlState a = TomlState