Language/DTC/Sym.hs

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