Added declEvaluate function.

This commit is contained in:
Martin Sosic 2021-09-21 19:43:59 +02:00
parent 074529d79c
commit 08eec6f1c7
2 changed files with 35 additions and 31 deletions

View File

@ -81,57 +81,60 @@ makeDeclType typeName = do
let instanceDeclaration = instanceD instanceContext instanceType =<< instanceDefinition
instanceContext = pure []
instanceType = [t|IsDeclType $(conT typeName)|]
instanceDefinition = makeIsDeclTypeInstanceDefinition dataConstructor
instanceDefinition = makeIsDeclTypeInstanceDefinition typeName dataConstructor
sequence [instanceDeclaration]
-- | Top-level "IsDeclType" instance generator.
makeIsDeclTypeInstanceDefinition :: Con -> Q [DecQ]
makeIsDeclTypeInstanceDefinition :: Name -> Con -> Q [DecQ]
-- The constructor is in the form @data Type = Type x@
makeIsDeclTypeInstanceDefinition _dataConstructor@(NormalC name [(_, typ)]) =
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor name typ
makeIsDeclTypeInstanceDefinition typeName _dataConstructor@(NormalC conName [(_, conType)]) =
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor typeName conName conType
-- The constructor is in the form @data Type = Type x1 x2 ... xn@, which is not valid for a decl
makeIsDeclTypeInstanceDefinition _dataConstructor@(NormalC name values) =
makeIsDeclTypeInstanceDefinition typeName _dataConstructor@(NormalC _ values) =
fail $
"makeDeclType expects given type " ++ show name
"makeDeclType expects given type " ++ show typeName
++ " to be a record or to have one data constructor with exactly 1 value, "
++ "but instead it was given a data constructor with "
++ show (length values)
++ "values."
-- The constructor is in the form @data Type = Type { k1 :: f1, ..., kn :: fn }
makeIsDeclTypeInstanceDefinition _dataConstructor@(RecC name records) =
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor name $ map (\(fieldName, _, typ) -> (fieldName, typ)) records
makeIsDeclTypeInstanceDefinition typeName _dataConstructor@(RecC conName records) =
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor typeName conName $
map (\(fieldName, _, fieldType) -> (fieldName, fieldType)) records
-- The constructor is in an unsupported form
makeIsDeclTypeInstanceDefinition _ = fail "makeDeclType expects given type to have a normal or record constructor"
makeIsDeclTypeInstanceDefinition _ _ = fail "makeDeclType expects given type to have a normal or record constructor"
-- | Create an "IsDeclType" instance for types that have a single data constructor which has a single value, e.g. @data Type = Type x@.
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor :: Name -> Type -> Q [DecQ]
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor dataConstructorName dataConstructorType = do
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor :: Name -> Name -> Type -> Q [DecQ]
genIsDeclTypeInstanceDefinitionFromNormalDataConstructor typeName dataConstructorName dataConstructorType = do
let evaluateE = [|runEvaluation $ $(conE dataConstructorName) <$> $(genEvaluationExprForHaskellType dataConstructorType)|]
let bodyTypeE = genWaspTypeFromHaskellType dataConstructorType
pure [genDeclTypeFuncOfIsDeclTypeInstance dataConstructorName bodyTypeE evaluateE]
pure $ genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE
-- | For decls with record constructors, i.e. @data Fields = Fields { a :: String, b :: String }
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor :: Name -> [(Name, Type)] -> Q [DecQ]
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor dataConstructorName fields = do
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor :: Name -> Name -> [(Name, Type)] -> Q [DecQ]
genIsDeclTypeInstanceDefinitionFromRecordDataConstructor typeName dataConstructorName fields = do
(dictEntryTypesE, dictEvaluationE) <- genDictEntryTypesAndEvaluationForRecord dataConstructorName fields
let evaluateE = [|runEvaluation $ dict $dictEvaluationE|]
let bodyTypeE = [|T.DictType $ H.fromList $dictEntryTypesE|]
pure [genDeclTypeFuncOfIsDeclTypeInstance dataConstructorName bodyTypeE evaluateE]
pure $ genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE
-- | Generates 'declType' function for a definition of IsDeclType instance.
-- A helper function for 'genPrimDecl' and 'genRecDecl'.
genDeclTypeFuncOfIsDeclTypeInstance :: Name -> ExpQ -> ExpQ -> DecQ
genDeclTypeFuncOfIsDeclTypeInstance dataConstructorName bodyTypeE evaluateE =
genFunc
'declType
[|
DeclType
{ dtName = $(nameToLowerFirstStringLiteralExpr dataConstructorName),
dtBodyType = $bodyTypeE,
dtEvaluate = \typeDefs bindings declName declBodyExpr ->
makeDecl declName <$> $evaluateE typeDefs bindings declBodyExpr
}
|]
genIsDeclTypeInstanceDefinition :: Name -> Name -> ExpQ -> ExpQ -> [DecQ]
genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE =
[ genFunc
'declType
[|
DeclType
{ dtName = $(nameToLowerFirstStringLiteralExpr dataConstructorName),
dtBodyType = $bodyTypeE,
dtEvaluate = \typeDefs bindings declName declBodyExpr ->
makeDecl @ $(conT typeName) declName <$> declEvaluate typeDefs bindings declBodyExpr
}
|],
genFunc 'declEvaluate evaluateE
]
--------------- Dict ------------------

View File

@ -6,8 +6,10 @@ module Analyzer.TypeDefinitions.Class
)
where
import Analyzer.Evaluator.Bindings (Bindings)
import Analyzer.Evaluator.EvaluationError (EvaluationError)
import Analyzer.TypeDefinitions.Internal (DeclType, EnumType)
import Analyzer.TypeChecker.AST (TypedExpr)
import Analyzer.TypeDefinitions.Internal (DeclType, EnumType, TypeDefinitions)
import Data.Typeable (Typeable)
-- | Marks Haskell type as a representation of a specific Wasp declaration type.
@ -20,9 +22,8 @@ import Data.Typeable (Typeable)
class Typeable a => IsDeclType a where
declType :: DeclType
-- TODO: Implement declEvaluate here? We don't really need it, but that way
-- it would be consistent with IsEnumType below, and if we need it we have it.
-- dtEvaluate would then use declEvaluate.
-- | TODO: comments
declEvaluate :: TypeDefinitions -> Bindings -> TypedExpr -> Either EvaluationError a
-- | Marks Haskell type as a representation of a specific Wasp enum type.
-- Analogous to IsDeclType, but for enums.