module Webc.Encoder where

import Control.Monad (Monad (..))
import Control.Monad.Trans.Reader qualified as MT
import Data.Either (Either (..))
import Data.Function (($))
import Data.Monoid (Endo (..), appEndo)
import Data.Semigroup (Semigroup (..))
import Network.URI.Slug
import Symantic.Classes (Iso (..), IsoFunctor ((<%>)), ProductFunctor ((<.>)), SumFunctor ((<+>)))

import Webc.Classes

-- * The 'Encoder' interpreter

newtype Encoder a = Encoder
  { unEncoder :: MT.Reader a (Endo [Slug])
  }

encode :: Encoder a -> a -> [Slug]
encode (Encoder enc) a = appEndo (MT.runReader enc a) []

instance IsoFunctor Encoder where
  Iso{..} <%> Encoder x = Encoder (MT.withReader b2a x)
instance ProductFunctor Encoder where
  Encoder x <.> Encoder y = Encoder $
    MT.ReaderT $ \(a, b) ->
      return $
        MT.runReader x a
          <> MT.runReader y b
instance SumFunctor Encoder where
  Encoder x <+> Encoder y = Encoder $
    MT.ReaderT $ \case
      Left a -> return $ MT.runReader x a
      Right b -> return $ MT.runReader y b
instance Slugable Encoder where
  literalSlug s = Encoder $ return $ Endo (s :)
  captureSlug _n = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)