{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module ToySolver.FileFormat.Base
(
FileFormat (..)
, ParseError (..)
, parseFile
, readFile
, writeFile
) where
import Prelude hiding (readFile, writeFile)
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Builder
import Data.Typeable
import System.IO hiding (readFile, writeFile)
#ifdef WITH_ZLIB
import qualified Codec.Compression.GZip as GZip
import qualified Data.CaseInsensitive as CI
import System.FilePath
#endif
class FileFormat a where
parse :: BS.ByteString -> Either String a
render :: a -> Builder
data ParseError = ParseError String
deriving (Show, Typeable)
instance Exception ParseError
parseFile :: (FileFormat a, MonadIO m) => FilePath -> m (Either String a)
parseFile filename = liftIO $ do
s <- BS.readFile filename
#ifdef WITH_ZLIB
let s2 = if CI.mk (takeExtension filename) == ".gz" then
GZip.decompress s
else
s
#else
let s2 = s
#endif
return $ parse s2
readFile :: (FileFormat a, MonadIO m) => FilePath -> m a
readFile filename = liftIO $ do
ret <- parseFile filename
case ret of
Left msg -> throwIO $ ParseError msg
Right a -> return a
writeFile :: (FileFormat a, MonadIO m) => FilePath -> a -> m ()
writeFile filepath a = liftIO $ do
withBinaryFile filepath WriteMode $ \h -> do
hSetBuffering h (BlockBuffering Nothing)
#ifdef WITH_ZLIB
if CI.mk (takeExtension filepath) == ".gz" then do
BS.hPut h $ GZip.compress $ toLazyByteString $ render a
else do
hPutBuilder h (render a)
#else
hPutBuilder h (render a)
#endif