{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# 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 hiding (writeFile)
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 (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, Typeable)
instance Exception ParseError
parseFile :: (FileFormat a, MonadIO m) => FilePath -> m (Either String a)
parseFile :: forall a (m :: * -> *).
(FileFormat a, MonadIO m) =>
String -> m (Either String a)
parseFile String
filename = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ByteString
s <- String -> IO ByteString
BS.readFile String
filename
#ifdef WITH_ZLIB
let s2 :: ByteString
s2 = if forall s. FoldCase s => s -> CI s
CI.mk (ShowS
takeExtension String
filename) forall a. Eq a => a -> a -> Bool
== CI String
".gz" then
ByteString -> ByteString
GZip.decompress ByteString
s
else
ByteString
s
#else
let s2 = s
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FileFormat a => ByteString -> Either String a
parse ByteString
s2
readFile :: (FileFormat a, MonadIO m) => FilePath -> m a
readFile :: forall a (m :: * -> *). (FileFormat a, MonadIO m) => String -> m a
readFile String
filename = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either String a
ret <- forall a (m :: * -> *).
(FileFormat a, MonadIO m) =>
String -> m (Either String a)
parseFile String
filename
case Either String a
ret of
Left String
msg -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
msg
Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
writeFile :: (FileFormat a, MonadIO m) => FilePath -> a -> m ()
writeFile :: forall a (m :: * -> *).
(FileFormat a, MonadIO m) =>
String -> a -> m ()
writeFile String
filepath a
a = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
filepath IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h (Maybe Int -> BufferMode
BlockBuffering forall a. Maybe a
Nothing)
#ifdef WITH_ZLIB
if forall s. FoldCase s => s -> CI s
CI.mk (ShowS
takeExtension String
filepath) forall a. Eq a => a -> a -> Bool
== CI String
".gz" then do
Handle -> ByteString -> IO ()
BS.hPut Handle
h forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
GZip.compress forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. FileFormat a => a -> Builder
render a
a
else do
Handle -> Builder -> IO ()
hPutBuilder Handle
h (forall a. FileFormat a => a -> Builder
render a
a)
#else
hPutBuilder h (render a)
#endif