module Composite.Aeson.Base
  ( ToJson(..), FromJson(..), JsonProfunctor(..), _JsonProfunctor, JsonFormat(..)
  , toJsonWithFormat, fromJsonWithFormat, parseJsonWithFormat, parseJsonWithFormat'
  , dimapJsonFormat, jsonFormatWithIso, wrappedJsonFormat
  ) where

import BasicPrelude
import Control.Lens (AnIso', Iso, Wrapped(type Unwrapped), _Wrapped', _Wrapped, iso, over, withIso)
import Control.Lens.TH (makeWrapped)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.BetterErrors as ABE
import Data.Functor.Contravariant (Contravariant, contramap)
import Data.Profunctor (Profunctor(dimap))
import Data.Void (Void)

-- |Type of functions which take a value @a@ and convert it to an 'Aeson.Value'.
--
-- Wrapper around a function of type @a -> Aeson.Value@.
--
-- Doesn't currently include support for the newer Aeson Encoding machinery, but should.
newtype ToJson a = ToJson { unToJson :: a -> Aeson.Value }

instance Contravariant ToJson where
  contramap f (ToJson g) = ToJson (g . f)

-- |Type of parsers which might emit some custom error of type @e@ and produce a value of type @a@ on success.
--
-- @a@ is the type of value that can be parsed from JSON using this profunctor, and @e@ is the type of custom error that can be produced when the JSON is
-- unacceptable. If your parser doesn't produce any custom errors, leave this type polymorphic.
--
-- Wrapper about an @aeson-better-errors@ 'ABE.Parse' @e@ @a@.
newtype FromJson e a = FromJson { unFromJson :: ABE.Parse e a }

deriving instance Functor (FromJson e)

-- |Type of profunctors which produce and consume JSON, a composition of @ToJson@ and @FromJson@.
--
-- @a@ is the type of value that can be converted to 'Aeson.Value' using this profunctor.
-- @b@ is the type of value that can be parsed from JSON using this profunctor, and @e@ is the type of custom error that can be produced when the JSON is
-- unacceptable. If your parser doesn't produce any custom errors, leave this type polymorphic.
--
-- Profunctors must have two type parameters @a@ and @b@ so this type has two, but @JsonProfunctor@s with different types aren't useful for JSON processing
-- directly. See 'JsonFormat' for a wrapper which fixes the two types.
--
-- Doesn't currently include support for the newer Aeson Encoding machinery, but should.
data JsonProfunctor e a b = JsonProfunctor (a -> Aeson.Value) (ABE.Parse e b)

instance Profunctor (JsonProfunctor e) where
  dimap f g (JsonProfunctor o i) = JsonProfunctor (o . f) (g <$> i)

-- |Observe that a 'JsonProfunctor' is isomorphic to a pair with a @ToJson@ and @FromJson@.
_JsonProfunctor :: Iso (JsonProfunctor e a b) (JsonProfunctor e' a' b') (ToJson a, FromJson e b) (ToJson a', FromJson e' b')
_JsonProfunctor =
  iso (\ (JsonProfunctor o i) -> (ToJson o, FromJson i))
      (\ (ToJson o, FromJson i) -> JsonProfunctor o i)

-- |Wrapper around 'JsonProfunctor' for use in JSON processing when the profunctor represents a bijection between JSON and a single type @a@, i.e. for
-- @JsonProfunctor e a a@.
newtype JsonFormat e a = JsonFormat { unJsonFormat :: JsonProfunctor e a a }

-- |Given a 'JsonFormat' for @a@, convert a value of @a@ into an 'Aeson.Value'.
toJsonWithFormat :: JsonFormat e a -> a -> Aeson.Value
toJsonWithFormat (JsonFormat (JsonProfunctor o _)) = o

-- |Given a 'JsonFormat' for @a@ which can produce custom errors of type @e@, yield an @aeson-better-errors@ 'ABE.Parse' which can be used to consume JSON.
fromJsonWithFormat :: JsonFormat e a -> ABE.Parse e a
fromJsonWithFormat (JsonFormat (JsonProfunctor _ i)) = i

-- |Given a 'JsonFormat' for @a@ which produces custom errors of type @e@ and some function to format those errors as messages, produce an Aeson parser function
-- @Value -> Parser a@.
parseJsonWithFormat :: (e -> Text) -> JsonFormat e a -> Aeson.Value -> Aeson.Parser a
parseJsonWithFormat showError = ABE.toAesonParser showError . fromJsonWithFormat

-- |Given a 'JsonFormat' for @a@ which doesn't produce custom errors, produce an Aeson parser function @Value -> Parser a@.
parseJsonWithFormat' :: JsonFormat Void a -> Aeson.Value -> Aeson.Parser a
parseJsonWithFormat' = ABE.toAesonParser' . fromJsonWithFormat

makeWrapped ''ToJson
makeWrapped ''FromJson
makeWrapped ''JsonFormat

-- |Wrap a 'JsonFormat' for type @a@ in a pair of functions representing an isomorphism between @a@ and @b@ to produce a new @JsonFormat@ for @b@.
dimapJsonFormat :: (b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat f g = over _Wrapped (dimap f g)

-- |Wrap a 'JsonFormat' for type @a@ in an isomorphism to produce a new @JsonFormat@ for @b@.
jsonFormatWithIso :: AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso i = withIso i dimapJsonFormat

-- |Given a format for the value type inside some wrapper type @a@ which instances 'Wrapped', produce a format which works on the wrapper type.
wrappedJsonFormat :: Wrapped a => JsonFormat e (Unwrapped a) -> JsonFormat e a
wrappedJsonFormat = jsonFormatWithIso _Wrapped'