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

import Control.Applicative (Applicative(..), (<$>), (<$))
import Control.Monad (void)
import Data.Default.Class (Default(..))
import Data.Foldable (Foldable(..), concat)
import Data.Function (($), (.), flip)
import Data.Maybe (Maybe(..), maybe)
import Data.TreeSeq.Strict (Tree(..), tree0)
import qualified Data.Sequence as Seq
import qualified Data.Text.Lazy as TL

import Language.XML
import Language.RNC.Sym as RNC
import Language.DTC.Anchor (wordify)
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
	position    :: repr DTC.Pos
	document    :: repr DTC.Document
	
	head        :: repr DTC.Head
	about       :: repr DTC.About
	keyword     :: repr TL.Text
	version     :: repr MayText
	author      :: repr DTC.Entity
	editor      :: repr DTC.Entity
	date        :: repr DTC.Date
	entity      :: repr DTC.Entity
	link        :: repr DTC.Link
	serie       :: repr DTC.Serie
	alias       :: repr DTC.Alias
	
	body        :: repr DTC.Body
	bodyValue   :: repr DTC.BodyNode
	toc         :: repr DTC.BodyNode
	tof         :: repr DTC.BodyNode
	index       :: repr DTC.BodyNode
	figure      :: repr DTC.BodyNode
	references  :: repr DTC.BodyNode
	reference   :: repr DTC.Reference
	include     :: repr DTC.Include
	
	block       :: repr DTC.Block
	para        :: repr DTC.Para
	lines       :: repr DTC.Lines
	
	commonAttrs :: repr DTC.CommonAttrs
	ident       :: repr Ident
	title       :: repr DTC.Title
	name        :: repr TL.Text
	url         :: repr URL
	path        :: repr Path
	to          :: repr Ident
	id          :: repr Ident
	
	commonAttrs =
		rule "commonAttrs" $
		interleaved $
		DTC.CommonAttrs
		 <$?> (def, Just <$> id)
		 <|?> (def, rule "class" $ attribute "class" $ TL.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" $
		(Seq.fromList <$>) $
		many $
			choice
			 [ element "section" $ Tree <$> section <*> body
			 , tree0 <$> bodyValue
			 ]
		where
		section =
			DTC.Section
			 <$> position
			 <*> commonAttrs
			 <*> title
			 <*> many alias
	bodyValue =
		choice
		 [ toc
		 , tof
		 , index
		 , figure
		 , references
		 , DTC.Block <$> block
		 ]
	title = rule "title" $ DTC.Title <$> element "title" para
	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)
	block = rule "block" $
		choice
		 [ DTC.Comment <$> comment
		 , element "para" $
			DTC.Para
			 <$> position
			 <*> commonAttrs
			 <*> para
		 , element "ol" $
			DTC.OL
			 <$> position
			 <*> commonAttrs
			 <*> many (element "li" $ many block)
		 , element "ul" $
			DTC.UL
			 <$> position
			 <*> commonAttrs
			 <*> many (element "li" $ many block)
		 , element "artwork" $
			DTC.Artwork
			 <$> position
			 <*> commonAttrs
			 <*> attribute "type" text
			 <*> text
		 , element "quote" $
			DTC.Quote
			 <$> position
			 <*> commonAttrs
			 <*> attribute "type" text
			 <*> many block
		 {-
		 , anyElem $ \n@XmlName{..} ->
				case xmlNameSpace of
				 "" -> figure n
		 -}
		 ]
	toc =
		rule "toc" $
		element "toc" $
		DTC.ToC
		 <$> position
		 <*> commonAttrs
		 <*> optional (attribute "depth" nat)
	tof =
		rule "tof" $
		element "tof" $
		DTC.ToF
		 <$> position
		 <*> commonAttrs
		 <*> option [] (
			element "ul" $
				many $
					element "li" $
						element "para" text)
	index =
		rule "index" $
		element "index" $
		DTC.Index
		 <$> position
		 <*> commonAttrs
		 <*> option [] (
			element "ul" $
				many $
					element "li" $
						element "para" $
							(concat <$>) $
							many $
								(wordify <$>) . TL.lines <$> text)
	figure =
		rule "figure" $
		element "figure" $
		DTC.Figure
		 <$> position
		 <*> commonAttrs
		 <*> attribute "type" text
		 <*> optional title
		 <*> many block
	references =
		element "references" $
		DTC.References
		 <$> position
		 <*> commonAttrs
		 <*> many reference
	para = rule "para" $ (Seq.fromList <$>) $ many lines
	lines =
		rule "lines" $
		choice
		 [ element "b"    $ Tree DTC.B    <$> para
		 , element "code" $ Tree DTC.Code <$> para
		 , element "del"  $ Tree DTC.Del  <$> para
		 , element "i"    $ Tree DTC.I    <$> para
		 , element "note" $ Tree (DTC.Note Nothing) <$> para
		 , element "q"    $ Tree DTC.Q    <$> para
		 , element "sc"   $ Tree DTC.SC   <$> para
		 , element "sub"  $ Tree DTC.Sub  <$> para
		 , element "sup"  $ Tree DTC.Sup  <$> para
		 , element "u"    $ Tree DTC.U    <$> para
		 , element "eref" $ Tree . DTC.Eref <$> attribute "to" url <*> para
		 , element "iref" $ Tree . DTC.Iref Nothing . wordify <$> attribute "to" text <*> para
		 , element "ref"  $ Tree . DTC.Ref  <$> to <*> para
		 , element "rref" $ Tree . DTC.Rref Nothing <$> to <*> para
		 , element "br"   $ tree0 DTC.BR <$ none
		 , tree0 . DTC.Plain <$> text
		 ]
	keyword = rule "keyword" $
		element "keyword" text
	version = rule "version" $
		MayText <$>
		element "version" text
	about =
		interleaved $
		DTC.About
		 <$*> title
		 <|?> (def, Just <$> attribute "url" url)
		 <|*> 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" $
		interleaved $
		DTC.Entity
		 <$?> (def, name)
		 <|?> (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)
		 <|?> (def, Just <$> attribute "url" url)
		 <|?> (def, Just <$> attribute "org" entity)
	serie = rule "serie" $
		element "serie" $
		interleaved $
		DTC.Serie
		 <$?> (def, name)
		 <|?> (def, attribute "key" text)
	link = rule "link" $
		element "link" $
		interleaved $
		(\n h r ls -> DTC.Link n h r (Seq.fromList ls))
		 <$?> (def, name)
		 <|?> (def, attribute "href" url)
		 <|?> (def, attribute "rel"  text)
		 <|*> lines
	alias = rule "alias" $
		element "alias" $
		interleaved $
		DTC.Alias
		 <$?> (def, id)
	reference = rule "reference" $
		element "reference" $
		DTC.Reference
		 <$> id
		 <*> about

instance Sym_DTC RNC.Writer where
	position = RNC.writeText ""
instance Sym_DTC RNC.RuleWriter where
	position = RNC.RuleWriter position

dtcRNC :: [RNC.RuleWriter ()]
dtcRNC =
 [ void $ document
  
 , void $ head
 , void $ rule "about" $ element "about" about
 , void $ keyword
 , void $ version
 , void $ author
 , void $ editor
 , void $ date
 , void $ entity
 , void $ link
 , void $ serie
 , void $ alias
  
 , void $ body
 , void $ bodyValue
 , void $ toc
 , void $ tof
 , void $ index
 , void $ figure
 , void $ references
 , void $ reference
 , void $ include
  
 , void $ block
 , void $ para
 , void $ lines
  
 , void $ commonAttrs
 , void $ ident
 , void $ title
 , void $ name
 , void $ url
 , void $ path
 , void $ to
 , void $ id
 ]