{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilyDependencies #-} module Language.DTC.Sym where import Control.Applicative (Applicative(..), (<$>), (<$)) import Control.Monad (void) 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 import Language.RNC.Sym as RNC import qualified Language.RNC.Write as RNC 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 RNC.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 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, 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" $ DTC.Section <$> commonAttrs <*> title <*> many alias <*> body , DTC.Verticals <$> some vertical ] 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) vertical = rule "vertical" $ choice [ DTC.Comment <$> comment , element "para" $ DTC.Para <$> commonAttrs <*> horizontals , element "ol" $ DTC.OL <$> commonAttrs <*> many (element "li" $ many vertical) , element "ul" $ DTC.UL <$> commonAttrs <*> many (element "li" $ many vertical) , 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 , figure {- , anyElem $ \n@XmlName{..} -> case xmlNameSpace of "" -> figure n -} ] figure = rule "figure" $ element "figure" $ 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 ]