module Nesting where
import Typeful.Text.HTMLs.Types.General
import Typeful.Text.HTMLs ((+++))

{- |
Appendix B says:

   The following elements have prohibitions on which
   elements they can contain (see SGML Exclusions). This
   prohibition applies to all depths of nesting, i.e. it
   contains all the descendant elements.

   a
       must not contain other a elements.
   pre
       must not contain the img, object, big, small, sub, or
       sup elements.

   button
       must not contain the input, select, textarea, label,
       button, form, fieldset, iframe or isindex elements.

   label
       must not contain other label elements.

   form
       must not contain other form elements. 


This module demonstrates a strategy to acheive this, on a
smaller datatype.

As to xhtml, we have that the following eighteen elements

   a, img, object, big, small, sub, sup, input, select,
   textarea, label, button, form, fieldset, iframe, isindex,
   label, form

are prohibited somewhere — which implies eighteen arguments
to each of the context type constructors! 

-}

top:: [Blk A B] -> [Blk A B]
top = id

newtype A_not_allowed_in_A b = ANAIA ()
    deriving Show
newtype B_not_allowed_in_B b = BNAIB ()
    deriving Show


data Inl a b
    = Inl_A (a (Inl A_not_allowed_in_A b))
    | Inl_B (b (Blk a B_not_allowed_in_B))
    | Inl_C (C a b)
    | Inl_T T
      -- deriving (Show)
data A inl
    = A [inl]
      deriving (Show)

data B blk
    = B (List1 blk)
      deriving (Show)

data C a b
    = C (One (Inl a b))
      -- deriving (Show)

class Showy t where
    showy:: Show a => t a -> ShowS
instance Showy A_not_allowed_in_A where
    showy = undefined
instance Showy A where
    showy (A x) = ("A " ++) .  shows x
instance Showy B_not_allowed_in_B where
    showy = undefined
instance Showy B where
    showy (B x) = ("B " ++) . shows x

instance (Showy a, Showy b) => Show (C a b) where
    show (C inl) = "C ("++ show inl ++ ")"

instance (Showy a, Showy b)
    => Show (Inl a b) where
    show (Inl_A a) = "(Inl_A " ++ showy a ")"
    show (Inl_B b) = "(Inl_B " ++ showy b ")"
    show (Inl_C c) = "(Inl_C " ++ shows c ")"
    show (Inl_T t) = show t

data Blk a b
    = Blk_P (P a b)
    | Blk_B (b (Blk a B_not_allowed_in_B))
    | Blk_T T
      -- deriving (Show)
instance (Showy a, Showy b)
    => Show (Blk a b) where
    show (Blk_P p) = "(Blk_P " ++ shows p ")"
    show (Blk_B b) = "(Blk_B " ++ showy b ")"
    show (Blk_T t) = show t

data P a b
    = P [Inl a b]
      -- deriving (Show)
instance (Showy a, Showy b)
    => Show (P a b) where
    show (P i) = "(P " ++ shows i ")"

data T = T
      deriving (Show)

{- I cant see how to do the equivalent of A_a_i a => A_a_i
   [a] because [] takes one argument, while the t's here all
   take two. Instead, have the allowed_in method (of
   elements that can be in list contexts, at least) return
   any monad.

   This might require the use of a unit(?) monad such as

-}

data One t = One t deriving Show
instance Monad One where
   return x = One x
   One a >>= f = f a

class A_allowed_in t where
    a :: (Is_A a, Monad m) => [Inl A_not_allowed_in_A b] -> m (t a b)

class Is_A t where
    is_A :: A b -> t b

instance A_allowed_in Inl where
    a x = return $ Inl_A (is_A $ A x)
instance Is_A A where
    is_A = Prelude.id


class B_allowed_in t where
    b :: (Is_B b, Monad m) => List1 (Blk a B_not_allowed_in_B) -> m (t a b)
instance B_allowed_in Inl where
    b x = return $ Inl_B (is_B $ B x)
instance B_allowed_in Blk where
    b x = return $ Blk_B (is_B $ B x)

class Is_B t where
    is_B :: B a -> t a
instance Is_B B where
    is_B = Prelude.id

class C_allowed_in t where
    c :: Monad m => One (Inl a b) -> m (t a b)
instance C_allowed_in Inl where
    c x = return $ Inl_C (C x)

class P_allowed_in t where
    p :: Monad m => [Inl a b] -> m (t a b)
instance P_allowed_in Blk where
    p x = return $ Blk_P (P x)
{-

 this strikes me as getting a bit Oleg, but without the
 olegs, GHC won't accept the instance definitions for
 T_allowed_in

-}

class Kind1 k where
    oleg :: k t
instance Kind1 A_not_allowed_in_A where
    oleg = undefined
instance Kind1 B_not_allowed_in_B where
    oleg = undefined
instance Kind1 A where
    oleg = undefined
instance Kind1 B where
    oleg = undefined

class T_allowed_in t where
    t :: (Kind1 a, Kind1 b, Monad m) => m (t a b)
instance T_allowed_in Blk where
    t = return $ Blk_T T
instance T_allowed_in Inl where
    t = return $ Inl_T T
{-
-}