{-# LANGUAGE TypeFamilies #-}
module Text.Seonbi.Html.TagStack
    ( HtmlTagStack
    , Text.Seonbi.Html.TagStack.any
    , descendsFrom
    , Text.Seonbi.Html.TagStack.elem
    , depth
    , empty
    , fromList
    , last
    , pop
    , push
    , rebase
    , toList
    ) where

import Prelude hiding (last)

import Data.List hiding (last)
import GHC.Exts (IsList (..))

import Text.Seonbi.Html.Tag

-- | Represents a hierarchy of a currently parsing position in an 'HtmlTag'
-- tree.
--
-- For example, if an 'scanHtml' has read "@\<a href="#">\<b>\<i>foo\</i> bar@"
-- it is represented as @'HtmlTagStack' ['B', 'A']@.
--
-- Note that the tags are stored in reverse order, from the deepest to
-- the shallowest, to make inserting a more deeper tag efficient.
newtype HtmlTagStack = HtmlTagStack [HtmlTag] deriving (HtmlTagStack -> HtmlTagStack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HtmlTagStack -> HtmlTagStack -> Bool
$c/= :: HtmlTagStack -> HtmlTagStack -> Bool
== :: HtmlTagStack -> HtmlTagStack -> Bool
$c== :: HtmlTagStack -> HtmlTagStack -> Bool
Eq, Eq HtmlTagStack
HtmlTagStack -> HtmlTagStack -> Bool
HtmlTagStack -> HtmlTagStack -> Ordering
HtmlTagStack -> HtmlTagStack -> HtmlTagStack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack
$cmin :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack
max :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack
$cmax :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack
>= :: HtmlTagStack -> HtmlTagStack -> Bool
$c>= :: HtmlTagStack -> HtmlTagStack -> Bool
> :: HtmlTagStack -> HtmlTagStack -> Bool
$c> :: HtmlTagStack -> HtmlTagStack -> Bool
<= :: HtmlTagStack -> HtmlTagStack -> Bool
$c<= :: HtmlTagStack -> HtmlTagStack -> Bool
< :: HtmlTagStack -> HtmlTagStack -> Bool
$c< :: HtmlTagStack -> HtmlTagStack -> Bool
compare :: HtmlTagStack -> HtmlTagStack -> Ordering
$ccompare :: HtmlTagStack -> HtmlTagStack -> Ordering
Ord)

instance IsList HtmlTagStack where
    type Item HtmlTagStack = HtmlTag
    fromList :: [Item HtmlTagStack] -> HtmlTagStack
fromList = [HtmlTag] -> HtmlTagStack
HtmlTagStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
    toList :: HtmlTagStack -> [Item HtmlTagStack]
toList (HtmlTagStack [HtmlTag]
tags) = forall a. [a] -> [a]
reverse [HtmlTag]
tags

instance Show HtmlTagStack where
    show :: HtmlTagStack -> String
show HtmlTagStack
tags = String
"fromList " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall l. IsList l => l -> [Item l]
toList HtmlTagStack
tags)

-- | An empty stack.
empty :: HtmlTagStack
empty :: HtmlTagStack
empty = [HtmlTag] -> HtmlTagStack
HtmlTagStack []

-- | Count the depth of a stack.
--
-- >>> :set -XOverloadedLists
-- >>> depth empty
-- 0
-- >>> depth [Div, Article, P, Em]
-- 4
depth :: HtmlTagStack -> Int
depth :: HtmlTagStack -> Int
depth (HtmlTagStack [HtmlTag]
stack) = forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length [HtmlTag]
stack

-- | Get the deepest tag from a 'HtmlTagStack'.
--
-- >>> :set -XOverloadedLists
-- >>> let stack = [Div, Article, P, Em] :: HtmlTagStack
-- >>> last stack
-- Just Em
-- >>> last []
-- Nothing
last :: HtmlTagStack -> Maybe HtmlTag
last :: HtmlTagStack -> Maybe HtmlTag
last (HtmlTagStack []) = forall a. Maybe a
Nothing
last (HtmlTagStack (HtmlTag
tag:[HtmlTag]
_)) = forall a. a -> Maybe a
Just HtmlTag
tag

-- | Build a new stack from a stack by replacing its bottom with a new base.
--
-- >>> :set -XOverloadedLists
-- >>> rebase [Article, BlockQuote] [Div] [Article, BlockQuote, P, Em]
-- fromList [Div,P,Em]
--
-- If there are no such bottom elements, it replaces nothing.
--
-- >>> rebase [Div, Article, BlockQuote] [Div] [Article, BlockQuote, P, Em]
-- fromList [Article,BlockQuote,P,Em]
rebase :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack -> HtmlTagStack
rebase :: HtmlTagStack -> HtmlTagStack -> HtmlTagStack -> HtmlTagStack
rebase (HtmlTagStack [HtmlTag]
base) (HtmlTagStack [HtmlTag]
newBase) stack :: HtmlTagStack
stack@(HtmlTagStack [HtmlTag]
l)
  | [HtmlTag]
base forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [HtmlTag]
l = [HtmlTag] -> HtmlTagStack
HtmlTagStack forall a b. (a -> b) -> a -> b
$
      forall a. Int -> [a] -> [a]
take (HtmlTagStack -> Int
depth HtmlTagStack
stack forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [HtmlTag]
base) [HtmlTag]
l forall a. [a] -> [a] -> [a]
++ [HtmlTag]
newBase
  | Bool
otherwise = HtmlTagStack
stack

-- | Push one deeper @tag@ to a 'HtmlTagStack'.
--
-- >>> push A empty
-- fromList [A]
-- >>> push B (push A empty)
-- fromList [A,B]
push :: HtmlTag -> HtmlTagStack -> HtmlTagStack
push :: HtmlTag -> HtmlTagStack -> HtmlTagStack
push HtmlTag
tag (HtmlTagStack [HtmlTag]
tags) =
    [HtmlTag] -> HtmlTagStack
HtmlTagStack (HtmlTag
tag forall a. a -> [a] -> [a]
: [HtmlTag]
tags)

-- | Pop the deepest @tag@ from a 'HtmlTagStack'.
--
-- >>> :set -XOverloadedLists
-- >>> pop Em [A, B, Em]
-- fromList [A,B]
--
-- It may pop a @tag@ in the middle if a @tag@ looking for is not the deepest:
--
-- >>> pop B [A, B, Em]
-- fromList [A,Em]
--
-- It does not affect to the input if there is no such @tag@ in the input:
--
-- >>> pop P [A, B, Em]
-- fromList [A,B,Em]
-- >>> pop A empty
-- fromList []
pop :: HtmlTag -> HtmlTagStack -> HtmlTagStack
pop :: HtmlTag -> HtmlTagStack -> HtmlTagStack
pop HtmlTag
tag (HtmlTagStack tags' :: [HtmlTag]
tags'@(HtmlTag
t : [HtmlTag]
ags)) =
    if HtmlTag
t forall a. Eq a => a -> a -> Bool
== HtmlTag
tag
         then [HtmlTag] -> HtmlTagStack
HtmlTagStack [HtmlTag]
ags
         else
            let
                ([HtmlTag]
head', [HtmlTag]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= HtmlTag
tag) [HtmlTag]
tags'
                tail' :: [HtmlTag]
tail' = case forall a. [a] -> Maybe (a, [a])
uncons [HtmlTag]
rest of
                    Just (HtmlTag
_, [HtmlTag]
tail'') -> [HtmlTag]
tail''
                    Maybe (HtmlTag, [HtmlTag])
Nothing -> []
            in
                [HtmlTag] -> HtmlTagStack
HtmlTagStack ([HtmlTag]
head' forall a. [a] -> [a] -> [a]
++ [HtmlTag]
tail')
pop HtmlTag
_ (HtmlTagStack []) = HtmlTagStack
empty

-- | Check if a node ('HtmlEntity') that a 'HtmlTagStack' (the first argument)
-- refers is contained by a node that another 'HtmlTagStack' (the second
-- argument), or they are sibling at least.
--
-- >>> :set -XOverloadedLists
-- >>> descendsFrom [Div, P, A, Em] [Div, P, A]
-- True
-- >>> descendsFrom [Div, P, A] [Div, P, A]
-- True
-- >>> descendsFrom [Div, P, Em] [Div, P, A]
-- False
-- >>> descendsFrom [Div, P] [Div, P, A]
-- False
descendsFrom :: HtmlTagStack -> HtmlTagStack -> Bool
HtmlTagStack [HtmlTag]
a descendsFrom :: HtmlTagStack -> HtmlTagStack -> Bool
`descendsFrom` HtmlTagStack [HtmlTag]
b =
    [HtmlTag]
b forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [HtmlTag]
a

-- | Determine whether any element of the tag stack satisfies the predicate.
--
-- >>> :set -XOverloadedLists
-- >>> Text.Seonbi.Html.TagStack.any ((== Void) . htmlTagKind) [Div, P, Script]
-- False
-- >>> Text.Seonbi.Html.TagStack.any ((== Void) . htmlTagKind) [BR, P, Script]
-- True
any :: (HtmlTag -> Bool) -> HtmlTagStack -> Bool
any :: (HtmlTag -> Bool) -> HtmlTagStack -> Bool
any HtmlTag -> Bool
fn (HtmlTagStack [HtmlTag]
stack) =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.any HtmlTag -> Bool
fn [HtmlTag]
stack

-- | Determine whether the element occurs in the tag stack.
--
-- >>> :set -XOverloadedLists
-- >>> A `Text.Seonbi.Html.TagStack.elem` [A, B, Code]
-- True
-- >>> Em `Text.Seonbi.Html.TagStack.elem` [A, B, Code]
-- False
elem :: HtmlTag -> HtmlTagStack -> Bool
elem :: HtmlTag -> HtmlTagStack -> Bool
elem HtmlTag
tag (HtmlTagStack [HtmlTag]
stack) = HtmlTag
tag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [HtmlTag]
stack