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

import Control.Applicative (Applicative(..), (<$>), (<$))
import Control.Monad (void)
import Data.Default.Class (Default(..))
import Data.Foldable (Foldable, foldl', foldr)
import Data.Function (($), flip)
import Data.Maybe (Maybe(..), maybe)
import Data.Text (Text)
import qualified Data.Text as Text

import Language.XML
import Language.RNC.Sym as RNC
import qualified Language.DTC.Document as DTC
import qualified Language.RNC.Write as RNC

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

class RNC.Sym_RNC repr => Sym_DTC repr where
	title       :: repr DTC.Title
	name        :: repr Text
	url         :: repr URL
	path        :: repr Path
	ident       :: repr Ident
	to          :: repr Ident
	id          :: repr Ident
	date        :: repr DTC.Date
	include     :: repr DTC.Include
	horizontals :: repr DTC.Horizontals
	horizontal  :: repr DTC.Horizontal
	vertical    :: repr DTC.Vertical
	reference   :: repr DTC.Reference
	document    :: repr DTC.Document
	head        :: repr DTC.Head
	body        :: repr [DTC.Body]
	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
	figure      :: repr DTC.Vertical
	commonAttrs :: repr DTC.CommonAttrs
	commonAttrs =
		rule "commonAttrs" $
		interleaved $
		DTC.CommonAttrs
		 <$?> (def, Just <$> id)
		 <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
	
	document = rule "document" $
		DTC.Document
		 <$> head
		 <*> body
	head = rule "head" $
		maybe def DTC.Head
		 <$> optional (rule "about" $ element "about" about)
	body =
		rule "body" $
		many $
			choice
			 [ rule "section" $
				element "section" $
				position $
				DTC.Section
				 <$> commonAttrs
				 <*> title
				 <*> many alias
				 <*> body
			 , element "toc" $
				position $
				DTC.ToC
				 <$> commonAttrs
				 <*> optional (attribute "depth" int)
			 , element "tof" $
				position $
				DTC.ToF
				 <$> commonAttrs
				 <*> optional (attribute "depth" int)
			 , element "index" $
				position $
				DTC.Index
				 <$> commonAttrs
				 <*  any
			 , DTC.Verticals
				 <$> some vertical
			 ]
	title = rule "title" $ DTC.Title <$> element "title" horizontals
	name  = rule "name"  $ attribute "name" text
	url   = rule "url"   $ URL   <$> text
	path  = rule "path"  $ Path  <$> text
	ident = rule "ident" $ 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)
	vertical = rule "vertical" $
		choice
		 [ DTC.Comment <$> comment
		 , element "para" $
			position $
			DTC.Para
			 <$> commonAttrs
			 <*> horizontals
		 , element "ol" $
			position $
			DTC.OL
			 <$> commonAttrs
			 <*> many (element "li" $ many vertical)
		 , element "ul" $
			position $
			DTC.UL
			 <$> commonAttrs
			 <*> many (element "li" $ many vertical)
		 , element "rl" $
			position $
			DTC.RL
			 <$> commonAttrs
			 <*> many reference
		 , figure
		 {-
		 , anyElem $ \n@XmlName{..} ->
				case xmlNameSpace of
				 "" -> figure n
		 -}
		 ]
	figure =
		rule "figure" $
		element "figure" $
		position $
		DTC.Figure
		 <$> attribute "type" text
		 <*> commonAttrs
		 <*> title
		 <*> many vertical
	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

instance Sym_DTC RNC.Writer
instance Sym_DTC RNC.RuleWriter
dtcRNC :: [RNC.RuleWriter ()]
dtcRNC =
 [ void document
 , void head
 , void body
 
 , void vertical
 , void horizontal
 , void $ rule "horizontals" horizontals
 
 , void title
 , void name
 , void url
 , void path
 , void ident
 
 , void commonAttrs
 , void to
 , void id
 
 , void $ rule "about" $ element "about" about
 , void address
 , void author
 , void date
 , void editor
 , void entity
 , void keyword
 , void link
 , void serie
 , void version
 
 , void alias
 , void reference
 
 , void include
 , void figure
 ]