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                  <*> option [] (
 164                         element "ul" $
 165                                 many $
 166                                         element "li" $
 167                                                 element "para" text)
 168         index =
 169                 rule "index" $
 170                 element "index" $
 171                 DTC.Index
 172                  <$> position
 173                  <*> commonAttrs
 174                  <*> option [] (
 175                         element "ul" $
 176                                 many $
 177                                         element "li" $
 178                                                 element "para" $
 179                                                         (concat <$>) $
 180                                                         many $
 181                                                                 (wordify <$>) . Text.lines <$> text)
 182         figure =
 183                 rule "figure" $
 184                 element "figure" $
 185                 DTC.Figure
 186                  <$> position
 187                  <*> commonAttrs
 188                  <*> attribute "type" text
 189                  <*> title
 190                  <*> many block
 191         para = rule "para" $ (Seq.fromList <$>) $ many lines
 192         lines =
 193                 choice
 194                  [ element "b"    $ TreeN DTC.B    <$> para
 195                  , element "code" $ TreeN DTC.Code <$> para
 196                  , element "del"  $ TreeN DTC.Del  <$> para
 197                  , element "i"    $ TreeN DTC.I    <$> para
 198                  , element "note" $ TreeN DTC.Note <$> para
 199                  , element "q"    $ TreeN DTC.Q    <$> para
 200                  , element "sc"   $ TreeN DTC.SC   <$> para
 201                  , element "sub"  $ TreeN DTC.Sub  <$> para
 202                  , element "sup"  $ TreeN DTC.Sup  <$> para
 203                  , element "u"    $ TreeN DTC.U    <$> para
 204                  , element "eref" $ TreeN . DTC.Eref <$> attribute "to" url <*> para
 205                  , element "iref" $ TreeN . DTC.Iref (-1) . wordify <$> attribute "to" text <*> para
 206                  , element "ref"  $ TreeN . DTC.Ref  <$> to <*> para
 207                  , element "rref" $ TreeN . DTC.Rref <$> to <*> para
 208                  , element "br"   $ Tree0 DTC.BR <$ none
 209                  , Tree0 . DTC.Plain <$> text
 210                  ]
 211         keyword = rule "keyword" $
 212                 element "keyword" text
 213         version = rule "version" $
 214                 MayText <$>
 215                 element "version" text
 216         about =
 217                 interleaved $
 218                 DTC.About
 219                  <$*> title
 220                  <|*> author
 221                  <|?> (Nothing, Just <$> editor)
 222                  <|?> (Nothing, Just <$> date)
 223                  <|?> (def, version)
 224                  <|*> keyword
 225                  <|*> link
 226                  <|*> serie
 227                  <|*> include
 228         author = rule "author" $ element "author" entity
 229         editor = rule "editor" $ element "editor" entity
 230         entity = rule "entity" $
 231                 DTC.Entity
 232                  <$> name
 233                  <*> address
 234         address = rule "address" $
 235                 element "address" $
 236                 interleaved $
 237                 DTC.Address
 238                  <$?> (def, attribute "street"  text)
 239                  <|?> (def, attribute "zipcode" text)
 240                  <|?> (def, attribute "city"    text)
 241                  <|?> (def, attribute "region"  text)
 242                  <|?> (def, attribute "country" text)
 243                  <|?> (def, attribute "email"   text)
 244                  <|?> (def, attribute "tel"     text)
 245                  <|?> (def, attribute "fax"     text)
 246         serie = rule "serie" $
 247                 element "serie" $
 248                 interleaved $
 249                 DTC.Serie
 250                  <$?> (def, attribute "name" text)
 251                  <|?> (def, attribute "key"  text)
 252         link = rule "link" $
 253                 element "link" $
 254                 interleaved $
 255                 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
 256                  <$?> (def, attribute "name" text)
 257                  <|?> (def, attribute "href" url)
 258                  <|?> (def, attribute "rel"  text)
 259                  <|*> lines
 260         alias = rule "alias" $
 261                 element "alias" $
 262                 interleaved $
 263                 DTC.Alias
 264                  <$?> (def, id)
 265         reference = rule "reference" $
 266                 element "reference" $
 267                 DTC.Reference
 268                  <$> id
 269                  <*> optional (attribute "to" url)
 270                  <*> about
 271
 272 instance Sym_DTC RNC.Writer
 273 instance Sym_DTC RNC.RuleWriter
 274 dtcRNC :: [RNC.RuleWriter ()]
 275 dtcRNC =
 276  [ void $ document
 277
 278  , void $ head
 279  , void $ rule "about" $ element "about" about
 280  , void $ keyword
 281  , void $ version
 282  , void $ author
 283  , void $ editor
 284  , void $ date
 285  , void $ entity
 286  , void $ address
 287  , void $ link
 288  , void $ serie
 289  , void $ alias
 290
 291  , void $ body
 292  , void $ bodyValue
 293  , void $ toc
 294  , void $ tof
 295  , void $ index
 296  , void $ figure
 297  , void $ reference
 298  , void $ include
 299
 300  , void $ block
 301  , void $ para
 302  , void $ lines
 303
 304  , void $ commonAttrs
 305  , void $ ident
 306  , void $ title
 307  , void $ name
 308  , void $ url
 309  , void $ path
 310  , void $ to
 311  , void $ id
 312  ]