{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Hdoc.DTC.Document
 ( module Hdoc.DTC.Document
 , module Hdoc.XML
 ) where

import Data.Default.Class (Default(..))
import Data.Default.Instances.Containers ()
import Data.Eq (Eq)
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, 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 Hdoc.XML

-- * Type 'Document'
data Document
 =   Document
 {   head  :: Head
 ,   body  :: Body
 } deriving (Eq,Show)
instance Default Document where
	def = Document
	 { head  = def
	 , body  = mempty
	 }

-- * Type 'Head'
data Head
 =   Head
 {   about :: About
 } deriving (Eq,Show)
instance Default Head where
	def = Head
	 { about = def
	 }

-- ** Type 'About'
data About
 =   About
 {   headers  :: [Header]
 ,   titles   :: [Title]
 ,   url      :: Maybe URL
 ,   authors  :: [Entity]
 ,   editor   :: Maybe Entity
 ,   date     :: Maybe Date
 ,   tags     :: [TL.Text]
 ,   links    :: [Link]
 ,   series   :: [Serie]
 ,   includes :: [Include]
 } deriving (Eq,Show)
instance Default About where
	def = About
	 { headers  = def
	 , includes = def
	 , titles   = def
	 , url      = def
	 , date     = def
	 , editor   = def
	 , authors  = def
	 , tags     = def
	 , links    = def
	 , series   = def
	 }
instance Semigroup About where
	x <> y = About
	 { 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
	 , 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
 =   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]
              }
 deriving (Eq,Show)

-- * 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
 | PlainSpan { attrs :: CommonAttrs } -- ^ Neutral node
 -- 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
 ,   posAncestorsWithFigureNames :: PosPath
 ,   posPrecedingsSiblings       :: Map XmlName Rank
 } deriving (Eq,Show)
instance Ord Pos where
	compare = compare `on` posAncestors
instance Default Pos where
	def = Pos mempty mempty mempty

-- *** Type 'PosPath'
type PosPath = Seq (XmlName,Rank)

posParent :: PosPath -> Maybe PosPath
posParent p =
	case viewr p of
	 EmptyR -> Nothing
	 ls :> _ -> Just ls

-- * Type 'CommonAttrs'
data CommonAttrs
 =   CommonAttrs
 {   id      :: Maybe Ident
 ,   classes :: [TL.Text]
 } deriving (Eq,Show)
instance Default CommonAttrs where
	def = CommonAttrs
	 { id      = def
	 , classes = def
	 }

-- ** Type 'Anchor'
data Anchor
 =   Anchor
 {   section :: Pos
 ,   count   :: Nat1
 } deriving (Eq,Ord,Show)

-- * Type 'Title'
newtype Title = Title { unTitle :: Plain }
 deriving (Eq,Show,Semigroup,Monoid,Default)

-- ** Type 'Entity'
data Entity
 =   Entity
 {   name    :: TL.Text
 ,   street  :: TL.Text
 ,   zipcode :: TL.Text
 ,   city    :: TL.Text
 ,   region  :: TL.Text
 ,   country :: TL.Text
 ,   email   :: TL.Text
 ,   tel     :: TL.Text
 ,   fax     :: TL.Text
 ,   url     :: Maybe URL
 ,   org     :: Maybe Entity
 } deriving (Eq,Show)
instance Default Entity where
	def = Entity
	 { name    = def
	 , street  = def
	 , zipcode = def
	 , city    = def
	 , region  = def
	 , country = def
	 , email   = def
	 , tel     = def
	 , fax     = def
	 , url     = def
	 , org     = def
	 }
instance Semigroup Entity where
	_x <> y = y

-- * Type 'Include'
data Include
 =   Include
 {   href :: Path
 } deriving (Eq,Show)
instance Default Include where
	def = Include
	 { href = def
	 }

-- * Type 'Reference'
data Reference
 =   Reference
 {   id    :: Ident
 ,   about :: About
 } deriving (Eq,Show)
reference :: Ident -> Reference
reference id =
	Reference
	 { id
	 , about = def
	 }
instance Default Reference where
	def = reference def

-- * Type 'Date'
data Date
 =   Date
 {   year  :: Int
 ,   month :: Maybe Nat1
 ,   day   :: Maybe Nat1
 } deriving (Eq,Show)
instance Default Date where
	def = Date
	 { year  = 1970
	 , month = Just (Nat1 01)
	 , day   = Just (Nat1 01)
	 }
instance Semigroup Date where
	_x <> y = y

-- * Type 'Link'
data Link
 =   Link
 {   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
	 , type_ = def
	 , plain = def
	 }

-- * Type 'Alias'
data Alias
 =   Alias
 {   id :: Ident
 } deriving (Eq,Show)
instance Default Alias where
	def = Alias
	 { id = def
	 }

-- * Type 'Serie'
data Serie
 =   Serie
 {   name :: TL.Text
 ,   id   :: TL.Text
 } deriving (Eq,Show)
instance Default Serie where
	def = Serie
	 { name = 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