-- | Internal newtype that we can safely define orphans on
module Calamity.Internal.OverriddenVia (
    OverriddenVia (..),
) where

import Calamity.Internal.ShapeCoerce
import Data.Aeson.Types
import Data.Default.Class
import TextShow

{- | @a@: The type that is to be wrapped
 @b@: The type to convert to and use the instance of
-}
newtype OverriddenVia a b = OverriddenVia {OverriddenVia a b -> a
unOverrideVia :: a}

instance (ShapeCoerce b a, Default b) => Default (OverriddenVia a b) where
    def :: OverriddenVia a b
def = a -> OverriddenVia a b
forall k a (b :: k). a -> OverriddenVia a b
OverriddenVia (a -> OverriddenVia a b) -> a -> OverriddenVia a b
forall a b. (a -> b) -> a -> b
$ (Generic b, Generic a, GShapeCoerce (Rep b) (Rep a)) => b -> a
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @b @a (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
$ b
forall a. Default a => a
def

instance (ShapeCoerce a b, Show b) => Show (OverriddenVia a b) where
    showsPrec :: Int -> OverriddenVia a b -> ShowS
showsPrec Int
d (OverriddenVia a
x) = Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (b -> ShowS) -> b -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b a
x
    show :: OverriddenVia a b -> String
show (OverriddenVia a
x) = b -> String
forall a. Show a => a -> String
show (b -> String) -> b -> String
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b a
x
    showList :: [OverriddenVia a b] -> ShowS
showList [OverriddenVia a b]
xs = [b] -> ShowS
forall a. Show a => [a] -> ShowS
showList ([b] -> ShowS) -> [b] -> ShowS
forall a b. (a -> b) -> a -> b
$ (OverriddenVia a b -> b) -> [OverriddenVia a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia) [OverriddenVia a b]
xs

instance (ShapeCoerce b a, FromJSON b) => FromJSON (OverriddenVia a b) where
    parseJSON :: Value -> Parser (OverriddenVia a b)
parseJSON Value
v = a -> OverriddenVia a b
forall k a (b :: k). a -> OverriddenVia a b
OverriddenVia (a -> OverriddenVia a b) -> (b -> a) -> b -> OverriddenVia a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Generic b, Generic a, GShapeCoerce (Rep b) (Rep a)) => b -> a
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @b @a (b -> OverriddenVia a b) -> Parser b -> Parser (OverriddenVia a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    parseJSONList :: Value -> Parser [OverriddenVia a b]
parseJSONList Value
v = (b -> OverriddenVia a b) -> [b] -> [OverriddenVia a b]
forall a b. (a -> b) -> [a] -> [b]
map (a -> OverriddenVia a b
forall k a (b :: k). a -> OverriddenVia a b
OverriddenVia (a -> OverriddenVia a b) -> (b -> a) -> b -> OverriddenVia a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Generic b, Generic a, GShapeCoerce (Rep b) (Rep a)) => b -> a
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @b @a) ([b] -> [OverriddenVia a b])
-> Parser [b] -> Parser [OverriddenVia a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [b]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList Value
v

instance (ShapeCoerce a b, ToJSON b) => ToJSON (OverriddenVia a b) where
    toJSON :: OverriddenVia a b -> Value
toJSON = b -> Value
forall a. ToJSON a => a -> Value
toJSON (b -> Value)
-> (OverriddenVia a b -> b) -> OverriddenVia a b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia
    toEncoding :: OverriddenVia a b -> Encoding
toEncoding = b -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (b -> Encoding)
-> (OverriddenVia a b -> b) -> OverriddenVia a b -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia

    toJSONList :: [OverriddenVia a b] -> Value
toJSONList = [b] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList ([b] -> Value)
-> ([OverriddenVia a b] -> [b]) -> [OverriddenVia a b] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OverriddenVia a b -> b) -> [OverriddenVia a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia)
    toEncodingList :: [OverriddenVia a b] -> Encoding
toEncodingList = [b] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList ([b] -> Encoding)
-> ([OverriddenVia a b] -> [b]) -> [OverriddenVia a b] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OverriddenVia a b -> b) -> [OverriddenVia a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia)

instance (ShapeCoerce a b, TextShow b) => TextShow (OverriddenVia a b) where
    showb :: OverriddenVia a b -> Builder
showb = b -> Builder
forall a. TextShow a => a -> Builder
showb (b -> Builder)
-> (OverriddenVia a b -> b) -> OverriddenVia a b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) => a -> b
forall a b.
(Generic a, Generic b, GShapeCoerce (Rep a) (Rep b)) =>
a -> b
shapeCoerce @a @b (a -> b) -> (OverriddenVia a b -> a) -> OverriddenVia a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverriddenVia a b -> a
forall a k (b :: k). OverriddenVia a b -> a
unOverrideVia