{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Options used to derive FromJSON/ToJSON instance. These options generally
comply to @elm-street@ rules regarding names.
-}

module Elm.Aeson
       ( elmStreetParseJson
       , elmStreetParseJsonWith
       , elmStreetToJson
       , elmStreetToJsonWith
       , 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)

import Elm.Generic (Elm (..), CodeGenOptions (..), GenericElmDefinition (..), ElmStreetGenericConstraints, defaultCodeGenOptions)

import qualified Data.Text as T
import qualified GHC.Generics as Generic (from)


{- | Allows to create 'Data.Aeson.FromJSON' instance for data types supported by 
@elm-street@. Strips data type name prefix from every field.

__Example:__

The following @JSON@

@
{ \"name\": \"John\"
, \"age\": 42
}
@

is decoded in the following way for each of the specified types:

+-------------------------------+--------------------------+
| Haskell data type             | Parsed type              |
+===============================+==========================+
| @                             | @                        |
| data User = User              | User                     |
|    { userName :: String       |    { userName = \"John\" |
|    , userAge  :: Int          |    , userAge  = 42       |
|    }                          |    }                     |
| @                             | @                        |
+-------------------------------+--------------------------+
|                               |                          |
| @                             | @                        |
| data LongUser = LongUser      | LongUser                 |
|    { luName :: String         |    { luName = \"John\"   |
|    , luAge  :: Int            |    , luAge  = 42         |
|    }                          |    }                     |
| @                             | @                        |
+-------------------------------+--------------------------+
| @                             | @                        |
| data SimpleUser = SimpleUser  | SimpleUser               |
|    { name :: String           |    { name = \"John\"     |
|    , age  :: Int              |    , age  = 42           |
|    }                          |    }                     |
| @                             | @                        |
+-------------------------------+--------------------------+

>>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show)
>>> instance FromJSON User where parseJSON = elmStreetParseJson
>>> decode @User "{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}"
Just (User {userName = "John", userAge = 42})


>>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show)
>>> instance FromJSON VeryLongType where parseJSON = elmStreetParseJson
>>> decode @VeryLongType "{\"age\":42,\"name\":\"John\",\"tag\":\"VeryLongType\"}"
Just (VeryLongType {vltName = "John", vltAge = 42})

-}
elmStreetParseJson
    :: forall a .
       (Typeable a, Generic a, GFromJSON Zero (Rep a))
    => Value
    -> Parser a
elmStreetParseJson :: forall a.
(Typeable a, Generic a, GFromJSON Zero (Rep a)) =>
Value -> Parser a
elmStreetParseJson = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
CodeGenOptions -> Value -> Parser a
elmStreetParseJsonWith (forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions @a)

{- | Use custom 'CodeGenOptions' to customize the behavior of derived FromJSON instance.
-}
elmStreetParseJsonWith
    :: forall a .
       (Generic a, GFromJSON Zero (Rep a))
    => CodeGenOptions
    -> Value
    -> Parser a
elmStreetParseJsonWith :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
CodeGenOptions -> Value -> Parser a
elmStreetParseJsonWith CodeGenOptions
options = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (CodeGenOptions -> Options
elmStreetJsonOptions CodeGenOptions
options)

{- | Allows to create 'Data.Aeson.ToJSON' instance for types supported by @elm-street@.
Strips type name prefix from every record field.

>>> data User = User { userName :: String, userAge :: Int } deriving (Generic, Show)
>>> instance ToJSON User where toJSON = elmStreetToJson
>>> encode $ User { userName = "John", userAge = 42 }
"{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}"

>>> data VeryLongType = VeryLongType { vltName :: String, vltAge :: Int } deriving (Generic, Show)
>>> instance ToJSON VeryLongType where toJSON = elmStreetToJson
>>> encode $ VeryLongType {vltName = "John", vltAge = 42}
"{\"age\":42,\"name\":\"John\",\"tag\":\"VeryLongType\"}"

>>> data User = User { name :: String, age :: Int } deriving (Generic, Show)
>>> instance ToJSON User where toJSON = elmStreetToJson
>>> encode $ User { name = "John", age = 42 }
"{\"age\":42,\"name\":\"John\",\"tag\":\"User\"}"
-}
elmStreetToJson
    :: forall a .
       (Typeable a, Generic a, GToJSON Zero (Rep a))
    => a
    -> Value
elmStreetToJson :: forall a.
(Typeable a, Generic a, GToJSON Zero (Rep a)) =>
a -> Value
elmStreetToJson = forall a.
(Generic a, GToJSON Zero (Rep a)) =>
CodeGenOptions -> a -> Value
elmStreetToJsonWith (forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions @a)

{- | Use custom 'CodeGenOptions' to customize the behavior of derived ToJSON instance.
-}
elmStreetToJsonWith
    :: forall a .
       (Generic a, GToJSON Zero (Rep a))
    => CodeGenOptions
    -> a
    -> Value
elmStreetToJsonWith :: forall a.
(Generic a, GToJSON Zero (Rep a)) =>
CodeGenOptions -> a -> Value
elmStreetToJsonWith CodeGenOptions
options = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (CodeGenOptions -> Options
elmStreetJsonOptions CodeGenOptions
options)

-- | Build @elm-street@ compatible 'Data.Aeson.Options' from 'CodeGenOptions'.
elmStreetJsonOptions :: CodeGenOptions -> Options
elmStreetJsonOptions :: CodeGenOptions -> Options
elmStreetJsonOptions CodeGenOptions
options = Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenOptions -> Text -> Text
cgoFieldLabelModifier CodeGenOptions
options forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    , tagSingleConstructors :: Bool
tagSingleConstructors = Bool
True
    }

{- | Newtype for reusing in @DerivingVia@.

In order to use it with your type @MyType@ add the following deriving to your type:

@
    __deriving__ (Elm, ToJSON, FromJSON) __via__ ElmStreet MyType
@
-}
newtype ElmStreet a = ElmStreet
    { forall a. ElmStreet a -> a
unElmStreet :: a
    }

instance (ElmStreetGenericConstraints a, Typeable a) => Elm (ElmStreet a) where
    toElmDefinition :: Proxy (ElmStreet a) -> ElmDefinition
toElmDefinition Proxy (ElmStreet a)
_ = forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
CodeGenOptions -> f a -> ElmDefinition
genericToElmDefinition (forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions @a)
        forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => a -> Rep a x
Generic.from (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 = forall a.
(Typeable a, Generic a, GToJSON Zero (Rep a)) =>
a -> Value
elmStreetToJson forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> ElmStreet a
ElmStreet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Typeable a, Generic a, GFromJSON Zero (Rep a)) =>
Value -> Parser a
elmStreetParseJson