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, foldl', foldr)
   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 qualified Language.DTC.Document as DTC
  19 import qualified Language.RNC.Write as RNC
  20
  21 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
  22 foldlApp = foldl' (flip ($)) def
  23 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
  24 foldrApp = foldr ($) def
  25
  26 class RNC.Sym_RNC repr => Sym_DTC repr where
  27         title       :: repr DTC.Title
  28         name        :: repr Text
  29         url         :: repr URL
  30         path        :: repr Path
  31         ident       :: repr Ident
  32         to          :: repr Ident
  33         id          :: repr Ident
  34         date        :: repr DTC.Date
  35         include     :: repr DTC.Include
  36         horizontals :: repr DTC.Horizontals
  37         horizontal  :: repr DTC.Horizontal
  38         vertical    :: repr DTC.Vertical
  39         reference   :: repr DTC.Reference
  40         document    :: repr DTC.Document
  41         head        :: repr DTC.Head
  42         body        :: repr DTC.Body
  43         bodyKey     :: repr DTC.BodyKey
  44         bodyValue   :: repr DTC.BodyValue
  45         figure      :: repr DTC.BodyValue
  46         about       :: repr DTC.About
  47         keyword     :: repr Text
  48         version     :: repr MayText
  49         author      :: repr DTC.Entity
  50         editor      :: repr DTC.Entity
  51         entity      :: repr DTC.Entity
  52         address     :: repr DTC.Address
  53         link        :: repr DTC.Link
  54         serie       :: repr DTC.Serie
  55         alias       :: repr DTC.Alias
  56         commonAttrs :: repr DTC.CommonAttrs
  57         commonAttrs =
  58                 rule "commonAttrs" $
  59                 interleaved $
  60                 DTC.CommonAttrs
  61                  <$?> (def, Just <$> id)
  62                  <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
  63
  64         document = rule "document" $
  65                 DTC.Document
  66                  <$> head
  67                  <*> body
  68         head = rule "head" $
  69                 maybe def DTC.Head
  70                  <$> optional (rule "about" $ element "about" about)
  71         body =
  72                 rule "body" $
  73                 (Seq.fromList <$>) $
  74                 many $
  75                         choice
  76                          [ rule "section" $ element "section" $ TreeN <$> bodyKey <*> body
  77                          , Tree0 . Seq.fromList <$> some bodyValue
  78                          ]
  79         bodyKey =
  80                 position $
  81                 DTC.Section
  82                  <$> commonAttrs
  83                  <*> title
  84                  <*> many alias
  85         bodyValue =
  86                 choice
  87                  [ element "toc" $
  88                         position $
  89                         DTC.ToC
  90                          <$> commonAttrs
  91                          <*> optional (attribute "depth" nat)
  92                  , element "tof" $
  93                         position $
  94                         DTC.ToF
  95                          <$> commonAttrs
  96                          <*> optional (attribute "depth" nat)
  97                  , element "index" $
  98                         position $
  99                         DTC.Index
 100                          <$> commonAttrs
 101                          <*  any
 102                  , figure
 103                  , DTC.Vertical
 104                          <$> vertical
 105                  ]
 106         title = rule "title" $ DTC.Title <$> element "title" horizontals
 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         vertical = rule "vertical" $
 126                 choice
 127                  [ DTC.Comment <$> comment
 128                  , element "para" $
 129                         position $
 130                         DTC.Para
 131                          <$> commonAttrs
 132                          <*> horizontals
 133                  , element "ol" $
 134                         position $
 135                         DTC.OL
 136                          <$> commonAttrs
 137                          <*> many (element "li" $ many vertical)
 138                  , element "ul" $
 139                         position $
 140                         DTC.UL
 141                          <$> commonAttrs
 142                          <*> many (element "li" $ many vertical)
 143                  , element "rl" $
 144                         position $
 145                         DTC.RL
 146                          <$> commonAttrs
 147                          <*> many reference
 148                  {-
 149                  , anyElem $ \n@XmlName{..} ->
 150                                 case xmlNameSpace of
 151                                  "" -> figure n
 152                  -}
 153                  ]
 154         figure =
 155                 rule "figure" $
 156                 element "figure" $
 157                 position $
 158                 DTC.Figure
 159                  <$> attribute "type" text
 160                  <*> commonAttrs
 161                  <*> title
 162                  <*> many vertical
 163         horizontals = many horizontal
 164         horizontal = rule "horizontal" $
 165                 choice
 166                  [ DTC.BR   <$  element "br"   none
 167                  , DTC.B    <$> element "b"    horizontals
 168                  , DTC.Code <$> element "code" horizontals
 169                  , DTC.Del  <$> element "del"  horizontals
 170                  , DTC.I    <$> element "i"    horizontals
 171                  , DTC.Note <$> element "note" horizontals
 172                  , DTC.Q    <$> element "q"    horizontals
 173                  , DTC.SC   <$> element "sc"   horizontals
 174                  , DTC.Sub  <$> element "sub"  horizontals
 175                  , DTC.Sup  <$> element "sup"  horizontals
 176                  , DTC.U    <$> element "u"    horizontals
 177                  , element "eref" $ DTC.Eref
 178                          <$> attribute "to" url
 179                          <*> horizontals
 180                  , element "iref" $ DTC.Iref <$> to <*> horizontals
 181                  , element "ref"  $ DTC.Ref  <$> to <*> horizontals
 182                  , element "rref" $ DTC.Rref <$> to <*> horizontals
 183                  , DTC.Plain <$> text
 184                  ]
 185         keyword = rule "keyword" $
 186                 element "keyword" text
 187         version = rule "version" $
 188                 MayText <$>
 189                 element "version" text
 190         about =
 191                 interleaved $
 192                 DTC.About
 193                  <$*> title
 194                  <|*> author
 195                  <|?> (Nothing, Just <$> editor)
 196                  <|?> (Nothing, Just <$> date)
 197                  <|?> (def, version)
 198                  <|*> keyword
 199                  <|*> link
 200                  <|*> serie
 201                  <|*> include
 202         author = rule "author" $ element "author" entity
 203         editor = rule "editor" $ element "editor" entity
 204         entity = rule "entity" $
 205                 DTC.Entity
 206                  <$> name
 207                  <*> address
 208         address = rule "address" $
 209                 element "address" $
 210                 interleaved $
 211                 DTC.Address
 212                  <$?> (def, attribute "street"  text)
 213                  <|?> (def, attribute "zipcode" text)
 214                  <|?> (def, attribute "city"    text)
 215                  <|?> (def, attribute "region"  text)
 216                  <|?> (def, attribute "country" text)
 217                  <|?> (def, attribute "email"   text)
 218                  <|?> (def, attribute "tel"     text)
 219                  <|?> (def, attribute "fax"     text)
 220         serie = rule "serie" $
 221                 element "serie" $
 222                 interleaved $
 223                 DTC.Serie
 224                  <$?> (def, attribute "name" text)
 225                  <|?> (def, attribute "key"  text)
 226         link = rule "link" $
 227                 element "link" $
 228                 interleaved $
 229                 DTC.Link
 230                  <$?> (def, attribute "name" text)
 231                  <|?> (def, attribute "href" url)
 232                  <|?> (def, attribute "rel"  text)
 233                  <|*> horizontal
 234         alias = rule "alias" $
 235                 element "alias" $
 236                 interleaved $
 237                 DTC.Alias
 238                  <$?> (def, id)
 239         reference = rule "reference" $
 240                 element "reference" $
 241                 DTC.Reference
 242                  <$> id
 243                  <*> optional (attribute "to" url)
 244                  <*> about
 245
 246 instance Sym_DTC RNC.Writer
 247 instance Sym_DTC RNC.RuleWriter
 248 dtcRNC :: [RNC.RuleWriter ()]
 249 dtcRNC =
 250  [ void document
 251  , void head
 252  , void body
 253
 254  , void vertical
 255  , void horizontal
 256  , void $ rule "horizontals" horizontals
 257
 258  , void title
 259  , void name
 260  , void url
 261  , void path
 262  , void ident
 263
 264  , void commonAttrs
 265  , void to
 266  , void id
 267
 268  , void $ rule "about" $ element "about" about
 269  , void address
 270  , void author
 271  , void date
 272  , void editor
 273  , void entity
 274  , void keyword
 275  , void link
 276  , void serie
 277  , void version
 278
 279  , void alias
 280  , void reference
 281
 282  , void include
 283  , void figure
 284  ]