{-# LANGUAGE UndecidableInstances #-}
module Symantic.XML.Language
 ( module Symantic.XML.Language
 , module Symantic.XML.Namespace
 , module Symantic.XML.Text
 , module Symantic.Base.Composable
 , module Symantic.Base.Algebrable
 , module Symantic.Base.Permutable
 ) where

import Data.Function ((.))
import Data.Maybe (Maybe)
import Data.Kind (Constraint)
import qualified Data.Text.Lazy as TL

import Symantic.XML.Namespace
import Symantic.XML.Text
import Symantic.Base.Algebrable
import Symantic.Base.Composable
import Symantic.Base.Permutable

-- * Class 'XML'
class
 ( Composable repr
 , Tupable repr
 , Eitherable repr
 , Textable repr
 ) => XML repr where
  --xmlPI ::  -> repr a k
  -- | @('namespace' p ns)@ declares a namespace prefix @(p)@
  -- to be used for the 'Namespace' @(ns)@.
  -- Or make @(ns)@ the default namespace if @(p)@ is 'Nothing'.
  namespace :: Maybe NCName -> Namespace -> repr k k
  default namespace ::
   Transformable repr => XML (UnTrans repr) =>
   Maybe NCName -> Namespace -> repr k k
  namespace n ns = noTrans (namespace n ns)

  default element :: Transformable repr => XML (UnTrans repr) =>
             QName -> repr a k -> repr a k
  element :: QName -> repr a k -> repr a k
  element n x = noTrans (element n (unTrans x))

  default attribute :: Transformable repr => XML (UnTrans repr) =>
               QName -> repr a k -> repr a k
  attribute :: QName -> repr a k -> repr a k
  attribute n x = noTrans (attribute n (unTrans x))

  default pi :: Transformable repr => XML (UnTrans repr) =>
        PName -> repr (TL.Text -> k) k
  pi :: PName -> repr (TL.Text -> k) k
  pi n = noTrans (pi n)

  default literal :: Transformable repr => XML (UnTrans repr) =>
             TL.Text -> repr k k
  literal :: TL.Text -> repr k k
  literal = noTrans . literal

  default comment :: Transformable repr => XML (UnTrans repr) =>
             repr (TL.Text -> k) k
  comment :: repr (TL.Text -> k) k
  comment = noTrans comment

  default cdata :: Transformable repr => XML (UnTrans repr) =>
           repr (TL.Text -> k) k
  cdata :: repr (TL.Text -> k) k
  cdata = noTrans cdata

-- ** Class 'Textable'
class Textable repr where
  type TextConstraint repr a :: Constraint
  type TextConstraint repr a = TextConstraint (UnTrans repr) a
  default text :: Transformable repr => XML (UnTrans repr) =>
          TextConstraint (UnTrans repr) a => repr (a -> k) k
  text :: TextConstraint repr a => repr (a -> k) k
  text = noTrans text