{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

module Text.HTML.TagSoup.Navigate.Types.TagTreePosParent(
  TagTreePosParent(..)
, HasTagTreePosParent(..)
, AsTagTreePosParent(..)
) where

import Control.Applicative((<*>))
import Control.Category((.), id)
import Control.Lens(Each(each), Lens', Prism')
import Data.Eq(Eq)
import Data.Eq.Deriving(deriveEq1)
import Data.Foldable(Foldable(foldMap))
import Data.Functor(Functor(fmap), (<$>))
import Data.Ord(Ord)
import Data.Ord.Deriving(deriveOrd1)
import Data.Monoid(mappend)
import Data.Traversable(Traversable(traverse))
import Prelude(Show)
import Text.HTML.TagSoup.Navigate.Types.Attribute(Attribute)
import Text.HTML.TagSoup.Navigate.Types.TagTree
import Text.Show.Deriving(deriveShow1)

data TagTreePosParent str =
  TagTreePosParent 
    [TagTree str]
    str
    [Attribute str]
    [TagTree str]
  deriving (Eq, Ord, Show)

instance Functor TagTreePosParent where
  fmap f (TagTreePosParent l x a r) =
    TagTreePosParent (fmap (fmap f) l) (f x) (fmap (fmap f) a) (fmap (fmap f) r)

instance Foldable TagTreePosParent where
  foldMap f (TagTreePosParent l x a r) =
    foldMap (foldMap f) l `mappend` f x `mappend` foldMap (foldMap f) a `mappend` foldMap (foldMap f) r

instance Traversable TagTreePosParent where
  traverse f (TagTreePosParent l x a r) =
    TagTreePosParent <$> traverse (traverse f) l <*> f x <*> traverse (traverse f) a <*> traverse (traverse f) r

instance Each (TagTreePosParent str) (TagTreePosParent str') str str' where
  each =
    traverse

class HasTagTreePosParent a str | a -> str where
  tagTreePosParent ::
    Lens' a (TagTreePosParent str)
  tagTreePosParentLeftSiblings ::
    Lens' a [TagTree str]
  tagTreePosParentLeftSiblings =
    tagTreePosParent . tagTreePosParentLeftSiblings
  tagTreePosParentFocus ::
    Lens' a str
  tagTreePosParentFocus =
    tagTreePosParent . tagTreePosParentFocus
  tagTreePosParentAttributes ::
    Lens' a [Attribute str]
  tagTreePosParentAttributes =
    tagTreePosParent . tagTreePosParentAttributes
  tagTreePosParentRightSiblings ::
    Lens' a [TagTree str]
  tagTreePosParentRightSiblings =
    tagTreePosParent . tagTreePosParentRightSiblings

instance HasTagTreePosParent (TagTreePosParent str) str where
  tagTreePosParent =
    id
  tagTreePosParentLeftSiblings f (TagTreePosParent l x a r) =
    fmap (\l' -> TagTreePosParent l' x a r) (f l)
  tagTreePosParentFocus f (TagTreePosParent l x a r) =
    fmap (\x' -> TagTreePosParent l x' a r) (f x)
  tagTreePosParentAttributes f (TagTreePosParent l x a r) =
    fmap (\a' -> TagTreePosParent l x a' r) (f a)
  tagTreePosParentRightSiblings f (TagTreePosParent l x a r) =
    fmap (\r' -> TagTreePosParent l x a r') (f r)

class AsTagTreePosParent a str | a -> str where
  _TagTreePosParent ::
    Prism' a (TagTreePosParent str)

instance AsTagTreePosParent (TagTreePosParent str) str where
  _TagTreePosParent =
    id

deriveEq1 ''TagTreePosParent
deriveOrd1 ''TagTreePosParent
deriveShow1 ''TagTreePosParent