Language/DTC/Document.hs

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