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