Language/DTC/Document.hs

   1 {-# LANGUAGE DisambiguateRecordFields #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 module Language.DTC.Document
   5  ( module Language.DTC.Document
   6  , module Language.XML
   7  ) where
   8
   9 import Data.Default.Class (Default(..))
  10 import Data.Eq (Eq)
  11 import Data.Int (Int)
  12 import Data.Maybe (Maybe(..))
  13 import Data.Monoid (Monoid(..))
  14 import Data.Ord (Ord)
  15 import Data.Semigroup (Semigroup(..))
  16 import Data.Text (Text)
  17 import Data.TreeSeq.Strict (Trees)
  18 import Text.Show (Show)
  19
  20 import Language.XML
  21
  22 -- * Type 'Document'
  23 data Document
  24  =   Document
  25  {   head  :: Head
  26  ,   body  :: Body
  27  } deriving (Eq,Show)
  28 instance Default Document where
  29         def = Document
  30          { head  = def
  31          , body  = mempty
  32          }
  33
  34 -- * Type 'Head'
  35 data Head
  36  =   Head
  37  {   about :: About
  38  } deriving (Eq,Show)
  39 instance Default Head where
  40         def = Head
  41          { about = def
  42          }
  43
  44 -- ** Type 'About'
  45 data About
  46  =   About
  47  {   titles   :: [Title]
  48  ,   authors  :: [Entity]
  49  ,   editor   :: Maybe Entity
  50  ,   date     :: Maybe Date
  51  ,   version  :: MayText
  52  ,   keywords :: [Text]
  53  ,   links    :: [Link]
  54  ,   series   :: [Serie]
  55  ,   includes :: [Include]
  56  } deriving (Eq,Show)
  57 instance Default About where
  58         def = About
  59          { includes = def
  60          , titles   = def
  61          , date     = def
  62          , version  = def
  63          , editor   = def
  64          , authors  = def
  65          , keywords = def
  66          , links    = def
  67          , series   = def
  68          }
  69 instance Semigroup About where
  70         x <> y = About
  71          { titles   = titles   x <> titles   y
  72          , authors  = authors  x <> authors  y
  73          , editor   = editor   x <> editor   y
  74          , date     = date     x <> date     y
  75          , version  = version  x <> version  y
  76          , keywords = keywords x <> keywords y
  77          , links    = links    x <> links    y
  78          , series   = series   x <> series   y
  79          , includes = includes x <> includes y
  80          }
  81
  82 -- * Type 'Body'
  83 type Body = Trees BodyKey BodyValue
  84
  85 -- ** Type 'BodyKey'
  86 data BodyKey
  87  = Section { pos     :: XmlPos
  88            , attrs   :: CommonAttrs
  89            , title   :: Title
  90            , aliases :: [Alias]
  91            }
  92  deriving (Eq,Show)
  93
  94 -- ** Type 'BodyValue'
  95 data BodyValue
  96  = ToC     { pos   :: XmlPos
  97            , attrs :: CommonAttrs
  98            , depth :: Maybe Nat
  99            }
 100  | ToF     { pos   :: XmlPos
 101            , attrs :: CommonAttrs
 102            , depth :: Maybe Nat
 103            }
 104  | Figure  { pos   :: XmlPos
 105            , attrs :: CommonAttrs
 106            , type_ :: Text
 107            , title :: Title
 108            , verts :: Verticals
 109            }
 110  | Index   { pos   :: XmlPos
 111            , attrs :: CommonAttrs
 112            , terms :: Terms
 113            }
 114  | Vertical Vertical
 115  deriving (Eq,Show)
 116
 117 -- ** Type 'Word'
 118 type Word = Text
 119
 120 -- *** Type 'Words'
 121 type Words = [WordOrSpace]
 122
 123 -- **** Type 'WordOrSpace'
 124 data WordOrSpace
 125  =   Word Word
 126  |   Space
 127  deriving (Eq,Ord,Show)
 128
 129 -- ** Type 'Aliases'
 130 type Aliases = [Words]
 131
 132 -- ** Type 'Terms'
 133 type Terms = [Aliases]
 134
 135 -- * Type 'Count'
 136 type Count = Int
 137
 138 -- * Type 'Vertical'
 139 data Vertical
 140  = Para    { pos   :: XmlPos
 141            , attrs :: CommonAttrs
 142            , horis :: Horizontals
 143            }
 144  | OL      { pos   :: XmlPos
 145            , attrs :: CommonAttrs
 146            , items :: [Verticals]
 147            }
 148  | UL      { pos   :: XmlPos
 149            , attrs :: CommonAttrs
 150            , items :: [Verticals]
 151            }
 152  | RL      { pos   :: XmlPos
 153            , attrs :: CommonAttrs
 154            , refs  :: [Reference]
 155            }
 156  | Artwork { pos   :: XmlPos
 157            , attrs :: CommonAttrs
 158            , art   :: Artwork
 159            }
 160  | Comment Text
 161  deriving (Eq,Show)
 162
 163 -- * Type 'CommonAttrs'
 164 data CommonAttrs
 165  =   CommonAttrs
 166  {   id      :: Maybe Ident
 167  ,   classes :: [Text]
 168  } deriving (Eq,Show)
 169
 170 -- * Type 'Auto'
 171 data Auto
 172  =   Auto
 173  {   auto_id :: Ident
 174  } deriving (Eq,Show)
 175
 176 -- * Type 'Verticals'
 177 type Verticals = [Vertical]
 178
 179 -- * Type 'Artwork'
 180 data Artwork
 181  =   Raw Text
 182  deriving (Eq,Show)
 183
 184 -- * Type 'Horizontal'
 185 data Horizontal
 186  =   BR
 187  |   B    Horizontals
 188  |   Code Horizontals
 189  |   Del  Horizontals
 190  |   I    Horizontals
 191  |   Note Horizontals
 192  |   Q    Horizontals
 193  |   SC   Horizontals
 194  |   Sub  Horizontals
 195  |   Sup  Horizontals
 196  |   U    Horizontals
 197  |   Eref {href :: URL, text :: Horizontals}
 198  |   Iref {count :: Int, term :: Words, text :: Horizontals}
 199  |   Ref  {to :: Ident, text :: Horizontals}
 200  |   Rref {to :: Ident, text :: Horizontals}
 201  |   Plain Text
 202  deriving (Eq,Show)
 203
 204 -- * Type 'Horizontals'
 205 type Horizontals = [Horizontal]
 206
 207 -- * Type 'Title'
 208 newtype Title = Title { unTitle :: Horizontals }
 209  deriving (Eq,Show,Default)
 210
 211 -- ** Type 'Address'
 212 data Address
 213  =   Address
 214  {   street  :: Text
 215  ,   zipcode :: Text
 216  ,   city    :: Text
 217  ,   region  :: Text
 218  ,   country :: Text
 219  ,   email   :: Text
 220  ,   tel     :: Text
 221  ,   fax     :: Text
 222  } deriving (Eq,Show)
 223 instance Default Address where
 224         def = Address
 225          { street  = def
 226          , zipcode = def
 227          , city    = def
 228          , region  = def
 229          , country = def
 230          , email   = def
 231          , tel     = def
 232          , fax     = def
 233          }
 234
 235 -- * Type 'Include'
 236 data Include
 237  =   Include
 238  {   href :: Path
 239  } deriving (Eq,Show)
 240 instance Default Include where
 241         def = Include
 242          { href = def
 243          }
 244
 245 -- * Type 'Reference'
 246 data Reference
 247  =   Reference
 248  {   id    :: Ident
 249  ,   to    :: Maybe URL
 250  ,   about :: About
 251  } deriving (Eq,Show)
 252 reference :: Ident -> Reference
 253 reference id =
 254         Reference
 255          { id
 256          , to    = def
 257          , about = def
 258          }
 259 instance Default Reference where
 260         def = reference def
 261
 262 -- * Type 'Entity'
 263 data Entity
 264  =   Entity
 265  {   name    :: Text
 266  ,   address :: Address
 267  } deriving (Eq,Show)
 268 instance Default Entity where
 269         def = Entity
 270          { name    = def
 271          , address = def
 272          }
 273 instance Semigroup Entity where
 274         _x <> y = y
 275
 276 -- * Type 'Date'
 277 data Date
 278  =   Date
 279  {   year  :: Int
 280  ,   month :: Maybe Nat1
 281  ,   day   :: Maybe Nat1
 282  } deriving (Eq,Show)
 283 instance Default Date where
 284         def = Date
 285          { year  = 1970
 286          , month = Just (Nat1 01)
 287          , day   = Just (Nat1 01)
 288          }
 289 instance Semigroup Date where
 290         _x <> y = y
 291
 292 -- * Type 'Link'
 293 data Link
 294  =   Link
 295  {   name  :: Text
 296  ,   href  :: URL
 297  ,   rel   :: Text
 298  ,   body  :: Horizontals
 299  } deriving (Eq,Show)
 300 instance Default Link where
 301         def = Link
 302          { name = def
 303          , href = def
 304          , rel  = def
 305          , body = def
 306          }
 307
 308 -- * Type 'Alias'
 309 data Alias
 310  =   Alias
 311  {   id :: Ident
 312  } deriving (Eq,Show)
 313 instance Default Alias where
 314         def = Alias
 315          { id = def
 316          }
 317
 318 -- * Type 'Serie'
 319 data Serie
 320  =   Serie
 321  {   name :: Text
 322  ,   key  :: Text
 323  } deriving (Eq,Show)
 324 instance Default Serie where
 325         def = Serie
 326          { name = def
 327          , key  = def
 328          }