newtype Stack a = Stk [a] deriving(Show)

-- The follwing Functions are supposed declared in the exams' question (just to make it work)
-- Start top/pop/push/empty

top :: Stack a -> a
top (Stk []) = error "Stack is empty, can't call top function on it!"
top (Stk (x:_)) = x

pop :: Stack a -> Stack a
pop (Stk []) = error "Stack is empty, can't call pop function on it!"
pop (Stk (x:xs)) = Stk xs

push :: a -> Stack a -> Stack a
push x (Stk xs) = Stk (x:xs)

empty :: Stack a -> Bool
empty (Stk []) = True
empty _ = False

-- End  top/pop/push/empty


-- 1) cvider

cvider :: Stack a -> [a]
cvider s | empty s = []
         | otherwise = (top s):(cvider (pop s))

-- 2) vider

vider :: Stack a -> (a -> Bool) -> [a] -> ([a], Stack a)
vider (Stk []) _ _ = ([], (Stk []))
vider s p ys | p $ top s = (ys,pop s)
             | otherwise = let (k,l) = vider (pop s) p ys in ((top s):k, l)

-- 3) transform
-- Algo: http://csis.pace.edu/~wolf/CS122/infix-postfix.htm (the last part; summary)

prio :: Char -> Int
prio '+' = 1
prio '*' = 2
prio '(' = 0

isOperand :: Char -> Bool
isOperand x | x == '+' || x == '*' || x == '(' || x == ')' = False
            | otherwise = True

transform :: [Char] -> [Char]
transform xs = tr' xs (Stk [])

tr' :: [Char] -> Stack Char -> [Char]
tr' [] s = cvider s
tr' (x:xs) s@(Stk []) | isOperand x = x:(tr' xs s)
                      | otherwise = tr' xs (push x s)
tr' (x:xs) s | isOperand x = x:(tr' xs s)
             | x == ')' = let (ys,t) = vider s (== '(') [] in ys ++ (tr' xs t)
             | x == '(' = tr' xs (push '(' s)
             | (prio x) > (prio ts) = tr' xs (push x s)
             | otherwise = ts:(tr' (x:xs) (pop s))
             where ts = top s


-- 4) pe2st (postfix expression to a syntaxic tree)

data AS = E | Node Char AS AS

pe2st :: [Char] -> AS
pe2st = pe2st' . (foldl (flip push) (Stk []))

pe2st' :: Stack Char -> AS
pe2st' s | isOperand ts = Node ts E E
         | otherwise = let (fstST, sndST, _) = squeeze (pop s) in Node ts fstST sndST
         where ts = top s

squeeze :: Stack Char -> (AS, AS, Stack Char) -- Left Squeezed, Right Squeezed, The rest after the squeezing is DONE! // Fuck this function in particular
squeeze s | isOperand ts && isOperand tss = (Node ts E E, Node tss E E, pss)
          | isOperand ts = (Node ts E E, pe2st' ps, Stk [])
          | otherwise = (Node ts sqzFst sqzSnd, pe2st' sqzRest, Stk [])
          where ts = top s
                tss = top ps
                ps = pop s    -- no ts
                pss = pop ps  -- no ts && no tss
                (sqzFst, sqzSnd, sqzRest) = squeeze ps




-- Debugging the correctness of the tree
instance Show AS where
    show E = "E"
    show (Node c s t) = "(" ++ [c] ++ " " ++ show s ++ ", " ++ show t ++ ")"



-- Tests:
--         Test 1) cvider (Stk [1..5])                      => [1,2,3,4,5]
--         Test 2) vider (Stk [1,3,5,4,8,7,10,9]) even []   => ([1,3,5], Stack [8,7,10,9])
--         Test 3) transform "a*(b+c)+d*f"                  => "abc+*df*+"
--         Test 4) pe2st (transform "a*(b+c)+d*f")          => Should give u the correct tree xZ

