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

import Data.Default.Class (Default(..))
import Data.Eq (Eq)
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.TreeSeq.Strict (Trees)
import Text.Show (Show)

import Language.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
 {   titles   :: [Title]
 ,   authors  :: [Entity]
 ,   editor   :: Maybe Entity
 ,   date     :: Maybe Date
 ,   version  :: MayText
 ,   keywords :: [Text]
 ,   links    :: [Link]
 ,   series   :: [Serie]
 ,   includes :: [Include]
 } deriving (Eq,Show)
instance Default About where
	def = About
	 { includes = def
	 , titles   = def
	 , date     = def
	 , version  = def
	 , editor   = def
	 , authors  = def
	 , keywords = def
	 , links    = def
	 , series   = def
	 }
instance Semigroup About where
	x <> y = About
	 { titles   = titles   x <> titles   y
	 , 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
	 , links    = links    x <> links    y
	 , series   = series   x <> series   y
	 , includes = includes x <> includes y
	 }

-- * Type 'Body'
type Body = Trees BodyKey BodyValue

-- ** Type 'BodyKey'
data BodyKey
 = Section { pos     :: XmlPos
           , attrs   :: CommonAttrs
           , title   :: Title
           , aliases :: [Alias]
           }
 deriving (Eq,Show)

-- ** Type 'BodyValue'
data BodyValue
 = ToC     { pos   :: XmlPos
           , attrs :: CommonAttrs
           , depth :: Maybe Nat
           }
 | ToF     { pos   :: XmlPos
           , attrs :: CommonAttrs
           , depth :: Maybe Nat
           }
 | Figure  { pos   :: XmlPos
           , attrs :: CommonAttrs
           , type_ :: Text
           , title :: Title
           , verts :: Verticals
           }
 | Index   { pos   :: XmlPos
           , attrs :: CommonAttrs
           , terms :: [[Text]]
           }
 | Vertical Vertical
 deriving (Eq,Show)

-- * Type 'Vertical'
data Vertical
 = Para    { pos   :: XmlPos
           , attrs :: CommonAttrs
           , horis :: Horizontals
           }
 | OL      { pos   :: XmlPos
           , attrs :: CommonAttrs
           , items :: [Verticals]
           }
 | UL      { pos   :: XmlPos
           , attrs :: CommonAttrs
           , items :: [Verticals]
           }
 | RL      { pos   :: XmlPos
           , attrs :: CommonAttrs
           , refs  :: [Reference]
           }
 | Artwork { pos   :: XmlPos
           , attrs :: CommonAttrs
           , art   :: Artwork
           }
 | Comment Text
 deriving (Eq,Show)

-- * Type 'CommonAttrs'
data CommonAttrs
 =   CommonAttrs
 {   id      :: Maybe Ident
 ,   classes :: [Text]
 } deriving (Eq,Show)

-- * Type 'Auto'
data Auto
 =   Auto
 {   auto_id :: Ident
 } deriving (Eq,Show)

-- * Type 'Verticals'
type Verticals = [Vertical]

-- * Type 'Artwork'
data Artwork
 =   Raw Text
 deriving (Eq,Show)

-- * Type 'Horizontal'
data Horizontal
 =   BR
 |   B    Horizontals
 |   Code Horizontals
 |   Del  Horizontals
 |   I    Horizontals
 |   Note Horizontals
 |   Q    Horizontals
 |   SC   Horizontals
 |   Sub  Horizontals
 |   Sup  Horizontals
 |   U    Horizontals
 |   Eref {href :: URL, text :: Horizontals}
 |   Iref {count :: Int, term :: Text, text :: Horizontals}
 |   Ref  {to :: Ident, text :: Horizontals}
 |   Rref {to :: Ident, text :: Horizontals}
 |   Plain Text
 deriving (Eq,Show)

-- * Type 'Horizontals'
type Horizontals = [Horizontal]

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

-- ** Type 'Address'
data Address
 =   Address
 {   street  :: Text
 ,   zipcode :: Text
 ,   city    :: Text
 ,   region  :: Text
 ,   country :: Text
 ,   email   :: Text
 ,   tel     :: Text
 ,   fax     :: Text
 } deriving (Eq,Show)
instance Default Address where
	def = Address
	 { street  = def
	 , zipcode = def
	 , city    = def
	 , region  = def
	 , country = def
	 , email   = def
	 , tel     = def
	 , fax     = def
	 }

-- * 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
 ,   to    :: Maybe URL
 ,   about :: About
 } deriving (Eq,Show)
reference :: Ident -> Reference
reference id =
	Reference
	 { id
	 , to    = def
	 , about = def
	 }
instance Default Reference where
	def = reference def

-- * Type 'Entity'
data Entity
 =   Entity
 {   name    :: Text
 ,   address :: Address
 } deriving (Eq,Show)
instance Default Entity where
	def = Entity
	 { name    = def
	 , address = def
	 }
instance Semigroup Entity where
	_x <> y = y

-- * 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  :: Text
 ,   href  :: URL
 ,   rel   :: Text
 ,   body  :: Horizontals
 } deriving (Eq,Show)
instance Default Link where
	def = Link
	 { name = def
	 , href = def
	 , rel  = def
	 , body = 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 :: Text
 ,   key  :: Text
 } deriving (Eq,Show)
instance Default Serie where
	def = Serie
	 { name = def
	 , key  = def
	 }