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