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