module Webc.Encoder where

import Control.Monad (Monad (..))
import Control.Monad.Trans.Reader qualified as MT
import Data.Either (Either (..))
import Data.Foldable (foldMap)
import Data.Function (id, ($))

-- import Data.List qualified as List

import Data.ByteString.Lazy qualified as BSL
import Data.Maybe (Maybe (..))
import Data.Monoid (Endo (..), appEndo)
import Data.Semigroup (Semigroup (..))
import Network.URI.Slug
import Symantic.Classes (Iso (..), IsoFunctor ((<%>)), Optionable (..), ProductFunctor ((<.>)), SumFunctor ((<+>)))

import Webc.Classes
import Webc.Decoder (Request (..))
import Webc.MIME

-- * The 'Encoder' interpreter

-- | Encode a given route to its URL.
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 Repeatable Encoder where
  many0 x = Encoder $
    MT.ReaderT $ \as ->
      return $ Endo (foldMap (encode x) as <>)
  many1 = many0
instance Optionable Encoder where
  optional (Encoder x) = Encoder $
    MT.ReaderT $ \case
      Nothing -> return $ Endo id
      Just a -> return $ MT.runReader x a
instance Slugable Encoder where
  literalSlug s = Encoder $ return $ Endo (s :)
  chooseSlug _s = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)

{-
instance ContentTypeable PlainText BSL.ByteString Encoder where
  contentType = Encoder $ MT.ReaderT $ \a ->
    return a
-}
-- chooseSlugs _s = Encoder $ MT.ReaderT $ \s -> return $ Endo (List.reverse s <>)
instance Capturable Encoder where
  captureSlug _n = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)
instance Endable Encoder where
  end = Encoder $ return $ Endo id

--chooseSlug _cs = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)
-- instance Fileable Encoder where
--   type FileableConstraint Encoder = Typeable
--   static = Encoder $ MT.ReaderT $ \_a ->
--     return $ Endo (\x -> x)