{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Ormolu.Fixity.Internal
  ( OpName,
    pattern OpName,
    unOpName,
    occOpName,
    FixityDirection (..),
    FixityInfo (..),
    colonFixityInfo,
    defaultFixityInfo,
    FixityApproximation (..),
    defaultFixityApproximation,
    HackageInfo (..),
    FixityOverrides (..),
    defaultFixityOverrides,
    ModuleReexports (..),
    defaultModuleReexports,
    PackageFixityMap (..),
    ModuleFixityMap (..),
    FixityProvenance (..),
    FixityQualification (..),
    inferFixity,
  )
where

import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as SBS
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Distribution.ModuleName (ModuleName)
import Distribution.Types.PackageName
import GHC.Data.FastString (fs_sbs)
import GHC.Generics (Generic)
import GHC.Types.Name (OccName (occNameFS))
import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)
import Ormolu.Utils (ghcModuleNameToCabal)

-- | An operator name.
newtype OpName = MkOpName
  { -- | Invariant: UTF-8 encoded
    OpName -> ShortByteString
getOpName :: ShortByteString
  }
  deriving newtype (OpName -> OpName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpName -> OpName -> Bool
$c/= :: OpName -> OpName -> Bool
== :: OpName -> OpName -> Bool
$c== :: OpName -> OpName -> Bool
Eq, Eq OpName
OpName -> OpName -> Bool
OpName -> OpName -> Ordering
OpName -> OpName -> OpName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpName -> OpName -> OpName
$cmin :: OpName -> OpName -> OpName
max :: OpName -> OpName -> OpName
$cmax :: OpName -> OpName -> OpName
>= :: OpName -> OpName -> Bool
$c>= :: OpName -> OpName -> Bool
> :: OpName -> OpName -> Bool
$c> :: OpName -> OpName -> Bool
<= :: OpName -> OpName -> Bool
$c<= :: OpName -> OpName -> Bool
< :: OpName -> OpName -> Bool
$c< :: OpName -> OpName -> Bool
compare :: OpName -> OpName -> Ordering
$ccompare :: OpName -> OpName -> Ordering
Ord, Get OpName
[OpName] -> Put
OpName -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [OpName] -> Put
$cputList :: [OpName] -> Put
get :: Get OpName
$cget :: Get OpName
put :: OpName -> Put
$cput :: OpName -> Put
Binary, OpName -> ()
forall a. (a -> ()) -> NFData a
rnf :: OpName -> ()
$crnf :: OpName -> ()
NFData)

-- | Convert an 'OpName' to 'Text'.
unOpName :: OpName -> Text
unOpName :: OpName -> Text
unOpName = ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName -> ShortByteString
getOpName

pattern OpName :: Text -> OpName
pattern $bOpName :: Text -> OpName
$mOpName :: forall {r}. OpName -> (Text -> r) -> ((# #) -> r) -> r
OpName opName <- (unOpName -> opName)
  where
    OpName = ShortByteString -> OpName
MkOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

{-# COMPLETE OpName #-}

-- | Convert an 'OccName to an 'OpName'.
occOpName :: OccName -> OpName
occOpName :: OccName -> OpName
occOpName = ShortByteString -> OpName
MkOpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ShortByteString
fs_sbs forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

instance Show OpName where
  show :: OpName -> String
show = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName -> Text
unOpName

instance IsString OpName where
  fromString :: String -> OpName
fromString = Text -> OpName
OpName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Fixity direction.
data FixityDirection
  = InfixL
  | InfixR
  | InfixN
  deriving stock (FixityDirection -> FixityDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityDirection -> FixityDirection -> Bool
$c/= :: FixityDirection -> FixityDirection -> Bool
== :: FixityDirection -> FixityDirection -> Bool
$c== :: FixityDirection -> FixityDirection -> Bool
Eq, Eq FixityDirection
FixityDirection -> FixityDirection -> Bool
FixityDirection -> FixityDirection -> Ordering
FixityDirection -> FixityDirection -> FixityDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FixityDirection -> FixityDirection -> FixityDirection
$cmin :: FixityDirection -> FixityDirection -> FixityDirection
max :: FixityDirection -> FixityDirection -> FixityDirection
$cmax :: FixityDirection -> FixityDirection -> FixityDirection
>= :: FixityDirection -> FixityDirection -> Bool
$c>= :: FixityDirection -> FixityDirection -> Bool
> :: FixityDirection -> FixityDirection -> Bool
$c> :: FixityDirection -> FixityDirection -> Bool
<= :: FixityDirection -> FixityDirection -> Bool
$c<= :: FixityDirection -> FixityDirection -> Bool
< :: FixityDirection -> FixityDirection -> Bool
$c< :: FixityDirection -> FixityDirection -> Bool
compare :: FixityDirection -> FixityDirection -> Ordering
$ccompare :: FixityDirection -> FixityDirection -> Ordering
Ord, Int -> FixityDirection -> ShowS
[FixityDirection] -> ShowS
FixityDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityDirection] -> ShowS
$cshowList :: [FixityDirection] -> ShowS
show :: FixityDirection -> String
$cshow :: FixityDirection -> String
showsPrec :: Int -> FixityDirection -> ShowS
$cshowsPrec :: Int -> FixityDirection -> ShowS
Show, forall x. Rep FixityDirection x -> FixityDirection
forall x. FixityDirection -> Rep FixityDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FixityDirection x -> FixityDirection
$cfrom :: forall x. FixityDirection -> Rep FixityDirection x
Generic)
  deriving anyclass (Get FixityDirection
[FixityDirection] -> Put
FixityDirection -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FixityDirection] -> Put
$cputList :: [FixityDirection] -> Put
get :: Get FixityDirection
$cget :: Get FixityDirection
put :: FixityDirection -> Put
$cput :: FixityDirection -> Put
Binary, FixityDirection -> ()
forall a. (a -> ()) -> NFData a
rnf :: FixityDirection -> ()
$crnf :: FixityDirection -> ()
NFData)

-- | Fixity information about an infix operator. This type provides precise
-- information as opposed to 'FixityApproximation'.
data FixityInfo = FixityInfo
  { -- | Fixity direction
    FixityInfo -> FixityDirection
fiDirection :: FixityDirection,
    -- | Precedence
    FixityInfo -> Int
fiPrecedence :: Int
  }
  deriving stock (FixityInfo -> FixityInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityInfo -> FixityInfo -> Bool
$c/= :: FixityInfo -> FixityInfo -> Bool
== :: FixityInfo -> FixityInfo -> Bool
$c== :: FixityInfo -> FixityInfo -> Bool
Eq, Eq FixityInfo
FixityInfo -> FixityInfo -> Bool
FixityInfo -> FixityInfo -> Ordering
FixityInfo -> FixityInfo -> FixityInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FixityInfo -> FixityInfo -> FixityInfo
$cmin :: FixityInfo -> FixityInfo -> FixityInfo
max :: FixityInfo -> FixityInfo -> FixityInfo
$cmax :: FixityInfo -> FixityInfo -> FixityInfo
>= :: FixityInfo -> FixityInfo -> Bool
$c>= :: FixityInfo -> FixityInfo -> Bool
> :: FixityInfo -> FixityInfo -> Bool
$c> :: FixityInfo -> FixityInfo -> Bool
<= :: FixityInfo -> FixityInfo -> Bool
$c<= :: FixityInfo -> FixityInfo -> Bool
< :: FixityInfo -> FixityInfo -> Bool
$c< :: FixityInfo -> FixityInfo -> Bool
compare :: FixityInfo -> FixityInfo -> Ordering
$ccompare :: FixityInfo -> FixityInfo -> Ordering
Ord, Int -> FixityInfo -> ShowS
[FixityInfo] -> ShowS
FixityInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityInfo] -> ShowS
$cshowList :: [FixityInfo] -> ShowS
show :: FixityInfo -> String
$cshow :: FixityInfo -> String
showsPrec :: Int -> FixityInfo -> ShowS
$cshowsPrec :: Int -> FixityInfo -> ShowS
Show, forall x. Rep FixityInfo x -> FixityInfo
forall x. FixityInfo -> Rep FixityInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FixityInfo x -> FixityInfo
$cfrom :: forall x. FixityInfo -> Rep FixityInfo x
Generic)
  deriving anyclass (Get FixityInfo
[FixityInfo] -> Put
FixityInfo -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FixityInfo] -> Put
$cputList :: [FixityInfo] -> Put
get :: Get FixityInfo
$cget :: Get FixityInfo
put :: FixityInfo -> Put
$cput :: FixityInfo -> Put
Binary, FixityInfo -> ()
forall a. (a -> ()) -> NFData a
rnf :: FixityInfo -> ()
$crnf :: FixityInfo -> ()
NFData)

-- | Fixity info of the built-in colon data constructor.
colonFixityInfo :: FixityInfo
colonFixityInfo :: FixityInfo
colonFixityInfo = FixityDirection -> Int -> FixityInfo
FixityInfo FixityDirection
InfixR Int
5

-- | Fixity that is implicitly assumed if no fixity declaration is present.
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo = FixityDirection -> Int -> FixityInfo
FixityInfo FixityDirection
InfixL Int
9

-- | Approximation of fixity information that takes the uncertainty that can
-- arise from conflicting definitions into account.
data FixityApproximation = FixityApproximation
  { -- | Fixity direction if it is known
    FixityApproximation -> Maybe FixityDirection
faDirection :: Maybe FixityDirection,
    -- | Minimum precedence level found in the (maybe conflicting)
    -- definitions for the operator (inclusive)
    FixityApproximation -> Int
faMinPrecedence :: Int,
    -- | Maximum precedence level found in the (maybe conflicting)
    -- definitions for the operator (inclusive)
    FixityApproximation -> Int
faMaxPrecedence :: Int
  }
  deriving stock (FixityApproximation -> FixityApproximation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityApproximation -> FixityApproximation -> Bool
$c/= :: FixityApproximation -> FixityApproximation -> Bool
== :: FixityApproximation -> FixityApproximation -> Bool
$c== :: FixityApproximation -> FixityApproximation -> Bool
Eq, Eq FixityApproximation
FixityApproximation -> FixityApproximation -> Bool
FixityApproximation -> FixityApproximation -> Ordering
FixityApproximation -> FixityApproximation -> FixityApproximation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FixityApproximation -> FixityApproximation -> FixityApproximation
$cmin :: FixityApproximation -> FixityApproximation -> FixityApproximation
max :: FixityApproximation -> FixityApproximation -> FixityApproximation
$cmax :: FixityApproximation -> FixityApproximation -> FixityApproximation
>= :: FixityApproximation -> FixityApproximation -> Bool
$c>= :: FixityApproximation -> FixityApproximation -> Bool
> :: FixityApproximation -> FixityApproximation -> Bool
$c> :: FixityApproximation -> FixityApproximation -> Bool
<= :: FixityApproximation -> FixityApproximation -> Bool
$c<= :: FixityApproximation -> FixityApproximation -> Bool
< :: FixityApproximation -> FixityApproximation -> Bool
$c< :: FixityApproximation -> FixityApproximation -> Bool
compare :: FixityApproximation -> FixityApproximation -> Ordering
$ccompare :: FixityApproximation -> FixityApproximation -> Ordering
Ord, Int -> FixityApproximation -> ShowS
[FixityApproximation] -> ShowS
FixityApproximation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityApproximation] -> ShowS
$cshowList :: [FixityApproximation] -> ShowS
show :: FixityApproximation -> String
$cshow :: FixityApproximation -> String
showsPrec :: Int -> FixityApproximation -> ShowS
$cshowsPrec :: Int -> FixityApproximation -> ShowS
Show, forall x. Rep FixityApproximation x -> FixityApproximation
forall x. FixityApproximation -> Rep FixityApproximation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FixityApproximation x -> FixityApproximation
$cfrom :: forall x. FixityApproximation -> Rep FixityApproximation x
Generic)
  deriving anyclass (Get FixityApproximation
[FixityApproximation] -> Put
FixityApproximation -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FixityApproximation] -> Put
$cputList :: [FixityApproximation] -> Put
get :: Get FixityApproximation
$cget :: Get FixityApproximation
put :: FixityApproximation -> Put
$cput :: FixityApproximation -> Put
Binary, FixityApproximation -> ()
forall a. (a -> ()) -> NFData a
rnf :: FixityApproximation -> ()
$crnf :: FixityApproximation -> ()
NFData)

-- | Gives the ability to merge two (maybe conflicting) definitions for an
-- operator, keeping the higher level of compatible information from both.
instance Semigroup FixityApproximation where
  FixityApproximation {faDirection :: FixityApproximation -> Maybe FixityDirection
faDirection = Maybe FixityDirection
dir1, faMinPrecedence :: FixityApproximation -> Int
faMinPrecedence = Int
min1, faMaxPrecedence :: FixityApproximation -> Int
faMaxPrecedence = Int
max1}
    <> :: FixityApproximation -> FixityApproximation -> FixityApproximation
<> FixityApproximation {faDirection :: FixityApproximation -> Maybe FixityDirection
faDirection = Maybe FixityDirection
dir2, faMinPrecedence :: FixityApproximation -> Int
faMinPrecedence = Int
min2, faMaxPrecedence :: FixityApproximation -> Int
faMaxPrecedence = Int
max2} =
      FixityApproximation
        { faDirection :: Maybe FixityDirection
faDirection = Maybe FixityDirection
dir',
          faMinPrecedence :: Int
faMinPrecedence = forall a. Ord a => a -> a -> a
min Int
min1 Int
min2,
          faMaxPrecedence :: Int
faMaxPrecedence = forall a. Ord a => a -> a -> a
max Int
max1 Int
max2
        }
      where
        dir' :: Maybe FixityDirection
dir' = case (Maybe FixityDirection
dir1, Maybe FixityDirection
dir2) of
          (Just FixityDirection
a, Just FixityDirection
b) | FixityDirection
a forall a. Eq a => a -> a -> Bool
== FixityDirection
b -> forall a. a -> Maybe a
Just FixityDirection
a
          (Maybe FixityDirection, Maybe FixityDirection)
_ -> forall a. Maybe a
Nothing

-- | The lowest level of information we can have about an operator.
defaultFixityApproximation :: FixityApproximation
defaultFixityApproximation :: FixityApproximation
defaultFixityApproximation = FixityInfo -> FixityApproximation
fixityInfoToApproximation FixityInfo
defaultFixityInfo

-- | Convert from 'FixityInfo' to 'FixityApproximation'.
fixityInfoToApproximation :: FixityInfo -> FixityApproximation
fixityInfoToApproximation :: FixityInfo -> FixityApproximation
fixityInfoToApproximation FixityInfo {Int
FixityDirection
fiPrecedence :: Int
fiDirection :: FixityDirection
fiPrecedence :: FixityInfo -> Int
fiDirection :: FixityInfo -> FixityDirection
..} =
  FixityApproximation
    { faDirection :: Maybe FixityDirection
faDirection = forall a. a -> Maybe a
Just FixityDirection
fiDirection,
      faMinPrecedence :: Int
faMinPrecedence = Int
fiPrecedence,
      faMaxPrecedence :: Int
faMaxPrecedence = Int
fiPrecedence
    }

