ReexportsSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.Ide.ReexportsSpec where

import           Protolude

import qualified Data.Map as Map
import           Language.PureScript.Ide.Reexports
import           Language.PureScript.Ide.Types
import           Language.PureScript.Ide.Test
import qualified Language.PureScript as P
import           Test.Hspec

valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn
valueA = ideValue "valueA" Nothing
typeA = ideType "TypeA" Nothing
classA = ideTypeClass "ClassA" P.kindType []
dtorA1 = ideDtor "DtorA1" "TypeA" Nothing
dtorA2 = ideDtor "DtorA2" "TypeA" Nothing

env :: ModuleMap [IdeDeclarationAnn]
env = Map.fromList
  [ (mn "A", [valueA, typeA, classA, dtorA1, dtorA2])
  ]

type Refs = [(P.ModuleName, P.DeclarationRef)]

succTestCases :: [(Text, Refs, [IdeDeclarationAnn])]
succTestCases =
  [ ("resolves a value reexport", [(mn "A", P.ValueRef (P.Ident "valueA"))], [valueA `annExp` "A"])
  , ("resolves a type reexport with explicit data constructors"
    , [(mn "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], [typeA `annExp` "A", dtorA1 `annExp` "A"])
  , ("resolves a type reexport with implicit data constructors"
    , [(mn "A", P.TypeRef (P.ProperName "TypeA") Nothing)], map (`annExp` "A") [typeA, dtorA1, dtorA2])
  , ("resolves a class reexport", [(mn "A", P.TypeClassRef (P.ProperName "ClassA"))], [classA `annExp` "A"])
  ]

failTestCases :: [(Text, Refs)]
failTestCases =
  [ ("fails to resolve a non existing value", [(mn "A", P.ValueRef (P.Ident "valueB"))])
  , ("fails to resolve a non existing type reexport" , [(mn "A", P.TypeRef (P.ProperName "TypeB") Nothing)])
  , ("fails to resolve a non existing class reexport", [(mn "A", P.TypeClassRef (P.ProperName "ClassB"))])
  ]

spec :: Spec
spec = do
  describe "Successful Reexports" $
    for_ succTestCases $ \(desc, refs, result) ->
      it (toS desc) $ do
        let reResult = resolveReexports' env refs
        reResolved reResult `shouldBe` result
        reResult `shouldSatisfy` not . reexportHasFailures
  describe "Failed Reexports" $
    for_ failTestCases $ \(desc, refs) ->
      it (toS desc) $ do
        let reResult = resolveReexports'  env refs
        reFailed reResult `shouldBe` refs
        reResult `shouldSatisfy` reexportHasFailures