{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-|
Copyright   : (c) 2020-2021 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <adetokunbo@users.noreply.github.com>

Specifies the schema of the data accessed by the demo service.

-}
module TmpProc.Example1.Schema

where

import           Data.Int (Int64)
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Text           (Text)
import qualified Database.Persist.TH as P

type ContactID = Int64

P.share [P.mkPersist P.sqlSettings, P.mkMigrate "migrateAll"] [P.persistLowerCase|
  Contact sql=contacts
    email Text
    name Text
    age Int
    title Text
    UniqueEmail email
    deriving Show Read
|]

instance ToJSON Contact where
  toJSON :: Contact -> Value
toJSON Contact {Text
contactEmail :: Contact -> Text
contactEmail :: Text
contactEmail, Text
contactName :: Contact -> Text
contactName :: Text
contactName, Int
contactAge :: Contact -> Int
contactAge :: Int
contactAge, Text
contactTitle :: Contact -> Text
contactTitle :: Text
contactTitle } = [Pair] -> Value
object
    [ Key
"email" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
contactEmail
    , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
contactName
    , Key
"age" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
contactAge
    , Key
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
contactTitle
    ]

instance FromJSON Contact where
  parseJSON :: Value -> Parser Contact
parseJSON = String -> (Object -> Parser Contact) -> Value -> Parser Contact
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Contact" Object -> Parser Contact
parseContact

parseContact :: Object -> Parser Contact
parseContact :: Object -> Parser Contact
parseContact Object
o = do
  Text
contactName <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
  Text
contactEmail <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
  Int
contactAge <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"age"
  Text
contactTitle <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
  Contact -> Parser Contact
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Contact
    { Text
contactName :: Text
contactName :: Text
contactName
    , Text
contactEmail :: Text
contactEmail :: Text
contactEmail
    , Int
contactAge :: Int
contactAge :: Int
contactAge
    , Text
contactTitle :: Text
contactTitle :: Text
contactTitle
    }