-- | The map of operators declared by each package grouped by module name.
newtype HackageInfo
  = HackageInfo (Map PackageName (Map ModuleName (Map OpName FixityInfo)))
  deriving stock (forall x. Rep HackageInfo x -> HackageInfo
forall x. HackageInfo -> Rep HackageInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HackageInfo x -> HackageInfo
$cfrom :: forall x. HackageInfo -> Rep HackageInfo x
Generic)
  deriving anyclass (Get HackageInfo
[HackageInfo] -> Put
HackageInfo -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [HackageInfo] -> Put
$cputList :: [HackageInfo] -> Put
get :: Get HackageInfo
$cget :: Get HackageInfo
put :: HackageInfo -> Put
$cput :: HackageInfo -> Put
Binary, HackageInfo -> ()
forall a. (a -> ()) -> NFData a
rnf :: HackageInfo -> ()
$crnf :: HackageInfo -> ()
NFData)

-- | Map from the operator name to its 'FixityInfo'.
newtype FixityOverrides = FixityOverrides
  { FixityOverrides -> Map OpName FixityInfo
unFixityOverrides :: Map OpName FixityInfo
  }
  deriving stock (FixityOverrides -> FixityOverrides -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityOverrides -> FixityOverrides -> Bool
$c/= :: FixityOverrides -> FixityOverrides -> Bool
== :: FixityOverrides -> FixityOverrides -> Bool
$c== :: FixityOverrides -> FixityOverrides -> Bool
Eq, Int -> FixityOverrides -> ShowS
[FixityOverrides] -> ShowS
FixityOverrides -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityOverrides] -> ShowS
$cshowList :: [FixityOverrides] -> ShowS
show :: FixityOverrides -> String
$cshow :: FixityOverrides -> String
showsPrec :: Int -> FixityOverrides -> ShowS
$cshowsPrec :: Int -> FixityOverrides -> ShowS
Show)

-- | Fixity overrides to use by default.
defaultFixityOverrides :: FixityOverrides
defaultFixityOverrides :: FixityOverrides
defaultFixityOverrides = Map OpName FixityInfo -> FixityOverrides
FixityOverrides forall k a. Map k a
Map.empty

-- | Module re-exports
newtype ModuleReexports = ModuleReexports
  { ModuleReexports
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
unModuleReexports :: Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
  }
  deriving stock (ModuleReexports -> ModuleReexports -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleReexports -> ModuleReexports -> Bool
$c/= :: ModuleReexports -> ModuleReexports -> Bool
== :: ModuleReexports -> ModuleReexports -> Bool
$c== :: ModuleReexports -> ModuleReexports -> Bool
Eq, Int -> ModuleReexports -> ShowS
[ModuleReexports] -> ShowS
ModuleReexports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleReexports] -> ShowS
$cshowList :: [ModuleReexports] -> ShowS
show :: ModuleReexports -> String
$cshow :: ModuleReexports -> String
showsPrec :: Int -> ModuleReexports -> ShowS
$cshowsPrec :: Int -> ModuleReexports -> ShowS
Show)

-- | Module re-exports to apply by default.
defaultModuleReexports :: ModuleReexports
defaultModuleReexports :: ModuleReexports
defaultModuleReexports =
  Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports
ModuleReexports forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
    [ ( ModuleName
"Control.Lens",
        forall {a} {a}. a -> [a] -> NonEmpty (Maybe a, a)
l
          PackageName
"lens"
          [ ModuleName
"Control.Lens.At",
            ModuleName
"Control.Lens.Cons",
            ModuleName
"Control.Lens.Each",
            ModuleName
"Control.Lens.Empty",
            ModuleName
"Control.Lens.Equality",
            ModuleName
"Control.Lens.Fold",
            ModuleName
"Control.Lens.Getter",
            ModuleName
"Control.Lens.Indexed",
            ModuleName
"Control.Lens.Iso",
            ModuleName
"Control.Lens.Lens",
            ModuleName
"Control.Lens.Level",
            ModuleName
"Control.Lens.Plated",
            ModuleName
"Control.Lens.Prism",
            ModuleName
"Control.Lens.Reified",
            ModuleName
"Control.Lens.Review",
            ModuleName
"Control.Lens.Setter",
            ModuleName
"Control.Lens.TH",
            ModuleName
"Control.Lens.Traversal",
            ModuleName
"Control.Lens.Tuple",
            ModuleName
"Control.Lens.Type",
            ModuleName
"Control.Lens.Wrapped",
            ModuleName
"Control.Lens.Zoom"
          ]
      ),
      ( ModuleName
"Servant",
        forall {a} {a}. a -> [a] -> NonEmpty (Maybe a, a)
l
          PackageName
"servant"
          [ ModuleName
"Servant.API"
          ]
      ),
      ( ModuleName
"Optics",
        forall {a} {a}. a -> [a] -> NonEmpty (Maybe a, a)
l
          PackageName
"optics"
          [ ModuleName
"Optics.Fold",
            ModuleName
"Optics.Operators",
            ModuleName
"Optics.IxAffineFold",
            ModuleName
"Optics.IxFold",
            ModuleName
"Optics.IxTraversal",
            ModuleName
"Optics.Traversal"
          ]
      ),
      ( ModuleName
"Test.Hspec",
        forall {a} {a}. a -> [a] -> NonEmpty (Maybe a, a)
l
          PackageName
"hspec-expectations"
          [ ModuleName
"Test.Hspec.Expectations"
          ]
      )
    ]
  where
    l :: a -> [a] -> NonEmpty (Maybe a, a)
l a
packageName [a]
xs = (forall a. a -> Maybe a
Just a
packageName,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> NonEmpty a
NE.fromList [a]
xs

-- | Fixity information that is specific to a package being formatted. It
-- requires module-specific imports in order to be usable.
newtype PackageFixityMap
  = PackageFixityMap (Map OpName (NonEmpty (PackageName, ModuleName, FixityInfo)))
  deriving stock (PackageFixityMap -> PackageFixityMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageFixityMap -> PackageFixityMap -> Bool
$c/= :: PackageFixityMap -> PackageFixityMap -> Bool
== :: PackageFixityMap -> PackageFixityMap -> Bool
$c== :: PackageFixityMap -> PackageFixityMap -> Bool
Eq, Int -> PackageFixityMap -> ShowS
[PackageFixityMap] -> ShowS
PackageFixityMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageFixityMap] -> ShowS
$cshowList :: [PackageFixityMap] -> ShowS
show :: PackageFixityMap -> String
$cshow :: PackageFixityMap -> String
showsPrec :: Int -> PackageFixityMap -> ShowS
$cshowsPrec :: Int -> PackageFixityMap -> ShowS
Show)

-- | Fixity map that takes into account imports in a particular module.
newtype ModuleFixityMap
  = ModuleFixityMap (Map OpName FixityProvenance)
  deriving stock (ModuleFixityMap -> ModuleFixityMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleFixityMap -> ModuleFixityMap -> Bool
$c/= :: ModuleFixityMap -> ModuleFixityMap -> Bool
== :: ModuleFixityMap -> ModuleFixityMap -> Bool
$c== :: ModuleFixityMap -> ModuleFixityMap -> Bool
Eq, Int -> ModuleFixityMap -> ShowS
[ModuleFixityMap] -> ShowS
ModuleFixityMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleFixityMap] -> ShowS
$cshowList :: [ModuleFixityMap] -> ShowS
show :: ModuleFixityMap -> String
$cshow :: ModuleFixityMap -> String
showsPrec :: Int -> ModuleFixityMap -> ShowS
$cshowsPrec :: Int -> ModuleFixityMap -> ShowS
Show)

