Language/DTC/Document.hs

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