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

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

import Hdoc.XML
import Hdoc.RNC.Sym as RNC
import Hdoc.DTC.Anchor (wordify)
import qualified Hdoc.DTC.Document as DTC
import qualified Hdoc.RNC.Write as RNC

-- Class 'Sym_DTC'
-- | Use a symantic (tagless final) class to encode
-- both the parsing and the schema of DTC,
-- when repr is respectively instanciated
-- on 'DTC.Parser' or 'RNC.RuleWriter'.
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
	header           :: repr DTC.Header
	tag              :: repr TL.Text
	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
	include          :: repr DTC.Include
	
	block            :: repr DTC.Block
	blockBreak       :: repr DTC.Block
	blockToC         :: repr DTC.Block
	blockToF         :: repr DTC.Block
	blockIndex       :: repr DTC.Block
	blockFigure      :: repr DTC.Block
	blockReferences  :: repr DTC.Block
	reference        :: repr DTC.Reference
	
	para             :: repr DTC.Para
	paraItem         :: repr DTC.ParaItem
	paraItems        :: repr DTC.Para
	
	plain            :: repr DTC.Plain
	plainNode        :: repr (Tree DTC.PlainNode)
	
	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 . DTC.BodyBlock <$> block
			 ]
		where
		section =
			DTC.BodySection
			 <$> position
			 <*> commonAttrs
			 <*> title
			 <*> many alias
	title = rule "title" $ DTC.Title <$> element "title" plain
	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.BlockPara <$> para
		 , blockBreak
		 , blockToC
		 , blockToF
		 , blockIndex
		 , blockFigure
		 , blockReferences
		 {-
		 , anyElem $ \n@XmlName{..} ->
				case xmlNameSpace of
				 "" -> figure n
		 -}
		 ]
	blockBreak = rule "break" $
		element "break" $
		DTC.BlockBreak
		 <$> commonAttrs
	blockToC =
		rule "blockToC" $
		element "toc" $
		DTC.BlockToC
		 <$> position
		 <*> commonAttrs
		 <*> optional (attribute "depth" nat)
	blockToF =
		rule "blockToF" $
		element "tof" $
		DTC.BlockToF
		 <$> position
		 <*> commonAttrs
		 <*> option [] (
			element "ul" $
				many $
					element "li" $
						element "para" text)
	blockIndex =
		rule "blockIndex" $
		element "index" $
		DTC.BlockIndex
		 <$> position
		 <*> commonAttrs
		 <*> option [] (
			element "ul" $
				many $
					element "li" $
						element "para" $
							(concat <$>) $
							many $
								(wordify <$>) . TL.lines <$> text)
	blockFigure =
		rule "blockFigure" $
		element "figure" $
		DTC.BlockFigure
		 <$> position
		 <*> commonAttrs
		 <*> attribute "type" text
		 <*> optional title
		 <*> many para
	blockReferences =
		rule "blockReferences" $
		element "references" $
		DTC.BlockReferences
		 <$> position
		 <*> commonAttrs
		 <*> many reference
	
	para = rule "para" $ paraItems <|> DTC.ParaItem <$> paraItem
	paraItem =
		rule "paraItem" $
		choice
		 [ element "ol"      $ DTC.ParaOL <$> many (element "li" $ DTC.ListItem <$> attribute "name" text <*> many para)
		 , element "ul"      $ DTC.ParaUL <$> many (element "li" $ many para)
		 , element "artwork" $ DTC.ParaArtwork <$> attribute "type" text <*> text
		 , element "quote"   $ DTC.ParaQuote   <$> attribute "type" text <*> many para
		 , DTC.ParaPlain . Seq.fromList <$> some plainNode
		 , DTC.ParaComment <$> comment
		 ]
	paraItems =
		rule "paraItems" $
		element "para" $
			DTC.ParaItems
			 <$> position
			 <*> commonAttrs
			 <*> many paraItem
	plain = rule "plain" $ (Seq.fromList <$>) $ many plainNode
	plainNode =
		rule "plainNode" $
		choice
		 [ tree0 . DTC.PlainText <$> text
		 , element "br"   $ tree0   DTC.PlainBreak <$ none
		 , element "b"    $ Tree    DTC.PlainB     <$> plain
		 , element "code" $ Tree    DTC.PlainCode  <$> plain
		 , element "del"  $ Tree    DTC.PlainDel   <$> plain
		 , element "i"    $ Tree    DTC.PlainI     <$> plain
		 , element "q"    $ Tree    DTC.PlainQ     <$> plain
		 , element "sc"   $ Tree    DTC.PlainSC    <$> plain
		 , element "span" $ Tree .  DTC.PlainSpan  <$> commonAttrs <*> plain
		 , element "sub"  $ Tree    DTC.PlainSub   <$> plain
		 , element "sup"  $ Tree    DTC.PlainSup   <$> plain
		 , element "u"    $ Tree    DTC.PlainU     <$> plain
		 , element "note" $ tree0 . DTC.PlainNote Nothing <$> many para
		 , element "iref" $ Tree .  DTC.PlainIref Nothing . wordify <$> attribute "to" text <*> plain
		 , element "eref" $ Tree .  DTC.PlainEref <$> attribute "to" url <*> plain
		 , element "ref"  $ Tree .  DTC.PlainRef  <$> to <*> plain
		 , element "rref" $ Tree .  DTC.PlainRref Nothing <$> to <*> plain
		 ]
	tag = rule "tag" $ element "tag" text
	about =
		(foldr ($) def <$>) $
		many $ choice
		 [ (\a acc -> acc{DTC.titles=a:DTC.titles acc})              <$> title
		 , (\a acc -> (acc::DTC.About){DTC.url=Just a})              <$> attribute "url" url
		 , (\a acc -> acc{DTC.authors=a:DTC.authors acc})            <$> author
		 , (\a acc -> acc{DTC.editor=DTC.editor acc Alt.<|> Just a}) <$> editor
		 , (\a acc -> acc{DTC.date=DTC.date acc Alt.<|> Just a})     <$> date
		 , (\a acc -> acc{DTC.tags=a:DTC.tags acc})                  <$> tag
		 , (\a acc -> acc{DTC.links=a:DTC.links acc})                <$> link
		 , (\a acc -> acc{DTC.series=a:DTC.series acc})              <$> serie
		 , (\a acc -> acc{DTC.headers=a:DTC.headers acc})            <$> header
		 ]
	header =
		rule "header" $
		anyElem $ \n ->
			DTC.Header (xmlNameLocal n)
			 <$> plain
	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 <$> element "org" entity)
	serie = rule "serie" $
		element "serie" $
		interleaved $
		DTC.Serie
		 <$?> (def, name)
		 <|?> (def, attribute "id" text)
	link = rule "link" $
		element "link" $
		interleaved $
		(\n h r t p -> DTC.Link n h r t (Seq.fromList p))
		 <$?> (def, name)
		 <|?> (def, attribute "href" url)
		 <|?> (def, attribute "rel"  text)
		 <|?> (def, Just <$> attribute "type" text)
		 <|*> plainNode
	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

-- | RNC schema for DTC
schema :: [RNC.RuleWriter ()]
schema =
 [ void $ document
  
 , void $ head
 , void $ rule "about" $ element "about" about
 , void $ header
 , void $ tag
 , void $ author
 , void $ editor
 , void $ date
 , void $ entity
 , void $ link
 , void $ serie
 , void $ alias
  
 , void $ body
 , void $ include
  
 , void $ block
 , void $ blockToC
 , void $ blockToF
 , void $ blockIndex
 , void $ blockFigure
 , void $ blockReferences
 , void $ reference
  
 , void $ para
 , void $ paraItem
 , void $ paraItems
  
 , void $ plain
 , void $ plainNode
  
 , void $ commonAttrs
 , void $ ident
 , void $ title
 , void $ name
 , void $ url
 , void $ path
 , void $ to
 , void $ id
 ]