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.TreeSeq.Strict (Tree(..), tree0)
  12 import qualified Data.Sequence as Seq
  13 import qualified Data.Text.Lazy as TL
  14
  15 import Language.XML
  16 import Language.RNC.Sym as RNC
  17 import Language.DTC.Anchor (wordify)
  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 'Sym_DTC'
  27 -- | Use a symantic (tagless final) class to encode
  28 -- both the parsing and the schema of DTC,
  29 -- when repr is respectively instanciated
  30 -- on 'DTC.Parser' or 'RNC.RuleWriter'.
  31 class RNC.Sym_RNC repr => Sym_DTC repr where
  32         position    :: repr DTC.Pos
  33         document    :: repr DTC.Document
  34
  35         head        :: repr DTC.Head
  36         about       :: repr DTC.About
  37         keyword     :: repr TL.Text
  38         version     :: repr MayText
  39         author      :: repr DTC.Entity
  40         editor      :: repr DTC.Entity
  41         date        :: repr DTC.Date
  42         entity      :: repr DTC.Entity
  43         link        :: repr DTC.Link
  44         serie       :: repr DTC.Serie
  45         alias       :: repr DTC.Alias
  46
  47         body        :: repr DTC.Body
  48         bodyValue   :: repr DTC.BodyNode
  49         toc         :: repr DTC.BodyNode
  50         tof         :: repr DTC.BodyNode
  51         index       :: repr DTC.BodyNode
  52         figure      :: repr DTC.BodyNode
  53         references  :: repr DTC.BodyNode
  54         reference   :: repr DTC.Reference
  55         include     :: repr DTC.Include
  56
  57         block       :: repr DTC.Block
  58         para        :: repr DTC.Para
  59         lines       :: repr DTC.Lines
  60
  61         commonAttrs :: repr DTC.CommonAttrs
  62         ident       :: repr Ident
  63         title       :: repr DTC.Title
  64         name        :: repr TL.Text
  65         url         :: repr URL
  66         path        :: repr Path
  67         to          :: repr Ident
  68         id          :: repr Ident
  69
  70         commonAttrs =
  71                 rule "commonAttrs" $
  72                 interleaved $
  73                 DTC.CommonAttrs
  74                  <$?> (def, Just <$> id)
  75                  <|?> (def, rule "class" $ attribute "class" $ TL.words <$> text)
  76
  77         document = rule "document" $
  78                 DTC.Document
  79                  <$> head
  80                  <*> body
  81         head = rule "head" $
  82                 maybe def DTC.Head
  83                  <$> optional (rule "about" $ element "about" about)
  84         body =
  85                 rule "body" $
  86                 (Seq.fromList <$>) $
  87                 many $
  88                         choice
  89                          [ element "section" $ Tree <$> section <*> body
  90                          , tree0 <$> bodyValue
  91                          ]
  92                 where
  93                 section =
  94                         DTC.Section
  95                          <$> position
  96                          <*> commonAttrs
  97                          <*> title
  98                          <*> many alias
  99         bodyValue =
 100                 choice
 101                  [ toc
 102                  , tof
 103                  , index
 104                  , figure
 105                  , references
 106                  , DTC.Block <$> block
 107                  ]
 108         title = rule "title" $ DTC.Title <$> element "title" para
 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         block = rule "block" $
 128                 choice
 129                  [ DTC.Comment <$> comment
 130                  , element "para" $
 131                         DTC.Para
 132                          <$> position
 133                          <*> commonAttrs
 134                          <*> para
 135                  , element "ol" $
 136                         DTC.OL
 137                          <$> position
 138                          <*> commonAttrs
 139                          <*> many (element "li" $ many block)
 140                  , element "ul" $
 141                         DTC.UL
 142                          <$> position
 143                          <*> commonAttrs
 144                          <*> many (element "li" $ many block)
 145                  , element "artwork" $
 146                         DTC.Artwork
 147                          <$> position
 148                          <*> commonAttrs
 149                          <*> attribute "type" text
 150                          <*> text
 151                  , element "quote" $
 152                         DTC.Quote
 153                          <$> position
 154                          <*> commonAttrs
 155                          <*> attribute "type" text
 156                          <*> many block
 157                  {-
 158                  , anyElem $ \n@XmlName{..} ->
 159                                 case xmlNameSpace of
 160                                  "" -> figure n
 161                  -}
 162                  ]
 163         toc =
 164                 rule "toc" $
 165                 element "toc" $
 166                 DTC.ToC
 167                  <$> position
 168                  <*> commonAttrs
 169                  <*> optional (attribute "depth" nat)
 170         tof =
 171                 rule "tof" $
 172                 element "tof" $
 173                 DTC.ToF
 174                  <$> position
 175                  <*> commonAttrs
 176                  <*> option [] (
 177                         element "ul" $
 178                                 many $
 179                                         element "li" $
 180                                                 element "para" text)
 181         index =
 182                 rule "index" $
 183                 element "index" $
 184                 DTC.Index
 185                  <$> position
 186                  <*> commonAttrs
 187                  <*> option [] (
 188                         element "ul" $
 189                                 many $
 190                                         element "li" $
 191                                                 element "para" $
 192                                                         (concat <$>) $
 193                                                         many $
 194                                                                 (wordify <$>) . TL.lines <$> text)
 195         figure =
 196                 rule "figure" $
 197                 element "figure" $
 198                 DTC.Figure
 199                  <$> position
 200                  <*> commonAttrs
 201                  <*> attribute "type" text
 202                  <*> optional title
 203                  <*> many block
 204         references =
 205                 element "references" $
 206                 DTC.References
 207                  <$> position
 208                  <*> commonAttrs
 209                  <*> many reference
 210         para = rule "para" $ (Seq.fromList <$>) $ many lines
 211         lines =
 212                 rule "lines" $
 213                 choice
 214                  [ element "b"    $ Tree DTC.B    <$> para
 215                  , element "code" $ Tree DTC.Code <$> para
 216                  , element "del"  $ Tree DTC.Del  <$> para
 217                  , element "i"    $ Tree DTC.I    <$> para
 218                  , element "note" $ Tree (DTC.Note Nothing) <$> para
 219                  , element "q"    $ Tree DTC.Q    <$> para
 220                  , element "sc"   $ Tree DTC.SC   <$> para
 221                  , element "sub"  $ Tree DTC.Sub  <$> para
 222                  , element "sup"  $ Tree DTC.Sup  <$> para
 223                  , element "u"    $ Tree DTC.U    <$> para
 224                  , element "eref" $ Tree . DTC.Eref <$> attribute "to" url <*> para
 225                  , element "iref" $ Tree . DTC.Iref Nothing . wordify <$> attribute "to" text <*> para
 226                  , element "ref"  $ Tree . DTC.Ref  <$> to <*> para
 227                  , element "rref" $ Tree . DTC.Rref Nothing <$> to <*> para
 228                  , element "br"   $ tree0 DTC.BR <$ none
 229                  , tree0 . DTC.Plain <$> text
 230                  ]
 231         keyword = rule "keyword" $
 232                 element "keyword" text
 233         version = rule "version" $
 234                 MayText <$>
 235                 element "version" text
 236         about =
 237                 interleaved $
 238                 DTC.About
 239                  <$*> title
 240                  <|?> (def, Just <$> attribute "url" url)
 241                  <|*> author
 242                  <|?> (Nothing, Just <$> editor)
 243                  <|?> (Nothing, Just <$> date)
 244                  <|?> (def, version)
 245                  <|*> keyword
 246                  <|*> link
 247                  <|*> serie
 248                  <|*> include
 249         author = rule "author" $ element "author" entity
 250         editor = rule "editor" $ element "editor" entity
 251         entity = rule "entity" $
 252                 interleaved $
 253                 DTC.Entity
 254                  <$?> (def, name)
 255                  <|?> (def, attribute "street"  text)
 256                  <|?> (def, attribute "zipcode" text)
 257                  <|?> (def, attribute "city"    text)
 258                  <|?> (def, attribute "region"  text)
 259                  <|?> (def, attribute "country" text)
 260                  <|?> (def, attribute "email"   text)
 261                  <|?> (def, attribute "tel"     text)
 262                  <|?> (def, attribute "fax"     text)
 263                  <|?> (def, Just <$> attribute "url" url)
 264                  <|?> (def, Just <$> attribute "org" entity)
 265         serie = rule "serie" $
 266                 element "serie" $
 267                 interleaved $
 268                 DTC.Serie
 269                  <$?> (def, name)
 270                  <|?> (def, attribute "key" text)
 271         link = rule "link" $
 272                 element "link" $
 273                 interleaved $
 274                 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
 275                  <$?> (def, name)
 276                  <|?> (def, attribute "href" url)
 277                  <|?> (def, attribute "rel"  text)
 278                  <|*> lines
 279         alias = rule "alias" $
 280                 element "alias" $
 281                 interleaved $
 282                 DTC.Alias
 283                  <$?> (def, id)
 284         reference = rule "reference" $
 285                 element "reference" $
 286                 DTC.Reference
 287                  <$> id
 288                  <*> about
 289
 290 instance Sym_DTC RNC.Writer where
 291         position = RNC.writeText ""
 292 instance Sym_DTC RNC.RuleWriter where
 293         position = RNC.RuleWriter position
 294
 295 -- | RNC schema for DTC
 296 schema :: [RNC.RuleWriter ()]
 297 schema =
 298  [ void $ document
 299
 300  , void $ head
 301  , void $ rule "about" $ element "about" about
 302  , void $ keyword
 303  , void $ version
 304  , void $ author
 305  , void $ editor
 306  , void $ date
 307  , void $ entity
 308  , void $ link
 309  , void $ serie
 310  , void $ alias
 311
 312  , void $ body
 313  , void $ bodyValue
 314  , void $ toc
 315  , void $ tof
 316  , void $ index
 317  , void $ figure
 318  , void $ references
 319  , void $ reference
 320  , void $ include
 321
 322  , void $ block
 323  , void $ para
 324  , void $ lines
 325
 326  , void $ commonAttrs
 327  , void $ ident
 328  , void $ title
 329  , void $ name
 330  , void $ url
 331  , void $ path
 332  , void $ to
 333  , void $ id
 334  ]