content: {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE TupleSections         #-}
  {-# LANGUAGE TypeFamilies          #-}
  {-# LANGUAGE TypeOperators         #-}
  {-# LANGUAGE UndecidableInstances  #-}
  
  {- |
  Module                  : Toml.Codec.Types
  Copyright               : (c) 2018-2022 Kowainik
  SPDX-License-Identifier : MPL-2.0
  Maintainer              : Kowainik <xrom.xkov@gmail.com>
  Stability               : Stable
  Portability             : Portable
  
  Contains general underlying monad for bidirectional conversion.
  
  @since 1.3.0.0
  -}
  
  module Toml.Codec.Types
         ( -- * Toml Codec
           TomlCodec
           -- * Toml Environment
         , TomlEnv
           -- * Toml State
         , TomlState (..)
         , eitherToTomlState
  
           -- * Codec
         , Codec (..)
  
           -- * Function alternative
         , (<!>)
         ) where
  
  import Control.Applicative (Alternative (..), liftA2)
  import Control.Monad.State (MonadState (..))
  import Data.Bifunctor (first)
  import Validation (Validation (..))
  
  import Toml.Codec.Error (TomlDecodeError)
  import Toml.Type (TOML (..))
  
  
  {- | Immutable environment for TOML conversion.
  
  @since 1.3.0.0
  -}
  type TomlEnv a = TOML -> Validation [TomlDecodeError] a
  
  
  {- | Specialied '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:
  
  1. How to read value of type @o@ (out) from 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@?
  
  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:
  
  @
  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:
  <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
      }
  
  -- | @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
          }
      {-# INLINE fmap #-}
  
  -- | @since 0.0.0
  instance Applicative (Codec i) where
      pure :: o -> Codec i o
      pure a = Codec
          { codecRead  = \_ -> Success a
          , codecWrite = \_ -> pure a
          }
      {-# 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
          }
      {-# INLINE (<*>) #-}
  
  instance Alternative (Codec i) where
      empty :: Codec i o
      empty = Codec
          { codecRead  = \_ -> empty
          , codecWrite = \_ -> empty
          }
      {-# INLINE empty #-}
  
      (<|>) :: Codec i o -> Codec i o -> Codec i o
      codec1 <|> codec2 = Codec
          { codecRead  = codecRead codec1 <!> codecRead codec2
          , codecWrite = \c -> codecWrite codec1 c <|> codecWrite codec2 c
          }
      {-# INLINE (<|>) #-}
  
  -- | Alternative instance for function arrow but without 'empty'.
  infixl 3 <!>
  (<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> (a -> f x)
  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.
  
  This newtype is equivalent to the following transformer:
  
  @
  MaybeT (State TOML)
  @
  
  
  @since 1.3.0.0
  -}
  newtype TomlState a = TomlState
      { unTomlState :: TOML -> (Maybe a, TOML)
      }
  
  -- | @since 1.3.0.0
  instance Functor TomlState where
      fmap :: (a -> b) -> TomlState a -> TomlState b
      fmap f TomlState{..} = TomlState (first (fmap f) . unTomlState)
      {-# INLINE fmap #-}
  
      (<$) :: a -> TomlState b -> TomlState a
      a <$ TomlState{..} = TomlState (first (fmap (const a)) . unTomlState)
      {-# INLINE (<$) #-}
  
  -- | @since 1.3.0.0
  instance Applicative TomlState where
      pure :: a -> TomlState a
      pure a = TomlState (Just a,)
      {-# INLINE pure #-}
  
      (<*>) :: TomlState (a -> b) -> TomlState a -> TomlState b
      tsF <*> tsA = TomlState $ \t ->
          let (mF, tF) = unTomlState tsF t
              (mA, tA) = unTomlState tsA tF
          in (mF <*> mA , tA)
      {-# INLINE (<*>) #-}
  
  -- | @since 1.3.0.0
  instance Alternative TomlState where
      empty :: TomlState a
      empty = TomlState (Nothing,)
      {-# INLINE empty #-}
  
      (<|>) :: TomlState a -> TomlState a -> TomlState a
      ts1 <|> ts2 = TomlState $ \t -> let (m1, t1) = unTomlState ts1 t in case m1 of
          Nothing -> unTomlState ts2 t
          Just _  -> (m1, t1)
      {-# INLINE (<|>) #-}
  
  -- | @since 1.3.0.0
  instance Monad TomlState where
      return :: a -> TomlState a
      return = pure
      {-# INLINE return #-}
  
      (>>=) :: TomlState a -> (a -> TomlState b) -> TomlState b
      tsA >>= f = TomlState $ \t -> let (mA, newT) = unTomlState tsA t in case mA of
          Nothing -> (Nothing, newT)
          Just a  -> unTomlState (f a) newT
      {-# INLINE (>>=) #-}
  
  -- | @since 1.3.0.0
  instance (s ~ TOML) => MonadState s TomlState where
      state :: (TOML -> (a, TOML)) -> TomlState a
      state f = TomlState (first Just . f)
      {-# INLINE state #-}
  
      get :: TomlState TOML
      get = TomlState (\t -> (Just t, t))
      {-# INLINE get #-}
  
      put :: TOML -> TomlState ()
      put t = TomlState (\_ -> (Just (), t))
      {-# INLINE put #-}
  
  {- | Transform 'Either' into 'TomlState'.
  
  @since 1.3.0.0
  -}
  eitherToTomlState :: Either e a -> TomlState a
  eitherToTomlState e = TomlState (either (const Nothing) Just e,)
  