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