module Oblig1 where
    --Axel Peter Glede Collett

import Data.Char

data AST = C String | Seq AST AST | Star AST | Plus AST AST deriving (Show)

parse :: String -> AST
parse (x:xs)
    | isDigit x || isLower x = case lookAhead xs of
        "*" -> Star (C [x])
        "+" -> Plus (C [x]) (parse $ tail xs)
        [] -> C [x]
        _ -> Seq (C [x]) $ parse xs

parse ('(':xs) =
    let (inside, rest) = parseParentes xs
    in case lookAhead rest of
        "*" -> Star inside
        "*_" -> Seq (Star inside) (parse $ tail rest)
        "+" -> Plus inside $ parse rest
        [] -> inside
        _ -> Seq inside $ parse rest

parse _ = error "Error: Invalid expression"

parseParentes xs =
    let insideParentes = takeWhile ( /= ')') xs
        rest = tail $ dropWhile ( /= ')') xs
    in (parse insideParentes, rest)

lookAhead :: String -> [Char]
lookAhead [] = []
lookAhead ('*':xs) = if null xs then "*" else "*_"
lookAhead ('+':xs) = "+"
lookAhead (x:xs) = [x]

type Rule = (String, String)
type Rules = [Rule]
type Gr = (String, Rules)
gr :: AST -> Gr
gr ast = gr' ast 0

gr' :: AST -> Int -> Gr
gr' (C a) counter =
    let startSymbol = fresh counter
    in (startSymbol, [(startSymbol, a)])

gr' (Star x) counter =
    let (s, rules)  = gr' x counter
        empty = (s, "")
        r1Rules = filter r1 rules
        newR1Rules = map (\(s,prod) -> (s,prod ++  s)) r1Rules
        r3Rules = filter r3 rules
        newR3Rules = map (\(p, prod) -> (p, s)) r3Rules
    in (s, newR1Rules ++ newR3Rules ++ [empty] ++ rules)

gr' (Seq x y) counter =
    let (xs, xrules) = gr' x counter
        (ys, yrules) = gr' y counter
        r2Rules = filter r2 xrules
        r1Rules = filter r1 xrules
        newR1Rules = map (\(s,prod) -> (s,prod ++ ys)) r1Rules
        r3Rules = filter r3 xrules
        newR3Rules = map (\(s,prod) -> (s, ys)) r3Rules
        r = (ys, r2Rules ++ newR1Rules ++ newR3Rules)

    in (ys, r2Rules ++ newR1Rules ++ newR3Rules)

--gr' (Plus x y) counter =
--    let (xs, xrules) = gr' x counter
--        (xy, yrules) = gr' y counter
--        n =
ex = "(a+b)*dc*"

ex = "(a+b)*dc*"

mem :: String -> String -> Bool
mem s ex =

r1 :: Rule -> Bool
r1 (s, prod) = (length prod == 1) && isLower (head prod)

r2 :: Rule -> Bool
r2 (s, prod) = not (null prod) && (length prod > 1)  && isLower (head prod) && isUpper (prod !! 1)

r3 :: Rule -> Bool
r3 (s, prod) = null prod

r4 :: Rule -> Bool
r4 (s, prod) = not (null prod) && isUpper (head prod)


fresh :: Int -> String
fresh 0 = "S"
fresh counter = "S" ++ show((counter+1))