{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Language.RNC.Sym where

import Control.Applicative (Applicative(..), (<$>), (<$))
import Data.Foldable (Foldable,foldl',foldr)
import Data.Function (($),(.),id,flip)
import Data.Int (Int)
import Data.Maybe (Maybe(..), maybe)
import Data.Text (Text)
import Text.Show (Show)
import qualified Data.Text as Text

import Language.DTC.Document (Default(..), MayText(..))
import Language.TCT.Write.XML (XmlName(..))
import qualified Language.DTC.Document as DTC

foldlApp :: (DTC.Default a, Foldable t) => t (a -> a) -> a
foldlApp = foldl' (flip ($)) def
foldrApp :: (DTC.Default a, Foldable t) => t (a -> a) -> a
foldrApp = foldr ($) def

-- * 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   :: XmlName -> repr a -> repr a
	attribute :: XmlName -> repr a -> repr a
	comment   :: repr Text
	try       :: repr a -> repr a
	none      :: repr ()
	anyElem   :: Show a => (XmlName -> repr a) -> repr a
	any       :: repr ()
	text      :: repr Text
	int       :: repr Int
	nat       :: repr DTC.Nat
	nat1      :: repr DTC.Nat1
	(<|>)     :: repr a -> repr a -> repr a
	many      :: repr a -> repr [a]
	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 <$>)