{-# LANGUAGE OverloadedStrings #-}

module Exercise04 where
import qualified Data.Text as T
import Control.Arrow
import Data.Char

{-WETT-}
xmlLight :: String -> Bool
xmlLight str =  ">" `T.count` head ls == 0 && all ((== 1) . T.count ">") ts     -- Rule 4
                && all (T.null . T.filter isSpace) tagTs                        -- Rule 3
                && null (foldl updateStack mempty tagTs)                        -- Rule 1, 6
    where   ls = T.splitOn "<" $ T.pack $ 'a':str 
            ts = tail ls
            tagTs = map (T.stripEnd . T.takeWhile (/= '>')) ts
            updateStack temps a = if not (null temps) && T.head a == '/' && head temps == T.tail a then tail temps else a : temps
{-TTEW-}


{- Solution Progress:

1) INCORRECT 75 Tokens
xmlLight :: String -> Bool
xmlLight str = null resultText
    where   addedPrefix = T.append "a" $ T.pack str
            firstSplit = T.splitOn "<" addedPrefix
            firstFilter = tail firstSplit     -- Remove Text before first Tag (There is alyways a text before it due to the added Prefix)
            onlyTags = map (T.strip . T.takeWhile (/= '>')) firstFilter -- Only Tags left
            -- TODO think about case null ts => head fail
            resultText = foldl (\ts a -> if not (null ts) && T.head a == '/' && head ts == T.tail a then tail ts else a : ts) mempty onlyTags

-----------------------------------------------------------------------------------------------------------------------------------------------

2) INCORRECT 57 Tokens
xmlLight =  null <<< foldl (\ts a -> if not (null ts) && T.head a == '/' && head ts == T.tail a then tail ts else a : ts) mempty
            <<< map (T.strip . T.takeWhile (/= '>')) <<< tail <<< T.splitOn "<" <<< T.append "a" <<< T.pack

-----------------------------------------------------------------------------------------------------------------------------------------------

3) 103 Tokens
xmlLight :: String -> Bool
xmlLight str =  countBack (head ls) == 0 && all ((== 1) . countBack) ts                                                                     -- Rule 4
                && all (T.null . T.filter isSpace) tagTs                                                                                    -- Rule 3
                && null (foldl (\ts a -> if not (null ts) && T.head a == '/' && head ts == T.tail a then tail ts else a : ts) mempty tagTs) -- Rule 1, 6
    where   ls = T.splitOn "<" $ T.pack $ 'a':str 
            h = head ls
            ts = tail ls
            tagTs = map (T.stripEnd . T.takeWhile (/= '>')) ts
            countBack = T.count ">"

-----------------------------------------------------------------------------------------------------------------------------------------------

4) 95 Tokens
xmlLight :: String -> Bool
xmlLight str =  ">" `T.count` head ls == 0 && all ((== 1) . T.count ">") ts                                                                 -- Rule 4
                && all (T.null . T.filter isSpace) tagTs                                                                                    -- Rule 3
                && null (foldl (\ts a -> if not (null ts) && T.head a == '/' && head ts == T.tail a then tail ts else a : ts) mempty tagTs) -- Rule 1, 6
    where   ls = T.splitOn "<" $ T.pack $ 'a':str 
            ts = tail ls
            tagTs = map (T.stripEnd . T.takeWhile (/= '>')) ts

-----------------------------------------------------------------------------------------------------------------------------------------------

5) 94 Tokens
xmlLight :: String -> Bool
xmlLight str =  ">" `T.count` head ls == 0 && all ((== 1) . T.count ">") ts     -- Rule 4
                && all (T.null . T.filter isSpace) tagTs                        -- Rule 3
                && null (foldl updateStack mempty tagTs)                        -- Rule 1, 6
    where   ls = T.splitOn "<" $ T.pack $ 'a':str 
            ts = tail ls
            tagTs = map (T.stripEnd . T.takeWhile (/= '>')) ts
            updateStack temps a = if not (null temps) && T.head a == '/' && head temps == T.tail a then tail temps else a : temps
-}