fixgrid.hs

import Text.Read
import Data.Foldable

sampleData =
  [
    ["10", "20", "30"],
    ["0", "1", "aa", "2"],
    ["0", "eheh", "1", "bb", "2"],
    ["2", "really", "bad"],
    ["3", "4", "5"]
  ]

main = processData sampleData

processData grid =
    let res = grid |> parseGrid |> fixGrid |> addOne
    in do printMatrix res
          explainFixes res
          explainBeyondRepair res

(|>) x f = f x       -- our pipeline operator

-- types for reporting errors for single elements of the grid
type Position = (Int, Int)

data Err = Err {
    position :: Position,
    message :: String
} deriving Show

parseElement :: String -> Position -> Either Err Double
parseElement str pos = case readMaybe str of
    Just x -> Right x
    Nothing -> Left (Err pos str)

coords :: [[Position]]
coords = [[(i,j) | j <-[1..]] | i <- [1..]]

parseGrid grid = zipWith (zipWith parseElement) grid coords

--                                unrec error  or  (row of numbers, list of remarks)
fixLine :: [Either Err Double] -> Either String ([Double], [String])
fixLine row = case row of
    Right a : Left e : Right b : rest -> do
        let v = (a+b)/2
        let newMsg = "Fixed a value at " ++ show (position e)
        (goodRest, messages) <- fixLine (Right v : Right b : rest)
        return (a : goodRest, newMsg : messages)
    Right _ : Left e : Left _ : rest -> Left ("Unrecoverable at " ++ show (position e))
    Right a : Right b : rest -> do
        (goodRest, messages) <- fixLine (Right b : rest)
        return (a : goodRest, messages)
    Right a : [] -> Right ([a], [])
    Left e : rest -> Left ("Unrecoverable at " ++ show (position e))

data Res = Res {         -- result of the whole computation
    ok :: Bool,          -- successful?
    matr :: [[Double]],  -- the matrix of numbers
    remarks :: [String]
} deriving Show

fixGrid :: [[Either Err Double]] -> Res
fixGrid grid = loop ([], []) grid where
    loop (matrix, messages) rows = case rows of
        [] -> Res True (reverse matrix) (reverse messages)
        row : rest -> case fixLine row of
                        Right (xs, msgs) -> loop (xs : matrix, msgs ++ messages) rest
                        Left msg -> Res False (reverse matrix) (msg : reverse messages)

addOne :: Res -> Res
addOne (Res o m r) = Res o (map (map (+ 1.0)) m) r

printMatrix :: Res -> IO ()
printMatrix (Res _ matrix _) = forM_ matrix (putStrLn . show)

explainFixes :: Res -> IO ()
explainFixes (Res ok _ messages) =
    -- if !ok the first msg is about beyond repair, skip it here
    let msgs = if ok then messages else drop 1 messages
    in forM_ msgs putStrLn

explainBeyondRepair :: Res -> IO ()
explainBeyondRepair (Res ok _ messages) =
    if ok then return () else putStrLn ("Why failed: " ++ head messages)