Language/DTC/Sym.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5 module Language.DTC.Sym where
   6
   7 import Control.Applicative (Applicative(..), (<$>), (<$))
   8 import Control.Monad (void)
   9 import Data.Default.Class (Default(..))
  10 import Data.Foldable (Foldable, foldl', foldr)
  11 import Data.Function (($), flip)
  12 import Data.Maybe (Maybe(..), maybe)
  13 import Data.Text (Text)
  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         title       :: repr DTC.Title
  28         name        :: repr Text
  29         url         :: repr URL
  30         path        :: repr Path
  31         ident       :: repr Ident
  32         to          :: repr Ident
  33         id          :: repr Ident
  34         date        :: repr DTC.Date
  35         include     :: repr DTC.Include
  36         horizontals :: repr DTC.Horizontals
  37         horizontal  :: repr DTC.Horizontal
  38         vertical    :: repr DTC.Vertical
  39         reference   :: repr DTC.Reference
  40         document    :: repr DTC.Document
  41         head        :: repr DTC.Head
  42         body        :: repr [DTC.Body]
  43         about       :: repr DTC.About
  44         keyword     :: repr Text
  45         version     :: repr MayText
  46         author      :: repr DTC.Entity
  47         editor      :: repr DTC.Entity
  48         entity      :: repr DTC.Entity
  49         address     :: repr DTC.Address
  50         link        :: repr DTC.Link
  51         serie       :: repr DTC.Serie
  52         alias       :: repr DTC.Alias
  53         figure      :: repr DTC.Vertical
  54         commonAttrs :: repr DTC.CommonAttrs
  55         commonAttrs =
  56                 rule "commonAttrs" $
  57                 interleaved $
  58                 DTC.CommonAttrs
  59                  <$?> (def, Just <$> id)
  60                  <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
  61
  62         document = rule "document" $
  63                 DTC.Document
  64                  <$> head
  65                  <*> body
  66         head = rule "head" $
  67                 maybe def DTC.Head
  68                  <$> optional (rule "about" $ element "about" about)
  69         body =
  70                 rule "body" $
  71                 many $
  72                         choice
  73                          [ rule "section" $
  74                                 element "section" $
  75                                 position $
  76                                 DTC.Section
  77                                  <$> commonAttrs
  78                                  <*> title
  79                                  <*> many alias
  80                                  <*> body
  81                          , element "toc" $
  82                                 position $
  83                                 DTC.ToC
  84                                  <$> commonAttrs
  85                                  <*> optional (attribute "depth" int)
  86                          , element "tof" $
  87                                 position $
  88                                 DTC.ToF
  89                                  <$> commonAttrs
  90                                  <*> optional (attribute "depth" int)
  91                          , element "index" $
  92                                 position $
  93                                 DTC.Index
  94                                  <$> commonAttrs
  95                                  <*  any
  96                          , DTC.Verticals
  97                                  <$> some vertical
  98                          ]
  99         title = rule "title" $ DTC.Title <$> element "title" horizontals
 100         name  = rule "name"  $ attribute "name" text
 101         url   = rule "url"   $ URL   <$> text
 102         path  = rule "path"  $ Path  <$> text
 103         ident = rule "ident" $ Ident <$> text
 104         to    = rule "to"    $ attribute "to" ident
 105         id    = rule "id"    $ attribute "id" ident
 106         date  = rule "date"  $
 107                 element "date" $
 108                 interleaved $
 109                 DTC.Date
 110                  <$?> (0, attribute "year" int)
 111                  <|?> (Nothing, Just <$> attribute "month" nat1)
 112                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 113         include  = rule "include"  $
 114                 element "include" $
 115                 interleaved $
 116                 DTC.Include
 117                  <$?> (def, attribute "href" path)
 118         vertical = rule "vertical" $
 119                 choice
 120                  [ DTC.Comment <$> comment
 121                  , element "para" $
 122                         position $
 123                         DTC.Para
 124                          <$> commonAttrs
 125                          <*> horizontals
 126                  , element "ol" $
 127                         position $
 128                         DTC.OL
 129                          <$> commonAttrs
 130                          <*> many (element "li" $ many vertical)
 131                  , element "ul" $
 132                         position $
 133                         DTC.UL
 134                          <$> commonAttrs
 135                          <*> many (element "li" $ many vertical)
 136                  , element "rl" $
 137                         position $
 138                         DTC.RL
 139                          <$> commonAttrs
 140                          <*> many reference
 141                  , figure
 142                  {-
 143                  , anyElem $ \n@XmlName{..} ->
 144                                 case xmlNameSpace of
 145                                  "" -> figure n
 146                  -}
 147                  ]
 148         figure =
 149                 rule "figure" $
 150                 element "figure" $
 151                 position $
 152                 DTC.Figure
 153                  <$> attribute "type" text
 154                  <*> commonAttrs
 155                  <*> title
 156                  <*> many vertical
 157         horizontals = many horizontal
 158         horizontal = rule "horizontal" $
 159                 choice
 160                  [ DTC.BR   <$  element "br"   none
 161                  , DTC.B    <$> element "b"    horizontals
 162                  , DTC.Code <$> element "code" horizontals
 163                  , DTC.Del  <$> element "del"  horizontals
 164                  , DTC.I    <$> element "i"    horizontals
 165                  , DTC.Note <$> element "note" horizontals
 166                  , DTC.Q    <$> element "q"    horizontals
 167                  , DTC.SC   <$> element "sc"   horizontals
 168                  , DTC.Sub  <$> element "sub"  horizontals
 169                  , DTC.Sup  <$> element "sup"  horizontals
 170                  , DTC.U    <$> element "u"    horizontals
 171                  , element "eref" $ DTC.Eref
 172                          <$> attribute "to" url
 173                          <*> horizontals
 174                  , element "iref" $ DTC.Iref <$> to <*> horizontals
 175                  , element "ref"  $ DTC.Ref  <$> to <*> horizontals
 176                  , element "rref" $ DTC.Rref <$> to <*> horizontals
 177                  , DTC.Plain <$> text
 178                  ]
 179         keyword = rule "keyword" $
 180                 element "keyword" text
 181         version = rule "version" $
 182                 MayText <$>
 183                 element "version" text
 184         about =
 185                 interleaved $
 186                 DTC.About
 187                  <$*> title
 188                  <|*> author
 189                  <|?> (Nothing, Just <$> editor)
 190                  <|?> (Nothing, Just <$> date)
 191                  <|?> (def, version)
 192                  <|*> keyword
 193                  <|*> link
 194                  <|*> serie
 195                  <|*> include
 196         author = rule "author" $ element "author" entity
 197         editor = rule "editor" $ element "editor" entity
 198         entity = rule "entity" $
 199                 DTC.Entity
 200                  <$> name
 201                  <*> address
 202         address = rule "address" $
 203                 element "address" $
 204                 interleaved $
 205                 DTC.Address
 206                  <$?> (def, attribute "street"  text)
 207                  <|?> (def, attribute "zipcode" text)
 208                  <|?> (def, attribute "city"    text)
 209                  <|?> (def, attribute "region"  text)
 210                  <|?> (def, attribute "country" text)
 211                  <|?> (def, attribute "email"   text)
 212                  <|?> (def, attribute "tel"     text)
 213                  <|?> (def, attribute "fax"     text)
 214         serie = rule "serie" $
 215                 element "serie" $
 216                 interleaved $
 217                 DTC.Serie
 218                  <$?> (def, attribute "name" text)
 219                  <|?> (def, attribute "key"  text)
 220         link = rule "link" $
 221                 element "link" $
 222                 interleaved $
 223                 DTC.Link
 224                  <$?> (def, attribute "name" text)
 225                  <|?> (def, attribute "href" url)
 226                  <|?> (def, attribute "rel"  text)
 227                  <|*> horizontal
 228         alias = rule "alias" $
 229                 element "alias" $
 230                 interleaved $
 231                 DTC.Alias
 232                  <$?> (def, id)
 233         reference = rule "reference" $
 234                 element "reference" $
 235                 DTC.Reference
 236                  <$> id
 237                  <*> optional (attribute "to" url)
 238                  <*> about
 239
 240 instance Sym_DTC RNC.Writer
 241 instance Sym_DTC RNC.RuleWriter
 242 dtcRNC :: [RNC.RuleWriter ()]
 243 dtcRNC =
 244  [ void document
 245  , void head
 246  , void body
 247
 248  , void vertical
 249  , void horizontal
 250  , void $ rule "horizontals" horizontals
 251
 252  , void title
 253  , void name
 254  , void url
 255  , void path
 256  , void ident
 257
 258  , void commonAttrs
 259  , void to
 260  , void id
 261
 262  , void $ rule "about" $ element "about" about
 263  , void address
 264  , void author
 265  , void date
 266  , void editor
 267  , void entity
 268  , void keyword
 269  , void link
 270  , void serie
 271  , void version
 272
 273  , void alias
 274  , void reference
 275
 276  , void include
 277  , void figure
 278  ]