Added support for custom evaluation to Analyzer. (#375)

waspc/package.yaml

@@ -141,3 +141,4 @@ tests:
       - path
       - unordered-containers
       - strong-path
+      - split

waspc/src/Wasp/Analyzer/Evaluator/Evaluation.hs

@@ -30,9 +30,11 @@
 -- @Page { title = "Home", author = Nothing, content = "Hello world" }@
 module Wasp.Analyzer.Evaluator.Evaluation
   ( runEvaluation,
+    evaluation,
+    evaluation',
     module Wasp.Analyzer.Evaluator.Evaluation.Combinators,
   )
 where
 
 import Wasp.Analyzer.Evaluator.Evaluation.Combinators
-import Wasp.Analyzer.Evaluator.Evaluation.Internal (runEvaluation)
+import Wasp.Analyzer.Evaluator.Evaluation.Internal (evaluation, evaluation', runEvaluation)

waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs

@@ -1,10 +1,11 @@
 module Wasp.Analyzer.Evaluator.EvaluationError
   ( EvaluationError (..),
     EvaluationErrorContext (..),
+    EvaluationParseError (..),
   )
 where
 
-import Text.Parsec (ParseError)
+import qualified Text.Parsec
 import Wasp.Analyzer.Type (Type)
 
 data EvaluationError
@@ -20,9 +21,10 @@ data EvaluationError
     InvalidEnumVariant String String
   | -- | "MissingField fieldName"
     MissingField String
-  | -- | In case when evaluation includes parsing with Parsec and it fails.
-    ParseError ParseError
-  | WithContext EvaluationErrorContext EvaluationError
+  | -- | In case when evaluation includes parsing and it fails.
+    ParseError EvaluationParseError
+  | -- | Not an actual error, but a wrapper that provides additional context.
+    WithContext EvaluationErrorContext EvaluationError
   deriving (Show, Eq)
 
 data EvaluationErrorContext
@@ -32,3 +34,10 @@ data EvaluationErrorContext
   | -- | ForVariable varName
     ForVariable String
   deriving (Show, Eq)
+
+data EvaluationParseError
+  = -- | In case when evaluation includes parsing with Parsec and it fails.
+    EvaluationParseErrorParsec Text.Parsec.ParseError
+  | -- | In case when evaluation does some general parsing and it fails.
+    EvaluationParseError String
+  deriving (Show, Eq)

waspc/src/Wasp/Analyzer/StdTypeDefinitions/Entity.hs

@@ -5,7 +5,7 @@ module Wasp.Analyzer.StdTypeDefinitions.Entity () where
 
 import Control.Arrow (left)
 import qualified Text.Parsec as Parsec
-import qualified Wasp.Analyzer.Evaluator.EvaluationError as EvaluationError
+import qualified Wasp.Analyzer.Evaluator.EvaluationError as ER
 import qualified Wasp.Analyzer.Type as Type
 import qualified Wasp.Analyzer.TypeChecker.AST as TC.AST
 import Wasp.Analyzer.TypeDefinitions (DeclType (..), IsDeclType (..))
@@ -24,6 +24,6 @@ instance IsDeclType Entity where
 
   declEvaluate _ _ expr = case expr of
     TC.AST.PSL pslString ->
-      left EvaluationError.ParseError $
+      left (ER.ParseError . ER.EvaluationParseErrorParsec) $
         makeEntity <$> Parsec.parse Wasp.Psl.Parser.Model.body "" pslString
-    _ -> Left $ EvaluationError.ExpectedType (Type.QuoterType "psl") (TC.AST.exprType expr)
+    _ -> Left $ ER.ExpectedType (Type.QuoterType "psl") (TC.AST.exprType expr)

waspc/src/Wasp/Analyzer/TypeDefinitions.hs

@@ -19,7 +19,8 @@ module Wasp.Analyzer.TypeDefinitions
 where
 
 import qualified Data.HashMap.Strict as M
-import Wasp.Analyzer.TypeDefinitions.Class
+import Wasp.Analyzer.TypeDefinitions.Class.IsDeclType
+import Wasp.Analyzer.TypeDefinitions.Class.IsEnumType
 import Wasp.Analyzer.TypeDefinitions.Internal
 
 empty :: TypeDefinitions

waspc/src/Wasp/Analyzer/TypeDefinitions/Class/HasCustomEvaluation.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Wasp.Analyzer.TypeDefinitions.Class.HasCustomEvaluation
+  ( HasCustomEvaluation (..),
+  )
+where
+
+import Data.Typeable (Typeable)
+import Wasp.Analyzer.Evaluator.Evaluation.TypedExpr (TypedExprEvaluation)
+import Wasp.Analyzer.Type (Type)
+
+-- | For a Haskell type @a@, provides its Wasp @Type@ (via @waspType@ function)
+-- | and its @Evaluation@ (via @evaluation@ function) that evaluates from
+-- | @waspType@ into @a@.
+-- | This class can be useful when using @makeDeclType@, since @makeDeclType@ checks
+-- | for types with this class and if they have it, it uses their custom evaluation
+-- | instead of trying to figure out their evaluation on its own.
+class (Typeable a) => HasCustomEvaluation a where
+  waspType :: Type
+  evaluation :: TypedExprEvaluation a

waspc/src/Wasp/Analyzer/TypeDefinitions/Class/IsDeclType.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 
-module Wasp.Analyzer.TypeDefinitions.Class
+module Wasp.Analyzer.TypeDefinitions.Class.IsDeclType
   ( IsDeclType (..),
-    IsEnumType (..),
   )
 where
 
@@ -10,52 +9,42 @@ import Data.Typeable (Typeable)
 import Wasp.Analyzer.Evaluator.Bindings (Bindings)
 import Wasp.Analyzer.Evaluator.EvaluationError (EvaluationError)
 import Wasp.Analyzer.TypeChecker.AST (TypedExpr)
-import Wasp.Analyzer.TypeDefinitions.Internal (DeclType, EnumType, TypeDefinitions)
+import Wasp.Analyzer.TypeDefinitions.Internal (DeclType, TypeDefinitions)
 import qualified Wasp.AppSpec.Core.Decl as AppSpecDecl
 
 -- | Marks Haskell type as a representation of a specific Wasp declaration type.
--- This is supposed to be used on types from Wasp AST (the IR between Analyzer and Generator)
+-- This is supposed to be used on types from @AppSpec@ (the main Wasp IR)
 -- in order to enrich them with information on how are they to be analyzed
 -- (and therefore make them part of the Wasp language).
 --
+-- To put it very practically, if you make a Haskell type (usually from @AppSpec@)
+-- an instance of this class, and if you add it to "Wasp.Analyzer.StdTypeDefinitions",
+-- you are telling Analyzer that there is a new declaration type in Wasp language with
+-- name, Wasp type and evaluation from that Wasp type into Haskell type as specified
+-- by this instance, and therefore you just added a new declaration type to the
+-- Wasp language and Analyzer will include it in the final result it produces.
+--
 -- NOTE: If this Haskell type satisfies certain requirements, the IsDeclType instance for it
--- can be automatically derived from its shape by using 'Analyzer.Evaluator.TH.makeDeclType'.
+-- can be automatically derived from its shape by using
+-- 'Wasp.Analyzer.TypeDefinitions.TH.makeDeclType'.
 class (Typeable a, AppSpecDecl.IsDecl a) => IsDeclType a where
   declType :: DeclType
 
-  -- | Evaluates a given Wasp "TypedExpr" to a value of this type, assuming it is of
-  -- declaration type described by (dtBodyType . declType) and (dtName . declType) (otherwise throws an error).
+  -- | Evaluates a given Wasp "TypedExpr" to a value of type @a@, assuming given
+  -- typed expression is of declaration type described by @dtBodyType . declType@
+  -- and @dtName . declType@ (otherwise throws an error).
   --
   -- For @declEvaluate typeDefs bindings declBodyExpr@:
   -- - "typeDefs" is the type definitions used in the Analyzer
   -- - "bindings" contains the values of all the declarations evaluated so far
-  -- - "declBodyExpr" is the expression describing declaration body, that should be evaluated by this function
+  -- - "declBodyExpr" is the expression describing declaration body,
+  --   that should be evaluated by this function
   --
   -- __Examples__
   --
   -- Imagine that we have Wasp code @test Example 4@, and we have @instance IsDeclType Test@.
-  -- Here, @test@ is declaration type name, @Example@ is declaration name, and @4@ is declaration body.
+  -- Here, @test@ is declaration type name, @Example@ is declaration name,
+  -- and @4@ is declaration body.
   -- @declEvaluate@ function would then be called somewhat like:
   -- @declEvaluate @Test typeDefs bindings (NumberLiteral 4)@
   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.
---
--- NOTE: If this Haskell type satisfies certain requirements, the IsEnumType instance for it
--- can be automatically derived from its shape by using 'Analyzer.Evaluator.TH.makeEnumType'.
-class Typeable a => IsEnumType a where
-  enumType :: EnumType
-
-  -- | Converts a string to a Haskell value of this type.
-  --
-  -- @mapM_ enumEvaluate (etVariants enumType) == Right ()@ should be true
-  -- for all instances of "IsEnumType".
-  --
-  -- __Examples__
-  --
-  -- >>> data Example = Foo | Bar
-  -- >>> instance IsEnumType Example where {- omitted -}
-  -- >>> enumEvaluate "Foo"
-  -- Foo
-  enumEvaluate :: String -> Either EvaluationError a

waspc/src/Wasp/Analyzer/TypeDefinitions/Class/IsEnumType.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Wasp.Analyzer.TypeDefinitions.Class.IsEnumType
+  ( IsEnumType (..),
+  )
+where
+
+import Data.Typeable (Typeable)
+import Wasp.Analyzer.Evaluator.EvaluationError (EvaluationError)
+import Wasp.Analyzer.TypeDefinitions.Internal (EnumType)
+
+-- | Marks Haskell type as a representation of a specific Wasp enum type.
+-- Analogous to IsDeclType, but for enums.
+--
+-- NOTE: If this Haskell type satisfies certain requirements, the IsEnumType instance for it
+-- can be automatically derived from its shape by using 'Analyzer.Evaluator.TH.makeEnumType'.
+class Typeable a => IsEnumType a where
+  enumType :: EnumType
+
+  -- | Converts a string to a Haskell value of this type.
+  --
+  -- @mapM_ enumEvaluate (etVariants enumType) == Right ()@ should be true
+  -- for all instances of "IsEnumType".
+  --
+  -- __Examples__
+  --
+  -- >>> data Example = Foo | Bar
+  -- >>> instance IsEnumType Example where {- omitted -}
+  -- >>> enumEvaluate "Foo"
+  -- Foo
+  enumEvaluate :: String -> Either EvaluationError a

waspc/src/Wasp/Analyzer/TypeDefinitions/TH/Decl.hs

@@ -11,37 +11,89 @@ import Control.Applicative ((<|>))
 import qualified Data.HashMap.Strict as H
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (VarBangType)
-import Wasp.Analyzer.Evaluator.Evaluation
+import qualified Wasp.Analyzer.Evaluator.Evaluation as E
 import qualified Wasp.Analyzer.Type as T
 import Wasp.Analyzer.TypeDefinitions (DeclType (..), EnumType (..), IsDeclType (..), IsEnumType (..))
+import Wasp.Analyzer.TypeDefinitions.Class.HasCustomEvaluation (HasCustomEvaluation)
+import qualified Wasp.Analyzer.TypeDefinitions.Class.HasCustomEvaluation as HasCustomEvaluation
 import Wasp.Analyzer.TypeDefinitions.TH.Common
 import Wasp.AppSpec.Core.Decl (makeDecl)
 import Wasp.AppSpec.Core.Ref (Ref)
 import qualified Wasp.AppSpec.ExtImport as AppSpec.ExtImport
 import qualified Wasp.AppSpec.JSON as AppSpec.JSON
 
--- | @makeDeclType ''Type@ writes an @IsDeclType@ instance for @Type@. A type
--- error is raised if @Type@ does not fit the criteria described below.
+-- | @makeDeclType ''T@ generates an @IsDeclType@ instance for Haskell type @T@.
+-- A type error is raised if @T@ does not fit the criteria described below, which are
+-- required for @makeDeclType@ to be able to automatically generate @IsDeclType@
+-- instance for a type @T@.
 --
--- Requirements on @Type@ for this to work:
---  - The type must be an ADT with one constructor.
---  - The type must have just one field OR use record syntax (in which case it can have multiple fields).
+-- Requirements on the shape of type @T@ for this to work:
+--   - type @T@ must be an ADT with one constructor, which must have
+--     just one field OR use record syntax (in which case it can have multiple record fields).
+--   - type @T@ must have no type parameters.
+-- Therefore, some valid types based on this would be:
+--   - `data T = Foo String`
+--   - `data T = Foo { a :: String, b :: Int }`
+-- while some invalid types would be:
+--   - `data T = Foo String | Bar Int`
+--   - `data T = Foo String Int`
+--   - `data T a = Foo a`
 --
--- Properties that hold for @Type@ and its generated @IsDeclType@ instance:
---   - For the rest of the bullet points below, let's say that
---     @let bodyType = dtBodyType (declType \@Type)@.
---   - If @Type@ uses record syntax, then
---     - @bodyType@ is a @Dict@
---     - If and only if there is a key @x@ in @bodyType@,
---       then @Type@ has a record @x@ with the same type.
---     - If a key @x@ is optional, then the record @x@ in @Type@ is a @Maybe@.
---   - If @Type@ is a simple ADT (not record) with one field, then @bodyType@ maps to the type of that field.
---   - @dtName (declType \@Type) == "type"@ -> the name of declaration type is the same as the name of @Type@
---     but with the first letter changed to lowercase.
+-- Further, there are requirements/limitations as to which types can @T@ contain in itself
+-- (be it as a type of the record field or as a type of the data constructor field).
+-- They can be:
+--   - Primitive: @String@, @Integer@, @Double@, @Bool@.
+--   - @[a]@ where @a@ is an accepted type itself.
+--   - @Maybe a@ (but only as a type of a record field) where @a@ is an accepted type itself.
+--   - A few special types from AppSpec:
+--     - 'Wasp.AppSpec.ExtImport.ExtImport'
+--     - 'Wasp.AppSpec.JSON.JSON'
+--     - @Wasp.AppSpec.Core.Ref a@ where @a@ is an instance of @IsDeclType@.
+--   - A type that implements an @IsEnumType@ instance.
+--   - A type with just one data constructor that is a record, and whose record field types
+--     are all accepted types.
+--   - A type that implements a @HasCustomEvaluation@ instance.
+-- Place in implementation that is a source of truth for this is 'waspKindOfHaskellType'.
+--
+-- If all of the above requirements are met, @IsDeclType@ instance is generated.
+-- Main parts of that instance are Wasp type ('Wasp.Analyzer.Type.Type')
+-- of the declaration body (referred to as @WT@ from now on) and the evaluator
+-- that evalutes from that Wasp type @WT@ into Haskell type @T@.
+-- We can also describe @WT@ with @let WT = dtBodyType (declType \@T)@.
+-- For the user of @makeDeclType@, it is important to understand how
+-- @makeDeclType@ determines @WT@ based on the @T@, since @WT@ then determines
+-- how will this new declaration type (that we described with @T@) manifest
+-- in the Wasp language itself.
+--
+-- @WT@ is determined based on @T@ in the following manner:
+--   - If @T@ is a record, then @WT@ is a @Dict@ with the same field keys as @T@ has,
+--     and field types are determined as described below. recursively in this same manner.
+--     Only exception is if type of field in record @T@ is @Maybe a@ -> in that case
+--     type of corresponding field in @Dict@ @WT@ is determined from @a@ but field is
+--     marked as optional (otherwise it is required).
+--   - If @T@ is a simple ADT (not record) with just one field, then @WT@ is determined
+--     directly from the type of that one field.
+--   - When determining how types of fields (in record or in simple ADT) from @T@ map
+--     to parts of @WT@, following approach is used:
+--       - Primitives, list, ExtImport, JSON, enum, decl ref -> all those are pretty
+--         straight-forwardly mapped onto corresponding types from `Wasp.Analyzer.Type`.
+--       - Type of record field in @T@ maps to required field in @WT@ @Dict@ of
+--         type that maps per rules mentioned above/below.
+--         Only exception is if type of field in record @T@ is @Maybe a@ -> in that case
+--         type of corresponding field in @Dict@ @WT@ is determined from @a@ but field is
+--         marked as optional (otherwise it is required).
+--       - If type of field is a record itself, then it is maped in a same way as
+--         @T@ would be mapped -> as a @Dict@ with the same fields as the record.
+--         Therefore this results in nested dictionaries.
+--       - For types that have an instance of @HasCustomEvaluation@,
+--         its @waspType@ method is directly used to obtain the Wasp type.
+--         This allows us to take control over how Wasp type is determined for this specific
+--         sub-part of @T@.
+--
+-- Finally, it is important to mention that name of the declaration type is the same
+-- as the name of @T@ but with first letter changed to lowercase:
+-- @dtName (declType \@MyType) == "myType"@
 --
--- One way to summarize the crux of properties above is to say: If given @Type@ is a simple ADT with one field,
--- it is translated into a declaration which has body corresponding to that field. If instead @Type@
--- is a record, it is translated into a declaration whose body is a dictionary with same fields as the record.
 --
 -- __Examples__
 --
@@ -110,18 +162,19 @@ makeIsDeclTypeInstanceDefinition _ _ = fail "makeDeclType expects given type to
 recordFieldsToNameTypePairs :: [VarBangType] -> [(Name, Type)]
 recordFieldsToNameTypePairs = map $ \(fieldName, _, fieldType) -> (fieldName, fieldType)
 
--- | Create an "IsDeclType" instance for types that have a single data constructor which has a single value, e.g. @data Type = Type x@.
+-- | 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 -> Name -> Type -> Q [DecQ]
 genIsDeclTypeInstanceDefinitionFromNormalDataConstructor typeName dataConstructorName dataConstructorType = do
-  let evaluateE = [|runEvaluation $ $(conE dataConstructorName) <$> $(genEvaluationExprForHaskellType dataConstructorType)|]
-  let bodyTypeE = genWaspTypeFromHaskellType dataConstructorType
+  (bodyTypeE, evaluationE) <- genWaspTypeAndEvaluationForHaskellType dataConstructorType
+  let evaluateE = [|E.runEvaluation $ $(conE dataConstructorName) <$> $evaluationE|]
   pure $ genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE
 
 -- | For decls with record constructors, i.e. @data Fields = Fields { a :: String, b :: String }
 genIsDeclTypeInstanceDefinitionFromRecordDataConstructor :: Name -> Name -> [(Name, Type)] -> Q [DecQ]
 genIsDeclTypeInstanceDefinitionFromRecordDataConstructor typeName dataConstructorName fields = do
-  (dictTypeE, dictEvaluationE) <- genDictTypeAndEvaluationForRecord dataConstructorName fields
-  let evaluateE = [|runEvaluation $dictEvaluationE|]
+  (dictTypeE, dictEvaluationE) <- genDictWaspTypeAndEvaluationForRecord dataConstructorName fields
+  let evaluateE = [|E.runEvaluation $dictEvaluationE|]
   let bodyTypeE = dictTypeE
   pure $ genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE
 
@@ -142,96 +195,61 @@ genIsDeclTypeInstanceDefinition typeName dataConstructorName bodyTypeE evaluateE
     genFunc 'declEvaluate evaluateE
   ]
 
---------------- Dict ------------------
+--------------- Kind, Wasp Type and Evaluation of a Haskell type ------------------
 
--- | Given a record data constructor name and fields, return the evaluation that evaluates
--- Wasp dictionary into the given record, and also return the type of such Wasp dictionary.
--- First member of returned couple is type, second is evaluation.
-genDictTypeAndEvaluationForRecord :: Name -> [(Name, Type)] -> Q (ExpQ, ExpQ)
-genDictTypeAndEvaluationForRecord dataConName fields = do
-  (dictEntryTypesE, dictEvaluationE) <- genDictEntriesTypeAndEvaluationForRecord dataConName fields
-  return
-    ( [|T.DictType $ H.fromList $dictEntryTypesE|],
-      [|dict $dictEvaluationE|]
-    )
+type WaspTypeExpQ = ExpQ
 
-genDictEntriesTypeAndEvaluationForRecord :: Name -> [(Name, Type)] -> Q (ExpQ, ExpQ)
-genDictEntriesTypeAndEvaluationForRecord dataConstructorName fields =
-  go $ reverse fields -- Reversing enables us to apply evaluations in right order.
-  where
-    go [] = pure (listE [], [|pure|] `appE` conE dataConstructorName)
-    go ((fieldName, fieldType) : restOfFields) = do
-      (restDictType, restEvaluation) <- go restOfFields
-      let thisDictTypeE =
-            [|
-              ($(nameToStringLiteralExpr fieldName), $(genDictEntryTypeFromHaskellType fieldType)) :
-              $restDictType
-              |]
-      let thisEvaluationE = [|$restEvaluation <*> $(genDictEntryEvaluationForRecordField fieldName fieldType)|]
-      pure (thisDictTypeE, thisEvaluationE)
+type EvaluationExpQ = ExpQ
 
--- | Write a @DictEntryType@ that corresponds to a given a Haskell type.
-genDictEntryTypeFromHaskellType :: Type -> ExpQ
-genDictEntryTypeFromHaskellType typ =
-  waspKindOfType typ >>= \case
-    KOptional elemType -> [|T.DictOptional $(genWaspTypeFromHaskellType elemType)|]
-    _ -> [|T.DictRequired $(genWaspTypeFromHaskellType typ)|]
-
--- | "genDictEvaluationE fieldName typ" writes a "DictEvaluation" for a haskell record field
--- named "fieldName" with a value "typ".
-genDictEntryEvaluationForRecordField :: Name -> Type -> ExpQ
-genDictEntryEvaluationForRecordField fieldName fieldType =
-  waspKindOfType fieldType >>= \case
-    KOptional elemType -> [|maybeField $(nameToStringLiteralExpr fieldName) $(genEvaluationExprForHaskellType elemType)|]
-    _ -> [|field $(nameToStringLiteralExpr fieldName) $(genEvaluationExprForHaskellType fieldType)|]
-
-----------------------------------------
-
---------------- Types ------------------
-
--- | Haskell type -> Wasp type.
-genWaspTypeFromHaskellType :: Type -> ExpQ
-genWaspTypeFromHaskellType typ =
-  waspKindOfType typ >>= \case
-    KString -> [|T.StringType|]
-    KInteger -> [|T.NumberType|]
-    KDouble -> [|T.NumberType|]
-    KBool -> [|T.BoolType|]
-    KList elemType -> [|T.ListType $(genWaspTypeFromHaskellType elemType)|]
-    KImport -> [|T.ExtImportType|]
-    KJSON -> [|T.QuoterType "json"|]
-    KDeclRef t -> [|T.DeclType $ dtName $ declType @ $(pure t)|]
-    KEnum -> [|T.EnumType $ etName $ enumType @ $(pure typ)|]
+-- | For a given Haskell type @typ@, generates two TH expressions:
+-- one that is a Wasp @Type@, and another that is @Evaluation@ that evaluates from that Wasp @Type@
+-- into a given Haskell type @typ@.
+genWaspTypeAndEvaluationForHaskellType :: Type -> Q (WaspTypeExpQ, EvaluationExpQ)
+genWaspTypeAndEvaluationForHaskellType typ =
+  waspKindOfHaskellType typ >>= \case
+    KString -> return ([|T.StringType|], [|E.string|])
+    KInteger -> return ([|T.NumberType|], [|E.integer|])
+    KDouble -> return ([|T.NumberType|], [|E.double|])
+    KBool -> return ([|T.BoolType|], [|E.bool|])
+    KList elemHaskellType -> do
+      (elemWaspType, elemEvaluation) <- genWaspTypeAndEvaluationForHaskellType elemHaskellType
+      return ([|T.ListType $(elemWaspType)|], [|E.list $(elemEvaluation)|])
+    KImport -> return ([|T.ExtImportType|], [|E.extImport|])
+    KJSON -> return ([|T.QuoterType "json"|], [|E.json|])
+    KDeclRef t ->
+      return
+        ( [|T.DeclType $ dtName $ declType @ $(pure t)|],
+          [|E.declRef @ $(pure t)|]
+        )
+    KEnum ->
+      return
+        ( [|T.EnumType $ etName $ enumType @ $(pure typ)|],
+          [|E.enum @ $(pure typ)|]
+        )
+    KRecord dataConName fields -> genDictWaspTypeAndEvaluationForRecord dataConName fields
+    KCustomEvaluation ->
+      return
+        ( [|HasCustomEvaluation.waspType @ $(pure typ)|],
+          [|HasCustomEvaluation.evaluation @ $(pure typ)|]
+        )
     KOptional _ -> fail "Maybe is only allowed in record fields"
-    KRecord dataConName fields ->
-      fst =<< genDictTypeAndEvaluationForRecord dataConName fields
-
--- | Generates an expression that is @Evaluation@ that evaluates to a given Haskell type.
-genEvaluationExprForHaskellType :: Type -> ExpQ
-genEvaluationExprForHaskellType typ =
-  waspKindOfType typ >>= \case
-    KString -> [|string|]
-    KInteger -> [|integer|]
-    KDouble -> [|double|]
-    KBool -> [|bool|]
-    KList elemType -> [|list $(genEvaluationExprForHaskellType elemType)|]
-    KImport -> [|extImport|]
-    KJSON -> [|json|]
-    KDeclRef t -> [|declRef @ $(pure t)|]
-    KEnum -> [|enum @ $(pure typ)|]
-    KOptional _ -> fail "Maybe is only allowed in record fields"
-    KRecord dataConName fields ->
-      snd =<< genDictTypeAndEvaluationForRecord dataConName fields
 
 -- | Find the "WaspKind" of a Haskell type.
-waspKindOfType :: Type -> Q WaspKind
-waspKindOfType typ = do
+-- Wasp Kind is really just an intermediate representation that captures
+-- information we will need to later determine Wasp type and Evaluation for
+-- this Haskell type, which will be used to evaluate type-checked AST.
+waspKindOfHaskellType :: Type -> Q WaspKind
+waspKindOfHaskellType typ = do
   maybeDeclRefKind <- tryCastingToDeclRefKind typ
   maybeEnumKind <- tryCastingToEnumKind typ
+  maybeCustomEvaluationKind <- tryCastingToCustomEvaluationKind typ
   maybeRecordKind <- tryCastingToRecordKind typ
   maybe (fail $ "No translation to wasp type for type " ++ show typ) return $
     maybeDeclRefKind
       <|> maybeEnumKind
+      -- NOTE: It is important that @maybeCustomEvaluationKind@ is before @maybeRecordKind@,
+      -- since having a custom evaluation should override typical record evalution, if type is a record.
+      <|> maybeCustomEvaluationKind
       <|> maybeRecordKind
       <|> case typ of
         ConT name
@@ -265,6 +283,11 @@ waspKindOfType typ = do
         _ -> Nothing
     tryCastingToRecordKind _ = return Nothing
 
+    tryCastingToCustomEvaluationKind :: Type -> Q (Maybe WaspKind)
+    tryCastingToCustomEvaluationKind t = do
+      hasInstance <- isInstance ''HasCustomEvaluation [t]
+      return $ if hasInstance then Just KCustomEvaluation else Nothing
+
 -- | An intermediate mapping between Haskell types and Wasp types, we use it internally
 -- in this module when generating @Types@, @Evaluation@, @DictEntryTypes@, and @DictEvaluation@
 -- so that we have easier time when figuring out what we are dealing with.
@@ -284,5 +307,48 @@ data WaspKind
   | -- | Type that has a single data constructor that is a record.
     -- KRecord <record constructor name> <fields:(identifier, type)>
     KRecord Name [(Name, Type)]
+  | KCustomEvaluation
 
----------------------------------------
+---------- Kind, Wasp Type and Evaluation of a Haskell Record as a Wasp Dict -------------
+
+-- | Given a record data constructor name and fields, return the evaluation that evaluates
+-- Wasp dictionary into the given record, and also return the type of such Wasp dictionary.
+-- First member of returned couple is type, second is evaluation.
+genDictWaspTypeAndEvaluationForRecord :: Name -> [(Name, Type)] -> Q (WaspTypeExpQ, EvaluationExpQ)
+genDictWaspTypeAndEvaluationForRecord dataConName fields = do
+  (dictEntryTypesE, dictEvaluationE) <- genDictEntriesWaspTypeAndEvaluationForRecord dataConName fields
+  return
+    ( [|T.DictType $ H.fromList $dictEntryTypesE|],
+      [|E.dict $dictEvaluationE|]
+    )
+
+genDictEntriesWaspTypeAndEvaluationForRecord :: Name -> [(Name, Type)] -> Q (WaspTypeExpQ, EvaluationExpQ)
+genDictEntriesWaspTypeAndEvaluationForRecord dataConstructorName fields =
+  go $ reverse fields -- Reversing enables us to apply evaluations in right order.
+  where
+    go [] = pure (listE [], [|pure|] `appE` conE dataConstructorName)
+    go ((fieldName, fieldType) : restOfFields) = do
+      (fieldWaspType, fieldEvaluation) <- genDictEntryWaspTypeAndEvaluationForRecordField fieldName fieldType
+      (restWaspType, restEvaluation) <- go restOfFields
+      pure
+        ( [|($(nameToStringLiteralExpr fieldName), $fieldWaspType) : $restWaspType|],
+          [|$restEvaluation <*> $fieldEvaluation|]
+        )
+
+-- | For a given Haskell record field (name and type), generate Wasp Type and
+-- Evaluation from that Wasp Type into given record field.
+genDictEntryWaspTypeAndEvaluationForRecordField :: Name -> Type -> Q (WaspTypeExpQ, EvaluationExpQ)
+genDictEntryWaspTypeAndEvaluationForRecordField fieldName fieldType =
+  waspKindOfHaskellType fieldType >>= \case
+    KOptional elemType -> do
+      (waspType, evaluation) <- genWaspTypeAndEvaluationForHaskellType elemType
+      return
+        ( [|T.DictOptional $(waspType)|],
+          [|E.maybeField $(nameToStringLiteralExpr fieldName) $(evaluation)|]
+        )
+    _ -> do
+      (waspType, evaluation) <- genWaspTypeAndEvaluationForHaskellType fieldType
+      return
+        ( [|T.DictRequired $(waspType)|],
+          [|E.field $(nameToStringLiteralExpr fieldName) $(evaluation)|]
+        )

waspc/src/Wasp/AppSpec/App.hs

@@ -18,18 +18,6 @@ data App = App
 
     -- | NOTE: This is new. Before, `dependencies` was a standalone declaration and it was a {=json json=},
     -- while now it is a [{ name :: String, version :: String }].
-    -- TODO: We might want to look into making this nicer in the future
-    -- -> maybe change how it is represented in the wasp lang, e.g. make it just a list of strings,
-    -- while here it would still be what it is or it would be parsed even more.
-    -- We could make this work by supporting manual definition of how Dependency evaluates / what is its type.
-    -- So, similar like we have IsDeclType instance for declarations, we could have similar abstraction for
-    -- sub-types like these, and we would inject it into Analyzer and it would be defined manually.
-    -- A way this might work: in Evaluator, we would check when the type matches the one we have this custom logic for,
-    -- probably in the function that figures out the Kind of the type, and then we would based on that use
-    -- evaluator provided for that type. This means we can provide this custom sort of logic per specific type from
-    -- AppSpec, but not for type + context in which it is. However, that should be enough, I don't think that is a problem.
-    -- If knowledge of context is important then it is best to just manually define the parent type's evaluation.
-    --   TODO: Make a github issue for this (TODO above)?
     dependencies :: Maybe [Dependency]
   }
   deriving (Show, Eq, Data)

