Problem K

gistfile1.hs

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

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 = parseTab src
     let solved = solveTable (keys table) table
     let lines = map strline (breakLines $ toList solved)
           where strline = (foldl1 (\ l r -> l ++ '\t':r) . map printCell) 
     sequence_ [putStrLn r | r <- lines]

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

printCell :: (TableKey, Cell) -> String
printCell (k, Empty) = ""
printCell (k, Error v) = v
printCell (k, StrConst v) = v
printCell (k, Number v) = show v

splitTab :: String -> [String]
splitTab [] = []
splitTab x = word : case str of
                    ('\t':rest) -> splitTab rest
                    [] -> []
                    _ -> error "Invalid data file"
             where (word, str) = break (== '\t') x

parseHdr :: String -> [Int]
parseHdr h = map read $ splitTab h

parseTab :: String -> Table
parseTab f = let (header:dat) = lines f
                 [ysize, xsize] = parseHdr header
             in enumTable xsize $ checkSize ysize $ map (checkSize xsize . splitTab) dat

checkSize :: Int -> [a] -> [a]
checkSize size row = if length row == size
                     then row
                     else error "Invalid table size"

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

toCellList :: Int -> Int -> Int-> [String] -> [(TableKey, Cell)]
toCellList _ _ _ [] = []
toCellList row col xsize (x:xs)
  | col > xsize = (TableKey (chr(row + 1) : "1"), mkCell x) : toCellList (row + 1) 2 xsize xs
  | otherwise    = (TableKey(chr row : show col), mkCell x) : toCellList row (col + 1) xsize xs

enumTable :: Int -> [[String]] -> Table
enumTable xsize table = fromList (toCellList (ord 'A') 1 xsize $ concat table)

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 expr1 = leftVal
  | otherwise = let (op:rest) = expr1
                    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, expr1) = 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