{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Server.Sophisticated.API
  ( app,
    EVENT,
    root,
  )
where

import Control.Monad.Trans (lift)
-- MORPHEUS
import Data.Map (Map)
import qualified Data.Map as M
  ( fromList,
  )
import Data.Morpheus
  ( App,
    deriveApp,
  )
import Data.Morpheus.Document
  ( importGQLDocumentWithNamespace,
  )
import Data.Morpheus.Subscriptions
  ( Event (..),
    Hashable,
  )
import Data.Morpheus.Types
  ( Arg (Arg),
    DecodeScalar (..),
    DefaultValue (..),
    Deprecated (..),
    Describe (..),
    DropNamespace (..),
    EncodeScalar (..),
    GQLType (..),
    ID,
    MUTATION,
    Rename (..),
    Resolver,
    ResolverM,
    ResolverQ,
    ResolverS,
    RootResolver (..),
    ScalarValue (..),
    SubscriptionField,
    TypeGuard (..),
    WithOperation,
    constRes,
    liftEither,
    publish,
    subscribe,
  )
import Data.Set (Set)
import qualified Data.Set as S
  ( fromList,
  )
import Data.Text
  ( Text,
    pack,
  )
import GHC.Generics (Generic)

newtype A a = A {wrappedA :: a}
  deriving (Generic, GQLType)

type AIntText = A (Int, Text)

type AText = A Text

type SetInt = Set Int

type MapTextInt = Map Text Int

importGQLDocumentWithNamespace "src/Server/Sophisticated/shared.gql"

importGQLDocumentWithNamespace "src/Server/Sophisticated/api.gql"

data Animal
  = AnimalCat Cat
  | AnimalDog Dog
  | AnimalBird Bird
  | Giraffe {giraffeName :: Text}
  | UnidentifiedSpecie
  deriving (Show, Generic, GQLType)

data Euro
  = Euro
      Int
      Int
  deriving (Show, Generic)

instance DecodeScalar Euro where
  decodeScalar (Int x) =
    pure
      ( Euro
          (round (fromIntegral x / 100 :: Double))
          (mod x 100)
      )
  decodeScalar _ = Left "Invalid Currency!"

instance EncodeScalar Euro where
  encodeScalar (Euro x y) = Int (x * 100 + y)

data Channel = USER | ADDRESS
  deriving
    ( Show,
      Eq,
      Ord,
      Generic,
      Hashable
    )

newtype Content = Content {contentID :: Int}

type EVENT = Event Channel Content

app :: App EVENT IO
app = deriveApp root

root :: RootResolver IO EVENT Query Mutation Subscription
root =
  RootResolver
    { queryResolver,
      mutationResolver,
      subscriptionResolver
    }
  where
    queryResolver =
      Query
        { queryUser = resolveUser,
          queryAnimal = resolveAnimal,
          querySet = const $ pure $ S.fromList [1, 2, 4],
          querySomeMap = pure $ M.fromList [("Robin", 1), ("carl", 2)],
          queryWrapped1 = constRes $ A (0, "some value"),
          queryWrapped2 = pure $ A "",
          queryFail1 = fail "fail example!!",
          queryFail2 = liftEither alwaysFail,
          queryShared =
            pure
              SharedType
                { sharedTypeName = pure "some name"
                },
          queryTestInterface =
            pure
              [ ResolveInterface
                  ( InterfaceAccount
                      { interfaceAccountName = pure "myName"
                      }
                  ),
                ResolveType (PossibleTypesAccountUser (pure user)),
                ResolveType
                  ( PossibleTypesAccountCompany
                      ( pure
                          Company
                            { companyName =
                                pure "MY Company Name"
                            }
                      )
                  )
              ],
          queryTestInput = pure . pack . show
        }
    -------------------------------------------------------------
    user =
      User
        { userName = pure "Test Name",
          userEmail = pure "Test Mail",
          userAddress = const $ lift (getDBAddress (Content 12)),
          userOffice = constRes Nothing,
          userHome = pure CityIDHH,
          userEntity = pure []
        }
    mutationResolver =
      Mutation
        { mutationCreateUser = resolveCreateUser,
          mutationCreateAddress = resolveCreateAddress,
          mutationSetAddress = resolveSetAddress
        }
    subscriptionResolver =
      Subscription
        { subscriptionNewUser = resolveNewUser,
          subscriptionNewAddress = const resolveNewAddress
        }

-- Resolve QUERY

alwaysFail :: IO (Either String a)
alwaysFail = pure $ Left "fail example"

resolveUser :: ResolverQ EVENT IO User
resolveUser = liftEither (getDBUser (Content 2))

resolveAnimal :: Arg "animal" (Maybe Animal) -> ResolverQ EVENT IO Text
resolveAnimal (Arg animal) =
  pure (pack $ show animal)

-- Resolve MUTATIONS
--
-- Mutation With Event Triggering : sends events to subscription
resolveCreateUser :: ResolverM EVENT IO User
resolveCreateUser = do
  requireAuthorized
  publish [userUpdate]
  liftEither setDBUser

-- Mutation With Event Triggering : sends events to subscription
resolveCreateAddress :: ResolverM EVENT IO Address
resolveCreateAddress = do
  requireAuthorized
  publish [addressUpdate]
  lift setDBAddress

-- Mutation Without Event Triggering
resolveSetAddress :: ResolverM EVENT IO Address
resolveSetAddress = lift setDBAddress

-- Resolve SUBSCRIPTION
resolveNewUser :: SubscriptionField (ResolverS EVENT IO User)
resolveNewUser = subscribe USER $ do
  requireAuthorized
  pure subResolver
  where
    subResolver (Event _ content) = liftEither (getDBUser content)

resolveNewAddress :: SubscriptionField (ResolverS EVENT IO Address)
resolveNewAddress = subscribe ADDRESS $ do
  requireAuthorized
  pure subResolver
  where
    subResolver (Event _ content) = lift (getDBAddress content)

-- Events ----------------------------------------------------------------
addressUpdate :: EVENT
addressUpdate = Event [ADDRESS] (Content {contentID = 10})

userUpdate :: EVENT
userUpdate = Event [USER] (Content {contentID = 12})

-- DB::Getter --------------------------------------------------------------------
getDBAddress :: (WithOperation o) => Content -> IO (Address (Resolver o EVENT IO))
getDBAddress _id = do
  city <- dbText
  street <- dbText
  number <- dbInt
  pure
    Address
      { addressCity = pure city,
        addressStreet = pure street,
        addressHouseNumber = pure number
      }

getDBUser :: (WithOperation o) => Content -> IO (Either String (User (Resolver o EVENT IO)))
getDBUser _ = do
  Person {name, email} <- dbPerson
  pure
    $ Right
      User
        { userName = pure name,
          userEmail = pure email,
          userAddress = const $ lift (getDBAddress (Content 12)),
          userOffice = constRes Nothing,
          userHome = pure CityIDHH,
          userEntity =
            pure
              [ MyUnionAddress
                  ( pure
                      Address
                        { addressCity = pure "City",
                          addressStreet = pure "street",
                          addressHouseNumber = pure 1
                        }
                  ),
                MyUnionUser
                  ( pure
                      User
                        { userName = pure name,
                          userEmail = pure email,
                          userAddress = const $ lift (getDBAddress (Content 12)),
                          userOffice = constRes Nothing,
                          userHome = pure CityIDHH,
                          userEntity = pure []
                        }
                  )
              ]
        }

-- DB::Setter --------------------------------------------------------------------
setDBAddress :: IO (Address (Resolver MUTATION EVENT IO))
setDBAddress = do
  city <- dbText
  street <- dbText
  houseNumber <- dbInt
  pure
    Address
      { addressCity = pure city,
        addressStreet = pure street,
        addressHouseNumber = pure houseNumber
      }

setDBUser :: IO (Either String (User (Resolver MUTATION EVENT IO)))
setDBUser = do
  Person {name, email} <- dbPerson
  pure
    $ Right
    $ User
      { userName = pure name,
        userEmail = pure email,
        userAddress = const $ lift setDBAddress,
        userOffice = constRes Nothing,
        userHome = pure CityIDHH,
        userEntity = pure []
      }

-- DB ----------------------
data Person = Person
  { name :: Text,
    email :: Text
  }

dbText :: IO Text
dbText = pure "Updated Text"

dbInt :: IO Int
dbInt = pure 11

dbPerson :: IO Person
dbPerson = pure Person {name = "George", email = "George@email.com"}

requireAuthorized :: (WithOperation o) => Resolver o e IO ()
requireAuthorized = pure ()
