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.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 Language.DTC.Index (wordify)
  19 import qualified Language.DTC.Document as DTC
  20 import qualified Language.RNC.Write as RNC
  21
  22 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
  23 foldlApp = foldl' (flip ($)) def
  24 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
  25 foldrApp = foldr ($) def
  26
  27 class RNC.Sym_RNC repr => Sym_DTC repr where
  28         document    :: repr DTC.Document
  29
  30         head        :: repr DTC.Head
  31         about       :: repr DTC.About
  32         keyword     :: repr Text
  33         version     :: repr MayText
  34         author      :: repr DTC.Entity
  35         editor      :: repr DTC.Entity
  36         date        :: repr DTC.Date
  37         entity      :: repr DTC.Entity
  38         address     :: repr DTC.Address
  39         link        :: repr DTC.Link
  40         serie       :: repr DTC.Serie
  41         alias       :: repr DTC.Alias
  42
  43         body        :: repr DTC.Body
  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         block       :: repr DTC.Block
  53         para        :: repr DTC.Para
  54         lines       :: repr (Tree DTC.LineKey DTC.LineValue)
  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                          [ element "section" $ TreeN <$> section <*> body
  85                          , Tree0 <$> bodyValue
  86                          ]
  87                 where
  88                 section =
  89                         DTC.Section
  90                          <$> position
  91                          <*> commonAttrs
  92                          <*> title
  93                          <*> many alias
  94         bodyValue =
  95                 choice
  96                  [ toc
  97                  , tof
  98                  , index
  99                  , figure
 100                  , DTC.Block <$> block
 101                  ]
 102         title = rule "title" $ DTC.Title <$> element "title" para
 103         name  = rule "name"  $ attribute "name" text
 104         url   = rule "url"   $ URL   <$> text
 105         path  = rule "path"  $ Path  <$> text
 106         ident = rule "ident" $ Ident <$> text
 107         to    = rule "to"    $ attribute "to" ident
 108         id    = rule "id"    $ attribute "id" ident
 109         date  = rule "date"  $
 110                 element "date" $
 111                 interleaved $
 112                 DTC.Date
 113                  <$?> (0, attribute "year" int)
 114                  <|?> (Nothing, Just <$> attribute "month" nat1)
 115                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 116         include  = rule "include"  $
 117                 element "include" $
 118                 interleaved $
 119                 DTC.Include
 120                  <$?> (def, attribute "href" path)
 121         block = rule "block" $
 122                 choice
 123                  [ DTC.Comment <$> comment
 124                  , element "para" $
 125                         DTC.Para
 126                          <$> position
 127                          <*> commonAttrs
 128                          <*> para
 129                  , element "ol" $
 130                         DTC.OL
 131                          <$> position
 132                          <*> commonAttrs
 133                          <*> many (element "li" $ many block)
 134                  , element "ul" $
 135                         DTC.UL
 136                          <$> position
 137                          <*> commonAttrs
 138                          <*> many (element "li" $ many block)
 139                  , element "rl" $
 140                         DTC.RL
 141                          <$> position
 142                          <*> commonAttrs
 143                          <*> many reference
 144                  {-
 145                  , anyElem $ \n@XmlName{..} ->
 146                                 case xmlNameSpace of
 147                                  "" -> figure n
 148                  -}
 149                  ]
 150         toc =
 151                 rule "toc" $
 152                 element "toc" $
 153                 DTC.ToC
 154                  <$> position
 155                  <*> commonAttrs
 156                  <*> optional (attribute "depth" nat)
 157         tof =
 158                 rule "tof" $
 159                 element "tof" $
 160                 DTC.ToF
 161                  <$> position
 162                  <*> commonAttrs
 163                  <*> optional (attribute "depth" nat)
 164         index =
 165                 rule "index" $
 166                 element "index" $
 167                 DTC.Index
 168                  <$> position
 169                  <*> commonAttrs
 170                  <*> element "ul" (
 171                         many $
 172                                 element "li" $
 173                                         element "para" $
 174                                                 (concat <$>) $
 175                                                 many $
 176                                                         (wordify <$>) . Text.lines <$> text)
 177         figure =
 178                 rule "figure" $
 179                 element "figure" $
 180                 DTC.Figure
 181                  <$> position
 182                  <*> commonAttrs
 183                  <*> attribute "type" text
 184                  <*> title
 185                  <*> many block
 186         para = rule "para" $ (Seq.fromList <$>) $ many lines
 187         lines =
 188                 choice
 189                  [ element "b"    $ TreeN DTC.B    <$> para
 190                  , element "code" $ TreeN DTC.Code <$> para
 191                  , element "del"  $ TreeN DTC.Del  <$> para
 192                  , element "i"    $ TreeN DTC.I    <$> para
 193                  , element "note" $ TreeN DTC.Note <$> para
 194                  , element "q"    $ TreeN DTC.Q    <$> para
 195                  , element "sc"   $ TreeN DTC.SC   <$> para
 196                  , element "sub"  $ TreeN DTC.Sub  <$> para
 197                  , element "sup"  $ TreeN DTC.Sup  <$> para
 198                  , element "u"    $ TreeN DTC.U    <$> para
 199                  , element "eref" $ TreeN . DTC.Eref <$> attribute "to" url <*> para
 200                  , element "iref" $ TreeN . DTC.Iref (-1) . wordify <$> attribute "to" text <*> para
 201                  , element "ref"  $ TreeN . DTC.Ref  <$> to <*> para
 202                  , element "rref" $ TreeN . DTC.Rref <$> to <*> para
 203                  , element "br"   $ Tree0 DTC.BR <$ none
 204                  , Tree0 . 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                 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
 251                  <$?> (def, attribute "name" text)
 252                  <|?> (def, attribute "href" url)
 253                  <|?> (def, attribute "rel"  text)
 254                  <|*> lines
 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 $ bodyValue
 288  , void $ toc
 289  , void $ tof
 290  , void $ index
 291  , void $ figure
 292  , void $ reference
 293  , void $ include
 294
 295  , void $ block
 296  , void $ para
 297  , void $ lines
 298
 299  , void $ commonAttrs
 300  , void $ ident
 301  , void $ title
 302  , void $ name
 303  , void $ url
 304  , void $ path
 305  , void $ to
 306  , void $ id
 307  ]