Language/DTC/Sym.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 module Language.DTC.Sym where
   4
   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
  14
  15 import Language.XML
  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
  20
  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
  25
  26 class RNC.Sym_RNC repr => Sym_DTC repr where
  27         position    :: repr DTC.Pos
  28         document    :: repr DTC.Document
  29
  30         head        :: repr DTC.Head
  31         about       :: repr DTC.About
  32         keyword     :: repr TL.Text
  33         version     :: repr MayText
  34         author      :: repr DTC.Entity
  35         editor      :: repr DTC.Entity
  36         date        :: repr DTC.Date
  37         entity      :: repr DTC.Entity
  38         link        :: repr DTC.Link
  39         serie       :: repr DTC.Serie
  40         alias       :: repr DTC.Alias
  41
  42         body        :: repr DTC.Body
  43         bodyValue   :: repr DTC.BodyNode
  44         toc         :: repr DTC.BodyNode
  45         tof         :: repr DTC.BodyNode
  46         index       :: repr DTC.BodyNode
  47         figure      :: repr DTC.BodyNode
  48         references  :: repr DTC.BodyNode
  49         reference   :: repr DTC.Reference
  50         include     :: repr DTC.Include
  51
  52         block       :: repr DTC.Block
  53         para        :: repr DTC.Para
  54         lines       :: repr DTC.Lines
  55
  56         commonAttrs :: repr DTC.CommonAttrs
  57         ident       :: repr Ident
  58         title       :: repr DTC.Title
  59         name        :: repr TL.Text
  60         url         :: repr URL
  61         path        :: repr Path
  62         to          :: repr Ident
  63         id          :: repr Ident
  64
  65         commonAttrs =
  66                 rule "commonAttrs" $
  67                 interleaved $
  68                 DTC.CommonAttrs
  69                  <$?> (def, Just <$> id)
  70                  <|?> (def, rule "class" $ attribute "class" $ TL.words <$> text)
  71
  72         document = rule "document" $
  73                 DTC.Document
  74                  <$> head
  75                  <*> body
  76         head = rule "head" $
  77                 maybe def DTC.Head
  78                  <$> optional (rule "about" $ element "about" about)
  79         body =
  80                 rule "body" $
  81                 (Seq.fromList <$>) $
  82                 many $
  83                         choice
  84                          [ element "section" $ Tree <$> section <*> body
  85                          , tree0 <$> bodyValue
  86                          ]
  87                 where
  88                 section =
  89                         DTC.Section
  90                          <$> position
  91                          <*> commonAttrs
  92                          <*> title
  93                          <*> many alias
  94         bodyValue =
  95                 choice
  96                  [ toc
  97                  , tof
  98                  , index
  99                  , figure
 100                  , references
 101                  , DTC.Block <$> block
 102                  ]
 103         title = rule "title" $ DTC.Title <$> element "title" para
 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
 110         date  = rule "date"  $
 111                 element "date" $
 112                 interleaved $
 113                 DTC.Date
 114                  <$?> (0, attribute "year" int)
 115                  <|?> (Nothing, Just <$> attribute "month" nat1)
 116                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 117         include  = rule "include"  $
 118                 element "include" $
 119                 interleaved $
 120                 DTC.Include
 121                  <$?> (def, attribute "href" path)
 122         block = rule "block" $
 123                 choice
 124                  [ DTC.Comment <$> comment
 125                  , element "para" $
 126                         DTC.Para
 127                          <$> position
 128                          <*> commonAttrs
 129                          <*> para
 130                  , element "ol" $
 131                         DTC.OL
 132                          <$> position
 133                          <*> commonAttrs
 134                          <*> many (element "li" $ many block)
 135                  , element "ul" $
 136                         DTC.UL
 137                          <$> position
 138                          <*> commonAttrs
 139                          <*> many (element "li" $ many block)
 140                  , element "artwork" $
 141                         DTC.Artwork
 142                          <$> position
 143                          <*> commonAttrs
 144                          <*> attribute "type" text
 145                          <*> text
 146                  , element "quote" $
 147                         DTC.Quote
 148                          <$> position
 149                          <*> commonAttrs
 150                          <*> attribute "type" text
 151                          <*> many block
 152                  {-
 153                  , anyElem $ \n@XmlName{..} ->
 154                                 case xmlNameSpace of
 155                                  "" -> figure n
 156                  -}
 157                  ]
 158         toc =
 159                 rule "toc" $
 160                 element "toc" $
 161                 DTC.ToC
 162                  <$> position
 163                  <*> commonAttrs
 164                  <*> optional (attribute "depth" nat)
 165         tof =
 166                 rule "tof" $
 167                 element "tof" $
 168                 DTC.ToF
 169                  <$> position
 170                  <*> commonAttrs
 171                  <*> option [] (
 172                         element "ul" $
 173                                 many $
 174                                         element "li" $
 175                                                 element "para" text)
 176         index =
 177                 rule "index" $
 178                 element "index" $
 179                 DTC.Index
 180                  <$> position
 181                  <*> commonAttrs
 182                  <*> option [] (
 183                         element "ul" $
 184                                 many $
 185                                         element "li" $
 186                                                 element "para" $
 187                                                         (concat <$>) $
 188                                                         many $
 189                                                                 (wordify <$>) . TL.lines <$> text)
 190         figure =
 191                 rule "figure" $
 192                 element "figure" $
 193                 DTC.Figure
 194                  <$> position
 195                  <*> commonAttrs
 196                  <*> attribute "type" text
 197                  <*> optional title
 198                  <*> many block
 199         references =
 200                 element "references" $
 201                 DTC.References
 202                  <$> position
 203                  <*> commonAttrs
 204                  <*> many reference
 205         para = rule "para" $ (Seq.fromList <$>) $ many lines
 206         lines =
 207                 rule "lines" $
 208                 choice
 209                  [ element "b"    $ Tree DTC.B    <$> para
 210                  , element "code" $ Tree DTC.Code <$> para
 211                  , element "del"  $ Tree DTC.Del  <$> para
 212                  , element "i"    $ Tree DTC.I    <$> para
 213                  , element "note" $ Tree (DTC.Note Nothing) <$> para
 214                  , element "q"    $ Tree DTC.Q    <$> para
 215                  , element "sc"   $ Tree DTC.SC   <$> para
 216                  , element "sub"  $ Tree DTC.Sub  <$> para
 217                  , element "sup"  $ Tree DTC.Sup  <$> para
 218                  , element "u"    $ Tree DTC.U    <$> para
 219                  , element "eref" $ Tree . DTC.Eref <$> attribute "to" url <*> para
 220                  , element "iref" $ Tree . DTC.Iref Nothing . wordify <$> attribute "to" text <*> para
 221                  , element "ref"  $ Tree . DTC.Ref  <$> to <*> para
 222                  , element "rref" $ Tree . DTC.Rref Nothing <$> to <*> para
 223                  , element "br"   $ tree0 DTC.BR <$ none
 224                  , tree0 . DTC.Plain <$> text
 225                  ]
 226         keyword = rule "keyword" $
 227                 element "keyword" text
 228         version = rule "version" $
 229                 MayText <$>
 230                 element "version" text
 231         about =
 232                 interleaved $
 233                 DTC.About
 234                  <$*> title
 235                  <|?> (def, Just <$> attribute "url" url)
 236                  <|*> author
 237                  <|?> (Nothing, Just <$> editor)
 238                  <|?> (Nothing, Just <$> date)
 239                  <|?> (def, version)
 240                  <|*> keyword
 241                  <|*> link
 242                  <|*> serie
 243                  <|*> include
 244         author = rule "author" $ element "author" entity
 245         editor = rule "editor" $ element "editor" entity
 246         entity = rule "entity" $
 247                 interleaved $
 248                 DTC.Entity
 249                  <$?> (def, name)
 250                  <|?> (def, attribute "street"  text)
 251                  <|?> (def, attribute "zipcode" text)
 252                  <|?> (def, attribute "city"    text)
 253                  <|?> (def, attribute "region"  text)
 254                  <|?> (def, attribute "country" text)
 255                  <|?> (def, attribute "email"   text)
 256                  <|?> (def, attribute "tel"     text)
 257                  <|?> (def, attribute "fax"     text)
 258                  <|?> (def, Just <$> attribute "url" url)
 259                  <|?> (def, Just <$> attribute "org" entity)
 260         serie = rule "serie" $
 261                 element "serie" $
 262                 interleaved $
 263                 DTC.Serie
 264                  <$?> (def, name)
 265                  <|?> (def, attribute "key" text)
 266         link = rule "link" $
 267                 element "link" $
 268                 interleaved $
 269                 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
 270                  <$?> (def, name)
 271                  <|?> (def, attribute "href" url)
 272                  <|?> (def, attribute "rel"  text)
 273                  <|*> lines
 274         alias = rule "alias" $
 275                 element "alias" $
 276                 interleaved $
 277                 DTC.Alias
 278                  <$?> (def, id)
 279         reference = rule "reference" $
 280                 element "reference" $
 281                 DTC.Reference
 282                  <$> id
 283                  <*> about
 284
 285 instance Sym_DTC RNC.Writer where
 286         position = RNC.writeText ""
 287 instance Sym_DTC RNC.RuleWriter where
 288         position = RNC.RuleWriter position
 289
 290 dtcRNC :: [RNC.RuleWriter ()]
 291 dtcRNC =
 292  [ void $ document
 293
 294  , void $ head
 295  , void $ rule "about" $ element "about" about
 296  , void $ keyword
 297  , void $ version
 298  , void $ author
 299  , void $ editor
 300  , void $ date
 301  , void $ entity
 302  , void $ link
 303  , void $ serie
 304  , void $ alias
 305
 306  , void $ body
 307  , void $ bodyValue
 308  , void $ toc
 309  , void $ tof
 310  , void $ index
 311  , void $ figure
 312  , void $ references
 313  , void $ reference
 314  , void $ include
 315
 316  , void $ block
 317  , void $ para
 318  , void $ lines
 319
 320  , void $ commonAttrs
 321  , void $ ident
 322  , void $ title
 323  , void $ name
 324  , void $ url
 325  , void $ path
 326  , void $ to
 327  , void $ id
 328  ]