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.Text (Text)
  12 import Data.TreeSeq.Strict (Tree(..))
  13 import qualified Data.Sequence as Seq
  14 import qualified Data.Text as Text
  15
  16 import Language.XML
  17 import Language.RNC.Sym as RNC
  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         document    :: repr DTC.Document
  28
  29         head        :: repr DTC.Head
  30         about       :: repr DTC.About
  31         keyword     :: repr Text
  32         version     :: repr MayText
  33         author      :: repr DTC.Entity
  34         editor      :: repr DTC.Entity
  35         date        :: repr DTC.Date
  36         entity      :: repr DTC.Entity
  37         address     :: repr DTC.Address
  38         link        :: repr DTC.Link
  39         serie       :: repr DTC.Serie
  40         alias       :: repr DTC.Alias
  41
  42         body        :: repr DTC.Body
  43         bodyKey     :: repr DTC.BodyKey
  44         bodyValue   :: repr DTC.BodyValue
  45         toc         :: repr DTC.BodyValue
  46         tof         :: repr DTC.BodyValue
  47         index       :: repr DTC.BodyValue
  48         figure      :: repr DTC.BodyValue
  49         reference   :: repr DTC.Reference
  50         include     :: repr DTC.Include
  51
  52         vertical    :: repr DTC.Vertical
  53         horizontals :: repr DTC.Horizontals
  54         horizontal  :: repr DTC.Horizontal
  55
  56         commonAttrs :: repr DTC.CommonAttrs
  57         ident       :: repr Ident
  58         title       :: repr DTC.Title
  59         name        :: repr 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" $ Text.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                          [ rule "section" $ element "section" $ TreeN <$> bodyKey <*> body
  85                          , Tree0 <$> bodyValue
  86                          ]
  87         bodyKey =
  88                 DTC.Section
  89                  <$> position
  90                  <*> commonAttrs
  91                  <*> title
  92                  <*> many alias
  93         bodyValue =
  94                 choice
  95                  [ toc
  96                  , tof
  97                  , index
  98                  , figure
  99                  , DTC.Vertical <$> vertical
 100                  ]
 101         title = rule "title" $ DTC.Title <$> element "title" horizontals
 102         name  = rule "name"  $ attribute "name" text
 103         url   = rule "url"   $ URL   <$> text
 104         path  = rule "path"  $ Path  <$> text
 105         ident = rule "ident" $ Ident <$> text
 106         to    = rule "to"    $ attribute "to" ident
 107         id    = rule "id"    $ attribute "id" ident
 108         date  = rule "date"  $
 109                 element "date" $
 110                 interleaved $
 111                 DTC.Date
 112                  <$?> (0, attribute "year" int)
 113                  <|?> (Nothing, Just <$> attribute "month" nat1)
 114                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 115         include  = rule "include"  $
 116                 element "include" $
 117                 interleaved $
 118                 DTC.Include
 119                  <$?> (def, attribute "href" path)
 120         vertical = rule "vertical" $
 121                 choice
 122                  [ DTC.Comment <$> comment
 123                  , element "para" $
 124                         DTC.Para
 125                          <$> position
 126                          <*> commonAttrs
 127                          <*> horizontals
 128                  , element "ol" $
 129                         DTC.OL
 130                          <$> position
 131                          <*> commonAttrs
 132                          <*> many (element "li" $ many vertical)
 133                  , element "ul" $
 134                         DTC.UL
 135                          <$> position
 136                          <*> commonAttrs
 137                          <*> many (element "li" $ many vertical)
 138                  , element "rl" $
 139                         DTC.RL
 140                          <$> position
 141                          <*> commonAttrs
 142                          <*> many reference
 143                  {-
 144                  , anyElem $ \n@XmlName{..} ->
 145                                 case xmlNameSpace of
 146                                  "" -> figure n
 147                  -}
 148                  ]
 149         toc =
 150                 rule "toc" $
 151                 element "toc" $
 152                 DTC.ToC
 153                  <$> position
 154                  <*> commonAttrs
 155                  <*> optional (attribute "depth" nat)
 156         tof =
 157                 rule "tof" $
 158                 element "tof" $
 159                 DTC.ToF
 160                  <$> position
 161                  <*> commonAttrs
 162                  <*> optional (attribute "depth" nat)
 163         index =
 164                 rule "index" $
 165                 element "index" $
 166                 DTC.Index
 167                  <$> position
 168                  <*> commonAttrs
 169                  <*> element "ul" (
 170                         concat
 171                          <$> many (
 172                                         element "li" $
 173                                                 element "para" (many text)
 174                                  )
 175                          )
 176         figure =
 177                 rule "figure" $
 178                 element "figure" $
 179                 DTC.Figure
 180                  <$> position
 181                  <*> commonAttrs
 182                  <*> attribute "type" text
 183                  <*> title
 184                  <*> many vertical
 185         horizontals = many horizontal
 186         horizontal = rule "horizontal" $
 187                 choice
 188                  [ DTC.BR   <$  element "br"   none
 189                  , DTC.B    <$> element "b"    horizontals
 190                  , DTC.Code <$> element "code" horizontals
 191                  , DTC.Del  <$> element "del"  horizontals
 192                  , DTC.I    <$> element "i"    horizontals
 193                  , DTC.Note <$> element "note" horizontals
 194                  , DTC.Q    <$> element "q"    horizontals
 195                  , DTC.SC   <$> element "sc"   horizontals
 196                  , DTC.Sub  <$> element "sub"  horizontals
 197                  , DTC.Sup  <$> element "sup"  horizontals
 198                  , DTC.U    <$> element "u"    horizontals
 199                  , element "eref" $ DTC.Eref
 200                          <$> attribute "to" url
 201                          <*> horizontals
 202                  , element "iref" $ DTC.Iref 0 <$> text <*> horizontals
 203                  , element "ref"  $ DTC.Ref <$> to <*> horizontals
 204                  , element "rref" $ DTC.Rref <$> to <*> horizontals
 205                  , DTC.Plain <$> text
 206                  ]
 207         keyword = rule "keyword" $
 208                 element "keyword" text
 209         version = rule "version" $
 210                 MayText <$>
 211                 element "version" text
 212         about =
 213                 interleaved $
 214                 DTC.About
 215                  <$*> title
 216                  <|*> author
 217                  <|?> (Nothing, Just <$> editor)
 218                  <|?> (Nothing, Just <$> date)
 219                  <|?> (def, version)
 220                  <|*> keyword
 221                  <|*> link
 222                  <|*> serie
 223                  <|*> include
 224         author = rule "author" $ element "author" entity
 225         editor = rule "editor" $ element "editor" entity
 226         entity = rule "entity" $
 227                 DTC.Entity
 228                  <$> name
 229                  <*> address
 230         address = rule "address" $
 231                 element "address" $
 232                 interleaved $
 233                 DTC.Address
 234                  <$?> (def, attribute "street"  text)
 235                  <|?> (def, attribute "zipcode" text)
 236                  <|?> (def, attribute "city"    text)
 237                  <|?> (def, attribute "region"  text)
 238                  <|?> (def, attribute "country" text)
 239                  <|?> (def, attribute "email"   text)
 240                  <|?> (def, attribute "tel"     text)
 241                  <|?> (def, attribute "fax"     text)
 242         serie = rule "serie" $
 243                 element "serie" $
 244                 interleaved $
 245                 DTC.Serie
 246                  <$?> (def, attribute "name" text)
 247                  <|?> (def, attribute "key"  text)
 248         link = rule "link" $
 249                 element "link" $
 250                 interleaved $
 251                 DTC.Link
 252                  <$?> (def, attribute "name" text)
 253                  <|?> (def, attribute "href" url)
 254                  <|?> (def, attribute "rel"  text)
 255                  <|*> horizontal
 256         alias = rule "alias" $
 257                 element "alias" $
 258                 interleaved $
 259                 DTC.Alias
 260                  <$?> (def, id)
 261         reference = rule "reference" $
 262                 element "reference" $
 263                 DTC.Reference
 264                  <$> id
 265                  <*> optional (attribute "to" url)
 266                  <*> about
 267
 268 instance Sym_DTC RNC.Writer
 269 instance Sym_DTC RNC.RuleWriter
 270 dtcRNC :: [RNC.RuleWriter ()]
 271 dtcRNC =
 272  [ void $ document
 273
 274  , void $ head
 275  , void $ rule "about" $ element "about" about
 276  , void $ keyword
 277  , void $ version
 278  , void $ author
 279  , void $ editor
 280  , void $ date
 281  , void $ entity
 282  , void $ address
 283  , void $ link
 284  , void $ serie
 285  , void $ alias
 286
 287  , void $ body
 288  , void $ bodyKey
 289  , void $ bodyValue
 290  , void $ toc
 291  , void $ tof
 292  , void $ index
 293  , void $ figure
 294  , void $ reference
 295  , void $ include
 296
 297  , void $ vertical
 298  , void $ rule "horizontals" horizontals
 299  , void $ horizontal
 300
 301  , void $ commonAttrs
 302  , void $ ident
 303  , void $ title
 304  , void $ name
 305  , void $ url
 306  , void $ path
 307  , void $ to
 308  , void $ id
 309  ]