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.Index (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         address     :: repr DTC.Address
  42         link        :: repr DTC.Link
  43         serie       :: repr DTC.Serie
  44         alias       :: repr DTC.Alias
  45
  46         body        :: repr DTC.Body
  47         bodyValue   :: repr DTC.BodyValue
  48         toc         :: repr DTC.BodyValue
  49         tof         :: repr DTC.BodyValue
  50         index       :: repr DTC.BodyValue
  51         figure      :: 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                  , DTC.Block <$> block
 104                  ]
 105         title = rule "title" $ DTC.Title <$> element "title" para
 106         name  = rule "name"  $ attribute "name" text
 107         url   = rule "url"   $ URL   <$> text
 108         path  = rule "path"  $ Path  <$> text
 109         ident = rule "ident" $ Ident <$> text
 110         to    = rule "to"    $ attribute "to" ident
 111         id    = rule "id"    $ attribute "id" ident
 112         date  = rule "date"  $
 113                 element "date" $
 114                 interleaved $
 115                 DTC.Date
 116                  <$?> (0, attribute "year" int)
 117                  <|?> (Nothing, Just <$> attribute "month" nat1)
 118                  <|?> (Nothing, Just <$> attribute "day"   nat1)
 119         include  = rule "include"  $
 120                 element "include" $
 121                 interleaved $
 122                 DTC.Include
 123                  <$?> (def, attribute "href" path)
 124         block = rule "block" $
 125                 choice
 126                  [ DTC.Comment <$> comment
 127                  , element "para" $
 128                         DTC.Para
 129                          <$> position
 130                          <*> commonAttrs
 131                          <*> para
 132                  , element "ol" $
 133                         DTC.OL
 134                          <$> position
 135                          <*> commonAttrs
 136                          <*> many (element "li" $ many block)
 137                  , element "ul" $
 138                         DTC.UL
 139                          <$> position
 140                          <*> commonAttrs
 141                          <*> many (element "li" $ many block)
 142                  , element "rl" $
 143                         DTC.RL
 144                          <$> position
 145                          <*> commonAttrs
 146                          <*> many reference
 147                  {-
 148                  , anyElem $ \n@XmlName{..} ->
 149                                 case xmlNameSpace of
 150                                  "" -> figure n
 151                  -}
 152                  ]
 153         toc =
 154                 rule "toc" $
 155                 element "toc" $
 156                 DTC.ToC
 157                  <$> position
 158                  <*> commonAttrs
 159                  <*> optional (attribute "depth" nat)
 160         tof =
 161                 rule "tof" $
 162                 element "tof" $
 163                 DTC.ToF
 164                  <$> position
 165                  <*> commonAttrs
 166                  <*> option [] (
 167                         element "ul" $
 168                                 many $
 169                                         element "li" $
 170                                                 element "para" text)
 171         index =
 172                 rule "index" $
 173                 element "index" $
 174                 DTC.Index
 175                  <$> position
 176                  <*> commonAttrs
 177                  <*> option [] (
 178                         element "ul" $
 179                                 many $
 180                                         element "li" $
 181                                                 element "para" $
 182                                                         (concat <$>) $
 183                                                         many $
 184                                                                 (wordify <$>) . Text.lines <$> text)
 185         figure =
 186                 rule "figure" $
 187                 element "figure" $
 188                 DTC.Figure
 189                  <$> position
 190                  <*> commonAttrs
 191                  <*> attribute "type" text
 192                  <*> title
 193                  <*> many block
 194         para = rule "para" $ (Seq.fromList <$>) $ many lines
 195         lines =
 196                 choice
 197                  [ element "b"    $ TreeN DTC.B    <$> para
 198                  , element "code" $ TreeN DTC.Code <$> para
 199                  , element "del"  $ TreeN DTC.Del  <$> para
 200                  , element "i"    $ TreeN DTC.I    <$> para
 201                  , element "note" $ TreeN DTC.Note <$> para
 202                  , element "q"    $ TreeN DTC.Q    <$> para
 203                  , element "sc"   $ TreeN DTC.SC   <$> para
 204                  , element "sub"  $ TreeN DTC.Sub  <$> para
 205                  , element "sup"  $ TreeN DTC.Sup  <$> para
 206                  , element "u"    $ TreeN DTC.U    <$> para
 207                  , element "eref" $ TreeN . DTC.Eref <$> attribute "to" url <*> para
 208                  , element "iref" $ TreeN . DTC.Iref (-1) . wordify <$> attribute "to" text <*> para
 209                  , element "ref"  $ TreeN . DTC.Ref  <$> to <*> para
 210                  , element "rref" $ TreeN . DTC.Rref <$> to <*> para
 211                  , element "br"   $ Tree0 DTC.BR <$ none
 212                  , Tree0 . DTC.Plain <$> text
 213                  ]
 214         keyword = rule "keyword" $
 215                 element "keyword" text
 216         version = rule "version" $
 217                 MayText <$>
 218                 element "version" text
 219         about =
 220                 interleaved $
 221                 DTC.About
 222                  <$*> title
 223                  <|*> author
 224                  <|?> (Nothing, Just <$> editor)
 225                  <|?> (Nothing, Just <$> date)
 226                  <|?> (def, version)
 227                  <|*> keyword
 228                  <|*> link
 229                  <|*> serie
 230                  <|*> include
 231         author = rule "author" $ element "author" entity
 232         editor = rule "editor" $ element "editor" entity
 233         entity = rule "entity" $
 234                 DTC.Entity
 235                  <$> name
 236                  <*> address
 237         address = rule "address" $
 238                 element "address" $
 239                 interleaved $
 240                 DTC.Address
 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         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                  <*> optional (attribute "to" url)
 273                  <*> about
 274
 275 instance Sym_DTC RNC.Writer where
 276         position = RNC.writeText ""
 277 deriving instance Sym_DTC RNC.RuleWriter
 278
 279 dtcRNC :: [RNC.RuleWriter ()]
 280 dtcRNC =
 281  [ void $ document
 282
 283  , void $ head
 284  , void $ rule "about" $ element "about" about
 285  , void $ keyword
 286  , void $ version
 287  , void $ author
 288  , void $ editor
 289  , void $ date
 290  , void $ entity
 291  , void $ address
 292  , void $ link
 293  , void $ serie
 294  , void $ alias
 295
 296  , void $ body
 297  , void $ bodyValue
 298  , void $ toc
 299  , void $ tof
 300  , void $ index
 301  , void $ figure
 302  , void $ reference
 303  , void $ include
 304
 305  , void $ block
 306  , void $ para
 307  , void $ lines
 308
 309  , void $ commonAttrs
 310  , void $ ident
 311  , void $ title
 312  , void $ name
 313  , void $ url
 314  , void $ path
 315  , void $ to
 316  , void $ id
 317  ]