File.hs

{-# LANGUAGE FlexibleContexts #-}
module Utils.File where

import Control.Monad.Error (MonadError, throwError, MonadIO, liftIO)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Binary as Binary
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (dropFileName)
import System.IO (withBinaryFile, IOMode(WriteMode))


writeBinary :: (Binary.Binary a) => FilePath -> a -> IO ()
writeBinary path value =
  do  let dir = dropFileName path
      createDirectoryIfMissing True dir
      withBinaryFile path WriteMode $ \handle ->
          LBS.hPut handle (Binary.encode value)


readBinary :: (Binary.Binary a, MonadError String m, MonadIO m) => FilePath -> m a
readBinary path =
  do  exists <- liftIO (doesFileExist path)
      if exists then decode else throwError (errorNotFound path)
  where
    decode =
      do  bits <- liftIO (LBS.readFile path)
          case Binary.decodeOrFail bits of
            Left _ -> throwError (errorCorrupted path)
            Right (_, _, value) -> return value


errorCorrupted :: FilePath -> String
errorCorrupted filePath =
    concat
    [ "Error reading build artifact ", filePath, "\n"
    , "    The file was generated by a previous build and may be outdated or corrupt.\n"
    , "    Please remove the file and try again."
    ]


errorNotFound :: FilePath -> String
errorNotFound filePath =
    "Unable to find file " ++ filePath ++ " for deserialization!"