1 {-# LANGUAGE NoMonomorphismRestriction #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 module Language.DTC.Sym where
5 import Control.Applicative (Applicative(..), (<$>), (<$))
6 import Control.Monad (void)
7 import Data.Default.Class (Default(..))
8 import Data.Foldable (Foldable(..), concat)
9 import Data.Function (($), (.), flip)
10 import Data.Maybe (Maybe(..), maybe)
11 import Data.TreeSeq.Strict (Tree(..), tree0)
12 import qualified Data.Sequence as Seq
13 import qualified Data.Text.Lazy as TL
16 import Language.RNC.Sym as RNC
17 import Language.DTC.Anchor (wordify)
18 import qualified Language.DTC.Document as DTC
19 import qualified Language.RNC.Write as RNC
21 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
22 foldlApp = foldl' (flip ($)) def
23 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
24 foldrApp = foldr ($) def
27 -- | Use a symantic (tagless final) class to encode
28 -- both the parsing and the schema of DTC,
29 -- when repr is respectively instanciated
30 -- on 'DTC.Parser' or 'RNC.RuleWriter'.
31 class RNC.Sym_RNC repr => Sym_DTC repr where
32 position :: repr DTC.Pos
33 document :: repr DTC.Document
36 about :: repr DTC.About
37 keyword :: repr TL.Text
38 version :: repr MayText
39 author :: repr DTC.Entity
40 editor :: repr DTC.Entity
42 entity :: repr DTC.Entity
44 serie :: repr DTC.Serie
45 alias :: repr DTC.Alias
48 include :: repr DTC.Include
50 block :: repr DTC.Block
51 blockToC :: repr DTC.Block
52 blockToF :: repr DTC.Block
53 blockIndex :: repr DTC.Block
54 blockFigure :: repr DTC.Block
55 blockReferences :: repr DTC.Block
56 reference :: repr DTC.Reference
59 paraItem :: repr DTC.ParaItem
60 paraItems :: repr DTC.Para
62 plain :: repr DTC.Plain
63 plainNode :: repr (Tree DTC.PlainNode)
65 commonAttrs :: repr DTC.CommonAttrs
67 title :: repr DTC.Title
78 <$?> (def, Just <$> id)
79 <|?> (def, rule "class" $ attribute "class" $ TL.words <$> text)
81 document = rule "document" $
87 <$> optional (rule "about" $ element "about" about)
93 [ element "section" $ Tree <$> section <*> body
94 , tree0 . DTC.BodyBlock <$> block
103 title = rule "title" $ DTC.Title <$> element "title" plain
104 name = rule "name" $ attribute "name" text
105 url = rule "url" $ URL <$> text
106 path = rule "path" $ Path <$> text
107 ident = rule "ident" $ Ident <$> text
108 to = rule "to" $ attribute "to" ident
109 id = rule "id" $ attribute "id" ident
114 <$?> (0, attribute "year" int)
115 <|?> (Nothing, Just <$> attribute "month" nat1)
116 <|?> (Nothing, Just <$> attribute "day" nat1)
122 <$?> (def, attribute "href" path)
123 block = rule "block" $
125 [ DTC.BlockPara <$> para
132 , anyElem $ \n@XmlName{..} ->
143 <*> optional (attribute "depth" nat)
168 (wordify <$>) . TL.lines <$> text)
175 <*> attribute "type" text
179 rule "blockReferences" $
180 element "references" $
186 para = rule "para" $ paraItems <|> DTC.ParaItem <$> paraItem
190 [ element "ol" $ DTC.ParaOL <$> many (element "li" $ many para)
191 , element "ul" $ DTC.ParaUL <$> many (element "li" $ many para)
192 , element "artwork" $ DTC.ParaArtwork <$> attribute "type" text <*> text
193 , element "quote" $ DTC.ParaQuote <$> attribute "type" text <*> many para
194 , DTC.ParaPlain . Seq.fromList <$> some plainNode
195 , DTC.ParaComment <$> comment
204 plain = rule "plain" $ (Seq.fromList <$>) $ many plainNode
208 [ tree0 . DTC.PlainText <$> text
209 , element "br" $ tree0 DTC.PlainBR <$ none
210 , element "b" $ Tree DTC.PlainB <$> plain
211 , element "code" $ Tree DTC.PlainCode <$> plain
212 , element "del" $ Tree DTC.PlainDel <$> plain
213 , element "i" $ Tree DTC.PlainI <$> plain
214 , element "q" $ Tree DTC.PlainQ <$> plain
215 , element "sc" $ Tree DTC.PlainSC <$> plain
216 , element "sub" $ Tree DTC.PlainSub <$> plain
217 , element "sup" $ Tree DTC.PlainSup <$> plain
218 , element "u" $ Tree DTC.PlainU <$> plain
219 , element "note" $ tree0 . DTC.PlainNote Nothing <$> many para
220 , element "iref" $ Tree . DTC.PlainIref Nothing . wordify <$> attribute "to" text <*> plain
221 , element "eref" $ Tree . DTC.PlainEref <$> attribute "to" url <*> plain
222 , element "ref" $ Tree . DTC.PlainRef <$> to <*> plain
223 , element "rref" $ Tree . DTC.PlainRref Nothing <$> to <*> plain
225 keyword = rule "keyword" $
226 element "keyword" text
227 version = rule "version" $
229 element "version" text
234 <|?> (def, Just <$> attribute "url" url)
236 <|?> (Nothing, Just <$> editor)
237 <|?> (Nothing, Just <$> date)
243 author = rule "author" $ element "author" entity
244 editor = rule "editor" $ element "editor" entity
245 entity = rule "entity" $
249 <|?> (def, attribute "street" text)
250 <|?> (def, attribute "zipcode" text)
251 <|?> (def, attribute "city" text)
252 <|?> (def, attribute "region" text)
253 <|?> (def, attribute "country" text)
254 <|?> (def, attribute "email" text)
255 <|?> (def, attribute "tel" text)
256 <|?> (def, attribute "fax" text)
257 <|?> (def, Just <$> attribute "url" url)
258 <|?> (def, Just <$> element "org" entity)
259 serie = rule "serie" $
264 <|?> (def, attribute "key" text)
268 (\n u t p -> DTC.Link n u t (Seq.fromList p))
270 <|?> (def, attribute "href" url)
271 <|?> (def, attribute "rel" text)
273 alias = rule "alias" $
278 reference = rule "reference" $
279 element "reference" $
284 instance Sym_DTC RNC.Writer where
285 position = RNC.writeText ""
286 instance Sym_DTC RNC.RuleWriter where
287 position = RNC.RuleWriter position
289 -- | RNC schema for DTC
290 schema :: [RNC.RuleWriter ()]
295 , void $ rule "about" $ element "about" about
314 , void $ blockReferences