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                                 DTC.Section
  75                                  <$> commonAttrs
  76                                  <*> title
  77                                  <*> many alias
  78                                  <*> body
  79                          , DTC.Verticals
  80                                  <$> some vertical
  81                          ]
  82         title = rule "title" $ DTC.Title <$> element "title" horizontals
  83         name  = rule "name"  $ attribute "name" text
  84         url   = rule "url"   $ DTC.URL   <$> text
  85         path  = rule "path"  $ DTC.Path  <$> text
  86         ident = rule "ident" $ DTC.Ident <$> text
  87         to    = rule "to"    $ attribute "to" ident
  88         id    = rule "id"    $ attribute "id" ident
  89         date  = rule "date"  $
  90                 element "date" $
  91                 interleaved $
  92                 DTC.Date
  93                  <$?> (0, attribute "year" int)
  94                  <|?> (Nothing, Just <$> attribute "month" nat1)
  95                  <|?> (Nothing, Just <$> attribute "day"   nat1)
  96         include  = rule "include"  $
  97                 element "include" $
  98                 interleaved $
  99                 DTC.Include
 100                  <$?> (def, attribute "href" path)
 101         vertical = rule "vertical" $
 102                 choice
 103                  [ DTC.Comment <$> comment
 104                  , element "para" $ DTC.Para
 105                          <$> commonAttrs
 106                          <*> horizontals
 107                  , element "ol" $ DTC.OL
 108                          <$> commonAttrs
 109                          <*> many (element "li" $ many vertical)
 110                  , element "ul" $ DTC.UL
 111                          <$> commonAttrs
 112                          <*> many (element "li" $ many vertical)
 113                  , element "rl" $ DTC.RL
 114                          <$> commonAttrs
 115                          <*> many reference
 116                  , element "toc" $ DTC.ToC
 117                          <$> commonAttrs
 118                          <*> optional (attribute "depth" int)
 119                  , element "tof" $ DTC.ToF
 120                          <$> commonAttrs
 121                          <*> optional (attribute "depth" int)
 122                  , element "index" $ DTC.Index
 123                          <$> commonAttrs
 124                          <*  any
 125                  , figure
 126                  {-
 127                  , anyElem $ \n@XmlName{..} ->
 128                                 case xmlNameSpace of
 129                                  "" -> figure n
 130                  -}
 131                  ]
 132         figure =
 133                 rule "figure" $
 134                 element "figure" $
 135                 DTC.Figure
 136                  <$> attribute "type" text
 137                  <*> commonAttrs
 138                  <*> title
 139                  <*> many vertical
 140         horizontals = many horizontal
 141         horizontal = rule "horizontal" $
 142                 choice
 143                  [ DTC.BR   <$  element "br"   none
 144                  , DTC.B    <$> element "b"    horizontals
 145                  , DTC.Code <$> element "code" horizontals
 146                  , DTC.Del  <$> element "del"  horizontals
 147                  , DTC.I    <$> element "i"    horizontals
 148                  , DTC.Note <$> element "note" horizontals
 149                  , DTC.Q    <$> element "q"    horizontals
 150                  , DTC.SC   <$> element "sc"   horizontals
 151                  , DTC.Sub  <$> element "sub"  horizontals
 152                  , DTC.Sup  <$> element "sup"  horizontals
 153                  , DTC.U    <$> element "u"    horizontals
 154                  , element "eref" $ DTC.Eref
 155                          <$> attribute "to" url
 156                          <*> horizontals
 157                  , element "iref" $ DTC.Iref <$> to <*> horizontals
 158                  , element "ref"  $ DTC.Ref  <$> to <*> horizontals
 159                  , element "rref" $ DTC.Rref <$> to <*> horizontals
 160                  , DTC.Plain <$> text
 161                  ]
 162         keyword = rule "keyword" $
 163                 element "keyword" text
 164         version = rule "version" $
 165                 MayText <$>
 166                 element "version" text
 167         about =
 168                 interleaved $
 169                 DTC.About
 170                  <$*> title
 171                  <|*> author
 172                  <|?> (Nothing, Just <$> editor)
 173                  <|?> (Nothing, Just <$> date)
 174                  <|?> (def, version)
 175                  <|*> keyword
 176                  <|*> link
 177                  <|*> serie
 178                  <|*> include
 179         author = rule "author" $ element "author" entity
 180         editor = rule "editor" $ element "editor" entity
 181         entity = rule "entity" $
 182                 DTC.Entity
 183                  <$> name
 184                  <*> address
 185         address = rule "address" $
 186                 element "address" $
 187                 interleaved $
 188                 DTC.Address
 189                  <$?> (def, attribute "street"  text)
 190                  <|?> (def, attribute "zipcode" text)
 191                  <|?> (def, attribute "city"    text)
 192                  <|?> (def, attribute "region"  text)
 193                  <|?> (def, attribute "country" text)
 194                  <|?> (def, attribute "email"   text)
 195                  <|?> (def, attribute "tel"     text)
 196                  <|?> (def, attribute "fax"     text)
 197         serie = rule "serie" $
 198                 element "serie" $
 199                 interleaved $
 200                 DTC.Serie
 201                  <$?> (def, attribute "name" text)
 202                  <|?> (def, attribute "key"  text)
 203         link = rule "link" $
 204                 element "link" $
 205                 interleaved $
 206                 DTC.Link
 207                  <$?> (def, attribute "name" text)
 208                  <|?> (def, attribute "href" url)
 209                  <|?> (def, attribute "rel"  text)
 210                  <|*> horizontal
 211         alias = rule "alias" $
 212                 element "alias" $
 213                 interleaved $
 214                 DTC.Alias
 215                  <$?> (def, id)
 216         reference = rule "reference" $
 217                 element "reference" $
 218                 DTC.Reference
 219                  <$> id
 220                  <*> optional (attribute "to" url)
 221                  <*> about
 222
 223 instance Sym_DTC RNC.Writer
 224 instance Sym_DTC RNC.RuleWriter
 225 dtcRNC :: [RNC.RuleWriter ()]
 226 dtcRNC =
 227  [ void document
 228  , void head
 229  , void body
 230
 231  , void vertical
 232  , void horizontal
 233  , void $ rule "horizontals" horizontals
 234
 235  , void title
 236  , void name
 237  , void url
 238  , void path
 239  , void ident
 240
 241  , void commonAttrs
 242  , void to
 243  , void id
 244
 245  , void $ rule "about" $ element "about" about
 246  , void address
 247  , void author
 248  , void date
 249  , void editor
 250  , void entity
 251  , void keyword
 252  , void link
 253  , void serie
 254  , void version
 255
 256  , void alias
 257  , void reference
 258
 259  , void include
 260  , void figure
 261  ]