{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}

{-|

Module      : MyJson
Description : Decode JSON
Copyright   : © Frank Jung, 2023
License     : GPL-3

Decode JSON which contains special characters like '°' (ASCII decimal \176).

See also [app/Json.hs](app/Json.hs) for an example of how to parse JSON when the
first key is variable. This is common in APIs such as the Alpha Vantage weekly
stock prices. In that case, the first key is the date of that weeks summary data.

== References

I found this a good guide when dealing with JSON and special characters:
<https://guide.aelve.com/haskell/aeson-cookbook-amra6lk6>

-}

module MyJson ( MyJson (..)
              , FromJSON
              , ToJSON
              , eitherDecodeSpecial
              , encodeSpecial
              ) where

import           Data.Aeson                    (FromJSON, ToJSON, Value (..),
                                                eitherDecode, object, parseJSON,
                                                toJSON, (.:), (.=))
import           Data.Aeson.Text               (encodeToLazyText)
import           Data.ByteString.Lazy.Internal (ByteString (..))
import           Data.Text                     (Text)
import           Data.Text.Lazy.Encoding       (decodeLatin1, encodeUtf8)
import           Data.Time.Clock               (UTCTime)
import           GHC.Generics                  (Generic)

-- | Define a test data type.
data MyJson = MyJson
  { MyJson -> Text
name       :: Text
  , MyJson -> Int
identifier :: Int
  , MyJson -> Float
modifier   :: Float
  , MyJson -> UTCTime
created    :: !UTCTime
  , MyJson -> [Int]
series     :: [Int]
  } deriving stock (MyJson -> MyJson -> Bool
(MyJson -> MyJson -> Bool)
-> (MyJson -> MyJson -> Bool) -> Eq MyJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyJson -> MyJson -> Bool
== :: MyJson -> MyJson -> Bool
$c/= :: MyJson -> MyJson -> Bool
/= :: MyJson -> MyJson -> Bool
Eq, Int -> MyJson -> ShowS
[MyJson] -> ShowS
MyJson -> String
(Int -> MyJson -> ShowS)
-> (MyJson -> String) -> ([MyJson] -> ShowS) -> Show MyJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyJson -> ShowS
showsPrec :: Int -> MyJson -> ShowS
$cshow :: MyJson -> String
show :: MyJson -> String
$cshowList :: [MyJson] -> ShowS
showList :: [MyJson] -> ShowS
Show, (forall x. MyJson -> Rep MyJson x)
-> (forall x. Rep MyJson x -> MyJson) -> Generic MyJson
forall x. Rep MyJson x -> MyJson
forall x. MyJson -> Rep MyJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MyJson -> Rep MyJson x
from :: forall x. MyJson -> Rep MyJson x
$cto :: forall x. Rep MyJson x -> MyJson
to :: forall x. Rep MyJson x -> MyJson
Generic)

instance FromJSON MyJson where
  parseJSON :: Value -> Parser MyJson
parseJSON (Object Object
v) =  Text -> Int -> Float -> UTCTime -> [Int] -> MyJson
MyJson
                            (Text -> Int -> Float -> UTCTime -> [Int] -> MyJson)
-> Parser Text
-> Parser (Int -> Float -> UTCTime -> [Int] -> MyJson)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                            Parser (Int -> Float -> UTCTime -> [Int] -> MyJson)
-> Parser Int -> Parser (Float -> UTCTime -> [Int] -> MyJson)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier"
                            Parser (Float -> UTCTime -> [Int] -> MyJson)
-> Parser Float -> Parser (UTCTime -> [Int] -> MyJson)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modifier"
                            Parser (UTCTime -> [Int] -> MyJson)
-> Parser UTCTime -> Parser ([Int] -> MyJson)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created"
                            Parser ([Int] -> MyJson) -> Parser [Int] -> Parser MyJson
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Int]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"series"
  parseJSON Value
_          = String -> Parser MyJson
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected an object"

instance ToJSON MyJson where
  toJSON :: MyJson -> Value
toJSON (MyJson Text
_name Int
_identifier Float
_modifier UTCTime
_created [Int]
_series) = [Pair] -> Value
object
    [ Key
"name"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_name
    , Key
"identifier" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
_identifier
    , Key
"modifier"   Key -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Float
_modifier
    , Key
"created"    Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UTCTime
_created
    , Key
"series"     Key -> [Int] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Int]
_series
    ]

-- | Decode Special Characters.
--
-- Where:
--
-- @
-- Data.Text.Lazy.Encoding.decodeLatin1 :: ByteString -> Text
-- Data.Text.Lazy.Encoding.encodeUtf8 :: Text -> ByteString
-- Data.Aeson.eitherDecode :: ByteString -> Either String a
-- @
--
-- This will successfully decode a ByteString containing special characters such
-- as '°' (ASCII decimal \176).
eitherDecodeSpecial :: FromJSON a => ByteString -> Either String a
eitherDecodeSpecial :: forall a. FromJSON a => ByteString -> Either String a
eitherDecodeSpecial = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String a)
-> (ByteString -> ByteString) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (ByteString -> Text) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1

-- | Encode Special Characters.
--
-- Where:
--
-- @
-- Data.Aeson.Text.encodeToLazyText :: ToJSON a => a -> Text
-- Data.Text.Lazy.Encoding.encodeUtf8 :: Text -> ByteString
-- @
--
encodeSpecial :: ToJSON a => a -> ByteString
encodeSpecial :: forall a. ToJSON a => a -> ByteString
encodeSpecial = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText