{-# OPTIONS_HADDOCK ignore-exports #-}
{-|
Module      : Data.Aeson.Safe
Copyright   : (c) 2019 Felix Paulusma
License     : MIT
Maintainer  : felix.paulusma@gmail.com
Stability   : experimental

This module contains homonyms of the "Data.Aeson" library's
encoding and decoding functions that, instead, use
"Data.SafeJSON"'s conversions.
This way, switching from "Data.Aeson" to "Data.SafeJSON" is
very easy. After any "Data.Aeson" imports, just add @.Safe@.

It also exports "Data.Aeson" and "Data.SafeJSON" itself for
convenience, but still hides 'parseJSON' and 'toJSON' so you
will get errors if you use them anywhere. That way you can
explicitly decide where to switch to 'safeFromJSON' or
'safeToJSON', or keep the current "Data.Aeson" functions.
-}
module Data.Aeson.Safe (
    module Data.SafeJSON
  , module Aeson
  , decode
  , decode'
  , eitherDecode
  , eitherDecode'
  , encode
  , encodeFile

  , decodeStrict
  , decodeStrict'
  , eitherDecodeStrict
  , eitherDecodeStrict'
  , decodeFileStrict
  , decodeFileStrict'
  , eitherDecodeFileStrict
  , eitherDecodeFileStrict'
  , encodeStrict

  , Parser
  , parseEither
  , parseMaybe
  ) where


import Data.Aeson as Aeson hiding (
    decode
  , decode'
  , decodeFileStrict
  , decodeFileStrict'
  , decodeStrict
  , decodeStrict'
  , eitherDecode
  , eitherDecode'
  , eitherDecodeFileStrict
  , eitherDecodeFileStrict'
  , eitherDecodeStrict
  , eitherDecodeStrict'
  , encode
  , encodeFile

  , parseJSON
  , toJSON
  )
import qualified Data.Aeson as A (
    decode
  , decode'
  , decodeFileStrict
  , decodeFileStrict'
  , decodeStrict
  , decodeStrict'
  , eitherDecode
  , eitherDecode'
  , eitherDecodeFileStrict
  , eitherDecodeFileStrict'
  , eitherDecodeStrict
  , eitherDecodeStrict'
  , encode
  , encodeFile
  )
import Data.Aeson.Types (Parser, parseEither, parseMaybe)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.SafeJSON


-- These definitions might not be the most efficient way to
-- encode/decode JSON values (especially not as efficient as
-- Aeson itself), but that can be addressed later if needed.
--
-- Aeson does the majority of the work encoding to and decoding
-- from 'ByteString's anyway.

-- * Decoding and encoding of SafeJSON types

-- ** Lazy ByteString variants

-- | Try to decode a 'LBS.ByteString' to a 'SafeJSON' value.
decode :: SafeJSON a => LBS.ByteString -> Maybe a
decode :: forall a. SafeJSON a => ByteString -> Maybe a
decode ByteString
lbs = forall a. FromJSON a => ByteString -> Maybe a
A.decode ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'LBS.ByteString' to a 'SafeJSON' value.
decode' :: SafeJSON a => LBS.ByteString -> Maybe a
decode' :: forall a. SafeJSON a => ByteString -> Maybe a
decode' ByteString
lbs = forall a. FromJSON a => ByteString -> Maybe a
A.decode' ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'LBS.ByteString' to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecode :: SafeJSON a => LBS.ByteString -> Either String a
eitherDecode :: forall a. SafeJSON a => ByteString -> Either String a
eitherDecode ByteString
lbs = forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'LBS.ByteString' to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecode' :: SafeJSON a => LBS.ByteString -> Either String a
eitherDecode' :: forall a. SafeJSON a => ByteString -> Either String a
eitherDecode' ByteString
lbs = forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Encode a 'SafeJSON' value to a 'LBS.ByteString'.
encode :: SafeJSON a => a -> LBS.ByteString
encode :: forall a. SafeJSON a => a -> ByteString
encode = forall a. ToJSON a => a -> ByteString
A.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeJSON a => a -> Value
safeToJSON

------------------------------------------------------
-- Strict variants
------------------------------------------------------

-- ** Strict ByteString variants

-- | Try to decode a 'BS.ByteString' to a 'SafeJSON' value.
decodeStrict :: SafeJSON a => BS.ByteString -> Maybe a
decodeStrict :: forall a. SafeJSON a => ByteString -> Maybe a
decodeStrict ByteString
lbs = forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'BS.ByteString' to a 'SafeJSON' value.
decodeStrict' :: SafeJSON a => BS.ByteString -> Maybe a
decodeStrict' :: forall a. SafeJSON a => ByteString -> Maybe a
decodeStrict' ByteString
lbs = forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict' ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'BS.ByteString' to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecodeStrict :: SafeJSON a => BS.ByteString -> Either String a
eitherDecodeStrict :: forall a. SafeJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
lbs = forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a 'BS.ByteString' to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecodeStrict' :: SafeJSON a => BS.ByteString -> Either String a
eitherDecodeStrict' :: forall a. SafeJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
lbs = forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict' ByteString
lbs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Same as 'encode', but also calls 'LBS.toStrict', for convenience.
encodeStrict :: SafeJSON a => a -> BS.ByteString
encodeStrict :: forall a. SafeJSON a => a -> ByteString
encodeStrict = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeJSON a => a -> ByteString
encode

-- * Encoding to and decoding from files

-- | Try to decode a file to a 'SafeJSON' value.
decodeFileStrict :: SafeJSON a => FilePath -> IO (Maybe a)
decodeFileStrict :: forall a. SafeJSON a => String -> IO (Maybe a)
decodeFileStrict String
fp = do
    Maybe Value
mVal <- forall a. FromJSON a => String -> IO (Maybe a)
A.decodeFileStrict String
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Value
mVal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a file to a 'SafeJSON' value.
decodeFileStrict' :: SafeJSON a => FilePath -> IO (Maybe a)
decodeFileStrict' :: forall a. SafeJSON a => String -> IO (Maybe a)
decodeFileStrict' String
fp = do
    Maybe Value
mVal <- forall a. FromJSON a => String -> IO (Maybe a)
A.decodeFileStrict' String
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Value
mVal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a file to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecodeFileStrict :: SafeJSON a => FilePath -> IO (Either String a)
eitherDecodeFileStrict :: forall a. SafeJSON a => String -> IO (Either String a)
eitherDecodeFileStrict String
fp = do
    Either String Value
eVal <- forall a. FromJSON a => String -> IO (Either String a)
A.eitherDecodeFileStrict String
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either String Value
eVal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Try to decode a file to a 'SafeJSON' value.
--   Produces an error message on failure.
eitherDecodeFileStrict' :: SafeJSON a => FilePath -> IO (Either String a)
eitherDecodeFileStrict' :: forall a. SafeJSON a => String -> IO (Either String a)
eitherDecodeFileStrict' String
fp = do
    Either String Value
eVal <- forall a. FromJSON a => String -> IO (Either String a)
A.eitherDecodeFileStrict' String
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either String Value
eVal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. SafeJSON a => Value -> Parser a
safeFromJSON

-- | Encode a 'SafeJSON' value to a file.
encodeFile :: SafeJSON a => FilePath -> a -> IO ()
encodeFile :: forall a. SafeJSON a => String -> a -> IO ()
encodeFile String
fp = forall a. ToJSON a => String -> a -> IO ()
A.encodeFile String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeJSON a => a -> Value
safeToJSON