waspc/test/Analyzer/EvaluatorTest.hs

@@ -1,16 +1,24 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Analyzer.EvaluatorTest where
 
 import Data.Data (Data)
+import Data.List.Split (splitOn)
 import Test.Tasty.Hspec
+import Text.Read (readMaybe)
 import Wasp.Analyzer.Evaluator
+import qualified Wasp.Analyzer.Evaluator.Evaluation as E
+import qualified Wasp.Analyzer.Evaluator.EvaluationError as EvaluationError
 import Wasp.Analyzer.Parser (parse)
+import qualified Wasp.Analyzer.Type as T
 import Wasp.Analyzer.TypeChecker (typeCheck)
+import qualified Wasp.Analyzer.TypeChecker.AST as TypedAST
 import qualified Wasp.Analyzer.TypeDefinitions as TD
+import Wasp.Analyzer.TypeDefinitions.Class.HasCustomEvaluation (HasCustomEvaluation (..))
 import Wasp.Analyzer.TypeDefinitions.TH
 import Wasp.AppSpec.Core.Decl (IsDecl)
 import Wasp.AppSpec.Core.Ref (Ref (..))
@@ -21,18 +29,24 @@ fromRight :: Show a => Either a b -> b
 fromRight (Right x) = x
 fromRight (Left e) = error $ show e
 
