Language/DTC/Document.hs

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