{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Hdoc.RNC.Sym where

import Control.Applicative (Applicative(..), (<$>))
import Data.Function ((.),id)
import Data.Bool (Bool)
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ratio (Rational)
import Data.Text (Text)
import Text.Show (Show)
import qualified Data.Text.Lazy as TL

import Hdoc.Utils (Nat(..), Nat1(..))
import qualified Hdoc.XML as XML

-- * Type 'Rule'
type Rule a = a -> a

-- ** Class 'Sym_Rule'
class Sym_Rule repr where
	rule :: Show a => Text -> Rule (repr a)
	rule _n = id

-- * Type family 'Perm'
type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr

-- * Class 'Sym_Interleaved'
class Sym_Interleaved repr where
	interleaved :: Perm repr a -> repr a
	(<$$>) :: (a -> b) -> repr a -> Perm repr b
	
	(<$?>) :: (a -> b) -> (a,repr a) -> Perm repr b
	(<||>) :: Perm repr (a -> b) -> repr a -> Perm repr b
	(<|?>) :: Perm repr (a -> b) -> (a,repr a) -> Perm repr b
	
	(<$*>) :: ([a] -> b) -> repr a -> Perm repr b
	(<|*>) :: Perm repr ([a] -> b) -> repr a -> Perm repr b

infixl 3 <|>
infixl 2 <$$>, <$?>, <$*>
infixl 1 <||>, <|?>, <|*>

-- * Class 'Sym_RNC'
class
 ( Applicative repr
 -- , Alternative repr
 , Sym_Rule repr
 , Sym_Interleaved repr
 ) => Sym_RNC repr where
	element   :: XML.Name -> repr a -> repr a
	attribute :: XML.Name -> repr a -> repr a
	comment   :: repr TL.Text
	try       :: repr a -> repr a
	fail      :: repr a
	none      :: repr ()
	anyElem   :: Show a => (XML.Name -> repr a) -> repr a
	any       :: repr ()
	text      :: repr TL.Text
	bool      :: repr Bool
	int       :: repr Int
	rational  :: repr Rational
	rationalPositive :: repr Rational
	nat       :: repr Nat
	nat1      :: repr Nat1
	(<|>)     :: repr a -> repr a -> repr a
	many      :: repr a -> repr [a]
	 -- TODO: maybe use Seq instead of []
	some      :: repr a -> repr [a]
	optional  :: repr a -> repr (Maybe a)
	option    :: a -> repr a -> repr a
	choice    :: [repr a] -> repr a
	intermany :: [repr a] -> repr [a]
	intermany = many . choice . (try <$>)