import Control.Applicative
type Symb = String

infixl 2 :@

data Expr = Var Symb
          | Expr :@ Expr
          | Lam Symb Expr
              deriving Eq

instance Show Expr where
    showsPrec _ = showExpr

showExpr :: Expr -> ShowS
showExpr (Var x)              = \z -> x ++ z
showExpr ((Var x) :@ (Var y)) = showExpr (Var x) . (" " ++) . showExpr (Var y)
showExpr ((Var x) :@ e)       = showExpr (Var x) . (" (" ++) . showExpr (e) . (")" ++)
showExpr (e :@ (Var x))       = ("(" ++) . showExpr (e) . (") " ++) . showExpr (Var x)
showExpr (e1 :@ e2)           = ("(" ++) . showExpr e1 . (")" ++) . (" (" ++) . showExpr e2 . (") "++)
showExpr (Lam x e)            = ("\\" ++) . (x ++) . (" -> " ++) . showExpr e

instance Read Expr where
    readsPrec _ s = filter (\(a, b) -> null b) $ delSpaces <$> (apply exprParser s)

delSpace s = filter (\x -> x /= ' ') s

delSpaces :: (Expr, String) -> (Expr, String)
delSpaces (a, b) = (a, delSpace b)

newtype Parser a = Parser { apply :: String -> [(a, String)] }

instance Functor Parser where
    fmap f p = Parser (\str -> map (\(val, s) -> (f val, s)) (apply p str))

instance Applicative Parser where
    pure x  = Parser $ \s -> [(x, s)]
    p <*> r = Parser (\s -> [(f a, sy) | (f, sx) <- apply p s,
                                         (a, sy) <- apply r sx])

instance Alternative Parser where
    empty   = Parser (const [])
    p <|> r = Parser $ \s -> apply p s ++ apply r s


flex :: String -> (String, String)
flex = head . lex

justCond :: Bool -> a -> Maybe a
justCond f x = if f then Just x else Nothing

exprParser :: Parser Expr
exprParser = parseBrackets <|> preLamParser <|> ((:@) <$> appParser <*> exprParser) <|> appParser <|> varParser

unitParser :: (String -> Maybe String) -> Parser String
unitParser f = Parser (\s -> let flexed = flex s in
    case f (fst flexed) of
        Nothing -> []
        Just x  -> [(x, snd flexed)])

symbParser :: Parser Symb
symbParser = unitParser (\x -> justCond (not (elem x bans)) x) where
    bans = ["(", ")", "->", "\\", ":@", ""]

varParser :: Parser Expr
varParser = Var <$> symbParser

preLamParser :: Parser Expr
preLamParser = (unitParser (\x -> justCond (x == "\\") x)) *> lamParser

lamParser :: Parser Expr
lamParser = (Lam <$> symbParser <* (unitParser (\x -> justCond (x == "->") x)) <*> exprParser)
            <|> (Lam <$> symbParser <*> lamParser)

parseBrackets :: Parser Expr
parseBrackets = (unitParser (\x -> justCond (x == "(") x)) *> exprParser <* (unitParser (\x -> justCond (x == ")") x))

appParser :: Parser Expr
appParser = (:@) <$> (parseBrackets <|> varParser) <*> (parseBrackets <|> varParser)