-- For Addresser
{-# LANGUAGE RankNTypes #-}
-- For Dataable
{-# LANGUAGE UndecidableInstances #-}

module Literate.Web.Semantics.Addresser where

import Data.Bool
import Data.Function (id, ($), (.))
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import GHC.Generics (Generic)
import Literate.Web.Syntaxes
import Literate.Web.Types.URL
import Symantic qualified as Sym
import Text.Show (Show (..))

-- * Type 'Addresser'

-- Interpreter building 'Address'.
data Addresser a = Addresser
  { unAddresser :: forall next. (Address -> next) -> a --> next
  }

-- | Nothing is needed at the 'Endpoint' for building an 'Address'.
type instance ToFEndpoint Addresser a next = next

address :: Addresser a -> a --> Address
address router = unAddresser router id

instance PathSegmentable (Addresser) where
  pathSegment s = Addresser \f -> f Address{addressPath = [s]}

instance Sym.SumFunctor Addresser where
  a <+> b = Addresser \n -> (unAddresser a n, unAddresser b n)
instance Sym.ProductFunctor Addresser where
  a <.> b = Addresser \k -> unAddresser a \aA -> unAddresser b \bA -> k (bA <> aA)
  a <. b = Addresser \k -> unAddresser a \aA -> unAddresser b \bA -> k (bA <> aA)
  a .> b = Addresser \k -> unAddresser a \aA -> unAddresser b \bA -> k (bA <> aA)
instance
  ( Generic a
  , Sym.EoTOfRep a
  , sem ~ Addresser
  , Sym.IsToF a ~ 'False
  , e ~ Sym.EoT (Sym.ADT a)
  , Sym.ToFable e
  ) =>
  Dataable a Addresser
  where
  -- dataType :: sem (Sym.EoT (Sym.ADT a)) -> sem a
  dataType a = Addresser (\a2n -> Sym.funOftof (unAddresser a a2n) . Sym.eotOfadt)
instance (Sym.IsToF a ~ 'False) => Optionable a Addresser where
  optional aA = Addresser \k -> \case
    Nothing -> k mempty
    Just a -> unAddresser aA k a

instance (end ~ Address) => Responsable a ts m (Addresser) where
  response = Addresser ($ mempty)

-- ** Type 'Address'
newtype Address = Address
  { addressPath :: [PathSegment]
  }
  deriving (Show)
instance Semigroup (Address) where
  Address a <> Address b = Address (a <> b)
instance Monoid (Address) where
  mempty = Address []