{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.DTC.Document where

import Control.Applicative (Applicative(..))
import Data.Eq (Eq)
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord)
import Data.Semigroup (Semigroup(..))
import Data.Sequence (Seq)
import Data.String (IsString(..))
import Data.Text (Text)
import Text.Show (Show)
import qualified Data.Sequence as Seq
import Language.TCT.Write.XML (XmlPos(..))

-- * Class 'Default'
class Default a where
	def :: a
instance Default Text where
	def = ""
instance Default (Maybe a) where
	def = Nothing
instance Default [a] where
	def = []
instance Default (Seq a) where
	def = Seq.empty

-- * Type 'MayText'
newtype MayText
 =      MayText { unMayText :: Text }
 deriving (Eq,Show,Default)
instance Semigroup MayText where
	MayText "" <> y = y
	x <> MayText "" = x
	_x <> y          = y

whenMayText :: Applicative m => MayText -> (MayText -> m ()) -> m ()
whenMayText (MayText "") _f = pure ()
whenMayText t f = f t

-- * Type 'Nat'
newtype Nat = Nat Int
 deriving (Eq, Ord, Show)

-- * Type 'Nat1'
newtype Nat1 = Nat1 Int
 deriving (Eq, Ord, Show)

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

-- * 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'
data Body
 = Section { attrs   :: CommonAttrs
           , title   :: Title
           , aliases :: [Alias]
           , body    :: [Body]
           , pos     :: XmlPos
           }
 | Verticals [Vertical]
 deriving (Eq,Show)

-- * Type 'Vertical'
data Vertical
 = Para    { attrs :: CommonAttrs
           , horis :: Horizontals
           , pos   :: XmlPos
           }
 | OL      { attrs :: CommonAttrs
           , items :: [Verticals]
           , pos   :: XmlPos
           }
 | UL      { attrs :: CommonAttrs
           , items :: [Verticals]
           , pos   :: XmlPos
           }
 | RL      { attrs :: CommonAttrs
           , refs  :: [Reference]
           , pos   :: XmlPos
           }
 | ToC     { attrs :: CommonAttrs
           , depth :: Maybe Int
           , pos   :: XmlPos
           }
 | ToF     { attrs :: CommonAttrs
           , depth :: Maybe Int
           , pos   :: XmlPos
           }
 | Index   { attrs :: CommonAttrs
           , pos   :: XmlPos
           }
 | Figure  { type_ :: Text
           , attrs :: CommonAttrs
           , title :: Title
           , verts :: Verticals
           , pos   :: XmlPos
           }
 | Artwork { attrs :: CommonAttrs
           , art   :: Artwork
           , pos   :: XmlPos
           }
 | 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 {to   :: Ident, text :: Horizontals}
 |   Ref  {to   :: Ident, text :: Horizontals}
 |   Rref {to   :: Ident, text :: Horizontals}
 |   Plain Text
 deriving (Eq,Show)

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

-- * Type 'Ident'
newtype Ident = Ident { unIdent :: Text }
 deriving (Eq,Show,Default,IsString)

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

-- * Type 'URL'
newtype URL = URL Text
 deriving (Eq,Show,Default)

-- * Type 'Path'
newtype Path = Path Text
 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
	 }