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