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