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, ViewR(..), viewr)
  21 import Data.TreeSeq.Strict (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  :: Maybe TL.Text
  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  =   BodySection { pos      :: Pos
  96                  , attrs    :: CommonAttrs
  97                  , title    :: Title
  98                  , aliases  :: [Alias]
  99                  }
 100  |   BodyBlock Block -- ^ leaf
 101  deriving (Eq,Show)
 102
 103 -- * Type 'Block'
 104 data Block
 105  = BlockPara       Para
 106  | BlockToC        { pos      :: Pos
 107                    , attrs    :: CommonAttrs
 108                    , depth    :: Maybe Nat
 109                    }
 110  | BlockToF        { pos      :: Pos
 111                    , attrs    :: CommonAttrs
 112                    , types    :: [TL.Text]
 113                    }
 114  | BlockFigure     { pos      :: Pos
 115                    , attrs    :: CommonAttrs
 116                    , type_    :: TL.Text
 117                    , mayTitle :: Maybe Title
 118                    , paras    :: [Para]
 119                    }
 120  | BlockIndex      { pos      :: Pos
 121                    , attrs    :: CommonAttrs
 122                    , terms    :: Terms
 123                    }
 124  | BlockReferences { pos      :: Pos
 125                    , attrs    :: CommonAttrs
 126                    , refs     :: [Reference]
 127                    }
 128  deriving (Eq,Show)
 129
 130 -- * Type 'Para'
 131 data Para
 132  = ParaItem  { item  :: ParaItem }
 133  | ParaItems { pos   :: Pos
 134              , attrs :: CommonAttrs
 135              , items :: [ParaItem]
 136              }
 137  deriving (Eq,Show)
 138
 139 -- ** Type 'ParaItem'
 140 data ParaItem
 141  = ParaPlain   Plain
 142  | ParaComment TL.Text
 143  | ParaOL      [ListItem]
 144  | ParaUL      [[Para]]
 145  | ParaQuote   { type_  :: TL.Text
 146                , paras  :: [Para]
 147                }
 148  | ParaArtwork { type_  :: TL.Text
 149                , text   :: TL.Text
 150                }
 151  deriving (Eq,Show)
 152
 153 -- *** Type 'ListItem'
 154 data ListItem
 155  =   ListItem { name  :: TL.Text
 156               , paras :: [Para]
 157               }
 158  deriving (Eq,Show)
 159
 160 -- * Type 'Plain'
 161 type Plain = Trees PlainNode
 162
 163 -- ** Type 'PlainNode'
 164 data PlainNode
 165  -- Nodes
 166  = PlainB     -- ^ Bold
 167  | PlainCode  -- ^ Code (monospaced)
 168  | PlainDel   -- ^ Deleted (crossed-over)
 169  | PlainI     -- ^ Italic
 170  | PlainGroup -- ^ Group subTrees (neutral)
 171  | PlainQ     -- ^ Quoted
 172  | PlainSC    -- ^ Small Caps
 173  | PlainSub   -- ^ Subscript
 174  | PlainSup   -- ^ Superscript
 175  | PlainU     -- ^ Underlined
 176  | PlainEref { href :: URL } -- ^ External reference
 177  | PlainIref { anchor :: Maybe Anchor
 178              , term :: Words
 179              } -- ^ Index reference
 180  | PlainRef  { to :: Ident }
 181              -- ^ Reference
 182  | PlainRref { anchor :: Maybe Anchor
 183              , to :: Ident
 184              } -- ^ Reference reference
 185  -- Leafs
 186  | PlainBR -- ^ Line break (\n)
 187  | PlainText TL.Text
 188  | PlainNote { number :: Maybe Nat1
 189              , note   :: [Para]
 190              } -- ^ Footnote
 191  deriving (Eq,Show)
 192
 193 -- * Type 'Pos'
 194 data Pos
 195  =   Pos
 196  {   posAncestors                :: PosPath
 197  ,   posAncestorsWithFigureNames :: PosPath
 198  ,   posPrecedingsSiblings       :: Map XmlName Rank
 199  } deriving (Eq,Show)
 200 instance Ord Pos where
 201         compare = compare `on` posAncestors
 202 instance Default Pos where
 203         def = Pos mempty mempty mempty
 204
 205 -- *** Type 'PosPath'
 206 type PosPath = Seq (XmlName,Rank)
 207
 208 posParent :: PosPath -> Maybe PosPath
 209 posParent p =
 210         case viewr p of
 211          EmptyR -> Nothing
 212          ls :> _ -> Just ls
 213
 214 -- * Type 'CommonAttrs'
 215 data CommonAttrs
 216  =   CommonAttrs
 217  {   id      :: Maybe Ident
 218  ,   classes :: [TL.Text]
 219  } deriving (Eq,Show)
 220 instance Default CommonAttrs where
 221         def = CommonAttrs
 222          { id      = def
 223          , classes = def
 224          }
 225
 226 -- ** Type 'Anchor'
 227 data Anchor
 228  =   Anchor
 229  {   section :: Pos
 230  ,   count   :: Nat1
 231  } deriving (Eq,Ord,Show)
 232
 233 -- * Type 'Title'
 234 newtype Title = Title { unTitle :: Plain }
 235  deriving (Eq,Show,Semigroup,Monoid,Default)
 236
 237 -- ** Type 'Entity'
 238 data Entity
 239  =   Entity
 240  {   name    :: TL.Text
 241  ,   street  :: TL.Text
 242  ,   zipcode :: TL.Text
 243  ,   city    :: TL.Text
 244  ,   region  :: TL.Text
 245  ,   country :: TL.Text
 246  ,   email   :: TL.Text
 247  ,   tel     :: TL.Text
 248  ,   fax     :: TL.Text
 249  ,   url     :: Maybe URL
 250  ,   org     :: Maybe Entity
 251  } deriving (Eq,Show)
 252 instance Default Entity where
 253         def = Entity
 254          { name    = def
 255          , street  = def
 256          , zipcode = def
 257          , city    = def
 258          , region  = def
 259          , country = def
 260          , email   = def
 261          , tel     = def
 262          , fax     = def
 263          , url     = def
 264          , org     = def
 265          }
 266 instance Semigroup Entity where
 267         _x <> y = y
 268
 269 -- * Type 'Include'
 270 data Include
 271  =   Include
 272  {   href :: Path
 273  } deriving (Eq,Show)
 274 instance Default Include where
 275         def = Include
 276          { href = def
 277          }
 278
 279 -- * Type 'Reference'
 280 data Reference
 281  =   Reference
 282  {   id    :: Ident
 283  ,   about :: About
 284  } deriving (Eq,Show)
 285 reference :: Ident -> Reference
 286 reference id =
 287         Reference
 288          { id
 289          , about = def
 290          }
 291 instance Default Reference where
 292         def = reference def
 293
 294 -- * Type 'Date'
 295 data Date
 296  =   Date
 297  {   year  :: Int
 298  ,   month :: Maybe Nat1
 299  ,   day   :: Maybe Nat1
 300  } deriving (Eq,Show)
 301 instance Default Date where
 302         def = Date
 303          { year  = 1970
 304          , month = Just (Nat1 01)
 305          , day   = Just (Nat1 01)
 306          }
 307 instance Semigroup Date where
 308         _x <> y = y
 309
 310 -- * Type 'Link'
 311 data Link
 312  =   Link
 313  {   name  :: TL.Text
 314  ,   href  :: URL
 315  ,   rel   :: TL.Text
 316  ,   plain :: Plain
 317  } deriving (Eq,Show)
 318 instance Default Link where
 319         def = Link
 320          { name  = def
 321          , href  = def
 322          , rel   = def
 323          , plain = def
 324          }
 325
 326 -- * Type 'Alias'
 327 data Alias
 328  =   Alias
 329  {   id :: Ident
 330  } deriving (Eq,Show)
 331 instance Default Alias where
 332         def = Alias
 333          { id = def
 334          }
 335
 336 -- * Type 'Serie'
 337 data Serie
 338  =   Serie
 339  {   name :: TL.Text
 340  ,   key  :: TL.Text
 341  } deriving (Eq,Show)
 342 instance Default Serie where
 343         def = Serie
 344          { name = def
 345          , key  = def
 346          }
 347
 348 -- * Type 'Word'
 349 type Word = TL.Text
 350
 351 -- ** Type 'Words'
 352 type Words = [WordOrSpace]
 353
 354 -- *** Type 'WordOrSpace'
 355 data WordOrSpace
 356  =   Word Word
 357  |   Space
 358  deriving (Eq,Ord,Show)
 359
 360 -- ** Type 'Aliases'
 361 type Aliases = [Words]
 362
 363 -- ** Type 'Terms'
 364 type Terms = [Aliases]
 365
 366 -- * Type 'Count'
 367 type Count = Int