Import.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.Config.Import
  ( checkImport
  ) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Hedgehog as HH
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Hedgehog as TastyHH

import qualified CompatGHC
import qualified Henforcer.Checks as Checks
import qualified Henforcer.CodeStructure as CodeStructure
import qualified Henforcer.Config as Config
import qualified Henforcer.Rules as Rules

singleProperty :: Tasty.TestName -> HH.PropertyT IO () -> Tasty.TestTree
singleProperty name =
  TastyHH.testProperty name . HH.withTests 1 . HH.property

checkImport :: Config.Config -> Tasty.TestTree
checkImport conf =
  Tasty.testGroup
    "Checking configuration parsing of import rules"
    [ checkAnyModule conf
    , checkPatternModule conf
    , checkPatternModulePicksFirst conf
    , checkSpecifiedModule conf
    , checkPatternModuleIgnores conf
    ]

checkAnyModule :: Config.Config -> Tasty.TestTree
checkAnyModule conf =
  singleProperty "Does folding correctly for any module section" $
    importAnyModuleRules
      HH.=== Checks.determineChecks conf (CompatGHC.mkModuleName "AnyModule")

checkPatternModule :: Config.Config -> Tasty.TestTree
checkPatternModule conf =
  singleProperty "Picks pattern module section when module matches" $
    importPatternModuleRules
      HH.=== Checks.determineChecks conf (CompatGHC.mkModuleName "Pattern.Module")

checkPatternModulePicksFirst :: Config.Config -> Tasty.TestTree
checkPatternModulePicksFirst conf =
  singleProperty "Overlapping patterns pick the first match" $
    importPatternModuleRules
      HH.=== Checks.determineChecks conf (CompatGHC.mkModuleName "Pattern2.Module")

checkSpecifiedModule :: Config.Config -> Tasty.TestTree
checkSpecifiedModule conf =
  singleProperty "Specified module is picked even if the pattern is matched" $
    importSpecifiedModuleRules
      HH.=== Checks.determineChecks
        conf
        (CompatGHC.mkModuleName "PatternMatchedButSpecifiedWins.Module")

checkPatternModuleIgnores :: Config.Config -> Tasty.TestTree
checkPatternModuleIgnores conf =
  singleProperty "Pattern module can ignore rules " $
    importPatternWithIgnoresModuleRules
      HH.=== Checks.determineChecks conf (CompatGHC.mkModuleName "WithIgnoresPattern.Module")

importAnyModuleRules :: Checks.ImportChecks
importAnyModuleRules =
  Checks.ImportChecks
    { Checks.importChecksTreeDependencies =
        Just . pure $
          Checks.CheckedDependency
            (CodeStructure.parse "Control.Monad")
            Rules.noUserNote
            (CodeStructure.parse "PetStore")
    , Checks.importChecksEncapsulatedTrees =
        Just (pure (CodeStructure.parse "Service.ThirdPartyPetsSite"))
    , Checks.importChecksAllowedQualifications =
        Map.fromList
          [
            ( CompatGHC.mkModuleName "UnliftIO"
            ,
              [ CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPre
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              , CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPost
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              ]
            )
          ]
    , Checks.importChecksAllowedOpenUnaliasedImports = Rules.Enforced 3
    , Checks.importChecksAllowedAliasUniqueness =
        Just . CodeStructure.AllAliasesUniqueExcept $
          CodeStructure.AliasUniquenessExceptions
            (Set.singleton $ CompatGHC.mkModuleName "Export")
            Rules.noUserNote
    }

importPatternModuleRules :: Checks.ImportChecks
importPatternModuleRules =
  Checks.ImportChecks
    { Checks.importChecksTreeDependencies =
        Just . pure $
          Checks.CheckedDependency
            (CodeStructure.parse "Control.Monad")
            Rules.noUserNote
            (CodeStructure.parse "PetStore")
    , Checks.importChecksEncapsulatedTrees =
        Just (pure (CodeStructure.parse "Service.ThirdPartyPetsSite"))
    , Checks.importChecksAllowedQualifications =
        Map.fromList
          [
            ( CompatGHC.mkModuleName "UnliftIO"
            ,
              [ CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPre
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              , CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPost
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              ]
            )
          ]
    , Checks.importChecksAllowedOpenUnaliasedImports = Rules.Enforced 2
    , Checks.importChecksAllowedAliasUniqueness =
        Just . CodeStructure.AllAliasesUniqueExcept $
          CodeStructure.AliasUniquenessExceptions
            (Set.singleton $ CompatGHC.mkModuleName "Export")
            Rules.noUserNote
    }

importPatternWithIgnoresModuleRules :: Checks.ImportChecks
importPatternWithIgnoresModuleRules =
  Checks.ImportChecks
    { Checks.importChecksTreeDependencies = Nothing
    , Checks.importChecksEncapsulatedTrees = Nothing
    , Checks.importChecksAllowedQualifications = mempty
    , Checks.importChecksAllowedOpenUnaliasedImports = Rules.NotEnforced
    , Checks.importChecksAllowedAliasUniqueness = Nothing
    }

importSpecifiedModuleRules :: Checks.ImportChecks
importSpecifiedModuleRules =
  Checks.ImportChecks
    { Checks.importChecksTreeDependencies =
        Just . pure $
          Checks.CheckedDependency
            (CodeStructure.parse "Control.Monad")
            Rules.noUserNote
            (CodeStructure.parse "PetStore")
    , Checks.importChecksEncapsulatedTrees =
        Just
          (pure (CodeStructure.parse "Service.ThirdPartyPetsSite"))
    , Checks.importChecksAllowedQualifications =
        Map.fromList
          [
            ( CompatGHC.mkModuleName "UnliftIO"
            ,
              [ CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPre
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              , CodeStructure.SchemeWithNote
                  { CodeStructure.schemeNote = Rules.noUserNote
                  , CodeStructure.underlyingScheme =
                      CodeStructure.Scheme
                        { CodeStructure.qualification = CompatGHC.QualifiedPost
                        , CodeStructure.alias = CodeStructure.WithAlias (CompatGHC.mkModuleName "Foo")
                        , CodeStructure.safe = CodeStructure.withoutSafe
                        , CodeStructure.packageQualification = CodeStructure.WithPackageQualifier "unliftio"
                        }
                  }
              ]
            )
          ]
    , Checks.importChecksAllowedOpenUnaliasedImports = Rules.Enforced 20
    , Checks.importChecksAllowedAliasUniqueness =
        Just . CodeStructure.AllAliasesUniqueExcept $
          CodeStructure.AliasUniquenessExceptions
            (Set.singleton $ CompatGHC.mkModuleName "Export")
            Rules.noUserNote
    }