Language/DTC/Sym.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2 {-# LANGUAGE NoMonomorphismRestriction #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE StandaloneDeriving #-}
   5 module Language.DTC.Sym where
   6
   7 import Control.Applicative (Applicative(..), (<$>), (<$))
   8 import Control.Monad (void)
   9 import Data.Default.Class (Default(..))
  10 import Data.Foldable (Foldable(..), concat)
  11 import Data.Function (($), (.), flip)
  12 import Data.Maybe (Maybe(..), maybe)
  13 import Data.Text (Text)
  14 import Data.TreeSeq.Strict (Tree(..))
  15 import qualified Data.Sequence as Seq
  16 import qualified Data.Text as Text
  17
  18 import Language.XML
  19 import Language.RNC.Sym as RNC
  20 import Language.DTC.Anchor (wordify)
  21 import qualified Language.DTC.Document as DTC
  22 import qualified Language.RNC.Write as RNC
  23
  24 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
  25 foldlApp = foldl' (flip ($)) def
  26 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
  27 foldrApp = foldr ($) def
  28
  29 class RNC.Sym_RNC repr => Sym_DTC repr where
  30         position    :: repr DTC.Pos
  31         document    :: repr DTC.Document
  32
  33         head        :: repr DTC.Head
  34         about       :: repr DTC.About
  35         keyword     :: repr Text
  36         version     :: repr MayText
  37         author      :: repr DTC.Entity
  38         editor      :: repr DTC.Entity
  39         date        :: repr DTC.Date
  40         entity      :: repr DTC.Entity
  41         link        :: repr DTC.Link
  42         serie       :: repr DTC.Serie
  43         alias       :: repr DTC.Alias
  44
  45         body        :: repr DTC.Body
  46         bodyValue   :: repr DTC.BodyValue
  47         toc         :: repr DTC.BodyValue
  48         tof         :: repr DTC.BodyValue
  49         index       :: repr DTC.BodyValue
  50         figure      :: repr DTC.BodyValue
  51         references  :: repr DTC.BodyValue
  52         reference   :: repr DTC.Reference
  53         include     :: repr DTC.Include
  54
  55         block       :: repr DTC.Block
  56         para        :: repr DTC.Para
  57         lines       :: repr (Tree DTC.LineKey DTC.LineValue)
  58
  59         commonAttrs :: repr DTC.CommonAttrs
  60         ident       :: repr Ident
  61         title       :: repr DTC.Title
  62         name        :: repr Text
  63         url         :: repr URL
  64         path        :: repr Path
  65         to          :: repr Ident
  66         id          :: repr Ident
  67
  68         commonAttrs =
  69                 rule "commonAttrs" $
  70                 interleaved $
  71                 DTC.CommonAttrs
  72                  <$?> (def, Just <$> id)
  73                  <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
  74
  75         document = rule "document" $
  76                 DTC.Document
  77                  <$> head
  78                  <*> body
  79         head = rule "head" $
  80                 maybe def DTC.Head
  81                  <$> optional (rule "about" $ element "about" about)
  82         body =
  83                 rule "body" $
  84                 (Seq.fromList <$>) $
  85                 many $
  86                         choice
  87                          [ element "section" $ TreeN <$> section <*> body
  88                          , Tree0 <$> bodyValue
  89                          ]
  90                 where
  91                 section =
  92                         DTC.Section
  93                          <$> position
  94                          <*> commonAttrs
  95                          <*> title
  96                          <*> many alias
  97         bodyValue =
  98                 choice
  99                  [ toc
 100                  , tof
 101                  , index
 102                  , figure
 103                  , references
 104                  , DTC.Block <$> block
 105                  ]
 106         title = rule "title" $ DTC.Title <$> element "title" para
 107         name  = rule "name"  $ attribute "name" text
 108         url   = rule "url"   $ URL   <$> text
 109         path  = rule "path"  $ Path  <$> text
 110         ident = rule "ident" $ Ident <$> text
 111         to    = rule "to"    $ attribute "to" ident
 112         id    = rule "id"    $ attribute "id" ident
 113         date  = rule "date"  $
 114                 element "date" $
 115                 interleaved $
 116                 DTC.Date
 117                  <$?> (0, attribute "year" int)
 118                  <|?> (Nothing, Just <$> attribute "month" nat1)
 119                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 120         include  = rule "include"  $
 121                 element "include" $
 122                 interleaved $
 123                 DTC.Include
 124                  <$?> (def, attribute "href" path)
 125         block = rule "block" $
 126                 choice
 127                  [ DTC.Comment <$> comment
 128                  , element "para" $
 129                         DTC.Para
 130                          <$> position
 131                          <*> commonAttrs
 132                          <*> para
 133                  , element "ol" $
 134                         DTC.OL
 135                          <$> position
 136                          <*> commonAttrs
 137                          <*> many (element "li" $ many block)
 138                  , element "ul" $
 139                         DTC.UL
 140                          <$> position
 141                          <*> commonAttrs
 142                          <*> many (element "li" $ many block)
 143                  {-
 144                  , anyElem $ \n@XmlName{..} ->
 145                                 case xmlNameSpace of
 146                                  "" -> figure n
 147                  -}
 148                  ]
 149         toc =
 150                 rule "toc" $
 151                 element "toc" $
 152                 DTC.ToC
 153                  <$> position
 154                  <*> commonAttrs
 155                  <*> optional (attribute "depth" nat)
 156         tof =
 157                 rule "tof" $
 158                 element "tof" $
 159                 DTC.ToF
 160                  <$> position
 161                  <*> commonAttrs
 162                  <*> option [] (
 163                         element "ul" $
 164                                 many $
 165                                         element "li" $
 166                                                 element "para" text)
 167         index =
 168                 rule "index" $
 169                 element "index" $
 170                 DTC.Index
 171                  <$> position
 172                  <*> commonAttrs
 173                  <*> option [] (
 174                         element "ul" $
 175                                 many $
 176                                         element "li" $
 177                                                 element "para" $
 178                                                         (concat <$>) $
 179                                                         many $
 180                                                                 (wordify <$>) . Text.lines <$> text)
 181         figure =
 182                 rule "figure" $
 183                 element "figure" $
 184                 DTC.Figure
 185                  <$> position
 186                  <*> commonAttrs
 187                  <*> attribute "type" text
 188                  <*> title
 189                  <*> many block
 190         references =
 191                 element "references" $
 192                 DTC.References
 193                  <$> position
 194                  <*> commonAttrs
 195                  <*> many reference
 196         para = rule "para" $ (Seq.fromList <$>) $ many lines
 197         lines =
 198                 choice
 199                  [ element "b"    $ TreeN DTC.B    <$> para
 200                  , element "code" $ TreeN DTC.Code <$> para
 201                  , element "del"  $ TreeN DTC.Del  <$> para
 202                  , element "i"    $ TreeN DTC.I    <$> para
 203                  , element "note" $ TreeN DTC.Note <$> para
 204                  , element "q"    $ TreeN DTC.Q    <$> para
 205                  , element "sc"   $ TreeN DTC.SC   <$> para
 206                  , element "sub"  $ TreeN DTC.Sub  <$> para
 207                  , element "sup"  $ TreeN DTC.Sup  <$> para
 208                  , element "u"    $ TreeN DTC.U    <$> para
 209                  , element "eref" $ TreeN . DTC.Eref <$> attribute "to" url <*> para
 210                  , element "iref" $ TreeN . DTC.Iref Nothing . wordify <$> attribute "to" text <*> para
 211                  , element "ref"  $ TreeN . DTC.Ref  <$> to <*> para
 212                  , element "rref" $ TreeN . DTC.Rref Nothing <$> to <*> para
 213                  , element "br"   $ Tree0 DTC.BR <$ none
 214                  , Tree0 . DTC.Plain <$> text
 215                  ]
 216         keyword = rule "keyword" $
 217                 element "keyword" text
 218         version = rule "version" $
 219                 MayText <$>
 220                 element "version" text
 221         about =
 222                 interleaved $
 223                 DTC.About
 224                  <$*> title
 225                  <|?> (def, Just <$> attribute "url" url)
 226                  <|*> author
 227                  <|?> (Nothing, Just <$> editor)
 228                  <|?> (Nothing, Just <$> date)
 229                  <|?> (def, version)
 230                  <|*> keyword
 231                  <|*> link
 232                  <|*> serie
 233                  <|*> include
 234         author = rule "author" $ element "author" entity
 235         editor = rule "editor" $ element "editor" entity
 236         entity = rule "entity" $
 237                 interleaved $
 238                 DTC.Entity
 239                  <$?> (def, attribute "name"    text)
 240                  <|?> (def, attribute "street"  text)
 241                  <|?> (def, attribute "zipcode" text)
 242                  <|?> (def, attribute "city"    text)
 243                  <|?> (def, attribute "region"  text)
 244                  <|?> (def, attribute "country" text)
 245                  <|?> (def, attribute "email"   text)
 246                  <|?> (def, attribute "tel"     text)
 247                  <|?> (def, attribute "fax"     text)
 248                  <|?> (def, Just <$> attribute "url" url)
 249         serie = rule "serie" $
 250                 element "serie" $
 251                 interleaved $
 252                 DTC.Serie
 253                  <$?> (def, attribute "name" text)
 254                  <|?> (def, attribute "key"  text)
 255         link = rule "link" $
 256                 element "link" $
 257                 interleaved $
 258                 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
 259                  <$?> (def, attribute "name" text)
 260                  <|?> (def, attribute "href" url)
 261                  <|?> (def, attribute "rel"  text)
 262                  <|*> lines
 263         alias = rule "alias" $
 264                 element "alias" $
 265                 interleaved $
 266                 DTC.Alias
 267                  <$?> (def, id)
 268         reference = rule "reference" $
 269                 element "reference" $
 270                 DTC.Reference
 271                  <$> id
 272                  <*> about
 273
 274 instance Sym_DTC RNC.Writer where
 275         position = RNC.writeText ""
 276 deriving instance Sym_DTC RNC.RuleWriter
 277
 278 dtcRNC :: [RNC.RuleWriter ()]
 279 dtcRNC =
 280  [ void $ document
 281
 282  , void $ head
 283  , void $ rule "about" $ element "about" about
 284  , void $ keyword
 285  , void $ version
 286  , void $ author
 287  , void $ editor
 288  , void $ date
 289  , void $ entity
 290  , void $ link
 291  , void $ serie
 292  , void $ alias
 293
 294  , void $ body
 295  , void $ bodyValue
 296  , void $ toc
 297  , void $ tof
 298  , void $ index
 299  , void $ figure
 300  , void $ references
 301  , void $ reference
 302  , void $ include
 303
 304  , void $ block
 305  , void $ para
 306  , void $ lines
 307
 308  , void $ commonAttrs
 309  , void $ ident
 310  , void $ title
 311  , void $ name
 312  , void $ url
 313  , void $ path
 314  , void $ to
 315  , void $ id
 316  ]