content: {-# 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 (Eq, Ord)
  
  instance IsList HtmlTagStack where
      type Item HtmlTagStack = HtmlTag
      fromList = HtmlTagStack . reverse
      toList (HtmlTagStack tags) = reverse tags
  
  instance Show HtmlTagStack where
      show tags = "fromList " ++ show (toList tags)
  
  -- | An empty stack.
  empty :: HtmlTagStack
  empty = HtmlTagStack []
  
  -- | Count the depth of a stack.
  --
  -- >>> :set -XOverloadedLists
  -- >>> depth empty
  -- 0
  -- >>> depth [Div, Article, P, Em]
  -- 4
  depth :: HtmlTagStack -> Int
  depth (HtmlTagStack stack) = Data.List.length 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 []) = Nothing
  last (HtmlTagStack (tag:_)) = Just 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 base) (HtmlTagStack newBase) stack@(HtmlTagStack l)
    | base `isSuffixOf` l = HtmlTagStack $
        take (depth stack - length base) l ++ newBase
    | otherwise = 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 tag (HtmlTagStack tags) =
      HtmlTagStack (tag : 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 tag (HtmlTagStack tags'@(t : ags)) =
      if t == tag
           then HtmlTagStack ags
           else
              let
                  (head', rest) = span (/= tag) tags'
                  tail' = case uncons rest of
                      Just (_, tail'') -> tail''
                      Nothing -> []
              in
                  HtmlTagStack (head' ++ tail')
  pop _ (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 a `descendsFrom` HtmlTagStack b =
      b `isSuffixOf` 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 fn (HtmlTagStack stack) =
      Prelude.any fn 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 tag (HtmlTagStack stack) = tag `Prelude.elem` stack
  