Problem K

problemK.hs

import Data.Char
import Data.Map (Map, keys, fromList, toList, adjust)
import qualified Data.Map
import Data.Maybe
import Data.List (intercalate)

data Cell = StrConst String |
            Empty |
            Number Int |
            Expr String |
            Error String
            deriving Show

data TableKey = TableKey String
                deriving (Eq, Ord, Show)

type Table = Map TableKey Cell

main = 
  do src <- readFile "test.dat"
     let table = parseTable src
     let solved = solveTable (keys table) table
     let tablines = printTable solved
     mapM_ putStrLn tablines

printTable :: Table -> [String]
printTable = map strline . breakLines . toList
                 where strline = intercalate "\t" . map printCell
                       printCell :: (TableKey, Cell) -> String
                       printCell (k, Empty) = ""
                       printCell (k, Error v) = v
                       printCell (k, StrConst v) = v
                       printCell (k, Number v) = show v
                       breakLines :: [(TableKey, Cell)] -> [[(TableKey, Cell)]]
                       breakLines [] = []
                       breakLines xs = row : breakLines rows
                                     where rowname (TableKey k) = head k
                                           ourrow = rowname $ fst $ head xs
                                           (row,rows) = span (\ (k,v) -> rowname k == ourrow) xs

parseTable :: String -> Table
parseTable f = let (header:dat) = lines f
                   [ysize, xsize] = map read $ splitTab header
               in enumTable xsize . checkSize ysize $ map (checkSize xsize . splitTab) dat
               where checkSize :: Int -> [a] -> [a]
                     checkSize size row | length row == size = row
                                        | otherwise = error "Invalid table size"
                     splitTab :: String -> [String]
                     splitTab [] = []
                     splitTab x = let (word, rest) = break (== '\t') x
                                  in word : case rest of
                                            ('\t':rest') -> splitTab rest'
                                            [] -> []

mkValue :: String -> Cell
mkValue [] = Empty
mkValue val@(x:xs)
    | x == '\'' = StrConst xs
    | x == '=' = Expr xs
    | all isDigit val = Number $ read val
    | otherwise = error "Value error"

mkKey :: Int -> Int -> TableKey
mkKey xsize index = TableKey (chr row : show col)
                  where col = 1 + index `rem` xsize
                        row = ord 'A' + index `div` xsize

enumTable :: Int -> [[String]] -> Table
enumTable xsize = fromList . zipWith (mkTabCell xsize) [0..] . concat 
                      where mkTabCell xsize idx val = (mkKey xsize idx, mkValue val)

markCycle :: TableKey -> Table -> Table
markCycle = adjust (\ _ -> Error "#CYCLE")

cellMath :: Char -> Int -> Cell -> Cell
cellMath op lval (Number rval) = Number $ math op lval rval
                                 where math '+' = (+)
                                       math '-' = (-)
                                       math '*' = (*)
                                       math '/' = div
cellMath _ _ (Error v) = Error v
cellMath _ _ _ = Error "#RNINT"

solveExpr :: String -> Table -> Cell
solveExpr expr table
  | null expr' = leftVal
  | otherwise = let (op:rest) = expr'
                    func (Number lval) rval = cellMath op lval rval
                    func (Error v) _ = Error v
                    func _ _ = Error "#LNINT"
                in func leftVal . solveExpr rest $ markCycle (TableKey ref) table
  where mathops = "+-*/"
        (ref, expr') = break (`elem` mathops) expr
        leftVal = if all isDigit ref
                  then Number $ read ref
                  else solveCell (TableKey ref) table

solveCell :: TableKey -> Table -> Cell
solveCell key table = func $ Data.Map.lookup key table
                    where func Nothing = Error "#BADREF"
                          func (Just (Expr expr)) = solveExpr expr $ markCycle key table
                          func (Just v) = v

solveTable :: [TableKey] -> Table -> Table
solveTable [] table = table
solveTable (x:xs) table = adjust (\ _ -> solveCell x table) x $ solveTable xs table

test.dat

3	5
12	=C2*A3	3	'Sample	=B5
=A1	=A2*A4	=B4	'Spread	=C5
'Test	4	=A1*4	'Sheet	=A5