{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Hdoc.XML 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 '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