mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-08-17 11:10:37 +03:00
fix
This commit is contained in:
parent
7a6fef9737
commit
29c11d5b68
@ -7,6 +7,8 @@ where
|
||||
|
||||
import AST.Core.Ref (Ref)
|
||||
|
||||
-- TODO: Make AST full-features, so it supports latest version of waps-lang.
|
||||
|
||||
-- TODO: Split into multiple files (one for App, one for Page, ...).
|
||||
|
||||
-- TODO: I should probably move Decl out of Analyzer and make it part of the AST here,
|
||||
|
@ -7,7 +7,7 @@ module Analyzer.Evaluator.Evaluation.TypedExpr.Combinators
|
||||
integer,
|
||||
double,
|
||||
bool,
|
||||
decl,
|
||||
declRef,
|
||||
enum,
|
||||
list,
|
||||
extImport,
|
||||
@ -55,8 +55,8 @@ bool = evaluation' $ \case
|
||||
expr -> Left $ EvaluationError.ExpectedType T.BoolType (TypedAST.exprType expr)
|
||||
|
||||
-- | An evaluation that expects a "Var" bound to a "Decl" of type "a".
|
||||
decl :: forall a. TD.IsDeclType a => TypedExprEvaluation (Ref a)
|
||||
decl = evaluation' $ \case
|
||||
declRef :: forall a. TD.IsDeclType a => TypedExprEvaluation (Ref a)
|
||||
declRef = evaluation' $ \case
|
||||
TypedAST.Var varName varType ->
|
||||
case varType of
|
||||
T.DeclType declTypeName | declTypeName == expectedDeclTypeName -> pure $ Ref.Ref varName
|
||||
|
@ -186,7 +186,7 @@ genWaspTypeFromHaskellType typ =
|
||||
KImport -> [|T.ExtImportType|]
|
||||
KJSON -> [|T.QuoterType "json"|]
|
||||
KPSL -> [|T.QuoterType "psl"|]
|
||||
KDecl t -> [|T.DeclType $ dtName $ declType @ $(pure t)|]
|
||||
KDeclRef t -> [|T.DeclType $ dtName $ declType @ $(pure t)|]
|
||||
KEnum -> [|T.EnumType $ etName $ enumType @ $(pure typ)|]
|
||||
KOptional _ -> fail "Maybe is only allowed in record fields"
|
||||
|
||||
@ -202,33 +202,17 @@ genEvaluationExprForHaskellType typ =
|
||||
KImport -> [|extImport|]
|
||||
KJSON -> [|json|]
|
||||
KPSL -> [|psl|]
|
||||
KDecl t -> [|decl @ $(pure t)|]
|
||||
KDeclRef t -> [|declRef @ $(pure t)|]
|
||||
KEnum -> [|enum @ $(pure typ)|]
|
||||
KOptional _ -> fail "Maybe is only allowed in record fields"
|
||||
|
||||
-- | An intermediate mapping between Haskell types and Wasp types, used for
|
||||
-- generating @Types@, @Evaluation@, @DictEntryTypes@, and @DictEvaluation@.
|
||||
data WaspKind
|
||||
= KString
|
||||
| KInteger
|
||||
| KDouble
|
||||
| KBool
|
||||
| KList Type
|
||||
| KImport
|
||||
| KJSON
|
||||
| KPSL
|
||||
| KDecl Type
|
||||
| KEnum
|
||||
| -- | Valid only in a record field, represents @DictOptional@/@Maybe@
|
||||
KOptional Type
|
||||
|
||||
-- | Find the "WaspKind" of a Haskell type.
|
||||
waspKindOfType :: Type -> Q WaspKind
|
||||
waspKindOfType typ = do
|
||||
maybeDeclKind <- tryCastingToDeclKind typ
|
||||
maybeDeclRefKind <- tryCastingToDeclRefKind typ
|
||||
maybeEnumKind <- tryCastingToEnumKind typ
|
||||
case maybeDeclKind of
|
||||
Just declKind -> pure declKind
|
||||
case maybeDeclRefKind of
|
||||
Just declRefKind -> pure declRefKind
|
||||
Nothing -> case maybeEnumKind of
|
||||
Just enumKind -> pure enumKind
|
||||
Nothing -> case typ of
|
||||
@ -244,15 +228,33 @@ waspKindOfType typ = do
|
||||
ConT name `AppT` elemType | name == ''Maybe -> pure (KOptional elemType)
|
||||
_ -> fail $ "No translation to wasp type for type " ++ show typ
|
||||
where
|
||||
tryCastingToDeclKind :: Type -> Q (Maybe WaspKind)
|
||||
tryCastingToDeclKind (ConT name `AppT` subType) | name == ''Ref = do
|
||||
tryCastingToDeclRefKind :: Type -> Q (Maybe WaspKind)
|
||||
tryCastingToDeclRefKind (ConT name `AppT` subType) | name == ''Ref = do
|
||||
isDeclTypeRef <- isInstance ''IsDeclType [subType]
|
||||
return $ if isDeclTypeRef then Just (KDecl subType) else Nothing
|
||||
tryCastingToDeclKind _ = return Nothing
|
||||
return $ if isDeclTypeRef then Just (KDeclRef subType) else Nothing
|
||||
tryCastingToDeclRefKind _ = return Nothing
|
||||
|
||||
tryCastingToEnumKind :: Type -> Q (Maybe WaspKind)
|
||||
tryCastingToEnumKind t = do
|
||||
isEnumType <- isInstance ''IsEnumType [t]
|
||||
return $ if isEnumType then Just KEnum 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.
|
||||
data WaspKind
|
||||
= KString
|
||||
| KInteger
|
||||
| KDouble
|
||||
| KBool
|
||||
| KList Type
|
||||
| KImport
|
||||
| KJSON
|
||||
| KPSL
|
||||
| -- | Reference to a declaration type @Type@.
|
||||
KDeclRef Type
|
||||
| KEnum
|
||||
| -- | Valid only in a record field, represents @DictOptional@/@Maybe@
|
||||
KOptional Type
|
||||
|
||||
---------------------------------------
|
||||
|
@ -1,7 +0,0 @@
|
||||
module Wasp.Ref
|
||||
( Ref (..),
|
||||
)
|
||||
where
|
||||
|
||||
-- | Reference to a named Wasp declaration.
|
||||
newtype Ref a = Ref {unref :: String}
|
@ -5,11 +5,7 @@ module AnalyzerTest where
|
||||
import AST (App (..), AuthMethod (..), Page (..))
|
||||
import AST.Core.Ref (Ref (..))
|
||||
import Analyzer
|
||||
import qualified Analyzer.Evaluator as E
|
||||
import qualified Analyzer.Evaluator.EvaluationError as E.Error
|
||||
import qualified Analyzer.Type as T
|
||||
import qualified Analyzer.TypeChecker as TC
|
||||
import qualified Analyzer.TypeChecker.TypeError as T.Error
|
||||
import Data.Either (isRight)
|
||||
import Test.Tasty.Hspec
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user