{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hdoc.XML
 ( module Hdoc.XML
 , XML.Node(..)
 ) where

import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
import Data.Function ((.), on)
import Data.Hashable (Hashable(..))
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.String (IsString(..))
import Text.Show (Show(..), showsPrec)
import qualified Data.Sequence as Seq
import qualified Data.Text.Lazy as TL
import qualified Language.Symantic.XML as XML

import qualified Hdoc.TCT.Cell as TCT
import Hdoc.Utils (Nat1)

-- * Type 'XML'
type XML  = XML.XML  TCT.Location
-- ** Type 'XMLs'
type XMLs = XML.XMLs TCT.Location

-- ** Type 'Attrs'
type Attrs = Map XML.QName (TCT.Cell TL.Text)
 -- TODO: Map -> HashMap?

-- * Type 'Pos'
data Pos = Pos
 { pos_ancestors                :: Ancestors
 , pos_ancestorsWithFigureNames :: Ancestors
 , pos_precedingSiblings        :: Map XML.QName Rank
 } deriving (Eq,Show)
instance Ord Pos where
	compare = compare`on`pos_ancestors
-- | Return only the hash on 'pos_ancestors',
-- which is unique because 'Ancestors'
-- includes the 'Rank' of each 'Node'.
instance Hashable Pos where
	hashWithSalt s Pos{..} =
		s`hashWithSalt`pos_ancestors
instance Default Pos where
	def = Pos mempty mempty mempty

-- ** Type 'Rank'
-- | Nth child.
type Rank = Nat1

-- ** Type 'Ancestors'
type Ancestors = Seq (XML.QName, Rank)

ancestors :: Ancestors -> Maybe Ancestors
ancestors p =
	case Seq.viewr p of
	 Seq.EmptyR -> Nothing
	 ls Seq.:> _ -> Just ls

-- * Type 'Ident'
newtype Ident = Ident { unIdent :: TL.Text }
 deriving (Eq,Ord,Show,Default,IsString,Semigroup,Monoid,Hashable)

-- * Type 'URL'
newtype URL = URL { unURL :: TL.Text }
 deriving (Eq,Ord,Default,Hashable)
instance Show URL where
	showsPrec p = showsPrec p . unURL
instance Semigroup URL where
	_x <> y = y