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