module Exercise04 where

import Data.Char ( isSpace )
import Data.Bifunctor ( Bifunctor(first, second) )

{-WETT-}
plainText :: Char -> Bool
plainText c = c `notElem` "<>"

tagText :: Char -> Bool
tagText x = x /= '/' && plainText x && not (isSpace x)

xmlLight :: String -> Bool
xmlLight = validXmlStack []

-- returns (tag text, is opening, remaining string)
parseTag :: String -> Maybe (String, Bool, String)
-- first applied to a 3-tuple maps on the second element, ie. (first f) (a, b, c) == (a, f b, c)
-- the take 1 is to avoid (partial) head, a single "/" is handled by the second pattern just fine anyway
parseTag ('/':xs) | take 1 xs /= "/" = parseTag xs >>= Just . first (const False)
parseTag xs = case second (dropWhile isSpace) $ span tagText xs of
        (tt, '>':xs') -> Just (tt, True, xs')
        _ -> Nothing

validXmlStack :: [String] -> String -> Bool
validXmlStack [] xs | all plainText xs = True
validXmlStack tags xs = case dropWhile plainText xs of
    '<':mtt -> case parseTag mtt of
                    Just (tt, True, xs') -> validXmlStack (tt:tags) xs'
                    Just (tt, False, xs') | take 1 tags == pure tt -> validXmlStack (tail tags) xs'
                    _ -> False
    _ -> False

{-TTEW-}

-- not (null tags) && tt == head tags
-- foo :: Eq a => [a] -> a -> Bool
-- foo xs x = take 1 xs == [x]