languagesandcompilershaskellrefresh.hs

import Data.Char

iunwords :: [String] -> String
iunwords [] = ""
iunwords [x] = x
iunwords (x:y:ys) = x ++ " " ++ iunwords (y:ys)

junwords :: [String] -> String
junwords (x:xs) = foldr func "" (x:xs)
  where
    func l r | length r > 1 = l ++ " " ++ r
             | otherwise = l


iwords :: String -> [String]
iwords [] = []
iwords input@(x:xs) | isSpace x = iwords xs
                    | otherwise = [takeWhile isNotSpace input] ++ iwords (dropWhile isNotSpace input) 
  where
    isSpace c = c == ' '
    isNotSpace c = c /= ' '

fwords :: String -> [String]
-- foldr op e xs
-- foldr op e [] = []
-- foldr op e (x:xs) = x op foldr op e []
fwords xs = foldr func [""] xs
  where
    func l r@(c:cs) | isSpace l && c == "" = r
                    | isSpace l = "" : r 
                    | otherwise = (l : c) : cs
    isSpace c = c == ' '

mfoldl :: (a -> b -> a) -> a -> [b] -> a
mfoldl op e [] = e
mfoldl op e (x:xs) = mfoldl op (e `op` x) xs

naiveconv :: [Int] -> Int
--naiveconv xs = foldr (\l r -> l * 10 + r * 10) 0 xs
naiveconv xs = foldl (\l r -> l * 10 + r) 0 xs

-- assuming the String only contains digits
stringconv :: String -> Int
-- requires import Data.Char
--stringconv xs = naiveconv $ map digitToInt xs
stringconv xs = read xs :: Int

data Tree a = Bin (Tree a) (Tree a)
             | Tip a
  deriving (Show)

information :: Tree a -> [a]
information (Tip a) = [a]
information (Bin l r) = information l ++ information r

pack :: Tree Int -> String
pack (Tip a) = [intToDigit a] 
pack (Bin l r) = "(" ++ pack l ++ "," ++ pack r ++ ")"

unpack :: String -> Tree Int
unpack = undefined

isBin :: Char -> Bool
isBin c = c == '('

isBinClosure :: Char -> Bool
isBinClosure c = c == ')'

isTip :: Char -> Bool
isTip c = not $ isBin c

getToClosure :: String -> String -> Int -> (String, String)
getToClosure ls [] c = (ls, "")
getToClosure ls (x:xs) c | isBin x = getToClosure (ls ++ [x]) xs (c+1)
                         | c == 0 = (ls, (x:xs))
                         | isBinClosure x = getToClosure (ls ++ [x]) xs (c-1)
                         | otherwise = getToClosure (ls ++ [x]) xs c


getLeftRight (x:y:ys) = (fst left, fst right) 
  where
    left | isBin y = getToClosure "" (y:ys) 0
         | otherwise = ([y], ys)
    right | isBin (head (tail(snd left))) = getToClosure "" (tail ( snd left )) 0
          | otherwise = ([(head(tail(snd left)))], (tail(tail (snd left))))

parse :: String -> Tree Int
parse [] = error "Parse error: empty string"
parse (x:xs) | isBin x = parseBin (x:xs)
             | otherwise = parseTip [x]


parseBin :: String -> Tree Int
parseBin (x:xs) = Bin (parse left) (parse right)
  where
    (left, right) = getLeftRight (x:xs)

parseTip :: String -> Tree Int
parseTip (x:xs) = Tip (digitToInt x)