parser.hs

import Data.List

data Formula = Atom String | Unary String Formula | Binary String Formula Formula

instance Show Formula where
    show (Atom name) = name
    show (Unary op remaining) = op ++ " " ++ (show remaining)
    show (Binary op left right) = "(" ++ (show left) ++ " " ++ op ++ " " ++ (show right) ++ ")"

unaries = ["-"]
binaries = ["^", "v", "->", "<->"]

data BracketTree = Leaf String | Node [BracketTree]
parseBrackets :: String -> ([BracketTree], String)
parseBrackets (')':string) = ([], string)
parseBrackets ('(':string) = ((Node branch):right, remaining)
    where
        (branch, next) = parseBrackets string
        (right, remaining) = parseBrackets next
parseBrackets (' ':string) = parseBrackets string
parseBrackets string = ((Leaf atom):right, remaining)
    where
        (atom, next) = parseWord string ""
        (right, remaining) = parseBrackets next
        parseWord :: String -> String -> (String, String)
        parseWord (')':string) atom = (atom, ')':string)
        parseWord ('(':string) atom = (atom, '(':string)
        parseWord (' ':string) atom = (atom, string)
        parseWord (char:string) atom = parseWord string (atom ++ [char])

parseFormula :: [BracketTree] -> Formula
parseFormula ((Leaf atom):[]) = parseUnary atom unaries
    where
        parseUnary :: String -> [String] -> Formula
        parseUnary string [] = Atom string
        parseUnary string (op:others) = case stripPrefix op string of
            Nothing -> parseUnary string others
            Just remaining -> Unary op (parseUnary remaining unaries)
parseFormula ((Node elements):[]) = parseBinary [] elements
    where
        parseBinary :: [BracketTree] -> [BracketTree] -> Formula
        parseBinary left ((Leaf name):right)
            | name `elem` binaries  = Binary name (parseFormula left) (parseFormula right)
            | otherwise             = parseBinary (left ++ [(Leaf name)]) right
        parseBinary left (this:right) = parseBinary (left ++ [this]) right
parseFormula ((Leaf op):remaining) = Unary op (parseFormula remaining)

parse :: String -> Formula
parse string = case parseBrackets (string ++ [')']) of
    (nodes, "") -> parseFormula nodes
    (_, remaining) -> error ("to many closing brackets, remaining: " ++ remaining)

main = print $ parse "(x -> -(y v -z))"