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  :: MayText
  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      [[Para]]
 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 'Plain'
 154 type Plain = Trees PlainNode
 155
 156 -- ** Type 'PlainNode'
 157 data PlainNode
 158  -- Nodes
 159  = PlainB     -- ^ Bold
 160  | PlainCode  -- ^ Code (monospaced)
 161  | PlainDel   -- ^ Deleted (crossed-over)
 162  | PlainI     -- ^ Italic
 163  | PlainGroup -- ^ Group subTrees (neutral)
 164  | PlainQ     -- ^ Quoted
 165  | PlainSC    -- ^ Small Caps
 166  | PlainSub   -- ^ Subscript
 167  | PlainSup   -- ^ Superscript
 168  | PlainU     -- ^ Underlined
 169  | PlainEref { href :: URL } -- ^ External reference
 170  | PlainIref { anchor :: Maybe Anchor
 171              , term :: Words
 172              } -- ^ Index reference
 173  | PlainRef  { to :: Ident }
 174              -- ^ Reference
 175  | PlainRref { anchor :: Maybe Anchor
 176              , to :: Ident
 177              } -- ^ Reference reference
 178  -- Leafs
 179  | PlainBR -- ^ Line break (\n)
 180  | PlainText TL.Text
 181  | PlainNote { number :: Maybe Nat1
 182              , note   :: [Para]
 183              } -- ^ Footnote
 184  deriving (Eq,Show)
 185
 186 -- * Type 'Pos'
 187 data Pos
 188  =   Pos
 189  {   posAncestors                :: PosPath
 190  ,   posAncestorsWithFigureNames :: PosPath
 191  ,   posPrecedingsSiblings       :: Map XmlName Rank
 192  } deriving (Eq,Show)
 193 instance Ord Pos where
 194         compare = compare `on` posAncestors
 195 instance Default Pos where
 196         def = Pos mempty mempty mempty
 197
 198 -- *** Type 'PosPath'
 199 type PosPath = Seq (XmlName,Rank)
 200
 201 posParent :: PosPath -> Maybe PosPath
 202 posParent p =
 203         case viewr p of
 204          EmptyR -> Nothing
 205          ls :> _ -> Just ls
 206
 207 -- * Type 'CommonAttrs'
 208 data CommonAttrs
 209  =   CommonAttrs
 210  {   id      :: Maybe Ident
 211  ,   classes :: [TL.Text]
 212  } deriving (Eq,Show)
 213 instance Default CommonAttrs where
 214         def = CommonAttrs
 215          { id      = def
 216          , classes = def
 217          }
 218
 219 -- ** Type 'Anchor'
 220 data Anchor
 221  =   Anchor
 222  {   section :: Pos
 223  ,   count   :: Nat1
 224  } deriving (Eq,Ord,Show)
 225
 226 -- * Type 'Title'
 227 newtype Title = Title { unTitle :: Plain }
 228  deriving (Eq,Show,Semigroup,Monoid,Default)
 229
 230 -- ** Type 'Entity'
 231 data Entity
 232  =   Entity
 233  {   name    :: TL.Text
 234  ,   street  :: TL.Text
 235  ,   zipcode :: TL.Text
 236  ,   city    :: TL.Text
 237  ,   region  :: TL.Text
 238  ,   country :: TL.Text
 239  ,   email   :: TL.Text
 240  ,   tel     :: TL.Text
 241  ,   fax     :: TL.Text
 242  ,   url     :: Maybe URL
 243  ,   org     :: Maybe Entity
 244  } deriving (Eq,Show)
 245 instance Default Entity where
 246         def = Entity
 247          { name    = def
 248          , street  = def
 249          , zipcode = def
 250          , city    = def
 251          , region  = def
 252          , country = def
 253          , email   = def
 254          , tel     = def
 255          , fax     = def
 256          , url     = def
 257          , org     = def
 258          }
 259 instance Semigroup Entity where
 260         _x <> y = y
 261
 262 -- * Type 'Include'
 263 data Include
 264  =   Include
 265  {   href :: Path
 266  } deriving (Eq,Show)
 267 instance Default Include where
 268         def = Include
 269          { href = def
 270          }
 271
 272 -- * Type 'Reference'
 273 data Reference
 274  =   Reference
 275  {   id    :: Ident
 276  ,   about :: About
 277  } deriving (Eq,Show)
 278 reference :: Ident -> Reference
 279 reference id =
 280         Reference
 281          { id
 282          , about = def
 283          }
 284 instance Default Reference where
 285         def = reference def
 286
 287 -- * Type 'Date'
 288 data Date
 289  =   Date
 290  {   year  :: Int
 291  ,   month :: Maybe Nat1
 292  ,   day   :: Maybe Nat1
 293  } deriving (Eq,Show)
 294 instance Default Date where
 295         def = Date
 296          { year  = 1970
 297          , month = Just (Nat1 01)
 298          , day   = Just (Nat1 01)
 299          }
 300 instance Semigroup Date where
 301         _x <> y = y
 302
 303 -- * Type 'Link'
 304 data Link
 305  =   Link
 306  {   name  :: TL.Text
 307  ,   href  :: URL
 308  ,   rel   :: TL.Text
 309  ,   plain :: Plain
 310  } deriving (Eq,Show)
 311 instance Default Link where
 312         def = Link
 313          { name  = def
 314          , href  = def
 315          , rel   = def
 316          , plain = def
 317          }
 318
 319 -- * Type 'Alias'
 320 data Alias
 321  =   Alias
 322  {   id :: Ident
 323  } deriving (Eq,Show)
 324 instance Default Alias where
 325         def = Alias
 326          { id = def
 327          }
 328
 329 -- * Type 'Serie'
 330 data Serie
 331  =   Serie
 332  {   name :: TL.Text
 333  ,   key  :: TL.Text
 334  } deriving (Eq,Show)
 335 instance Default Serie where
 336         def = Serie
 337          { name = def
 338          , key  = def
 339          }
 340
 341 -- * Type 'Word'
 342 type Word = TL.Text
 343
 344 -- ** Type 'Words'
 345 type Words = [WordOrSpace]
 346
 347 -- *** Type 'WordOrSpace'
 348 data WordOrSpace
 349  =   Word Word
 350  |   Space
 351  deriving (Eq,Ord,Show)
 352
 353 -- ** Type 'Aliases'
 354 type Aliases = [Words]
 355
 356 -- ** Type 'Terms'
 357 type Terms = [Aliases]
 358
 359 -- * Type 'Count'
 360 type Count = Int