module Webc.Classes where

import Data.Function ((.))
import Network.URI.Slug qualified as URI
import Symantic.Classes (ProductFunctor (..))
import Symantic.Data (Data, SomeData (..))
import Symantic.Derive (Derivable (..))

-- * Class 'Slugable'

-- | Syntax (final algebra) for expressing URL paths.
class Slugable repr where
  slug :: URI.Slug -> repr ()

-- | Pattern-matchable encoding (initial algebra) of 'Slugable'.
data instance Data Slugable repr a where
  Slug :: URI.Slug -> Data Slugable repr ()

-- | Initial to final algebra.
instance Slugable repr => Derivable (Data Slugable repr) where
  derive = \case
    Slug s -> slug s

-- | Final to initial algebra.
instance Slugable repr => Slugable (SomeData repr) where
  slug = SomeData . Slug

-- | Convenient alias for an @index.html@ page.
index :: Slugable repr => repr ()
index = slug "index.html"

-- | Convenient alias for prefixing a 'slug'.
(</>) ::
  ProductFunctor repr =>
  Slugable repr =>
  URI.Slug ->
  repr a ->
  repr a
(</>) n = (slug n .>)

infixr 4 </>