Language/DTC/Sym.hs

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