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