{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.ComposableAssociation.Aeson
    ( -- * Quickstart
      -- $quickstart

      -- * Re-Exported Core Types\/Functions\/Lens
      module Data.ComposableAssociation

      -- * Invalid JSON Encoding Exception
    , JsonObjectEncodingException (..)
    ) where


import GHC.TypeLits
import Data.Proxy
import Data.Typeable
import Control.Exception

import qualified Data.Text as T
import Data.Aeson
import Data.Aeson.Types
import qualified Data.HashMap.Lazy as HashMap

import Data.ComposableAssociation


-- | More specific version of @ObjectEncodingException@ to only Aeson encoding issues.
newtype JsonObjectEncodingException = JsonObjectEncodingException Value deriving (Show, Typeable)
instance Exception JsonObjectEncodingException where
  toException = toException . ObjectEncodingException
  fromException x = do
    ObjectEncodingException e <- fromException x
    cast e



instance (ToJSON obj, KnownSymbol key) => ToJSON (Association key obj) where
  toJSON (Association key obj) = object [keyName .= toJSON obj]
    where keyName = T.pack $ symbolVal key

instance (FromJSON obj, KnownSymbol key) => FromJSON (Association key obj) where
  parseJSON = withObject "Association" $ \v' -> Association proxy <$> (v' .:? key .!= Null >>= parseJSON)
      where proxy = Proxy :: Proxy key
            key = T.pack $ symbolVal proxy


-- | Throws a @JsonObjectEncodingException@ if the base value isn't encoded as a JSON object
instance (ToJSON base, ToJSON obj, KnownSymbol key) => ToJSON (base :<> Association key obj) where
  toJSON (base :<> Association key obj) = Object $ HashMap.insert keyName objJson baseJsonMap
    where keyName = T.pack $ symbolVal key
          baseJsonMap = case toJSON base of (Object jsonObjVal) -> jsonObjVal
                                            notAnObject -> throw $ JsonObjectEncodingException notAnObject
          objJson = toJSON obj

instance (FromJSON base, FromJSON obj, KnownSymbol key) => FromJSON (base :<> Association key obj) where
  parseJSON = withObject "base :<> assoc" $ \v' -> (:<>) <$>
                                            parseJSON (Object $ HashMap.delete key v') <*>
                                            fmap (Association proxy) (v' .:? key .!= Null >>= parseJSON)
    where proxy = Proxy :: Proxy key
          key = T.pack $ symbolVal proxy

-- $setup
-- >>> import GHC.Generics

-- $quickstart
-- Assume some example data below:
--
-- >>> data ExampleUser = ExampleUser { name :: String, age :: Int } deriving (Show, Eq, Generic)
-- >>> instance ToJSON ExampleUser
-- >>> instance FromJSON ExampleUser
--
-- >>> let alice = ExampleUser { name = "Alice", age = 25 }
-- >>> encode alice
-- "{\"age\":25,\"name\":\"Alice\"}"
--
-- >>> let messageIds = [102, 305, 410]
-- >>> encode messageIds
-- "[102,305,410]"
--
-- Let's add those messages to the user JSON object without bothering to define another type.
--
-- >>> let aliceWithMessages = alice :<> (asValue messageIds :: Association "messages" [Int])
-- >>> encode aliceWithMessages
-- "{\"age\":25,\"name\":\"Alice\",\"messages\":[102,305,410]}"
--
-- Since "messages" is type (not value) information, we can decode as well.
--
-- >>> decode "{\"age\":25,\"name\":\"Alice\",\"messages\":[102,305,410]}" :: Maybe (ExampleUser :<> Association "messages" [Int])
-- Just (ExampleUser {name = "Alice", age = 25} :<> Association Proxy [102,305,410])
--
-- In the above, "Proxy" is the value of type "messages".
--
-- @Association Proxy a@ has a stand-alone encoding/decoding too
--
-- >>> encode $ Association (Proxy :: Proxy "one-off-key") [1, 2, 3]
-- "{\"one-off-key\":[1,2,3]}"
--
-- >>> decode "{\"one-off-key\":[1,2,3]}" :: Maybe (Association "one-off-key" [Int])
-- Just (Association Proxy [1,2,3])
--
-- These are chainable too!
--
-- >>> :{
-- let manyAssociations :: ExampleUser :<> Association "numbers" [Int] :<> Association "bools" [Bool]
--     manyAssociations = alice :<> asValue [1,2,3] :<> asValue [True, False]
-- in encode manyAssociations
-- :}
-- "{\"age\":25,\"name\":\"Alice\",\"bools\":[true,false],\"numbers\":[1,2,3]}"
--
-- You can build JSON objects from just values!
--
-- >>> :{
-- let allValues :: Association "a-bool" Bool :<> Association "a-string" String :<> Association "an-alice" ExampleUser
--     allValues = asValue True :<> asValue "Hello" :<> asValue alice
-- in encode allValues
-- :}
-- "{\"a-bool\":true,\"an-alice\":{\"age\":25,\"name\":\"Alice\"},\"a-string\":\"Hello\"}"
--
-- Decoding fails if you specify a non-existent key (standard Aeson behavior for failed decoding).
--
-- >>> decode "{\"one-off-key\":[1,2,3]}" :: Maybe (Association "wrong-key" [Int])
-- Nothing
--
-- If you try encoding with a "base" value that is itself not encoded to a JSON object you'll get a runtime exception.
--
-- >>> encode $ True :<> (asValue [1,2,3] :: Association "this-ends-poorly" [Int])
-- "*** Exception: JsonObjectEncodingException (Bool True)
-- >>> encode $ [1,2,3] :<> (asValue "will not work" :: Association "still" String)
-- "*** Exception: JsonObjectEncodingException (Array [Number 1.0,Number 2.0,Number 3.0])
--
-- GHC Extension Note:
--
-- * You'll need @DataKinds@ for this library (type level literals, no getting around this).
--
-- * You'll probably want @TypeOperators@ as well (although you can use @WithAssociation@ instead of @:<>@ to avoid this).
--
-- * You can avoid @PolyKinds@ if you use @asValue True :: Association "key" Bool@ or type inference instead of
-- @Association (Proxy :: Proxy "key") True@.