-- {-# OPTIONS_GHC -fdefer-type-errors -w #-}
{-# OPTIONS_GHC -Wall #-}
module Language.GraphQL.Reflection (document, schemaDocument) where

import GraphQL.Internal.Name as GraphQL
import GraphQL.Internal.Syntax.AST
import Language.Haskell.Exts.Syntax as Haskell
import qualified Data.Text as Text

import Debug.Trace

document :: QueryDocument -> [Haskell.Decl ()]
document (QueryDocument defs) = fmap definition defs

definition :: Definition -> Haskell.Decl ()
definition = \case
  DefinitionOperation def -> operationDefinition def
  DefinitionFragment def -> fragmentDefinition def

operationDefinition :: OperationDefinition -> Haskell.Decl ()
operationDefinition = \case
  Query n -> node n
  Mutation n -> node n
  AnonymousQuery s -> selectionSet s

node :: Node -> Haskell.Decl ()
node = showDie

selectionSet :: SelectionSet -> Haskell.Decl ()
selectionSet = undefined

fragmentDefinition :: FragmentDefinition -> Haskell.Decl ()
fragmentDefinition = undefined

schemaDocument :: SchemaDocument -> [Haskell.Decl ()]
schemaDocument (SchemaDocument defs) = fmap typeDefinition defs

typeDefinition :: TypeDefinition -> Haskell.Decl ()
typeDefinition = \case
  TypeDefinitionObject x        -> objectTypeDefinition x
  TypeDefinitionInterface x     -> interfaceTypeDefinition x
  TypeDefinitionUnion x         -> unionTypeDefinition x
  TypeDefinitionScalar x        -> scalarTypeDefinition x
  TypeDefinitionEnum x          -> enumTypeDefinition x
  TypeDefinitionInputObject x   -> inputObjectTypeDefinition x
  TypeDefinitionTypeExtension x -> typeExtensionDefinition x

objectTypeDefinition :: ObjectTypeDefinition -> Haskell.Decl ()
objectTypeDefinition (ObjectTypeDefinition nm _interfaces fields)
  = DataDecl () (DataType ()) Nothing (DHead () (Ident () name')) (pure qualConDecl) []
  where
  name' = name nm
  qualConDecl = QualConDecl () Nothing Nothing (RecDecl () (Ident () name') (fmap fieldDefinition fields))

name :: GraphQL.Name -> String
name (Name nm) = Text.unpack nm

fieldDefinition :: FieldDefinition -> FieldDecl ()
fieldDefinition (FieldDefinition nm argumentsDefinition gType)
  = FieldDecl () [Ident () (name nm)] (fieldType argumentsDefinition gType)

fieldType :: [InputValueDefinition] -> GType -> Type ()
fieldType xs gType = foldr (TyFun () . inputValueDefinition) (baseType gType) xs

inputValueDefinition :: InputValueDefinition -> Type ()
inputValueDefinition (InputValueDefinition _name gType _maybeDefaultValue)
  = baseType gType

baseType :: GType -> Type ()
baseType = \case
  TypeNamed nm                      -> maybeOf $ namedType nm
  TypeList (ListType listType)      -> maybeOf $ listOf $ baseType listType
  TypeNonNull gType                 -> nonNullType gType

nonNullType :: NonNullType -> Type ()
nonNullType = \case
  NonNullTypeNamed nm                 -> namedType nm
  NonNullTypeList (ListType listType) -> listOf $ baseType listType

namedType :: NamedType -> Type ()
namedType (NamedType nm) = TyCon () (UnQual () (Ident () (name nm)))

-- FIXME: Given a concrete type `t` it should create the type `[t]`.
listOf :: Type () -> Type ()
listOf = id

-- FIXME: Given a concrete type `t` it should create the type `Maybe t`.
maybeOf :: Type () -> Type ()
maybeOf = id

interfaceTypeDefinition :: InterfaceTypeDefinition -> Haskell.Decl ()
interfaceTypeDefinition (InterfaceTypeDefinition nm fields)
  = DataDecl () (DataType ()) Nothing (DHead () (Ident () name')) (pure qualConDecl) []
  where
  name' = name nm
  qualConDecl = QualConDecl () Nothing Nothing (RecDecl () (Ident () name') (fmap fieldDefinition fields))
-- objectTypeDefinition (ObjectTypeDefinition nm _interfaces fields)
--   = DataDecl () (DataType ()) Nothing (DHead () (Ident () name')) (pure qualConDecl) []
--   where
--   name' = name nm
--   qualConDecl = QualConDecl () Nothing Nothing (RecDecl () (Ident () name') (fmap fieldDefinition fields))

unionTypeDefinition :: UnionTypeDefinition -> Haskell.Decl ()
unionTypeDefinition (UnionTypeDefinition nm xs)
  = DataDecl () (DataType ()) Nothing
    (DHead () (Ident () (name nm)))
    (fmap (unionVariant nm) (zip [0..] xs)) []

unionVariant :: GraphQL.Name -> (Int, NamedType) -> QualConDecl ()
unionVariant nm (n, namedTp) = QualConDecl () Nothing Nothing (ConDecl () (Ident () nm') [namedType namedTp])
  where
  nm' = name nm <> "__" <> show n

-- [QualConDecl () Nothing Nothing (ConDecl () (Ident () "T") [TyCon () (UnQual () (Ident () "Int"))])]

-- UnionTypeDefinition (Name {unName = "ArticleOwner"}) [NamedType (Name {unName = "Group"}),NamedType (Name {unName = "User"})]

-- TODO: Figure out what type the scalar should map to.  Currently we just translate a scalar `R` to:
-- type R = ()
scalarTypeDefinition :: ScalarTypeDefinition -> Haskell.Decl ()
scalarTypeDefinition (ScalarTypeDefinition nm)
  = TypeDecl () (DHead () (Ident () name')) (TyCon () (UnQual () (Ident () "()")))
  where
  name' = name nm

enumTypeDefinition :: EnumTypeDefinition -> Haskell.Decl ()
enumTypeDefinition (EnumTypeDefinition nm xs)
  = DataDecl () (DataType ()) Nothing
    (DHead () (Ident () (name nm)))
    (fmap enumValueDefinition xs) []

-- [QualConDecl () Nothing Nothing (ConDecl () (Ident () "False") []),QualConDecl () Nothing Nothing (ConDecl () (Ident () "True") [])]
enumValueDefinition :: EnumValueDefinition -> QualConDecl ()
enumValueDefinition (EnumValueDefinition nm)
  = QualConDecl () Nothing Nothing (ConDecl () (Ident () (name nm)) [])

-- DataDecl () (DataType ()) Nothing (DHead () (Ident () "Bool")) [QualConDecl () Nothing Nothing (ConDecl () (Ident () "False") []),QualConDecl () Nothing Nothing (ConDecl () (Ident () "True") [])] []

inputObjectTypeDefinition :: InputObjectTypeDefinition -> Haskell.Decl ()
inputObjectTypeDefinition (InputObjectTypeDefinition nm xs)
-- objectTypeDefinition (ObjectTypeDefinition nm _interfaces fields)
  = DataDecl () (DataType ()) Nothing (DHead () (Ident () nm')) (pure qualConDecl) []
  where
  nm' = name nm
  qualConDecl = QualConDecl () Nothing Nothing (RecDecl () (Ident () nm') (fmap step xs))
  step :: InputValueDefinition -> FieldDecl ()
  step (InputValueDefinition fieldName gType _mDefault) = FieldDecl () [Ident () (name fieldName)] (baseType gType)

-- inputValueDefinition :: InputValueDefinition -> ()
-- inputValueDefinition = _

typeExtensionDefinition :: TypeExtensionDefinition -> Haskell.Decl ()
typeExtensionDefinition = showDie

showDie :: Show a => a -> b
showDie a = traceShow a undefined