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         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" $
 226                 element "keyword" text
 227         version = rule "version" $
 228                 MayText <$>
 229                 element "version" text
 230         about =
 231                 interleaved $
 232                 DTC.About
 233                  <$*> title
 234                  <|?> (def, Just <$> attribute "url" url)
 235                  <|*> author
 236                  <|?> (Nothing, Just <$> editor)
 237                  <|?> (Nothing, Just <$> date)
 238                  <|?> (def, version)
 239                  <|*> keyword
 240                  <|*> link
 241                  <|*> serie
 242                  <|*> include
 243         author = rule "author" $ element "author" entity
 244         editor = rule "editor" $ element "editor" entity
 245         entity = rule "entity" $
 246                 interleaved $
 247                 DTC.Entity
 248                  <$?> (def, name)
 249                  <|?> (def, attribute "street"  text)
 250                  <|?> (def, attribute "zipcode" text)
 251                  <|?> (def, attribute "city"    text)
 252                  <|?> (def, attribute "region"  text)
 253                  <|?> (def, attribute "country" text)
 254                  <|?> (def, attribute "email"   text)
 255                  <|?> (def, attribute "tel"     text)
 256                  <|?> (def, attribute "fax"     text)
 257                  <|?> (def, Just <$> attribute "url" url)
 258                  <|?> (def, Just <$> element "org" entity)
 259         serie = rule "serie" $
 260                 element "serie" $
 261                 interleaved $
 262                 DTC.Serie
 263                  <$?> (def, name)
 264                  <|?> (def, attribute "key" text)
 265         link = rule "link" $
 266                 element "link" $
 267                 interleaved $
 268                 (\n u t p -> DTC.Link n u t (Seq.fromList p))
 269                  <$?> (def, name)
 270                  <|?> (def, attribute "href" url)
 271                  <|?> (def, attribute "rel"  text)
 272                  <|*> plainNode
 273         alias = rule "alias" $
 274                 element "alias" $
 275                 interleaved $
 276                 DTC.Alias
 277                  <$?> (def, id)
 278         reference = rule "reference" $
 279                 element "reference" $
 280                 DTC.Reference
 281                  <$> id
 282                  <*> about
 283
 284 instance Sym_DTC RNC.Writer where
 285         position = RNC.writeText ""
 286 instance Sym_DTC RNC.RuleWriter where
 287         position = RNC.RuleWriter position
 288
 289 -- | RNC schema for DTC
 290 schema :: [RNC.RuleWriter ()]
 291 schema =
 292  [ void $ document
 293
 294  , void $ head
 295  , void $ rule "about" $ element "about" about
 296  , void $ keyword
 297  , void $ version
 298  , void $ author
 299  , void $ editor
 300  , void $ date
 301  , void $ entity
 302  , void $ link
 303  , void $ serie
 304  , void $ alias
 305
 306  , void $ body
 307  , void $ include
 308
 309  , void $ block
 310  , void $ blockToC
 311  , void $ blockToF
 312  , void $ blockIndex
 313  , void $ blockFigure
 314  , void $ blockReferences
 315  , void $ reference
 316
 317  , void $ para
 318  , void $ paraItem
 319  , void $ paraItems
 320
 321  , void $ plain
 322  , void $ plainNode
 323
 324  , void $ commonAttrs
 325  , void $ ident
 326  , void $ title
 327  , void $ name
 328  , void $ url
 329  , void $ path
 330  , void $ to
 331  , void $ id
 332  ]