{-# LANGUAGE DeriveDataTypeable #-}

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

import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Pretty

import           Control.Monad.Trans.Except (runExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
import           Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey)
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           Data.Data (Data)

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
$c== :: JsonDecodeError -> JsonDecodeError -> Bool
== :: JsonDecodeError -> JsonDecodeError -> Bool
$c/= :: JsonDecodeError -> JsonDecodeError -> Bool
/= :: 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
$cshowsPrec :: Int -> JsonDecodeError -> ShowS
showsPrec :: Int -> JsonDecodeError -> ShowS
$cshow :: JsonDecodeError -> String
show :: JsonDecodeError -> String
$cshowList :: [JsonDecodeError] -> ShowS
showList :: [JsonDecodeError] -> ShowS
Show, Typeable JsonDecodeError
Typeable JsonDecodeError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JsonDecodeError)
-> (JsonDecodeError -> Constr)
-> (JsonDecodeError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JsonDecodeError))
-> ((forall b. Data b => b -> b)
    -> JsonDecodeError -> JsonDecodeError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JsonDecodeError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JsonDecodeError -> m JsonDecodeError)
-> Data JsonDecodeError
JsonDecodeError -> Constr
JsonDecodeError -> DataType
(forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonDecodeError -> c JsonDecodeError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonDecodeError
$ctoConstr :: JsonDecodeError -> Constr
toConstr :: JsonDecodeError -> Constr
$cdataTypeOf :: JsonDecodeError -> DataType
dataTypeOf :: JsonDecodeError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonDecodeError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JsonDecodeError)
$cgmapT :: (forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
gmapT :: (forall b. Data b => b -> b) -> JsonDecodeError -> JsonDecodeError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonDecodeError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JsonDecodeError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JsonDecodeError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JsonDecodeError -> m JsonDecodeError
Data)

instance Error JsonDecodeError where
  prettyError :: forall ann. JsonDecodeError -> Doc ann
prettyError (JsonDecodeError String
err) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
err

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

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

deserialiseFromJSON
  :: FromJSON a
  => AsType a
  -> ByteString
  -> Either JsonDecodeError a
deserialiseFromJSON :: forall a.
FromJSON a =>
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 :: forall a.
FromJSON a =>
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 <- String
-> (String -> IO ByteString)
-> ExceptT (FileError JsonDecodeError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT String
path String -> IO ByteString
BS.readFile
    (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 :: forall a. ToJSON a => 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)