{-# 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.Text (Text) import Data.TreeSeq.Strict (Tree(..)) import qualified Data.Sequence as Seq import qualified Data.Text as Text import Language.XML import Language.RNC.Sym as RNC import Language.DTC.Index (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 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 date :: repr DTC.Date entity :: repr DTC.Entity address :: repr DTC.Address link :: repr DTC.Link serie :: repr DTC.Serie alias :: repr DTC.Alias body :: repr DTC.Body bodyKey :: repr DTC.BodyKey bodyValue :: repr DTC.BodyValue toc :: repr DTC.BodyValue tof :: repr DTC.BodyValue index :: repr DTC.BodyValue figure :: repr DTC.BodyValue reference :: repr DTC.Reference include :: repr DTC.Include vertical :: repr DTC.Vertical horizontals :: repr DTC.Horizontals horizontal :: repr DTC.Horizontal commonAttrs :: repr DTC.CommonAttrs ident :: repr Ident title :: repr DTC.Title name :: repr 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" $ 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" $ (Seq.fromList <$>) $ many $ choice [ rule "section" $ element "section" $ TreeN <$> bodyKey <*> body , Tree0 <$> bodyValue ] bodyKey = DTC.Section <$> position <*> commonAttrs <*> title <*> many alias bodyValue = choice [ toc , tof , index , figure , DTC.Vertical <$> 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" $ DTC.Para <$> position <*> commonAttrs <*> horizontals , element "ol" $ DTC.OL <$> position <*> commonAttrs <*> many (element "li" $ many vertical) , element "ul" $ DTC.UL <$> position <*> commonAttrs <*> many (element "li" $ many vertical) , element "rl" $ DTC.RL <$> position <*> commonAttrs <*> many reference {- , 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 <*> optional (attribute "depth" nat) index = rule "index" $ element "index" $ DTC.Index <$> position <*> commonAttrs <*> element "ul" ( many $ element "li" $ element "para" $ (concat <$>) $ many $ (wordify <$>) . Text.lines <$> text) figure = rule "figure" $ element "figure" $ DTC.Figure <$> position <*> commonAttrs <*> attribute "type" text <*> 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 0 . wordify <$> text <*> 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 $ rule "about" $ element "about" about , void $ keyword , void $ version , void $ author , void $ editor , void $ date , void $ entity , void $ address , void $ link , void $ serie , void $ alias , void $ body , void $ bodyKey , void $ bodyValue , void $ toc , void $ tof , void $ index , void $ figure , void $ reference , void $ include , void $ vertical , void $ rule "horizontals" horizontals , void $ horizontal , void $ commonAttrs , void $ ident , void $ title , void $ name , void $ url , void $ path , void $ to , void $ id ]