{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Elm.Aeson
( elmStreetParseJson
, elmStreetToJson
, elmStreetJsonOptions
, ElmStreet (..)
) where
import Data.Aeson (FromJSON (..), GFromJSON, GToJSON, Options (..), ToJSON (..), Value, Zero,
defaultOptions, genericParseJSON, genericToJSON)
import Data.Aeson.Types (Parser)
import GHC.Generics (Generic, Rep)
import Type.Reflection (Typeable, typeRep)
import Elm.Ast (TypeName (..))
import Elm.Generic (Elm (..), GenericElmDefinition (..), HasLessThanEightUnnamedFields,
HasNoNamedSum, HasNoTypeVars, stripTypeNamePrefix)
import qualified Data.Text as T
import qualified GHC.Generics as Generic (from)
elmStreetParseJson
:: forall a .
(Typeable a, Generic a, GFromJSON Zero (Rep a))
=> Value
-> Parser a
elmStreetParseJson :: Value -> Parser a
elmStreetParseJson = Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Typeable a => Options
forall a. Typeable a => Options
elmStreetJsonOptions @a)
elmStreetToJson
:: forall a .
(Typeable a, Generic a, GToJSON Zero (Rep a))
=> a
-> Value
elmStreetToJson :: a -> Value
elmStreetToJson = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Typeable a => Options
forall a. Typeable a => Options
elmStreetJsonOptions @a)
elmStreetJsonOptions :: forall a . Typeable a => Options
elmStreetJsonOptions :: Options
elmStreetJsonOptions = Options
defaultOptions
{ fieldLabelModifier :: String -> String
fieldLabelModifier = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text -> Text
stripTypeNamePrefix TypeName
typeName (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
, tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True
}
where
typeName :: TypeName
typeName :: TypeName
typeName = Text -> TypeName
TypeName (Text -> TypeName) -> Text -> TypeName
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep a -> String
forall a. Show a => a -> String
show (TypeRep a -> String) -> TypeRep a -> String
forall a b. (a -> b) -> a -> b
$ Typeable a => TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep @a
newtype ElmStreet a = ElmStreet
{ ElmStreet a -> a
unElmStreet :: a
}
instance ( HasNoTypeVars a
, HasLessThanEightUnnamedFields a
, HasNoNamedSum a
, Generic a
, GenericElmDefinition (Rep a)
) => Elm (ElmStreet a) where
toElmDefinition :: Proxy (ElmStreet a) -> ElmDefinition
toElmDefinition Proxy (ElmStreet a)
_ = Rep a Any -> ElmDefinition
forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
f a -> ElmDefinition
genericToElmDefinition
(Rep a Any -> ElmDefinition) -> Rep a Any -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
Generic.from (String -> a
forall a. HasCallStack => String -> a
error String
"Proxy for generic elm was evaluated" :: a)
instance (Typeable a, Generic a, GToJSON Zero (Rep a)) => ToJSON (ElmStreet a) where
toJSON :: ElmStreet a -> Value
toJSON = a -> Value
forall a.
(Typeable a, Generic a, GToJSON Zero (Rep a)) =>
a -> Value
elmStreetToJson (a -> Value) -> (ElmStreet a -> a) -> ElmStreet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElmStreet a -> a
forall a. ElmStreet a -> a
unElmStreet
instance (Typeable a, Generic a, GFromJSON Zero (Rep a)) => FromJSON (ElmStreet a) where
parseJSON :: Value -> Parser (ElmStreet a)
parseJSON = (a -> ElmStreet a) -> Parser a -> Parser (ElmStreet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ElmStreet a
forall a. a -> ElmStreet a
ElmStreet (Parser a -> Parser (ElmStreet a))
-> (Value -> Parser a) -> Value -> Parser (ElmStreet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a.
(Typeable a, Generic a, GFromJSON Zero (Rep a)) =>
Value -> Parser a
elmStreetParseJson