{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
module Language.DTC.Document
( module Language.DTC.Document
, module Language.XML
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
-- ** 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
-- *** 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
{ 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
} deriving (Eq,Ord,Show)
-- * Type 'Title'
-newtype Title = Title { unTitle :: Para }
+newtype Title = Title { unTitle :: Plain }
deriving (Eq,Show,Semigroup,Monoid,Default)
-- ** Type 'Entity'
-- * 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'
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