Hdoc/DTC/Document.hs

   1 {-# LANGUAGE DisambiguateRecordFields #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 module Hdoc.DTC.Document
   7  ( module Hdoc.DTC.Document
   8  , module Hdoc.XML
   9  ) where
  10
  11 import Data.Default.Class (Default(..))
  12 import Data.Default.Instances.Containers ()
  13 import Data.Eq (Eq)
  14 import Data.Function (on, ($))
  15 import Data.Int (Int)
  16 import Data.Map.Strict (Map)
  17 import Data.Maybe (Maybe(..))
  18 import Data.Monoid (Monoid(..))
  19 import Data.Ord (Ord(..))
  20 import Data.Semigroup (Semigroup(..))
  21 import Data.Sequence (Seq, ViewR(..), viewr)
  22 import Data.TreeSeq.Strict (Trees)
  23 import Text.Show (Show)
  24 import qualified Data.Char as Char
  25 import qualified Data.Text.Lazy as TL
  26
  27 import Hdoc.XML
  28
  29 -- * Type 'Document'
  30 data Document
  31  =   Document
  32  {   head  :: Head
  33  ,   body  :: Body
  34  } deriving (Eq,Show)
  35 instance Default Document where
  36         def = Document
  37          { head  = def
  38          , body  = mempty
  39          }
  40
  41 -- * Type 'Head'
  42 data Head
  43  =   Head
  44  {   about :: About
  45  } deriving (Eq,Show)
  46 instance Default Head where
  47         def = Head
  48          { about = def
  49          }
  50
  51 -- ** Type 'About'
  52 data About
  53  =   About
  54  {   headers  :: [Header]
  55  ,   titles   :: [Title]
  56  ,   url      :: Maybe URL
  57  ,   authors  :: [Entity]
  58  ,   editor   :: Maybe Entity
  59  ,   date     :: Maybe Date
  60  ,   tags     :: [TL.Text]
  61  ,   links    :: [Link]
  62  ,   series   :: [Serie]
  63  ,   includes :: [Include]
  64  } deriving (Eq,Show)
  65 instance Default About where
  66         def = About
  67          { headers  = def
  68          , includes = def
  69          , titles   = def
  70          , url      = def
  71          , date     = def
  72          , editor   = def
  73          , authors  = def
  74          , tags     = def
  75          , links    = def
  76          , series   = def
  77          }
  78 instance Semigroup About where
  79         x <> y = About
  80          { headers  = headers  x <> headers  y
  81          , titles   = titles   x <> titles   y
  82          , url      = url (x::About) <> url (y::About)
  83          , authors  = authors  x <> authors  y
  84          , editor   = editor   x <> editor   y
  85          , date     = date     x <> date     y
  86          , tags     = tags     x <> tags     y
  87          , links    = links    x <> links    y
  88          , series   = series   x <> series   y
  89          , includes = includes x <> includes y
  90          }
  91
  92 -- * Type 'Header'
  93 data Header
  94  =   Header
  95  {   name  :: TL.Text
  96  ,   value :: Plain
  97  } deriving (Eq,Show)
  98
  99 -- * Type 'Body'
 100 type Body = Trees BodyNode
 101
 102 -- ** Type 'BodyNode'
 103 data BodyNode
 104  =   BodySection { pos      :: Pos
 105                  , attrs    :: CommonAttrs
 106                  , title    :: Title
 107                  , aliases  :: [Alias]
 108                  }
 109  |   BodyBlock Block -- ^ leaf
 110  deriving (Eq,Show)
 111
 112 -- * Type 'Block'
 113 data Block
 114  = BlockPara       Para
 115  | BlockBreak      { attrs    :: CommonAttrs }
 116  | BlockToC        { pos      :: Pos
 117                    , attrs    :: CommonAttrs
 118                    , depth    :: Maybe Nat
 119                    }
 120  | BlockToF        { pos      :: Pos
 121                    , attrs    :: CommonAttrs
 122                    , types    :: [TL.Text]
 123                    }
 124  | BlockFigure     { pos      :: Pos
 125                    , attrs    :: CommonAttrs
 126                    , type_    :: TL.Text
 127                    , mayTitle :: Maybe Title
 128                    , paras    :: [Para]
 129                    }
 130  | BlockIndex      { pos      :: Pos
 131                    , attrs    :: CommonAttrs
 132                    , terms    :: Terms
 133                    }
 134  | BlockReferences { pos      :: Pos
 135                    , attrs    :: CommonAttrs
 136                    , refs     :: [Reference]
 137                    }
 138  deriving (Eq,Show)
 139
 140 -- * Type 'Para'
 141 data Para
 142  = ParaItem  { item  :: ParaItem }
 143  | ParaItems { pos   :: Pos
 144              , attrs :: CommonAttrs
 145              , items :: [ParaItem]
 146              }
 147  deriving (Eq,Show)
 148
 149 -- ** Type 'ParaItem'
 150 data ParaItem
 151  = ParaPlain   Plain
 152  | ParaComment TL.Text
 153  | ParaOL      [ListItem]
 154  | ParaUL      [[Para]]
 155  | ParaQuote   { type_  :: TL.Text
 156                , paras  :: [Para]
 157                }
 158  | ParaArtwork { type_  :: TL.Text
 159                , text   :: TL.Text
 160                }
 161  deriving (Eq,Show)
 162
 163 -- *** Type 'ListItem'
 164 data ListItem
 165  =   ListItem { name  :: TL.Text
 166               , paras :: [Para]
 167               }
 168  deriving (Eq,Show)
 169
 170 -- * Type 'Plain'
 171 type Plain = Trees PlainNode
 172
 173 -- ** Type 'PlainNode'
 174 data PlainNode
 175  -- Nodes
 176  = PlainB     -- ^ Bold
 177  | PlainCode  -- ^ Code (monospaced)
 178  | PlainDel   -- ^ Deleted (crossed-over)
 179  | PlainI     -- ^ Italic
 180  | PlainGroup -- ^ Group subTrees (neutral)
 181  | PlainQ     -- ^ Quoted
 182  | PlainSC    -- ^ Small Caps
 183  | PlainSub   -- ^ Subscript
 184  | PlainSup   -- ^ Superscript
 185  | PlainU     -- ^ Underlined
 186  | PlainEref { href :: URL } -- ^ External reference
 187  | PlainIref { anchor :: Maybe Anchor
 188              , term :: Words
 189              } -- ^ Index reference
 190  | PlainRef  { to :: Ident }
 191              -- ^ Reference
 192  | PlainRref { anchor :: Maybe Anchor
 193              , to :: Ident
 194              } -- ^ Reference reference
 195  | PlainSpan { attrs :: CommonAttrs } -- ^ Neutral node
 196  -- Leafs
 197  | PlainBreak -- ^ Line break (\n)
 198  | PlainText TL.Text
 199  | PlainNote { number :: Maybe Nat1
 200              , note   :: [Para]
 201              } -- ^ Footnote
 202  deriving (Eq,Show)
 203
 204 -- * Type 'Pos'
 205 data Pos
 206  =   Pos
 207  {   posAncestors                :: PosPath
 208  ,   posAncestorsWithFigureNames :: PosPath
 209  ,   posPrecedingsSiblings       :: Map XmlName Rank
 210  } deriving (Eq,Show)
 211 instance Ord Pos where
 212         compare = compare `on` posAncestors
 213 instance Default Pos where
 214         def = Pos mempty mempty mempty
 215
 216 -- *** Type 'PosPath'
 217 type PosPath = Seq (XmlName,Rank)
 218
 219 posParent :: PosPath -> Maybe PosPath
 220 posParent p =
 221         case viewr p of
 222          EmptyR -> Nothing
 223          ls :> _ -> Just ls
 224
 225 -- * Type 'CommonAttrs'
 226 data CommonAttrs
 227  =   CommonAttrs
 228  {   id      :: Maybe Ident
 229  ,   classes :: [TL.Text]
 230  } deriving (Eq,Show)
 231 instance Default CommonAttrs where
 232         def = CommonAttrs
 233          { id      = def
 234          , classes = def
 235          }
 236
 237 -- ** Type 'Anchor'
 238 data Anchor
 239  =   Anchor
 240  {   section :: Pos
 241  ,   count   :: Nat1
 242  } deriving (Eq,Ord,Show)
 243
 244 -- * Type 'Title'
 245 newtype Title = Title { unTitle :: Plain }
 246  deriving (Eq,Show,Semigroup,Monoid,Default)
 247
 248 -- ** Type 'Entity'
 249 data Entity
 250  =   Entity
 251  {   name    :: TL.Text
 252  ,   street  :: TL.Text
 253  ,   zipcode :: TL.Text
 254  ,   city    :: TL.Text
 255  ,   region  :: TL.Text
 256  ,   country :: TL.Text
 257  ,   email   :: TL.Text
 258  ,   tel     :: TL.Text
 259  ,   fax     :: TL.Text
 260  ,   url     :: Maybe URL
 261  ,   org     :: Maybe Entity
 262  } deriving (Eq,Show)
 263 instance Default Entity where
 264         def = Entity
 265          { name    = def
 266          , street  = def
 267          , zipcode = def
 268          , city    = def
 269          , region  = def
 270          , country = def
 271          , email   = def
 272          , tel     = def
 273          , fax     = def
 274          , url     = def
 275          , org     = def
 276          }
 277 instance Semigroup Entity where
 278         _x <> y = y
 279
 280 -- * Type 'Include'
 281 data Include
 282  =   Include
 283  {   href :: Path
 284  } deriving (Eq,Show)
 285 instance Default Include where
 286         def = Include
 287          { href = def
 288          }
 289
 290 -- * Type 'Reference'
 291 data Reference
 292  =   Reference
 293  {   id    :: Ident
 294  ,   about :: About
 295  } deriving (Eq,Show)
 296 reference :: Ident -> Reference
 297 reference id =
 298         Reference
 299          { id
 300          , about = def
 301          }
 302 instance Default Reference where
 303         def = reference def
 304
 305 -- * Type 'Date'
 306 data Date
 307  =   Date
 308  {   year  :: Int
 309  ,   month :: Maybe Nat1
 310  ,   day   :: Maybe Nat1
 311  } deriving (Eq,Show)
 312 instance Default Date where
 313         def = Date
 314          { year  = 1970
 315          , month = Just (Nat1 01)
 316          , day   = Just (Nat1 01)
 317          }
 318 instance Semigroup Date where
 319         _x <> y = y
 320
 321 -- * Type 'Link'
 322 data Link
 323  =   Link
 324  {   name  :: TL.Text
 325  ,   href  :: URL
 326  ,   rel   :: TL.Text
 327  ,   type_ :: Maybe TL.Text
 328  ,   plain :: Plain
 329  } deriving (Eq,Show)
 330 instance Default Link where
 331         def = Link
 332          { name  = def
 333          , href  = def
 334          , rel   = def
 335          , type_ = def
 336          , plain = def
 337          }
 338
 339 -- * Type 'Alias'
 340 data Alias
 341  =   Alias
 342  {   id :: Ident
 343  } deriving (Eq,Show)
 344 instance Default Alias where
 345         def = Alias
 346          { id = def
 347          }
 348
 349 -- * Type 'Serie'
 350 data Serie
 351  =   Serie
 352  {   name :: TL.Text
 353  ,   id   :: TL.Text
 354  } deriving (Eq,Show)
 355 instance Default Serie where
 356         def = Serie
 357          { name = def
 358          , id   = def
 359          }
 360
 361 -- | Builtins 'URL' recognized from |Serie|'s 'name'.
 362 urlSerie :: Serie -> Maybe URL
 363 urlSerie Serie{id=id_, name} =
 364         case name of
 365          "RFC" | TL.all Char.isDigit id_ ->
 366                 Just $ URL $ "https://tools.ietf.org/html/rfc"<>id_
 367          "DOI" -> Just $ URL $ "https://dx.doi.org/"<>id_
 368          _ -> Nothing
 369
 370 -- * Type 'Word'
 371 type Word = TL.Text
 372
 373 -- ** Type 'Words'
 374 type Words = [WordOrSpace]
 375
 376 -- *** Type 'WordOrSpace'
 377 data WordOrSpace
 378  =   Word Word
 379  |   Space
 380  deriving (Eq,Ord,Show)
 381
 382 -- ** Type 'Aliases'
 383 type Aliases = [Words]
 384
 385 -- ** Type 'Terms'
 386 type Terms = [Aliases]
 387
 388 -- * Type 'Count'
 389 type Count = Int