StateSpec.hs

module Language.PureScript.Ide.StateSpec where

import Protolude
import Control.Lens (Ixed(..), folded)
import Language.PureScript.Ide.Types (IdeDeclarationAnn, IdeInstance(..), ModuleMap, _IdeDeclTypeClass, anyOf, idaDeclaration, ideTCInstances)
import Language.PureScript.Ide.State (resolveDataConstructorsForModule, resolveInstances, resolveOperatorsForModule)
import Language.PureScript.Ide.Test (ideDtor, ideType, ideTypeClass, ideTypeOp, ideValue, ideValueOp, mn)
import Language.PureScript qualified as P
import Test.Hspec (Spec, describe, it, shouldSatisfy)
import Data.Map qualified as Map

valueOperator :: Maybe P.SourceType -> IdeDeclarationAnn
valueOperator =
  ideValueOp "<$>" (P.Qualified (P.ByModuleName (mn "Test")) (Left "function")) 2 Nothing

ctorOperator :: Maybe P.SourceType -> IdeDeclarationAnn
ctorOperator =
  ideValueOp ":" (P.Qualified (P.ByModuleName (mn "Test")) (Right "Cons")) 2 Nothing

typeOperator :: Maybe P.SourceType -> IdeDeclarationAnn
typeOperator =
  ideTypeOp ":" (P.Qualified (P.ByModuleName (mn "Test")) "List") 2 Nothing

testModule :: (P.ModuleName, [IdeDeclarationAnn])
testModule =
  (mn "Test",
    [ ideValue "function" (Just P.srcREmpty)
    , ideDtor "Cons" "List" (Just P.tyString)
    , ideType "List" Nothing []
    , valueOperator Nothing
    , ctorOperator Nothing
    , typeOperator Nothing
    ])

testState :: ModuleMap [IdeDeclarationAnn]
testState = Map.fromList [testModule]

-- The accessor fields for these data types are not exposed unfortunately
ef :: P.ExternsFile
ef = P.ExternsFile
  -- { efVersion =
    mempty
  -- , efModuleName =
    (mn "InstanceModule")
  -- , efExports =
    mempty
  -- , efImports =
    mempty
  -- , efFixities =
    mempty
  -- , efTypeFixities =
    mempty
  --, efDeclarations =
    [ P.EDInstance
      -- { edInstanceClassName =
      (P.Qualified (P.ByModuleName (mn "ClassModule")) (P.ProperName "MyClass"))
      -- , edInstanceName =
      (P.Ident "myClassInstance")
      -- . edInstanceForAll =
      []
      -- , edInstanceKinds =
      mempty
      -- , edInstanceTypes =
      mempty
      -- , edInstanceConstraints =
      mempty
      -- , edInstanceChain =
      Nothing
      -- , edInstanceChainIndex =
      0
      -- , edInstanceNameSource =
      P.UserNamed
      -- , edInstanceSourceSpan =
      P.NullSourceSpan
 --     }
    ]
  --, efSourceSpan =
    (P.internalModuleSourceSpan "<tests>")
 -- }

moduleMap :: ModuleMap [IdeDeclarationAnn]
moduleMap = Map.singleton (mn "ClassModule") [ideTypeClass "MyClass" P.kindType []]

ideInstance :: IdeInstance
ideInstance = IdeInstance (mn "InstanceModule") (P.Ident "myClassInstance") mempty mempty

spec :: Spec
spec = do
  describe "resolving operators" $ do
    it "resolves the type for a value operator" $
      resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (valueOperator (Just P.srcREmpty))
    it "resolves the type for a constructor operator" $
      resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (ctorOperator (Just P.tyString))
    it "resolves the kind for a type operator" $
      resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.kindType))
  describe "resolving instances for type classes" $ do
    it "resolves an instance for an existing type class" $ do
      resolveInstances (Map.singleton (mn "InstanceModule") ef) moduleMap
        `shouldSatisfy`
        anyOf (ix (mn "ClassModule") . ix 0 . idaDeclaration . _IdeDeclTypeClass . ideTCInstances . folded) (ideInstance ==)
  describe "resolving data constructors" $ do
    it "resolves a constructor" $ do
      resolveDataConstructorsForModule (snd testModule)
        `shouldSatisfy`
        elem (ideType "List" Nothing [(P.ProperName "Cons", P.tyString)])