A.Readme.md

This would need de-MTL'ing.

We have a process that builds up lots and lots of matrices row by row.

• Each matrix has a header which accessed where it's needed via Reader
• We don't want to write to some of the files but not all, because that's probably a bug (ie. we've missed a row in one of the matrices)
• We track the number of lines written in State
• We error out when the lines don't match.

The calling code calls appendAll a bunch of times for different sub-groups of matrices, and then checkFileWritingConsistency after doing all the sub-groups.

CsvMat.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.CsvMat where

import System.Directory
import           Control.Monad.IO.Class
import           Control.Monad.State.Class
import           Control.Monad.Error.Class
import Control.Monad.Reader.Class
import qualified Control.Monad.Trans.Reader as R
import           Control.Monad
import           Data.ByteString.Lazy                  (ByteString)
import qualified Data.ByteString.Lazy                  as BS
import           Data.Csv hiding ((.=))
import qualified Data.Map.Strict                         as M
import Data.Foldable
import Data.Monoid ((<>))
import Data.String (fromString)

appendAll :: (MonadIO m, MonadError FileState m, MonadState FileState m) => Int -> [(FilePath, Record)] -> m ()
appendAll zones xs =
  R.runReaderT (traverse_ (uncurry appendRecord) xs) matTop
  where matTop =
          fold ["* OmniTRANS Ascii Matrix v1.0\n"
               ,"* centroids=" <>
                fromString (show zones) <>
                "\n"]

-- | Add a record to a file
appendRecord :: (ToRecord a, MonadIO m, MonadState FileState m, MonadReader ByteString m) => FilePath -> a -> m ()
appendRecord fp v = writeLineToFile (encode [v]) fp

-- | Check if all files have had the same number of lines written to them
checkFileWritingConsistency :: (MonadState FileState m, MonadError FileState m) => m ()
checkFileWritingConsistency =
  do x <- get
     unless (allConsistent x) $ throwError x

-- assume input is already terminated with a newline
-- TODO: should this delete the file if we haven't written lines?
writeLineToFile :: (MonadState FileState m, MonadIO m, MonadReader ByteString m) => ByteString  -> FilePath -> m ()
writeLineToFile line fp =
  do fileExists <- liftIO $ doesFileExist fp
     unless fileExists $ (liftIO . BS.writeFile fp) =<< ask
     liftIO $ BS.appendFile fp line
     incLinesWritten fp

incLinesWritten :: MonadState FileState m => FilePath -> m ()
incLinesWritten fp = modify (incFileState fp)

type FileState = M.Map FilePath Int

incFileState :: FilePath -> FileState -> FileState
incFileState fp = M.insertWith (+) fp 1

allConsistent :: FileState -> Bool
allConsistent fs = case M.elems fs of
  [] -> True
  x:xs -> all (==x) xs