module Codec.Tiled.Object.Template.IO
  ( TemplateError(..)
  , 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.Object.Template (Template)

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

instance Exception TemplateError

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

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

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