{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
module Composite.Aeson.Refined (refinedJsonFormat) where

import Composite.Aeson (DefaultJsonFormat, defaultJsonFormat, JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor))
import Control.Monad.Error.Class (throwError)
import qualified Data.Aeson.BetterErrors as ABE
import Refined
  ( Predicate, Refined, refine, unrefine
#if MIN_VERSION_refined(0,2,0)
  , displayRefineException
#endif
  )

-- |Given a @'JsonFormat' e a@, produce a @JsonFormat e ('Refined' p a)@ where @p@ is some 'Predicate' from the refined library for @a@.
--
-- This maps to the same JSON as the given 'JsonFormat', but when parsing it will apply 'refine' to assert that the incoming JSON value conforms to the
-- predicate, failing to parse if not.
refinedJsonFormat :: Predicate p a => JsonFormat e a -> JsonFormat e (Refined p a)
refinedJsonFormat :: forall p a e.
Predicate p a =>
JsonFormat e a -> JsonFormat e (Refined p a)
refinedJsonFormat (JsonFormat (JsonProfunctor a -> Value
oa Parse e a
ia)) = forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat forall a b. (a -> b) -> a -> b
$ forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor Refined p a -> Value
o ParseT e Identity (Refined p a)
i
  where
    o :: Refined p a -> Value
o = a -> Value
oa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p x. Refined p x -> x
unrefine
#if MIN_VERSION_refined(0,2,0)
    i :: ParseT e Identity (Refined p a)
i = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {a}. String -> ParseT e Identity a
toss forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefineException -> String
displayRefineException) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p x.
Predicate p x =>
x -> Either RefineException (Refined p x)
refine forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parse e a
ia
#else
    i = either toss pure . refine =<< ia
#endif
    toss :: String -> ParseT e Identity a
toss = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABE.BadSchema [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err. String -> ErrorSpecifics err
ABE.FromAeson

instance (DefaultJsonFormat a, Predicate p a) => DefaultJsonFormat (Refined p a) where
  defaultJsonFormat :: forall e. JsonFormat e (Refined p a)
defaultJsonFormat = forall p a e.
Predicate p a =>
JsonFormat e a -> JsonFormat e (Refined p a)
refinedJsonFormat forall a e. DefaultJsonFormat a => JsonFormat e a
defaultJsonFormat