packages feed

keiro-dsl-0.10.0.0: test/import-planning/Main.hs

module Main (main) where

import Data.Set qualified as Set
import Data.Text qualified as T
import Keiro.Dsl.HaskellImport
import Test.Hspec

main :: IO ()
main = hspec $ describe "haskell import planning" $ do
  it "imports a unique external type explicitly and renders it unqualified" $ do
    let reference = typeReference "Mori.Modules.Project.Domain.Types" "ProjectArtifactId"
        plan = expectImportPlan defaultImportEnvironment (Set.singleton reference)
    renderPlannedImports plan
      `shouldBe` "import Mori.Modules.Project.Domain.Types (ProjectArtifactId)"
    renderPlannedReference plan reference `shouldBe` Right "ProjectArtifactId"

  it "short-qualifies colliding type occurrence names with unique suffixes" $ do
    let orderStatus = typeReference "Consumer.Order.Types" "Status"
        invoiceStatus = typeReference "Consumer.Invoice.Types" "Status"
        plan = expectImportPlan defaultImportEnvironment (Set.fromList [orderStatus, invoiceStatus])
    renderPlannedImports plan
      `shouldBe` T.intercalate
        "\n"
        [ "import Consumer.Invoice.Types qualified as InvoiceTypes",
          "import Consumer.Order.Types qualified as OrderTypes"
        ]
    renderPlannedReference plan orderStatus `shouldBe` Right "OrderTypes.Status"
    renderPlannedReference plan invoiceStatus `shouldBe` Right "InvoiceTypes.Status"

  it "qualifies values and constructors and deduplicates their module import" $ do
    let binding = valueReference "Consumer.Order.Bindings" "orderBinding"
        constructor = constructorReference "Consumer.Order.Bindings" "OrderBinding"
        plan = expectImportPlan defaultImportEnvironment (Set.fromList [binding, constructor, binding])
    renderPlannedImports plan
      `shouldBe` "import Consumer.Order.Bindings qualified as Bindings"
    renderPlannedReference plan binding `shouldBe` Right "Bindings.orderBinding"
    renderPlannedReference plan constructor `shouldBe` Right "Bindings.OrderBinding"

  it "merges and sorts explicit imports from one module" $ do
    let alpha = typeReference "Consumer.Types" "Alpha"
        zeta = typeReference "Consumer.Types" "Zeta"
        plan = expectImportPlan defaultImportEnvironment (Set.fromList [zeta, alpha, zeta])
    renderPlannedImports plan
      `shouldBe` "import Consumer.Types (Alpha, Zeta)"

  it "qualifies type names that conflict with local names or reserved qualifiers" $ do
    let local = typeReference "Consumer.Domain" "Domain"
        reserved = typeReference "Consumer.Map" "Map"
        environment =
          defaultImportEnvironment
            { localNames = Set.singleton "Domain",
              reservedQualifiers = Set.insert "Map" (reservedQualifiers defaultImportEnvironment)
            }
        plan = expectImportPlan environment (Set.fromList [local, reserved])
    renderPlannedImports plan
      `shouldBe` T.intercalate
        "\n"
        [ "import Consumer.Domain qualified as ConsumerDomain",
          "import Consumer.Map qualified as ConsumerMap"
        ]
    renderPlannedReference plan local `shouldBe` Right "ConsumerDomain.Domain"
    renderPlannedReference plan reserved `shouldBe` Right "ConsumerMap.Map"

  it "is independent of reference discovery order" $ do
    let references =
          [ typeReference "Consumer.Order.Types" "Status",
            typeReference "Consumer.Invoice.Types" "Status",
            typeReference "Consumer.Shared.Types" "Label",
            valueReference "Consumer.Bindings" "statusBinding"
          ]
        forward = expectImportPlan defaultImportEnvironment (Set.fromList references)
        backward = expectImportPlan defaultImportEnvironment (Set.fromList (reverse references))
    renderPlannedImports forward `shouldBe` renderPlannedImports backward
    traverse (renderPlannedReference forward) references
      `shouldBe` traverse (renderPlannedReference backward) references

  it "reports missing references with target-module context" $ do
    let planned = typeReference "Consumer.Types" "Planned"
        missing = typeReference "Consumer.Types" "Missing"
        plan = expectImportPlan defaultImportEnvironment (Set.singleton planned)
    renderPlannedReference plan missing
      `shouldBe` Left (MissingHaskellReference "Generated.Example" missing)

  it "accepts contextual GHC words that remain valid value identifiers" $ do
    let reference = valueReference "Consumer.Bindings" "role"
        plan = expectImportPlan defaultImportEnvironment (Set.singleton reference)
    renderPlannedReference plan reference `shouldBe` Right "Bindings.role"

  it "rejects lexical keywords with target-module context" $ do
    let reference = valueReference "Consumer.Bindings" "case"
    case planHaskellImports defaultImportEnvironment (Set.singleton reference) of
      Left failure -> failure `shouldBe` InvalidHaskellOccurrence "Generated.Example" ValueNamespace "case"
      Right _ -> expectationFailure "lexical keyword unexpectedly planned"

defaultImportEnvironment :: ImportEnvironment
defaultImportEnvironment =
  ImportEnvironment
    { targetModule = "Generated.Example",
      localNames = Set.empty,
      reservedQualifiers = Set.fromList ["B", "K", "KindID", "Map", "S", "Set", "T"]
    }

typeReference :: T.Text -> T.Text -> HaskellReference
typeReference moduleName occurrence =
  HaskellReference moduleName occurrence TypeNamespace PreferUnqualified

valueReference :: T.Text -> T.Text -> HaskellReference
valueReference moduleName occurrence =
  HaskellReference moduleName occurrence ValueNamespace RequireQualified

constructorReference :: T.Text -> T.Text -> HaskellReference
constructorReference moduleName occurrence =
  HaskellReference moduleName occurrence ConstructorNamespace RequireQualified

expectImportPlan :: ImportEnvironment -> Set.Set HaskellReference -> HaskellImportPlan
expectImportPlan environment references =
  either
    (error . ("unexpected Haskell import planning failure: " <>) . show)
    id
    (planHaskellImports environment references)