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.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

-- * 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 :)

-- 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)