-- | JSON serialisation
--
module Bcc.Api.SerialiseJSON
  ( serialiseToJSON
  , ToJSON(..)
  , ToJSONKey
  , deserialiseFromJSON
  , prettyPrintJSON
  , FromJSON(..)
  , FromJSONKey
  , JsonDecodeError(..)
  , readFileJSON
  , writeFileJSON
  ) where

import           Prelude

import           Control.Monad.Trans.Except (runExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
import           Data.Aeson (FromJSON (..), ToJSON (..), ToJSONKey, FromJSONKey)
import qualified Data.Aeson as Aeson
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS

import           Bcc.Api.Error
import           Bcc.Api.HasTypeProxy


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

instance Error JsonDecodeError where
  displayError :: JsonDecodeError -> String
displayError (JsonDecodeError String
err) = String
err


serialiseToJSON :: ToJSON a => a -> ByteString
serialiseToJSON :: a -> ByteString
serialiseToJSON = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

prettyPrintJSON :: ToJSON a => a -> ByteString
prettyPrintJSON :: a -> ByteString
prettyPrintJSON = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty

deserialiseFromJSON :: FromJSON a
                    => AsType a
                    -> ByteString
                    -> Either JsonDecodeError a
deserialiseFromJSON :: AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON AsType a
_proxy = (String -> Either JsonDecodeError a)
-> (a -> Either JsonDecodeError a)
-> Either String a
-> Either JsonDecodeError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JsonDecodeError -> Either JsonDecodeError a
forall a b. a -> Either a b
Left (JsonDecodeError -> Either JsonDecodeError a)
-> (String -> JsonDecodeError)
-> String
-> Either JsonDecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonDecodeError
JsonDecodeError) a -> Either JsonDecodeError a
forall a b. b -> Either a b
Right
                           (Either String a -> Either JsonDecodeError a)
-> (ByteString -> Either String a)
-> ByteString
-> Either JsonDecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'


readFileJSON :: FromJSON a
             => AsType a
             -> FilePath
             -> IO (Either (FileError JsonDecodeError) a)
readFileJSON :: AsType a -> String -> IO (Either (FileError JsonDecodeError) a)
readFileJSON AsType a
ttoken String
path =
    ExceptT (FileError JsonDecodeError) IO a
-> IO (Either (FileError JsonDecodeError) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError JsonDecodeError) IO a
 -> IO (Either (FileError JsonDecodeError) a))
-> ExceptT (FileError JsonDecodeError) IO a
-> IO (Either (FileError JsonDecodeError) a)
forall a b. (a -> b) -> a -> b
$ do
      ByteString
content <- (IOException -> FileError JsonDecodeError)
-> IO ByteString
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError JsonDecodeError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError JsonDecodeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
path
      (JsonDecodeError -> FileError JsonDecodeError)
-> ExceptT JsonDecodeError IO a
-> ExceptT (FileError JsonDecodeError) IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> JsonDecodeError -> FileError JsonDecodeError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT JsonDecodeError IO a
 -> ExceptT (FileError JsonDecodeError) IO a)
-> ExceptT JsonDecodeError IO a
-> ExceptT (FileError JsonDecodeError) IO a
forall a b. (a -> b) -> a -> b
$ Either JsonDecodeError a -> ExceptT JsonDecodeError IO a
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either JsonDecodeError a -> ExceptT JsonDecodeError IO a)
-> Either JsonDecodeError a -> ExceptT JsonDecodeError IO a
forall a b. (a -> b) -> a -> b
$
        AsType a -> ByteString -> Either JsonDecodeError a
forall a.
FromJSON a =>
AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON AsType a
ttoken ByteString
content

writeFileJSON :: ToJSON a
              => FilePath
              -> a
              -> IO (Either (FileError ()) ())
writeFileJSON :: String -> a -> IO (Either (FileError ()) ())
writeFileJSON String
path a
x =
    ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ()))
-> ExceptT (FileError ()) IO () -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      (IOException -> FileError ())
-> IO () -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
        String -> ByteString -> IO ()
BS.writeFile String
path (a -> ByteString
forall a. ToJSON a => a -> ByteString
serialiseToJSON a
x)