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  | 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  -- Leafs
 196  | PlainBreak -- ^ Line break (\n)
 197  | PlainText TL.Text
 198  | PlainNote { number :: Maybe Nat1
 199              , note   :: [Para]
 200              } -- ^ Footnote
 201  deriving (Eq,Show)
 202
 203 -- * Type 'Pos'
 204 data Pos
 205  =   Pos
 206  {   posAncestors                :: PosPath
 207  ,   posAncestorsWithFigureNames :: PosPath
 208  ,   posPrecedingsSiblings       :: Map XmlName Rank
 209  } deriving (Eq,Show)
 210 instance Ord Pos where
 211         compare = compare `on` posAncestors
 212 instance Default Pos where
 213         def = Pos mempty mempty mempty
 214
 215 -- *** Type 'PosPath'
 216 type PosPath = Seq (XmlName,Rank)
 217
 218 posParent :: PosPath -> Maybe PosPath
 219 posParent p =
 220         case viewr p of
 221          EmptyR -> Nothing
 222          ls :> _ -> Just ls
 223
 224 -- * Type 'CommonAttrs'
 225 data CommonAttrs
 226  =   CommonAttrs
 227  {   id      :: Maybe Ident
 228  ,   classes :: [TL.Text]
 229  } deriving (Eq,Show)
 230 instance Default CommonAttrs where
 231         def = CommonAttrs
 232          { id      = def
 233          , classes = def
 234          }
 235
 236 -- ** Type 'Anchor'
 237 data Anchor
 238  =   Anchor
 239  {   section :: Pos
 240  ,   count   :: Nat1
 241  } deriving (Eq,Ord,Show)
 242
 243 -- * Type 'Title'
 244 newtype Title = Title { unTitle :: Plain }
 245  deriving (Eq,Show,Semigroup,Monoid,Default)
 246
 247 -- ** Type 'Entity'
 248 data Entity
 249  =   Entity
 250  {   name    :: TL.Text
 251  ,   street  :: TL.Text
 252  ,   zipcode :: TL.Text
 253  ,   city    :: TL.Text
 254  ,   region  :: TL.Text
 255  ,   country :: TL.Text
 256  ,   email   :: TL.Text
 257  ,   tel     :: TL.Text
 258  ,   fax     :: TL.Text
 259  ,   url     :: Maybe URL
 260  ,   org     :: Maybe Entity
 261  } deriving (Eq,Show)
 262 instance Default Entity where
 263         def = Entity
 264          { name    = def
 265          , street  = def
 266          , zipcode = def
 267          , city    = def
 268          , region  = def
 269          , country = def
 270          , email   = def
 271          , tel     = def
 272          , fax     = def
 273          , url     = def
 274          , org     = def
 275          }
 276 instance Semigroup Entity where
 277         _x <> y = y
 278
 279 -- * Type 'Include'
 280 data Include
 281  =   Include
 282  {   href :: Path
 283  } deriving (Eq,Show)
 284 instance Default Include where
 285         def = Include
 286          { href = def
 287          }
 288
 289 -- * Type 'Reference'
 290 data Reference
 291  =   Reference
 292  {   id    :: Ident
 293  ,   about :: About
 294  } deriving (Eq,Show)
 295 reference :: Ident -> Reference
 296 reference id =
 297         Reference
 298          { id
 299          , about = def
 300          }
 301 instance Default Reference where
 302         def = reference def
 303
 304 -- * Type 'Date'
 305 data Date
 306  =   Date
 307  {   year  :: Int
 308  ,   month :: Maybe Nat1
 309  ,   day   :: Maybe Nat1
 310  } deriving (Eq,Show)
 311 instance Default Date where
 312         def = Date
 313          { year  = 1970
 314          , month = Just (Nat1 01)
 315          , day   = Just (Nat1 01)
 316          }
 317 instance Semigroup Date where
 318         _x <> y = y
 319
 320 -- * Type 'Link'
 321 data Link
 322  =   Link
 323  {   name  :: TL.Text
 324  ,   href  :: URL
 325  ,   rel   :: TL.Text
 326  ,   type_ :: Maybe TL.Text
 327  ,   plain :: Plain
 328  } deriving (Eq,Show)
 329 instance Default Link where
 330         def = Link
 331          { name  = def
 332          , href  = def
 333          , rel   = def
 334          , type_ = def
 335          , plain = def
 336          }
 337
 338 -- * Type 'Alias'
 339 data Alias
 340  =   Alias
 341  {   id :: Ident
 342  } deriving (Eq,Show)
 343 instance Default Alias where
 344         def = Alias
 345          { id = def
 346          }
 347
 348 -- * Type 'Serie'
 349 data Serie
 350  =   Serie
 351  {   name :: TL.Text
 352  ,   id   :: TL.Text
 353  } deriving (Eq,Show)
 354 instance Default Serie where
 355         def = Serie
 356          { name = def
 357          , id   = def
 358          }
 359
 360 -- | Builtins 'URL' recognized from |Serie|'s 'name'.
 361 urlSerie :: Serie -> Maybe URL
 362 urlSerie Serie{id=id_, name} =
 363         case name of
 364          "RFC" | TL.all Char.isDigit id_ ->
 365                 Just $ URL $ "https://tools.ietf.org/html/rfc"<>id_
 366          "DOI" -> Just $ URL $ "https://dx.doi.org/"<>id_
 367          _ -> Nothing
 368
 369 -- * Type 'Word'
 370 type Word = TL.Text
 371
 372 -- ** Type 'Words'
 373 type Words = [WordOrSpace]
 374
 375 -- *** Type 'WordOrSpace'
 376 data WordOrSpace
 377  =   Word Word
 378  |   Space
 379  deriving (Eq,Ord,Show)
 380
 381 -- ** Type 'Aliases'
 382 type Aliases = [Words]
 383
 384 -- ** Type 'Terms'
 385 type Terms = [Aliases]
 386
 387 -- * Type 'Count'
 388 type Count = Int