-- | Provenance of fixity info.
data FixityProvenance
  = -- | 'FixityInfo' of a built-in operator or provided by a user override.
    Given FixityInfo
  | -- | 'FixityInfo' to be inferred from module imports.
    FromModuleImports (NonEmpty (FixityQualification, FixityInfo))
  deriving stock (FixityProvenance -> FixityProvenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityProvenance -> FixityProvenance -> Bool
$c/= :: FixityProvenance -> FixityProvenance -> Bool
== :: FixityProvenance -> FixityProvenance -> Bool
$c== :: FixityProvenance -> FixityProvenance -> Bool
Eq, Int -> FixityProvenance -> ShowS
[FixityProvenance] -> ShowS
FixityProvenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityProvenance] -> ShowS
$cshowList :: [FixityProvenance] -> ShowS
show :: FixityProvenance -> String
$cshow :: FixityProvenance -> String
showsPrec :: Int -> FixityProvenance -> ShowS
$cshowsPrec :: Int -> FixityProvenance -> ShowS
Show)

-- | Fixity qualification that determines how 'FixityInfo' matches a
-- particular use of an operator, given whether it is qualified or
-- unqualified and the module name used.
data FixityQualification
  = UnqualifiedAndQualified ModuleName
  | OnlyQualified ModuleName
  deriving stock (FixityQualification -> FixityQualification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixityQualification -> FixityQualification -> Bool
$c/= :: FixityQualification -> FixityQualification -> Bool
== :: FixityQualification -> FixityQualification -> Bool
$c== :: FixityQualification -> FixityQualification -> Bool
Eq, Int -> FixityQualification -> ShowS
[FixityQualification] -> ShowS
FixityQualification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixityQualification] -> ShowS
$cshowList :: [FixityQualification] -> ShowS
show :: FixityQualification -> String
$cshow :: FixityQualification -> String
showsPrec :: Int -> FixityQualification -> ShowS
$cshowsPrec :: Int -> FixityQualification -> ShowS
Show)

-- | Get a 'FixityApproximation' of an operator.
inferFixity :: RdrName -> ModuleFixityMap -> FixityApproximation
inferFixity :: RdrName -> ModuleFixityMap -> FixityApproximation
inferFixity RdrName
rdrName (ModuleFixityMap Map OpName FixityProvenance
m) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OpName
opName Map OpName FixityProvenance
m of
    Maybe FixityProvenance
Nothing -> FixityApproximation
defaultFixityApproximation
    Just (Given FixityInfo
fixityInfo) ->
      FixityInfo -> FixityApproximation
fixityInfoToApproximation FixityInfo
fixityInfo
    Just (FromModuleImports NonEmpty (FixityQualification, FixityInfo)
xs) ->
      let isMatching :: (FixityQualification, b) -> Bool
isMatching (FixityQualification
provenance, b
_fixityInfo) =
            case FixityQualification
provenance of
              UnqualifiedAndQualified ModuleName
mn ->
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Eq a => a -> a -> Bool
== ModuleName
mn) Maybe ModuleName
moduleName
              OnlyQualified ModuleName
mn ->
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
== ModuleName
mn) Maybe ModuleName
moduleName
       in forall a. a -> Maybe a -> a
fromMaybe FixityApproximation
defaultFixityApproximation
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixityInfo -> FixityApproximation
fixityInfoToApproximation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
            forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter forall {b}. (FixityQualification, b) -> Bool
isMatching NonEmpty (FixityQualification, FixityInfo)
xs
  where
    opName :: OpName
opName = OccName -> OpName
occOpName (RdrName -> OccName
rdrNameOcc RdrName
rdrName)
    moduleName :: Maybe ModuleName
moduleName = case RdrName
rdrName of
      Qual ModuleName
x OccName
_ -> forall a. a -> Maybe a
Just (ModuleName -> ModuleName
ghcModuleNameToCabal ModuleName
x)
      RdrName
_ -> forall a. Maybe a
Nothing