+------- Simple -------
+
 newtype Simple = Simple String deriving (Eq, Show, Data)
 
 instance IsDecl Simple
 
 makeDeclType ''Simple
 
+------- Fields -------
+
 data Fields = Fields {a :: String, b :: Maybe Double} deriving (Eq, Show, Data)
 
 instance IsDecl Fields
 
 makeDeclType ''Fields
 
+------ Business ------
+
 data Person = Person {name :: String, age :: Integer} deriving (Eq, Show, Data)
 
 instance IsDecl Person
@@ -43,12 +57,6 @@ data BusinessType = Manufacturer | Seller | Store deriving (Eq, Show, Data)
 
 makeEnumType ''BusinessType
 
-data Special = Special {imps :: [ExtImport], json :: JSON} deriving (Eq, Show)
-
-instance IsDecl Special
-
-makeDeclType ''Special
-
 data Business = Business
   { employees :: [Ref Person],
     worth :: Double,
@@ -61,6 +69,53 @@ instance IsDecl Business
 
 makeDeclType ''Business
 
+-------- Special --------
+
+data Special = Special {imps :: [ExtImport], json :: JSON} deriving (Eq, Show)
+
+instance IsDecl Special
+
+makeDeclType ''Special
+
+------ HasCustomEvaluation ------
+
+data SemanticVersion = SemanticVersion Int Int Int
+  deriving (Eq, Show, Data)
+
+instance HasCustomEvaluation SemanticVersion where
+  waspType = T.StringType
+  evaluation = E.evaluation' $ \case
+    TypedAST.StringLiteral str -> case splitOn "." str of
+      [major, minor, patch] ->
+        maybe
+          ( Left $
+              EvaluationError.ParseError $
+                EvaluationError.EvaluationParseError
+                  "Failed parsing semantic version -> some part is not int"
+          )
+          pure
+          $ do
+            majorInt <- readMaybe @Int major
+            minorInt <- readMaybe @Int minor
+            patchInt <- readMaybe @Int patch
+            return $ SemanticVersion majorInt minorInt patchInt
+      _ ->
+        Left $
+          EvaluationError.ParseError $
+            EvaluationError.EvaluationParseError $
+              "Failed parsing semantic version -> it doesn't have 3 comma separated parts."
+    expr -> Left $ EvaluationError.ExpectedType T.StringType (TypedAST.exprType expr)
+
+data Custom = Custom
+  {version :: SemanticVersion}
+  deriving (Eq, Show, Data)
+
+instance IsDecl Custom
+
+makeDeclType ''Custom
+
+--------------------------------
+
 eval :: TD.TypeDefinitions -> [String] -> Either EvaluationError [Decl]
 eval typeDefs source = evaluate typeDefs $ fromRight $ typeCheck typeDefs $ fromRight $ parse $ unlines source
 
@@ -112,6 +167,7 @@ spec_Evaluator = do
                 "  json: {=json \"key\": 1 json=}",
                 "}"
               ]
+
         fmap takeDecls (eval typeDefs source)
           `shouldBe` Right
             [ ( "Test",
@@ -120,3 +176,9 @@ spec_Evaluator = do
                   (JSON " \"key\": 1 ")
               )
             ]
+
+      it "Evaluates a declaration with a field that has custom evaluation" $ do
+        let typeDefs = TD.addDeclType @Custom $ TD.empty
+        let decls = eval typeDefs ["custom Test { version: \"1.2.3\" }"]
+        fmap takeDecls decls
+          `shouldBe` Right [("Test", Custom {version = SemanticVersion 1 2 3})]