Fix href= in <toc>.
[doclang.git] / Language / DTC / Document.hs
index e439392c899df62074cad14f3109924c0dbd9baf..9635dc7d9fec97c31c1fd2147feaa5e043d4681f 100644 (file)
@@ -2,6 +2,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Language.DTC.Document
  ( module Language.DTC.Document
  , module Language.XML
@@ -10,16 +11,17 @@ module Language.DTC.Document
 import Data.Default.Class (Default(..))
 import Data.Default.Instances.Containers ()
 import Data.Eq (Eq)
-import Data.Function (on)
+import Data.Function (on, ($))
 import Data.Int (Int)
 import Data.Map.Strict (Map)
 import Data.Maybe (Maybe(..))
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
-import Data.Sequence (Seq)
-import Data.TreeSeq.Strict (Tree(..), Trees)
+import Data.Sequence (Seq, ViewR(..), viewr)
+import Data.TreeSeq.Strict (Trees)
 import Text.Show (Show)
+import qualified Data.Char as Char
 import qualified Data.Text.Lazy as TL
 
 import Language.XML
@@ -49,80 +51,156 @@ instance Default Head where
 -- ** Type 'About'
 data About
  =   About
- {   titles   :: [Title]
+ {   headers  :: [Header]
+ ,   titles   :: [Title]
  ,   url      :: Maybe URL
  ,   authors  :: [Entity]
  ,   editor   :: Maybe Entity
  ,   date     :: Maybe Date
- ,   version  :: MayText
- ,   keywords :: [TL.Text]
+ ,   tags     :: [TL.Text]
  ,   links    :: [Link]
  ,   series   :: [Serie]
  ,   includes :: [Include]
  } deriving (Eq,Show)
 instance Default About where
        def = About
-        { includes = def
+        { headers  = def
+        , includes = def
         , titles   = def
         , url      = def
         , date     = def
-        , version  = def
         , editor   = def
         , authors  = def
-        , keywords = def
+        , tags     = def
         , links    = def
         , series   = def
         }
 instance Semigroup About where
        x <> y = About
-        { titles   = titles   x <> titles   y
+        { headers  = headers  x <> headers  y
+        , titles   = titles   x <> titles   y
         , url      = url (x::About) <> url (y::About)
         , authors  = authors  x <> authors  y
         , editor   = editor   x <> editor   y
         , date     = date     x <> date     y
-        , version  = version  x <> version  y
-        , keywords = keywords x <> keywords y
+        , tags     = tags     x <> tags     y
         , links    = links    x <> links    y
         , series   = series   x <> series   y
         , includes = includes x <> includes y
         }
 
+-- * Type 'Header'
+data Header
+ =   Header
+ {   name  :: TL.Text
+ ,   value :: Plain
+ } deriving (Eq,Show)
+
 -- * Type 'Body'
 type Body = Trees BodyNode
 
 -- ** Type 'BodyNode'
 data BodyNode
- = Section    { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , title   :: Title
-              , aliases :: [Alias]
-              }
- | ToC        { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , depth   :: Maybe Nat
-              }
- | ToF        { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , types   :: [TL.Text]
-              }
- | Figure     { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , type_   :: TL.Text
-              , mayTitle :: Maybe Title
-              , blocks  :: Blocks
-              }
- | Index      { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , terms   :: Terms
-              }
- | References { pos     :: Pos
-              , attrs   :: CommonAttrs
-              , refs    :: [Reference]
+ =   BodySection { pos      :: Pos
+                 , attrs    :: CommonAttrs
+                 , title    :: Title
+                 , aliases  :: [Alias]
+                 }
+ |   BodyBlock Block -- ^ leaf
+ deriving (Eq,Show)
+
+-- * Type 'Block'
+data Block
+ = BlockPara       Para
+ | BlockBreak      { attrs    :: CommonAttrs }
+ | BlockToC        { pos      :: Pos
+                   , attrs    :: CommonAttrs
+                   , depth    :: Maybe Nat
+                   }
+ | BlockToF        { pos      :: Pos
+                   , attrs    :: CommonAttrs
+                   , types    :: [TL.Text]
+                   }
+ | BlockFigure     { pos      :: Pos
+                   , attrs    :: CommonAttrs
+                   , type_    :: TL.Text
+                   , mayTitle :: Maybe Title
+                   , paras    :: [Para]
+                   }
+ | BlockIndex      { pos      :: Pos
+                   , attrs    :: CommonAttrs
+                   , terms    :: Terms
+                   }
+ | BlockReferences { pos      :: Pos
+                   , attrs    :: CommonAttrs
+                   , refs     :: [Reference]
+                   }
+ deriving (Eq,Show)
+
+-- * Type 'Para'
+data Para
+ = ParaItem  { item  :: ParaItem }
+ | ParaItems { pos   :: Pos
+             , attrs :: CommonAttrs
+             , items :: [ParaItem]
+             }
+ deriving (Eq,Show)
+
+-- ** Type 'ParaItem'
+data ParaItem
+ = ParaPlain   Plain
+ | ParaComment TL.Text
+ | ParaOL      [ListItem]
+ | ParaUL      [[Para]]
+ | ParaQuote   { type_  :: TL.Text
+               , paras  :: [Para]
+               }
+ | ParaArtwork { type_  :: TL.Text
+               , text   :: TL.Text
+               }
+ deriving (Eq,Show)
+
+-- *** Type 'ListItem'
+data ListItem
+ =   ListItem { name  :: TL.Text
+              , paras :: [Para]
               }
- | Block Block
  deriving (Eq,Show)
 
--- ** Type 'Pos'
+-- * Type 'Plain'
+type Plain = Trees PlainNode
+
+-- ** Type 'PlainNode'
+data PlainNode
+ -- Nodes
+ = PlainB     -- ^ Bold
+ | PlainCode  -- ^ Code (monospaced)
+ | PlainDel   -- ^ Deleted (crossed-over)
+ | PlainI     -- ^ Italic
+ | PlainGroup -- ^ Group subTrees (neutral)
+ | PlainQ     -- ^ Quoted
+ | PlainSC    -- ^ Small Caps
+ | PlainSub   -- ^ Subscript
+ | PlainSup   -- ^ Superscript
+ | PlainU     -- ^ Underlined
+ | PlainEref { href :: URL } -- ^ External reference
+ | PlainIref { anchor :: Maybe Anchor
+             , term :: Words
+             } -- ^ Index reference
+ | PlainRef  { to :: Ident }
+             -- ^ Reference
+ | PlainRref { anchor :: Maybe Anchor
+             , to :: Ident
+             } -- ^ Reference reference
+ -- Leafs
+ | PlainBreak -- ^ Line break (\n)
+ | PlainText TL.Text
+ | PlainNote { number :: Maybe Nat1
+             , note   :: [Para]
+             } -- ^ Footnote
+ deriving (Eq,Show)
+
+-- * Type 'Pos'
 data Pos
  =   Pos
  {   posAncestors                :: PosPath
@@ -137,53 +215,11 @@ instance Default Pos where
 -- *** Type 'PosPath'
 type PosPath = Seq (XmlName,Rank)
 
--- ** Type 'Word'
-type Word = TL.Text
-
--- *** Type 'Words'
-type Words = [WordOrSpace]
-
--- **** Type 'WordOrSpace'
-data WordOrSpace
- =   Word Word
- |   Space
- deriving (Eq,Ord,Show)
-
--- ** Type 'Aliases'
-type Aliases = [Words]
-
--- ** Type 'Terms'
-type Terms = [Aliases]
-
--- * Type 'Count'
-type Count = Int
-
--- * Type 'Block'
-data Block
- = Para    { pos    :: Pos
-           , attrs  :: CommonAttrs
-           , para   :: Para
-           }
- | OL      { pos    :: Pos
-           , attrs  :: CommonAttrs
-           , items  :: [Blocks]
-           }
- | UL      { pos    :: Pos
-           , attrs  :: CommonAttrs
-           , items  :: [Blocks]
-           }
- | Artwork { pos    :: Pos
-           , attrs  :: CommonAttrs
-           , type_  :: TL.Text
-           , text   :: TL.Text
-           }
- | Quote   { pos    :: Pos
-           , attrs  :: CommonAttrs
-           , type_  :: TL.Text
-           , blocks :: Blocks
-           }
- | Comment TL.Text
- deriving (Eq,Show)
+posParent :: PosPath -> Maybe PosPath
+posParent p =
+       case viewr p of
+        EmptyR -> Nothing
+        ls :> _ -> Just ls
 
 -- * Type 'CommonAttrs'
 data CommonAttrs
@@ -191,35 +227,11 @@ data CommonAttrs
  {   id      :: Maybe Ident
  ,   classes :: [TL.Text]
  } deriving (Eq,Show)
-
--- * Type 'Blocks'
-type Blocks = [Block]
-
--- * Type 'Para'
-type Para = Seq Lines
-
--- * Type 'Lines'
-type Lines = Tree LineNode
-
--- ** Type 'LineNode'
-data LineNode
- = B
- | Code
- | Del
- | I
- | Note {number :: Maybe Nat1}
- | Q
- | SC
- | Sub
- | Sup
- | U
- | Eref {href :: URL}
- | Iref {anchor :: Maybe Anchor, term :: Words}
- | Ref  {to :: Ident}
- | Rref {anchor :: Maybe Anchor, to :: Ident}
- | BR
- | Plain TL.Text
- deriving (Eq,Show)
+instance Default CommonAttrs where
+       def = CommonAttrs
+        { id      = def
+        , classes = def
+        }
 
 -- ** Type 'Anchor'
 data Anchor
@@ -229,7 +241,7 @@ data Anchor
  } deriving (Eq,Ord,Show)
 
 -- * Type 'Title'
-newtype Title = Title { unTitle :: Para }
+newtype Title = Title { unTitle :: Plain }
  deriving (Eq,Show,Semigroup,Monoid,Default)
 
 -- ** Type 'Entity'
@@ -308,17 +320,19 @@ instance Semigroup Date where
 -- * Type 'Link'
 data Link
  =   Link
- {   name :: TL.Text
- ,   href :: URL
- ,   rel  :: TL.Text
- ,   para :: Para
+ {   name  :: TL.Text
+ ,   href  :: URL
+ ,   rel   :: TL.Text
+ ,   type_ :: Maybe TL.Text
+ ,   plain :: Plain
  } deriving (Eq,Show)
 instance Default Link where
        def = Link
-        { name = def
-        , href = def
-        , rel  = def
-        , para = def
+        { name  = def
+        , href  = def
+        , rel   = def
+        , type_ = def
+        , plain = def
         }
 
 -- * Type 'Alias'
@@ -335,10 +349,40 @@ instance Default Alias where
 data Serie
  =   Serie
  {   name :: TL.Text
- ,   key  :: TL.Text
+ ,   id   :: TL.Text
  } deriving (Eq,Show)
 instance Default Serie where
        def = Serie
         { name = def
-        , key  = def
+        , id   = def
         }
+
+-- | Builtins 'URL' recognized from |Serie|'s 'name'.
+urlSerie :: Serie -> Maybe URL
+urlSerie Serie{id=id_, name} =
+       case name of
+        "RFC" | TL.all Char.isDigit id_ ->
+               Just $ URL $ "https://tools.ietf.org/html/rfc"<>id_
+        "DOI" -> Just $ URL $ "https://dx.doi.org/"<>id_
+        _ -> Nothing
+
+-- * Type 'Word'
+type Word = TL.Text
+
+-- ** Type 'Words'
+type Words = [WordOrSpace]
+
+-- *** Type 'WordOrSpace'
+data WordOrSpace
+ =   Word Word
+ |   Space
+ deriving (Eq,Ord,Show)
+
+-- ** Type 'Aliases'
+type Aliases = [Words]
+
+-- ** Type 'Terms'
+type Terms = [Aliases]
+
+-- * Type 'Count'
+type Count = Int