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         verticals   :: repr DTC.Verticals
  44         vertical    :: repr DTC.Vertical
  45         reference   :: repr DTC.Reference
  46         document    :: repr DTC.Document
  47         head        :: repr DTC.Head
  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      :: XmlName -> 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                  <*> many (
  71                         choice
  72                          [ rule "section" $
  73                                 element "section" $
  74                                 DTC.Section
  75                                  <$> commonAttrs
  76                                  <*> title
  77                                  <*> many alias
  78                                  <*> verticals
  79                          , vertical
  80                          ]
  81                  )
  82         head = rule "head" $
  83                 maybe def DTC.Head
  84                  <$> optional (rule "about" $ element "about" about)
  85         title = rule "title" $ DTC.Title <$> element "title" horizontals
  86         name  = rule "name"  $ attribute "name" text
  87         url   = rule "url"   $ DTC.URL   <$> text
  88         path  = rule "path"  $ DTC.Path  <$> text
  89         ident = rule "ident" $ DTC.Ident <$> text
  90         to    = rule "to"    $ attribute "to" ident
  91         id    = rule "id"    $ attribute "id" ident
  92         date  = rule "date"  $
  93                 element "date" $
  94                 interleaved $
  95                 DTC.Date
  96                  <$?> (0, attribute "year" int)
  97                  <|?> (Nothing, Just <$> attribute "month" nat1)
  98                  <|?> (Nothing, Just <$> attribute "day"   nat1)
  99         include  = rule "include"  $
 100                 element "include" $
 101                 interleaved $
 102                 DTC.Include
 103                  <$?> (def, attribute "href" path)
 104         verticals = many vertical
 105         vertical = rule "vertical" $
 106                 choice
 107                  [ DTC.Comment <$> comment
 108                  , element "para" $ DTC.Para
 109                          <$> commonAttrs
 110                          <*> horizontals
 111                  , element "ol" $ DTC.OL
 112                          <$> commonAttrs
 113                          <*> many (element "li" verticals)
 114                  , element "ul" $ DTC.UL
 115                          <$> commonAttrs
 116                          <*> many (element "li" verticals)
 117                  , element "rl" $ DTC.RL
 118                          <$> commonAttrs
 119                          <*> many reference
 120                  , element "toc" $ DTC.ToC
 121                          <$> commonAttrs
 122                          <*> optional (attribute "depth" int)
 123                  , element "tof" $ DTC.ToF
 124                          <$> commonAttrs
 125                          <*> optional (attribute "depth" int)
 126                  , element "index" $ DTC.Index
 127                          <$> commonAttrs
 128                          <*  any
 129                  , anyElem $ \n@XmlName{..} ->
 130                                 case xmlNameSpace of
 131                                  "" -> figure n
 132                  ]
 133         figure XmlName{..} =
 134                 rule "figure" $
 135                 (`DTC.Figure` xmlNameLocal)
 136                  <$> commonAttrs
 137                  <*> title
 138                  <*> verticals
 139         horizontals = many horizontal
 140         horizontal = rule "horizontal" $
 141                 choice
 142                  [ DTC.BR   <$  element "br"   none
 143                  , DTC.B    <$> element "b"    horizontals
 144                  , DTC.Code <$> element "code" horizontals
 145                  , DTC.Del  <$> element "del"  horizontals
 146                  , DTC.I    <$> element "i"    horizontals
 147                  , DTC.Note <$> element "note" horizontals
 148                  , DTC.Q    <$> element "q"    horizontals
 149                  , DTC.SC   <$> element "sc"   horizontals
 150                  , DTC.Sub  <$> element "sub"  horizontals
 151                  , DTC.Sup  <$> element "sup"  horizontals
 152                  , DTC.U    <$> element "u"    horizontals
 153                  , element "eref" $ DTC.Eref
 154                          <$> attribute "to" url
 155                          <*> horizontals
 156                  , element "iref" $ DTC.Iref <$> to <*> horizontals
 157                  , element "ref"  $ DTC.Ref  <$> to <*> horizontals
 158                  , element "rref" $ DTC.Rref <$> to <*> horizontals
 159                  , DTC.Plain <$> text
 160                  ]
 161         keyword = rule "keyword" $
 162                 element "keyword" text
 163         version = rule "version" $
 164                 MayText <$>
 165                 element "version" text
 166         about =
 167                 interleaved $
 168                 DTC.About
 169                  <$*> title
 170                  <|*> author
 171                  <|?> (Nothing, Just <$> editor)
 172                  <|?> (Nothing, Just <$> date)
 173                  <|?> (def, version)
 174                  <|*> keyword
 175                  <|*> link
 176                  <|*> serie
 177                  <|*> include
 178         author = rule "author" $ element "author" entity
 179         editor = rule "editor" $ element "editor" entity
 180         entity = rule "entity" $
 181                 DTC.Entity
 182                  <$> name
 183                  <*> address
 184         address = rule "address" $
 185                 element "address" $
 186                 interleaved $
 187                 DTC.Address
 188                  <$?> (def, attribute "street"  text)
 189                  <|?> (def, attribute "zipcode" text)
 190                  <|?> (def, attribute "city"    text)
 191                  <|?> (def, attribute "region"  text)
 192                  <|?> (def, attribute "country" text)
 193                  <|?> (def, attribute "email"   text)
 194                  <|?> (def, attribute "tel"     text)
 195                  <|?> (def, attribute "fax"     text)
 196         serie = rule "serie" $
 197                 element "serie" $
 198                 interleaved $
 199                 DTC.Serie
 200                  <$?> (def, attribute "name" text)
 201                  <|?> (def, attribute "key"  text)
 202         link = rule "link" $
 203                 element "link" $
 204                 interleaved $
 205                 DTC.Link
 206                  <$?> (def, attribute "name" text)
 207                  <|?> (def, attribute "href" url)
 208                  <|?> (def, attribute "rel"  text)
 209                  <|*> horizontal
 210         alias = rule "alias" $
 211                 element "alias" $
 212                 interleaved $
 213                 DTC.Alias
 214                  <$?> (def, id)
 215         reference = rule "reference" $
 216                 element "reference" $
 217                 DTC.Reference
 218                  <$> id
 219                  <*> optional (attribute "to" url)
 220                  <*> about
 221
 222          {-
 223          , element "figure" $ ul
 224                { type_ :: Text
 225                , body  :: Verticals
 226                }
 227          , Artwork     Artwork
 228          -}
 229
 230 instance Sym_DTC RNC.Writer
 231 instance Sym_DTC RNC.RuleWriter
 232 dtcRNC :: [RNC.RuleWriter ()]
 233 dtcRNC =
 234  [ void title
 235  , void name
 236  , void url
 237  , void path
 238  , void ident
 239  , void to
 240  , void id
 241  , void date
 242  , void include
 243  , void $ rule "horizontals" horizontals
 244  , void horizontal
 245  , void $ rule "verticals" verticals
 246  , void vertical
 247  , void $ figure "<element>"
 248  , void reference
 249  , void document
 250  , void head
 251  , void $ rule "about" $ element "about" about
 252  , void keyword
 253  , void version
 254  , void author
 255  , void editor
 256  , void entity
 257  , void address
 258  , void link
 259  , void serie
 260  , void alias
 261  , void commonAttrs
 262  ]