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 TL.Text
  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         include          :: repr DTC.Include
  49
  50         block            :: repr DTC.Block
  51         blockToC         :: repr DTC.Block
  52         blockToF         :: repr DTC.Block
  53         blockIndex       :: repr DTC.Block
  54         blockFigure      :: repr DTC.Block
  55         blockReferences  :: repr DTC.Block
  56         reference        :: repr DTC.Reference
  57
  58         para             :: repr DTC.Para
  59         paraItem         :: repr DTC.ParaItem
  60         paraItems        :: repr DTC.Para
  61
  62         plain            :: repr DTC.Plain
  63         plainNode        :: repr (Tree DTC.PlainNode)
  64
  65         commonAttrs      :: repr DTC.CommonAttrs
  66         ident            :: repr Ident
  67         title            :: repr DTC.Title
  68         name             :: repr TL.Text
  69         url              :: repr URL
  70         path             :: repr Path
  71         to               :: repr Ident
  72         id               :: repr Ident
  73
  74         commonAttrs =
  75                 rule "commonAttrs" $
  76                 interleaved $
  77                 DTC.CommonAttrs
  78                  <$?> (def, Just <$> id)
  79                  <|?> (def, rule "class" $ attribute "class" $ TL.words <$> text)
  80
  81         document = rule "document" $
  82                 DTC.Document
  83                  <$> head
  84                  <*> body
  85         head = rule "head" $
  86                 maybe def DTC.Head
  87                  <$> optional (rule "about" $ element "about" about)
  88         body =
  89                 rule "body" $
  90                 (Seq.fromList <$>) $
  91                 many $
  92                         choice
  93                          [ element "section" $ Tree <$> section <*> body
  94                          , tree0 . DTC.BodyBlock <$> block
  95                          ]
  96                 where
  97                 section =
  98                         DTC.BodySection
  99                          <$> position
 100                          <*> commonAttrs
 101                          <*> title
 102                          <*> many alias
 103         title = rule "title" $ DTC.Title <$> element "title" plain
 104         name  = rule "name"  $ attribute "name" text
 105         url   = rule "url"   $ URL   <$> text
 106         path  = rule "path"  $ Path  <$> text
 107         ident = rule "ident" $ Ident <$> text
 108         to    = rule "to"    $ attribute "to" ident
 109         id    = rule "id"    $ attribute "id" ident
 110         date  = rule "date"  $
 111                 element "date" $
 112                 interleaved $
 113                 DTC.Date
 114                  <$?> (0, attribute "year" int)
 115                  <|?> (Nothing, Just <$> attribute "month" nat1)
 116                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 117         include =
 118                 rule "include"  $
 119                 element "include" $
 120                 interleaved $
 121                 DTC.Include
 122                  <$?> (def, attribute "href" path)
 123         block = rule "block" $
 124                 choice
 125                  [ DTC.BlockPara <$> para
 126                  , blockToC
 127                  , blockToF
 128                  , blockIndex
 129                  , blockFigure
 130                  , blockReferences
 131                  {-
 132                  , anyElem $ \n@XmlName{..} ->
 133                                 case xmlNameSpace of
 134                                  "" -> figure n
 135                  -}
 136                  ]
 137         blockToC =
 138                 rule "blockToC" $
 139                 element "toc" $
 140                 DTC.BlockToC
 141                  <$> position
 142                  <*> commonAttrs
 143                  <*> optional (attribute "depth" nat)
 144         blockToF =
 145                 rule "blockToF" $
 146                 element "tof" $
 147                 DTC.BlockToF
 148                  <$> position
 149                  <*> commonAttrs
 150                  <*> option [] (
 151                         element "ul" $
 152                                 many $
 153                                         element "li" $
 154                                                 element "para" text)
 155         blockIndex =
 156                 rule "blockIndex" $
 157                 element "index" $
 158                 DTC.BlockIndex
 159                  <$> position
 160                  <*> commonAttrs
 161                  <*> option [] (
 162                         element "ul" $
 163                                 many $
 164                                         element "li" $
 165                                                 element "para" $
 166                                                         (concat <$>) $
 167                                                         many $
 168                                                                 (wordify <$>) . TL.lines <$> text)
 169         blockFigure =
 170                 rule "blockFigure" $
 171                 element "figure" $
 172                 DTC.BlockFigure
 173                  <$> position
 174                  <*> commonAttrs
 175                  <*> attribute "type" text
 176                  <*> optional title
 177                  <*> many para
 178         blockReferences =
 179                 rule "blockReferences" $
 180                 element "references" $
 181                 DTC.BlockReferences
 182                  <$> position
 183                  <*> commonAttrs
 184                  <*> many reference
 185
 186         para = rule "para" $ paraItems <|> DTC.ParaItem <$> paraItem
 187         paraItem =
 188                 rule "paraItem" $
 189                 choice
 190                  [ element "ol"      $ DTC.ParaOL <$> many (element "li" $ DTC.ListItem <$> attribute "name" text <*> many para)
 191                  , element "ul"      $ DTC.ParaUL <$> many (element "li" $ many para)
 192                  , element "artwork" $ DTC.ParaArtwork <$> attribute "type" text <*> text
 193                  , element "quote"   $ DTC.ParaQuote   <$> attribute "type" text <*> many para
 194                  , DTC.ParaPlain . Seq.fromList <$> some plainNode
 195                  , DTC.ParaComment <$> comment
 196                  ]
 197         paraItems =
 198                 rule "paraItems" $
 199                 element "para" $
 200                         DTC.ParaItems
 201                          <$> position
 202                          <*> commonAttrs
 203                          <*> many paraItem
 204         plain = rule "plain" $ (Seq.fromList <$>) $ many plainNode
 205         plainNode =
 206                 rule "plainNode" $
 207                 choice
 208                  [ tree0 . DTC.PlainText <$> text
 209                  , element "br"   $ tree0   DTC.PlainBR   <$ none
 210                  , element "b"    $ Tree    DTC.PlainB    <$> plain
 211                  , element "code" $ Tree    DTC.PlainCode <$> plain
 212                  , element "del"  $ Tree    DTC.PlainDel  <$> plain
 213                  , element "i"    $ Tree    DTC.PlainI    <$> plain
 214                  , element "q"    $ Tree    DTC.PlainQ    <$> plain
 215                  , element "sc"   $ Tree    DTC.PlainSC   <$> plain
 216                  , element "sub"  $ Tree    DTC.PlainSub  <$> plain
 217                  , element "sup"  $ Tree    DTC.PlainSup  <$> plain
 218                  , element "u"    $ Tree    DTC.PlainU    <$> plain
 219                  , element "note" $ tree0 . DTC.PlainNote Nothing <$> many para
 220                  , element "iref" $ Tree .  DTC.PlainIref Nothing . wordify <$> attribute "to" text <*> plain
 221                  , element "eref" $ Tree .  DTC.PlainEref <$> attribute "to" url <*> plain
 222                  , element "ref"  $ Tree .  DTC.PlainRef  <$> to <*> plain
 223                  , element "rref" $ Tree .  DTC.PlainRref Nothing <$> to <*> plain
 224                  ]
 225         keyword = rule "keyword" $ element "keyword" text
 226         version = rule "version" $ element "version" text
 227         about =
 228                 interleaved $
 229                 DTC.About
 230                  <$*> title
 231                  <|?> (def, Just <$> attribute "url" url)
 232                  <|*> author
 233                  <|?> (def, Just <$> editor)
 234                  <|?> (def, Just <$> date)
 235                  <|?> (def, Just <$> version)
 236                  <|*> keyword
 237                  <|*> link
 238                  <|*> serie
 239                  <|*> include
 240         author = rule "author" $ element "author" entity
 241         editor = rule "editor" $ element "editor" entity
 242         entity = rule "entity" $
 243                 interleaved $
 244                 DTC.Entity
 245                  <$?> (def, name)
 246                  <|?> (def, attribute "street"  text)
 247                  <|?> (def, attribute "zipcode" text)
 248                  <|?> (def, attribute "city"    text)
 249                  <|?> (def, attribute "region"  text)
 250                  <|?> (def, attribute "country" text)
 251                  <|?> (def, attribute "email"   text)
 252                  <|?> (def, attribute "tel"     text)
 253                  <|?> (def, attribute "fax"     text)
 254                  <|?> (def, Just <$> attribute "url" url)
 255                  <|?> (def, Just <$> element "org" entity)
 256         serie = rule "serie" $
 257                 element "serie" $
 258                 interleaved $
 259                 DTC.Serie
 260                  <$?> (def, name)
 261                  <|?> (def, attribute "id" text)
 262         link = rule "link" $
 263                 element "link" $
 264                 interleaved $
 265                 (\n u t p -> DTC.Link n u t (Seq.fromList p))
 266                  <$?> (def, name)
 267                  <|?> (def, attribute "href" url)
 268                  <|?> (def, attribute "rel"  text)
 269                  <|*> plainNode
 270         alias = rule "alias" $
 271                 element "alias" $
 272                 interleaved $
 273                 DTC.Alias
 274                  <$?> (def, id)
 275         reference = rule "reference" $
 276                 element "reference" $
 277                 DTC.Reference
 278                  <$> id
 279                  <*> about
 280
 281 instance Sym_DTC RNC.Writer where
 282         position = RNC.writeText ""
 283 instance Sym_DTC RNC.RuleWriter where
 284         position = RNC.RuleWriter position
 285
 286 -- | RNC schema for DTC
 287 schema :: [RNC.RuleWriter ()]
 288 schema =
 289  [ void $ document
 290
 291  , void $ head
 292  , void $ rule "about" $ element "about" about
 293  , void $ keyword
 294  , void $ version
 295  , void $ author
 296  , void $ editor
 297  , void $ date
 298  , void $ entity
 299  , void $ link
 300  , void $ serie
 301  , void $ alias
 302
 303  , void $ body
 304  , void $ include
 305
 306  , void $ block
 307  , void $ blockToC
 308  , void $ blockToF
 309  , void $ blockIndex
 310  , void $ blockFigure
 311  , void $ blockReferences
 312  , void $ reference
 313
 314  , void $ para
 315  , void $ paraItem
 316  , void $ paraItems
 317
 318  , void $ plain
 319  , void $ plainNode
 320
 321  , void $ commonAttrs
 322  , void $ ident
 323  , void $ title
 324  , void $ name
 325  , void $ url
 326  , void $ path
 327  , void $ to
 328  , void $ id
 329  ]