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

import Control.Applicative (Applicative(..), Alternative(..), optional, (<$>), (<$))
import Data.Foldable (Foldable,foldl',foldr)
import Data.Function (($),(.),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

class (Applicative repr, Alternative repr) => Sym_RNC repr where
	rule      :: Show a => Text -> repr a -> repr a
	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
	choice    :: [repr a] -> repr a
	intermany :: [repr a] -> repr [a]
	intermany = many . choice . (try <$>)
	
	type Perm repr = (r :: * -> *) | r -> repr
	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 2 <$$>, <$?>, <$*>
infixl 1 <||>, <|?>, <|*>

class Sym_RNC repr => Sym_DTC repr where
	title       :: repr DTC.Title
	name        :: repr Text
	url         :: repr DTC.URL
	path        :: repr DTC.Path
	ident       :: repr DTC.Ident
	to          :: repr DTC.Ident
	id          :: repr DTC.Ident
	date        :: repr DTC.Date
	include     :: repr DTC.Include
	horizontals :: repr DTC.Horizontals
	horizontal  :: repr DTC.Horizontal
	verticals   :: repr DTC.Verticals
	vertical    :: repr DTC.Vertical
	reference   :: repr DTC.Reference
	document    :: repr DTC.Document
	head        :: repr DTC.Head
	about       :: repr DTC.About
	keyword     :: repr Text
	version     :: repr MayText
	author      :: repr DTC.Entity
	editor      :: repr DTC.Entity
	entity      :: repr DTC.Entity
	address     :: repr DTC.Address
	link        :: repr DTC.Link
	serie       :: repr DTC.Serie
	alias       :: repr DTC.Alias
	commonAttrs :: repr DTC.CommonAttrs
	commonAttrs =
		interleaved $
		DTC.CommonAttrs
		 <$?> (def, id)
		 <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
	
	document = rule "document" $
		DTC.Document
		 <$> head
		 <*> many (
			choice
			 [ rule "section" $
				element "section" $
				DTC.Section
				 <$> commonAttrs
				 <*> title
				 <*> many alias
				 <*> verticals
			 , vertical
			 ]
		 )
	head = rule "head" $
		maybe def DTC.Head
		 <$> optional (rule "about" $ element "about" about)
	title = rule "title" $ DTC.Title <$> element "title" horizontals
	name  = rule "name"  $ attribute "name" text
	url   = rule "url"   $ DTC.URL   <$> text
	path  = rule "path"  $ DTC.Path  <$> text
	ident = rule "ident" $ DTC.Ident <$> text
	to    = rule "to"    $ attribute "to" ident
	id    = rule "id"    $ attribute "id" ident
	date  = rule "date"  $
		element "date" $
		interleaved $
		DTC.Date
		 <$?> (0, attribute "year" int)
		 <|?> (Nothing, Just <$> attribute "month" nat1)
		 <|?> (Nothing, Just <$> attribute "day"   nat1)
	include  = rule "include"  $
		element "include" $
		interleaved $
		DTC.Include
		 <$?> (def, attribute "href" path)
	verticals = many vertical
	vertical = rule "vertical" $
		choice
		 [ DTC.Comment <$> comment
		 , element "para" $ DTC.Para
			 <$> commonAttrs
			 <*> horizontals
		 , element "ol" $ DTC.OL
			 <$> commonAttrs
			 <*> many (element "li" verticals)
		 , element "ul" $ DTC.UL
			 <$> commonAttrs
			 <*> many (element "li" verticals)
		 , element "rl" $ DTC.RL
			 <$> commonAttrs
			 <*> many reference
		 , element "toc" $ DTC.ToC
			 <$> commonAttrs
			 <*> optional (attribute "depth" int)
		 , element "tof" $ DTC.ToF
			 <$> commonAttrs
			 <*> optional (attribute "depth" int)
		 , element "index" $ DTC.Index
			 <$> commonAttrs
			 <*  any
		 , anyElem $ \XmlName{..} ->
				case xmlNameSpace of
				 "" ->
					rule "figure" $
					DTC.Figure
					 <$> commonAttrs
					 <*> pure xmlNameLocal
					 <*> title
					 <*> verticals
		 ]
	horizontals = many horizontal
	horizontal = rule "horizontal" $
		choice
		 [ DTC.BR   <$  element "br"   none
		 , DTC.B    <$> element "b"    horizontals
		 , DTC.Code <$> element "code" horizontals
		 , DTC.Del  <$> element "del"  horizontals
		 , DTC.I    <$> element "i"    horizontals
		 , DTC.Note <$> element "note" horizontals
		 , DTC.Q    <$> element "q"    horizontals
		 , DTC.SC   <$> element "sc"   horizontals
		 , DTC.Sub  <$> element "sub"  horizontals
		 , DTC.Sup  <$> element "sup"  horizontals
		 , DTC.U    <$> element "u"    horizontals
		 , element "eref" $ DTC.Eref
			 <$> attribute "to" url
			 <*> horizontals
		 , element "iref" $ DTC.Iref <$> to <*> horizontals
		 , element "ref"  $ DTC.Ref  <$> to <*> horizontals
		 , element "rref" $ DTC.Rref <$> to <*> horizontals
		 , DTC.Plain <$> text
		 ]
	keyword = rule "keyword" $
		element "keyword" text
	version = rule "version" $
		MayText <$>
		element "version" text
	about =
		interleaved $
		DTC.About
		 <$*> title
		 <|*> author
		 <|?> (Nothing, Just <$> editor)
		 <|?> (Nothing, Just <$> date)
		 <|?> (def, version)
		 <|*> keyword
		 <|*> link
		 <|*> serie
		 <|*> include
	author = rule "author" $ element "author" entity
	editor = rule "editor" $ element "editor" entity
	entity = rule "entity" $
		DTC.Entity
		 <$> name
		 <*> address
	address = rule "address" $
		element "address" $
		interleaved $
		DTC.Address
		 <$?> (def, attribute "street"  text)
		 <|?> (def, attribute "zipcode" text)
		 <|?> (def, attribute "city"    text)
		 <|?> (def, attribute "region"  text)
		 <|?> (def, attribute "country" text)
		 <|?> (def, attribute "email"   text)
		 <|?> (def, attribute "tel"     text)
		 <|?> (def, attribute "fax"     text)
	serie = rule "serie" $
		element "serie" $
		interleaved $
		DTC.Serie
		 <$?> (def, attribute "name" text)
		 <|?> (def, attribute "key"  text)
	link = rule "link" $
		element "link" $
		interleaved $
		DTC.Link
		 <$?> (def, attribute "name" text)
		 <|?> (def, attribute "href" url)
		 <|?> (def, attribute "rel"  text)
		 <|*> horizontal
	alias = rule "alias" $
		element "alias" $
		interleaved $
		DTC.Alias
		 <$?> (def, id)
	reference = rule "reference" $
		element "reference" $
		DTC.Reference
		 <$> id
		 <*> optional (attribute "to" url)
		 <*> about
	
	 {-
	 , element "figure" $ ul
	       { type_ :: Text
	       , body  :: Verticals
	       }
	 , Artwork     Artwork
	 -}