module Codec.Tiled.Tileset.IO
  ( TilesetError(..)
  , readFile
  , writeFile
  ) where

import Prelude hiding (readFile, writeFile)

import Control.Exception (Exception, throwIO)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Aeson qualified as Aeson
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.Text (Text)
import Data.Text qualified as Text

import Codec.Tiled.Tileset (Tileset)

newtype TilesetError = TilesetError Text
  deriving (TilesetError -> TilesetError -> Bool
(TilesetError -> TilesetError -> Bool)
-> (TilesetError -> TilesetError -> Bool) -> Eq TilesetError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TilesetError -> TilesetError -> Bool
$c/= :: TilesetError -> TilesetError -> Bool
== :: TilesetError -> TilesetError -> Bool
$c== :: TilesetError -> TilesetError -> Bool
Eq, Int -> TilesetError -> ShowS
[TilesetError] -> ShowS
TilesetError -> String
(Int -> TilesetError -> ShowS)
-> (TilesetError -> String)
-> ([TilesetError] -> ShowS)
-> Show TilesetError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TilesetError] -> ShowS
$cshowList :: [TilesetError] -> ShowS
show :: TilesetError -> String
$cshow :: TilesetError -> String
showsPrec :: Int -> TilesetError -> ShowS
$cshowsPrec :: Int -> TilesetError -> ShowS
Show)

instance Exception TilesetError

readFile :: MonadIO m => FilePath -> m Tileset
readFile :: String -> m Tileset
readFile String
source = IO Tileset -> m Tileset
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ByteString
bytes <- String -> IO ByteString
ByteString.readFile String
source
  case ByteString -> Either String Tileset
decodeMap ByteString
bytes of
    Left String
msg ->
      TilesetError -> IO Tileset
forall e a. Exception e => e -> IO a
throwIO (TilesetError -> IO Tileset) -> TilesetError -> IO Tileset
forall a b. (a -> b) -> a -> b
$ Text -> TilesetError
TilesetError (String -> Text
Text.pack String
msg)
    Right Tileset
res ->
      Tileset -> IO Tileset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tileset
res

decodeMap :: ByteString -> Either String Tileset
decodeMap :: ByteString -> Either String Tileset
decodeMap = ByteString -> Either String Tileset
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'

writeFile :: MonadIO m => FilePath -> Tileset -> m ()
writeFile :: String -> Tileset -> m ()
writeFile String
destination = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Tileset -> IO ()) -> Tileset -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Tileset -> IO ()
forall a. ToJSON a => String -> a -> IO ()
Aeson.encodeFile String
destination