{-# 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 verticals :: repr DTC.Verticals vertical :: repr DTC.Vertical reference :: repr DTC.Reference 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 entity :: repr DTC.Entity address :: repr DTC.Address link :: repr DTC.Link serie :: repr DTC.Serie alias :: repr DTC.Alias figure :: XmlName -> 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 <*> many ( choice [ rule "section" $ element "section" $ DTC.Section <$> commonAttrs <*> title <*> many alias <*> verticals , vertical ] ) head = rule "head" $ maybe def DTC.Head <$> optional (rule "about" $ element "about" about) 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) verticals = many vertical vertical = rule "vertical" $ choice [ DTC.Comment <$> comment , element "para" $ DTC.Para <$> commonAttrs <*> horizontals , element "ol" $ DTC.OL <$> commonAttrs <*> many (element "li" verticals) , element "ul" $ DTC.UL <$> commonAttrs <*> many (element "li" verticals) , 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 , anyElem $ \n@XmlName{..} -> case xmlNameSpace of "" -> figure n ] figure XmlName{..} = rule "figure" $ (`DTC.Figure` xmlNameLocal) <$> commonAttrs <*> title <*> verticals 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 {- , element "figure" $ ul { type_ :: Text , body :: Verticals } , Artwork Artwork -} instance Sym_DTC RNC.Writer instance Sym_DTC RNC.RuleWriter dtcRNC :: [RNC.RuleWriter ()] dtcRNC = [ void title , void name , void url , void path , void ident , void to , void id , void date , void include , void $ rule "horizontals" horizontals , void horizontal , void $ rule "verticals" verticals , void vertical , void $ figure "" , void reference , void document , void head , void $ rule "about" $ element "about" about , void keyword , void version , void author , void editor , void entity , void address , void link , void serie , void alias , void commonAttrs ]