content: {-# LANGUAGE OverloadedLabels #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Ormolu.FixitySpec (spec) where
  
  import Data.Choice (pattern Without)
  import Data.Function ((&))
  import Data.List.NonEmpty (NonEmpty (..))
  import Data.Map.Strict qualified as Map
  import Data.Set qualified as Set
  import Data.Text qualified as T
  import Distribution.ModuleName (ModuleName)
  import Distribution.Types.PackageName (PackageName)
  import GHC.Types.Name (OccName)
  import GHC.Types.Name.Occurrence (mkVarOcc)
  import GHC.Types.Name.Reader
  import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..))
  import Language.Haskell.Syntax.Module.Name (mkModuleName)
  import Ormolu.Fixity
  import Ormolu.Fixity.Imports
  import Ormolu.Fixity.Internal
  import Ormolu.Utils (showOutputable)
  import Test.Hspec
  
  instance Show RdrName where
    show = showOutputable
  
  spec :: Spec
  spec = do
    it "gives the correct fixity info for (:) (built-in)" $
      checkFixities
        []
        []
        [(unqual ":", FixityApproximation (Just InfixR) 5 5)]
    it "does not know operators from base if base is not a dependency" $
      checkFixities
        []
        []
        [ (unqual "$", defaultFixityApproximation),
          (unqual "+", defaultFixityApproximation),
          (unqual "++", defaultFixityApproximation)
        ]
    it "does not know operators from base if Prelude is not imported" $
      checkFixities
        []
        []
        [ (unqual "$", defaultFixityApproximation),
          (unqual "+", defaultFixityApproximation),
          (unqual "++", defaultFixityApproximation)
        ]
    it "infers fixities of operators from base correctly" $
      checkFixities
        ["base"]
        [import_ "Prelude"]
        [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", FixityApproximation (Just InfixL) 6 6),
          (unqual "++", FixityApproximation (Just InfixR) 5 5)
        ]
    it "does not know (>>>) when Control.Category is not imported" $
      checkFixities
        ["base"]
        [import_ "Prelude"]
        [ (unqual ">>>", defaultFixityApproximation)
        ]
    it "infer correct fixity for (>>>) when Control.Category is imported" $
      checkFixities
        ["base"]
        [ import_ "Prelude",
          import_ "Control.Category"
        ]
        [ (unqual ">>>", FixityApproximation (Just InfixR) 1 1)
        ]
    it "handles 'as' imports correctly" $
      checkFixities
        ["base"]
        [ import_ "Control.Category" & as_ "Foo"
        ]
        [ (unqual ">>>", FixityApproximation (Just InfixR) 1 1),
          (qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1),
          (qual "Bar" ">>>", defaultFixityApproximation)
        ]
    it "handles 'qualified' imports correctly" $
      checkFixities
        ["base"]
        [import_ "Control.Category" & qualified_]
        [ (unqual ">>>", defaultFixityApproximation),
          (qual "Control.Category" ">>>", FixityApproximation (Just InfixR) 1 1)
        ]
    it "handles 'qualified as' imports correctly" $
      checkFixities
        ["base"]
        [import_ "Control.Category" & qualified_ & as_ "Foo"]
        [ (unqual ">>>", defaultFixityApproximation),
          (qual "Control.Category" ">>>", defaultFixityApproximation),
          (qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1)
        ]
    it "handles explicit import lists correctly" $
      checkFixities
        ["base"]
        [import_ "Prelude" & exactly_ ["$"]]
        [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", defaultFixityApproximation)
        ]
    it "handles hiding import lists correctly" $
      checkFixities
        ["base"]
        [import_ "Prelude" & hiding_ ["$"]]
        [ (unqual "$", defaultFixityApproximation),
          (unqual "+", FixityApproximation (Just InfixL) 6 6),
          (unqual "++", FixityApproximation (Just InfixR) 5 5)
        ]
    it "handles qualified imports with explicit import lists correctly" $
      checkFixities
        ["base"]
        [import_ "Prelude" & qualified_ & exactly_ ["$"]]
        [ (unqual "$", defaultFixityApproximation),
          (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", defaultFixityApproximation),
          (qual "Prelude" "+", defaultFixityApproximation)
        ]
    it "handles qualified import with hiding correctly" $
      checkFixities
        ["base"]
        [import_ "Prelude" & qualified_ & hiding_ ["$"]]
        [ (unqual "$", defaultFixityApproximation),
          (qual "Prelude" "$", defaultFixityApproximation),
          (unqual "+", defaultFixityApproximation),
          (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
        ]
    it "handles qualified import and explicit import lists correctly (1)" $
      checkFixities
        ["base"]
        [ import_ "Prelude" & qualified_,
          import_ "Prelude" & exactly_ ["$"]
        ]
        [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
          (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", defaultFixityApproximation),
          (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
        ]
    it "handles qualified import and explicit import lists correctly (2)" $
      checkFixities
        ["base"]
        [ import_ "Prelude" & exactly_ ["$"],
          import_ "Prelude" & qualified_
        ]
        [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
          (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", defaultFixityApproximation),
          (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
        ]
    it "handles qualified import and hiding import correctly (1)" $
      checkFixities
        ["base"]
        [ import_ "Prelude" & qualified_,
          import_ "Prelude" & hiding_ ["$"]
        ]
        [ (unqual "$", defaultFixityApproximation),
          (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", FixityApproximation (Just InfixL) 6 6),
          (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
        ]
    it "handles qualified import and hiding import correctly (2)" $
      checkFixities
        ["base"]
        [ import_ "Prelude" & hiding_ ["$"],
          import_ "Prelude" & qualified_
        ]
        [ (unqual "$", defaultFixityApproximation),
          (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
          (unqual "+", FixityApproximation (Just InfixL) 6 6),
          (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
        ]
    it "works for several imports from different packages" $
      checkFixities
        ["base", "esqueleto"]
        [ import_ "Prelude",
          import_ "Database.Esqueleto.Experimental" & qualified_ & as_ "E"
        ]
        [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
          (qual "E" "++.", FixityApproximation (Just InfixR) 5 5),
          (qual "E" "on", FixityApproximation (Just InfixN) 9 9)
        ]
    it "merges approximations in case of a conflict" $
      checkFixities
        ["fclabels", "persistent"]
        [ import_ "Data.Label.Monadic",
          import_ "Database.Persist"
        ]
        [ (unqual "=.", FixityApproximation (Just InfixR) 2 3)
        ]
    it "correctly handles package-qualified imports (1)" $
      checkFixities
        ["esqueleto"]
        [package_ "esqueleto" $ import_ "Database.Esqueleto.Experimental"]
        [(unqual "++.", FixityApproximation (Just InfixR) 5 5)]
    it "correctly handles package-qualified imports (2)" $
      checkFixities
        ["esqueleto"]
        [package_ "bob" $ import_ "Database.Esqueleto.Experimental"]
        [(unqual "++.", defaultFixityApproximation)]
    it "default module re-exports: Control.Lens brings into scope Control.Lens.Lens" $
      checkFixities
        ["lens"]
        ( applyModuleReexports
            defaultModuleReexports
            [import_ "Control.Lens"]
        )
        [(unqual "<+~", FixityApproximation (Just InfixR) 4 4)]
    it "default module re-exports: Control.Lens qualified brings into scope Control.Lens.Lens" $
      checkFixities
        ["lens"]
        ( applyModuleReexports
            defaultModuleReexports
            [import_ "Control.Lens" & qualified_]
        )
        [ (unqual "<+~", defaultFixityApproximation),
          (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
          (qual "Control.Lens" "<+~", FixityApproximation (Just InfixR) 4 4)
        ]
    it "default module re-exports: Control.Lens qualified as brings into scope Control.Lens.Lens" $
      checkFixities
        ["lens"]
        ( applyModuleReexports
            defaultModuleReexports
            [import_ "Control.Lens" & qualified_ & as_ "L"]
        )
        [ (unqual "<+~", defaultFixityApproximation),
          (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
          (qual "Control.Lens" "<+~", defaultFixityApproximation),
          (qual "L" "<+~", FixityApproximation (Just InfixR) 4 4)
        ]
    it "re-export chains: exported module can itself re-export another module" $ do
      let reexports =
            ModuleReexports $
              Map.insert
                "Foo"
                ((Nothing, "Control.Lens") :| [])
                (unModuleReexports defaultModuleReexports)
      checkFixities
        ["lens"]
        ( applyModuleReexports
            reexports
            [import_ "Foo"]
        )
        [ (unqual "<+~", FixityApproximation (Just InfixR) 4 4)
        ]
  
  -- | Build a fixity map using the Hoogle database and then check the fixity
  -- of the specified subset of operators.
  checkFixities ::
    -- | List of dependencies
    [PackageName] ->
    -- | Imports
    [FixityImport] ->
    -- | Associative list representing a subset of the resulting fixity map
    -- that should be checked.
    [(RdrName, FixityApproximation)] ->
    Expectation
  checkFixities dependencies fixityImports expectedResult =
    actualResult `shouldBe` expectedResult
    where
      actualResult =
        fmap
          (\(k, _) -> (k, inferFixity (Without #debug) k resultMap))
          expectedResult
      resultMap =
        moduleFixityMap
          (packageFixityMap (Set.fromList dependencies))
          fixityImports
  
  qual :: String -> OpName -> RdrName
  qual moduleName opName = mkRdrQual (mkModuleName moduleName) (opNameToOccName opName)
  
  unqual :: OpName -> RdrName
  unqual = mkRdrUnqual . opNameToOccName
  
  opNameToOccName :: OpName -> OccName
  opNameToOccName = mkVarOcc . T.unpack . unOpName
  
  -- | Explicitly specify the package.
  package_ :: PackageName -> FixityImport -> FixityImport
  package_ packageName fixityImport =
    fixityImport
      { fimportPackage = Just packageName
      }
  
  -- | Construct a simple 'FixityImport'.
  import_ :: ModuleName -> FixityImport
  import_ moduleName =
    FixityImport
      { fimportPackage = Nothing,
        fimportModule = moduleName,
        fimportQualified = UnqualifiedAndQualified moduleName,
        fimportList = Nothing
      }
  
  -- | Adds an alias for an import.
  as_ :: ModuleName -> FixityImport -> FixityImport
  as_ moduleName fixityImport =
    fixityImport
      { fimportQualified = case fimportQualified fixityImport of
          UnqualifiedAndQualified _ -> UnqualifiedAndQualified moduleName
          OnlyQualified _ -> OnlyQualified moduleName
      }
  
  -- | Qualified imports.
  qualified_ :: FixityImport -> FixityImport
  qualified_ fixityImport =
    fixityImport
      { fimportQualified = case fimportQualified fixityImport of
          UnqualifiedAndQualified m -> OnlyQualified m
          OnlyQualified m -> OnlyQualified m
      }
  
  -- | Exact import lists.
  exactly_ :: [OpName] -> FixityImport -> FixityImport
  exactly_ opNames fixityImports =
    fixityImports
      { fimportList = Just (Exactly, opNames)
      }
  
  -- | Hiding.
  hiding_ :: [OpName] -> FixityImport -> FixityImport
  hiding_ opNames fixityImports =
    fixityImports
      { fimportList = Just (EverythingBut, opNames)
      }
  