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.Semigroup (Semigroup(..))
  15 import Data.Sequence (Seq)
  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 (Seq BodyValue)
  84
  85 -- ** Type 'BodyKey'
  86 data BodyKey
  87  = Section { attrs   :: CommonAttrs
  88            , title   :: Title
  89            , aliases :: [Alias]
  90            , pos     :: XmlPos
  91            }
  92  deriving (Eq,Show)
  93
  94 -- ** Type 'BodyValue'
  95 data BodyValue
  96  = ToC     { attrs :: CommonAttrs
  97            , depth :: Maybe Nat
  98            , pos   :: XmlPos
  99            }
 100  | ToF     { attrs :: CommonAttrs
 101            , depth :: Maybe Nat
 102            , pos   :: XmlPos
 103            }
 104  | Figure  { type_ :: Text
 105            , attrs :: CommonAttrs
 106            , title :: Title
 107            , verts :: Verticals
 108            , pos   :: XmlPos
 109            }
 110  | Index   { attrs :: CommonAttrs
 111            , pos   :: XmlPos
 112            }
 113  | Vertical Vertical
 114  deriving (Eq,Show)
 115
 116 -- * Type 'Vertical'
 117 data Vertical
 118  = Para    { attrs :: CommonAttrs
 119            , horis :: Horizontals
 120            , pos   :: XmlPos
 121            }
 122  | OL      { attrs :: CommonAttrs
 123            , items :: [Verticals]
 124            , pos   :: XmlPos
 125            }
 126  | UL      { attrs :: CommonAttrs
 127            , items :: [Verticals]
 128            , pos   :: XmlPos
 129            }
 130  | RL      { attrs :: CommonAttrs
 131            , refs  :: [Reference]
 132            , pos   :: XmlPos
 133            }
 134  | Artwork { attrs :: CommonAttrs
 135            , art   :: Artwork
 136            , pos   :: XmlPos
 137            }
 138  | Comment Text
 139  deriving (Eq,Show)
 140
 141 -- * Type 'CommonAttrs'
 142 data CommonAttrs
 143  =   CommonAttrs
 144  {   id      :: Maybe Ident
 145  ,   classes :: [Text]
 146  } deriving (Eq,Show)
 147
 148 -- * Type 'Auto'
 149 data Auto
 150  =   Auto
 151  {   auto_id :: Ident
 152  } deriving (Eq,Show)
 153
 154 -- * Type 'Verticals'
 155 type Verticals = [Vertical]
 156
 157 -- * Type 'Artwork'
 158 data Artwork
 159  =   Raw Text
 160  deriving (Eq,Show)
 161
 162 -- * Type 'Horizontal'
 163 data Horizontal
 164  =   BR
 165  |   B    Horizontals
 166  |   Code Horizontals
 167  |   Del  Horizontals
 168  |   I    Horizontals
 169  |   Note Horizontals
 170  |   Q    Horizontals
 171  |   SC   Horizontals
 172  |   Sub  Horizontals
 173  |   Sup  Horizontals
 174  |   U    Horizontals
 175  |   Eref {href :: URL  , text :: Horizontals}
 176  |   Iref {to   :: Ident, text :: Horizontals}
 177  |   Ref  {to   :: Ident, text :: Horizontals}
 178  |   Rref {to   :: Ident, text :: Horizontals}
 179  |   Plain Text
 180  deriving (Eq,Show)
 181
 182 -- * Type 'Horizontals'
 183 type Horizontals = [Horizontal]
 184
 185 -- * Type 'Title'
 186 newtype Title = Title { unTitle :: Horizontals }
 187  deriving (Eq,Show,Default)
 188
 189 -- ** Type 'Address'
 190 data Address
 191  =   Address
 192  {   street  :: Text
 193  ,   zipcode :: Text
 194  ,   city    :: Text
 195  ,   region  :: Text
 196  ,   country :: Text
 197  ,   email   :: Text
 198  ,   tel     :: Text
 199  ,   fax     :: Text
 200  } deriving (Eq,Show)
 201 instance Default Address where
 202         def = Address
 203          { street  = def
 204          , zipcode = def
 205          , city    = def
 206          , region  = def
 207          , country = def
 208          , email   = def
 209          , tel     = def
 210          , fax     = def
 211          }
 212
 213 -- * Type 'Include'
 214 data Include
 215  =   Include
 216  {   href :: Path
 217  } deriving (Eq,Show)
 218 instance Default Include where
 219         def = Include
 220          { href = def
 221          }
 222
 223 -- * Type 'Reference'
 224 data Reference
 225  =   Reference
 226  {   id    :: Ident
 227  ,   to    :: Maybe URL
 228  ,   about :: About
 229  } deriving (Eq,Show)
 230 reference :: Ident -> Reference
 231 reference id =
 232         Reference
 233          { id
 234          , to    = def
 235          , about = def
 236          }
 237 instance Default Reference where
 238         def = reference def
 239
 240 -- * Type 'Entity'
 241 data Entity
 242  =   Entity
 243  {   name    :: Text
 244  ,   address :: Address
 245  } deriving (Eq,Show)
 246 instance Default Entity where
 247         def = Entity
 248          { name    = def
 249          , address = def
 250          }
 251 instance Semigroup Entity where
 252         _x <> y = y
 253
 254 -- * Type 'Date'
 255 data Date
 256  =   Date
 257  {   year  :: Int
 258  ,   month :: Maybe Nat1
 259  ,   day   :: Maybe Nat1
 260  } deriving (Eq,Show)
 261 instance Default Date where
 262         def = Date
 263          { year  = 1970
 264          , month = Just (Nat1 01)
 265          , day   = Just (Nat1 01)
 266          }
 267 instance Semigroup Date where
 268         _x <> y = y
 269
 270 -- * Type 'Link'
 271 data Link
 272  =   Link
 273  {   name  :: Text
 274  ,   href  :: URL
 275  ,   rel   :: Text
 276  ,   body  :: Horizontals
 277  } deriving (Eq,Show)
 278 instance Default Link where
 279         def = Link
 280          { name = def
 281          , href = def
 282          , rel  = def
 283          , body = def
 284          }
 285
 286 -- * Type 'Alias'
 287 data Alias
 288  =   Alias
 289  {   id :: Ident
 290  } deriving (Eq,Show)
 291 instance Default Alias where
 292         def = Alias
 293          { id = def
 294          }
 295
 296 -- * Type 'Serie'
 297 data Serie
 298  =   Serie
 299  {   name :: Text
 300  ,   key  :: Text
 301  } deriving (Eq,Show)
 302 instance Default Serie where
 303         def = Serie
 304          { name = def
 305          , key  = def
 306          }