{-# 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 = CodeGenOptions -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
CodeGenOptions -> Value -> Parser a
elmStreetParseJsonWith (forall a. Typeable a => CodeGenOptions
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 = Options -> Value -> Parser a
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 = CodeGenOptions -> a -> Value
forall a.
(Generic a, GToJSON Zero (Rep a)) =>
CodeGenOptions -> a -> Value
elmStreetToJsonWith (forall a. Typeable a => CodeGenOptions
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 = Options -> a -> Value
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 = T.unpack . cgoFieldLabelModifier options . T.pack
    , tagSingleConstructors = 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)
_ = CodeGenOptions -> Rep a Any -> ElmDefinition
forall a. CodeGenOptions -> Rep a a -> ElmDefinition
forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
CodeGenOptions -> f a -> ElmDefinition
genericToElmDefinition (forall a. Typeable a => CodeGenOptions
forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions @a)
        (Rep a Any -> ElmDefinition) -> Rep a Any -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
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 a b. (a -> b) -> Parser a -> Parser b
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