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