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

module Literate.Web.Semantics.Addresser where

import Data.Bool
import Data.Eq (Eq)
import Data.Function (id, ($), (.))
import Data.Functor ((<$>))
import Data.List qualified as List
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Ord (Ord)
import Data.Semigroup (Semigroup (..))
import Data.Text qualified as Text
import GHC.Generics (Generic)
import Literate.Web.Syntaxes
import Literate.Web.Types.URL
import Symantic qualified as Sym
import System.FilePath qualified as Sys
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{addressSegs = [s], addressExts = []}

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 (aA <> bA)
  a <. b = Addresser \k -> unAddresser a \aA -> unAddresser b \bA -> k (aA <> bA)
  a .> b = Addresser \k -> unAddresser a \aA -> unAddresser b \bA -> k (aA <> bA)
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'
data Address = Address
  { addressSegs :: [PathSegment]
  , addressExts :: [PathSegment]
  }
  deriving (Eq, Ord, Show)
instance Semigroup Address where
  x <> y =
    Address
      { addressSegs = addressSegs x <> addressSegs y
      , addressExts = addressExts x <> addressExts y
      }
instance Monoid Address where
  mempty = Address{addressSegs = [], addressExts = []}

addressFile :: Address -> Sys.FilePath
addressFile addr =
  List.intercalate "." $
    encodePath (addressSegs addr)
      : (Text.unpack . encodePathSegment <$> addressExts addr)