{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.FileFormat.Base
-- Copyright   :  (c) Masahiro Sakai 2016-2018
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module ToySolver.FileFormat.Base
  (
  -- * FileFormat class
    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

-- | A type class that abstracts file formats
class FileFormat a where
  -- | Parse a lazy byte string, and either returns error message or a parsed value
  parse :: BS.ByteString -> Either String a

  -- | Encode a value into 'Builder'
  render :: a -> Builder

-- | 'ParseError' represents a parse error and it wraps a error message.
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

-- | Parse a file but returns an error message when parsing fails.
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

-- | Parse a file. Similar to 'parseFile' but this function throws 'ParseError' when parsing fails.
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

-- | Write a value into a file.
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