{-# language DeriveGeneric     #-}
{-# language OverloadedStrings #-}
-- | Simple interface for using AutoType inference
--   in other code generators.
--
--   Simply takes a list of Aeson values,
--   and returns a type description.
--
--   For this type description,
--   we can use function to generate an entire new module.
--
--   Note that while we can put more code in the module,
--   it is recommended to avoid multiple automatically
--   generated types in order to avoid name conflicts.
module Data.Aeson.AutoType.Nested(
    defaultImportedModules
  , generateModuleImports
  , inferType
  , CodeFragment
  , TypeName
  , DeclaredType(..)
  ) where

import Data.Aeson
import Data.Aeson.AutoType.CodeGen.Haskell(generateModuleImports, requiredPackages, importedModules)
import Data.Aeson.AutoType.CodeGen.HaskellFormat(displaySplitTypes)
import Data.Aeson.AutoType.Extract(extractType, unifyTypes)
import Data.Aeson.AutoType.Split(splitTypeByLabel)
import Data.Default
import Data.Typeable
import Data.Text(Text)
import GHC.Generics

-- FIXME: general type to compose generated types
-- move to JSON Autotype as library interface?
-- * API Response Structures
type CodeFragment   = Text
type TypeName       = Text
type ImportedModule = Text
type PackageName    = Text

-- | Type declaration and its requirements
--   Content to embed in an autogenerated module:
--   * name of the type to reference
--   * declarations to describe it
--   * module imports necessary for declarations
--     to work
data DeclaredType = DeclaredType
  {
    -- | Code fragment to be inserted in generated module
    DeclaredType -> CodeFragment
typeCodeFragment    ::  CodeFragment
    -- | Toplevel type name to refer to
  , DeclaredType -> CodeFragment
typeName            ::  TypeName
    -- | List of clauses to add to imports list
  , DeclaredType -> [CodeFragment]
typeImportedModules :: [ImportedModule]
    -- | List of packages to add to generated package dependencies
  , DeclaredType -> [CodeFragment]
typePackages        :: [PackageName]
  }
  deriving
    ( DeclaredType -> DeclaredType -> Bool
(DeclaredType -> DeclaredType -> Bool)
-> (DeclaredType -> DeclaredType -> Bool) -> Eq DeclaredType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclaredType -> DeclaredType -> Bool
$c/= :: DeclaredType -> DeclaredType -> Bool
== :: DeclaredType -> DeclaredType -> Bool
$c== :: DeclaredType -> DeclaredType -> Bool
Eq
    , Int -> DeclaredType -> ShowS
[DeclaredType] -> ShowS
DeclaredType -> String
(Int -> DeclaredType -> ShowS)
-> (DeclaredType -> String)
-> ([DeclaredType] -> ShowS)
-> Show DeclaredType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclaredType] -> ShowS
$cshowList :: [DeclaredType] -> ShowS
show :: DeclaredType -> String
$cshow :: DeclaredType -> String
showsPrec :: Int -> DeclaredType -> ShowS
$cshowsPrec :: Int -> DeclaredType -> ShowS
Show
    , (forall x. DeclaredType -> Rep DeclaredType x)
-> (forall x. Rep DeclaredType x -> DeclaredType)
-> Generic DeclaredType
forall x. Rep DeclaredType x -> DeclaredType
forall x. DeclaredType -> Rep DeclaredType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeclaredType x -> DeclaredType
$cfrom :: forall x. DeclaredType -> Rep DeclaredType x
Generic
    , Typeable
    )


instance Default DeclaredType where
  -- Minimal placeholder to use in case we cannot infer proper type
  def :: DeclaredType
def = DeclaredType :: CodeFragment
-> CodeFragment -> [CodeFragment] -> [CodeFragment] -> DeclaredType
DeclaredType {
            typeCodeFragment :: CodeFragment
typeCodeFragment    =  ""
          , typeName :: CodeFragment
typeName            =  "Data.Aeson.Value"
          , typeImportedModules :: [CodeFragment]
typeImportedModules = ["qualified Data.Aeson"]
          , typePackages :: [CodeFragment]
typePackages        = ["aeson"]
          }

-- | List of modules imported for Autotyped declarations
defaultImportedModules :: [CodeFragment]
defaultImportedModules = [CodeFragment]
importedModules

-- | Given intended type name, and a list of
--   text fields with JSON, return
--   either an error, or an `EndpointResponse`
--   that allows to declare and use this type
--   in generated module.
inferType :: Text -> [Value] -> DeclaredType
inferType :: CodeFragment -> [Value] -> DeclaredType
inferType typeName :: CodeFragment
typeName []         = DeclaredType
forall a. Default a => a
def
inferType typeName :: CodeFragment
typeName jsonValues :: [Value]
jsonValues =
    DeclaredType :: CodeFragment
-> CodeFragment -> [CodeFragment] -> [CodeFragment] -> DeclaredType
DeclaredType {
          typeImportedModules :: [CodeFragment]
typeImportedModules = [CodeFragment]
defaultImportedModules
        , typeCodeFragment :: CodeFragment
typeCodeFragment    = Map CodeFragment Type -> CodeFragment
displaySplitTypes Map CodeFragment Type
splitTypeDescriptors
        , typeName :: CodeFragment
typeName            = CodeFragment
typeName
        , typePackages :: [CodeFragment]
typePackages        = [CodeFragment]
requiredPackages
        }
  where
    valueTypes :: [Type]
valueTypes           = (Value -> Type) -> [Value] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Type
extractType [Value]
jsonValues
    -- FIXME: should be <> in Typelike?
    unifiedType :: Type
unifiedType          = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
unifyTypes [Type]
valueTypes
    splitTypeDescriptors :: Map CodeFragment Type
splitTypeDescriptors = CodeFragment -> Type -> Map CodeFragment Type
splitTypeByLabel CodeFragment
typeName Type
unifiedType