module Codec.Tiled.Map.IO
  ( MapError(..)
  , 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.Map (Map)

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

instance Exception MapError

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

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

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