{-# LANGUAGE DataKinds #-}
{-# 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 Data.Binary (Binary)
import Data.Binary qualified as Binary
import Data.Binary.Get qualified as Binary
import Data.Binary.Put qualified as Binary
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as SBS
import Data.Choice (Choice)
import Data.Choice qualified as Choice
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 Debug.Trace (trace)
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
(OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool) -> Eq OpName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpName -> OpName -> Bool
== :: OpName -> OpName -> Bool
$c/= :: OpName -> OpName -> Bool
/= :: OpName -> OpName -> Bool
Eq, Eq OpName
Eq OpName =>
(OpName -> OpName -> Ordering)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> OpName)
-> (OpName -> OpName -> OpName)
-> Ord 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
$ccompare :: OpName -> OpName -> Ordering
compare :: OpName -> OpName -> Ordering
$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
>= :: OpName -> OpName -> Bool
$cmax :: OpName -> OpName -> OpName
max :: OpName -> OpName -> OpName
$cmin :: OpName -> OpName -> OpName
min :: OpName -> OpName -> OpName
Ord, Get OpName
[OpName] -> Put
OpName -> Put
(OpName -> Put) -> Get OpName -> ([OpName] -> Put) -> Binary OpName
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: OpName -> Put
put :: OpName -> Put
$cget :: Get OpName
get :: Get OpName
$cputList :: [OpName] -> Put
putList :: [OpName] -> Put
Binary)

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

pattern OpName :: Text -> OpName
pattern $mOpName :: forall {r}. OpName -> (Text -> r) -> ((# #) -> r) -> r
$bOpName :: Text -> OpName
OpName opName <- (unOpName -> opName)
  where
    OpName = ShortByteString -> OpName
MkOpName (ShortByteString -> OpName)
-> (Text -> ShortByteString) -> Text -> OpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Text -> ByteString) -> Text -> ShortByteString
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 (ShortByteString -> OpName)
-> (OccName -> ShortByteString) -> OccName -> OpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ShortByteString
fs_sbs (FastString -> ShortByteString)
-> (OccName -> FastString) -> OccName -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

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

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

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

-- | 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 -> Double
fiPrecedence :: Double
  }
  deriving stock (FixityInfo -> FixityInfo -> Bool
(FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> Bool) -> Eq FixityInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityInfo -> FixityInfo -> Bool
== :: FixityInfo -> FixityInfo -> Bool
$c/= :: FixityInfo -> FixityInfo -> Bool
/= :: FixityInfo -> FixityInfo -> Bool
Eq, Eq FixityInfo
Eq FixityInfo =>
(FixityInfo -> FixityInfo -> Ordering)
-> (FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> FixityInfo)
-> (FixityInfo -> FixityInfo -> FixityInfo)
-> Ord 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
$ccompare :: FixityInfo -> FixityInfo -> Ordering
compare :: FixityInfo -> FixityInfo -> Ordering
$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
>= :: FixityInfo -> FixityInfo -> Bool
$cmax :: FixityInfo -> FixityInfo -> FixityInfo
max :: FixityInfo -> FixityInfo -> FixityInfo
$cmin :: FixityInfo -> FixityInfo -> FixityInfo
min :: FixityInfo -> FixityInfo -> FixityInfo
Ord, Int -> FixityInfo -> ShowS
[FixityInfo] -> ShowS
FixityInfo -> [Char]
(Int -> FixityInfo -> ShowS)
-> (FixityInfo -> [Char])
-> ([FixityInfo] -> ShowS)
-> Show FixityInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityInfo -> ShowS
showsPrec :: Int -> FixityInfo -> ShowS
$cshow :: FixityInfo -> [Char]
show :: FixityInfo -> [Char]
$cshowList :: [FixityInfo] -> ShowS
showList :: [FixityInfo] -> ShowS
Show, (forall x. FixityInfo -> Rep FixityInfo x)
-> (forall x. Rep FixityInfo x -> FixityInfo) -> Generic FixityInfo
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
$cfrom :: forall x. FixityInfo -> Rep FixityInfo x
from :: forall x. FixityInfo -> Rep FixityInfo x
$cto :: forall x. Rep FixityInfo x -> FixityInfo
to :: forall x. Rep FixityInfo x -> FixityInfo
Generic)

instance Binary FixityInfo where
  put :: FixityInfo -> Put
put FixityInfo {Double
FixityDirection
fiDirection :: FixityInfo -> FixityDirection
fiPrecedence :: FixityInfo -> Double
fiDirection :: FixityDirection
fiPrecedence :: Double
..} = do
    FixityDirection -> Put
forall t. Binary t => t -> Put
Binary.put FixityDirection
fiDirection
    Double -> Put
Binary.putDoublele Double
fiPrecedence

  get :: Get FixityInfo
get = do
    FixityDirection
fiDirection <- Get FixityDirection
forall t. Binary t => Get t
Binary.get
    Double
fiPrecedence <- Get Double
Binary.getDoublele
    FixityInfo -> Get FixityInfo
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityInfo {Double
FixityDirection
fiDirection :: FixityDirection
fiPrecedence :: Double
fiDirection :: FixityDirection
fiPrecedence :: Double
..}

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

-- | Fixity that is implicitly assumed if no fixity declaration is present.
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo = FixityDirection -> Double -> FixityInfo
FixityInfo FixityDirection
InfixL Double
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 -> Double
faMinPrecedence :: Double,
    -- | Maximum precedence level found in the (maybe conflicting)
    -- definitions for the operator (inclusive)
    FixityApproximation -> Double
faMaxPrecedence :: Double
  }
  deriving stock (FixityApproximation -> FixityApproximation -> Bool
(FixityApproximation -> FixityApproximation -> Bool)
-> (FixityApproximation -> FixityApproximation -> Bool)
-> Eq FixityApproximation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityApproximation -> FixityApproximation -> Bool
== :: FixityApproximation -> FixityApproximation -> Bool
$c/= :: FixityApproximation -> FixityApproximation -> Bool
/= :: FixityApproximation -> FixityApproximation -> Bool
Eq, Eq FixityApproximation
Eq FixityApproximation =>
(FixityApproximation -> FixityApproximation -> Ordering)
-> (FixityApproximation -> FixityApproximation -> Bool)
-> (FixityApproximation -> FixityApproximation -> Bool)
-> (FixityApproximation -> FixityApproximation -> Bool)
-> (FixityApproximation -> FixityApproximation -> Bool)
-> (FixityApproximation
    -> FixityApproximation -> FixityApproximation)
-> (FixityApproximation
    -> FixityApproximation -> FixityApproximation)
-> Ord 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
$ccompare :: FixityApproximation -> FixityApproximation -> Ordering
compare :: FixityApproximation -> FixityApproximation -> Ordering
$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
>= :: FixityApproximation -> FixityApproximation -> Bool
$cmax :: FixityApproximation -> FixityApproximation -> FixityApproximation
max :: FixityApproximation -> FixityApproximation -> FixityApproximation
$cmin :: FixityApproximation -> FixityApproximation -> FixityApproximation
min :: FixityApproximation -> FixityApproximation -> FixityApproximation
Ord, Int -> FixityApproximation -> ShowS
[FixityApproximation] -> ShowS
FixityApproximation -> [Char]
(Int -> FixityApproximation -> ShowS)
-> (FixityApproximation -> [Char])
-> ([FixityApproximation] -> ShowS)
-> Show FixityApproximation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityApproximation -> ShowS
showsPrec :: Int -> FixityApproximation -> ShowS
$cshow :: FixityApproximation -> [Char]
show :: FixityApproximation -> [Char]
$cshowList :: [FixityApproximation] -> ShowS
showList :: [FixityApproximation] -> ShowS
Show, (forall x. FixityApproximation -> Rep FixityApproximation x)
-> (forall x. Rep FixityApproximation x -> FixityApproximation)
-> Generic FixityApproximation
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
$cfrom :: forall x. FixityApproximation -> Rep FixityApproximation x
from :: forall x. FixityApproximation -> Rep FixityApproximation x
$cto :: forall x. Rep FixityApproximation x -> FixityApproximation
to :: forall x. Rep FixityApproximation x -> FixityApproximation
Generic)

instance Binary FixityApproximation where
  put :: FixityApproximation -> Put
put FixityApproximation {Double
Maybe FixityDirection
faDirection :: FixityApproximation -> Maybe FixityDirection
faMinPrecedence :: FixityApproximation -> Double
faMaxPrecedence :: FixityApproximation -> Double
faDirection :: Maybe FixityDirection
faMinPrecedence :: Double
faMaxPrecedence :: Double
..} = do
    Maybe FixityDirection -> Put
forall t. Binary t => t -> Put
Binary.put Maybe FixityDirection
faDirection
    Double -> Put
Binary.putDoublele Double
faMinPrecedence
    Double -> Put
Binary.putDoublele Double
faMaxPrecedence

  get :: Get FixityApproximation
get = do
    Maybe FixityDirection
faDirection <- Get (Maybe FixityDirection)
forall t. Binary t => Get t
Binary.get
    Double
faMinPrecedence <- Get Double
Binary.getDoublele
    Double
faMaxPrecedence <- Get Double
Binary.getDoublele
    FixityApproximation -> Get FixityApproximation
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityApproximation {Double
Maybe FixityDirection
faDirection :: Maybe FixityDirection
faMinPrecedence :: Double
faMaxPrecedence :: Double
faDirection :: Maybe FixityDirection
faMinPrecedence :: Double
faMaxPrecedence :: Double
..}

-- | 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 -> Double
faMinPrecedence = Double
min1, faMaxPrecedence :: FixityApproximation -> Double
faMaxPrecedence = Double
max1}
    <> :: FixityApproximation -> FixityApproximation -> FixityApproximation
<> FixityApproximation {faDirection :: FixityApproximation -> Maybe FixityDirection
faDirection = Maybe FixityDirection
dir2, faMinPrecedence :: FixityApproximation -> Double
faMinPrecedence = Double
min2, faMaxPrecedence :: FixityApproximation -> Double
faMaxPrecedence = Double
max2} =
      FixityApproximation
        { faDirection :: Maybe FixityDirection
faDirection = Maybe FixityDirection
dir',
          faMinPrecedence :: Double
faMinPrecedence = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
min1 Double
min2,
          faMaxPrecedence :: Double
faMaxPrecedence = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
max1 Double
max2
        }
      where
        dir' :: Maybe FixityDirection
dir' = case (Maybe FixityDirection
dir1, Maybe FixityDirection
dir2) of
          (Just FixityDirection
a, Just FixityDirection
b) | FixityDirection
a FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
b -> FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
a
          (Maybe FixityDirection, 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 {Double
FixityDirection
fiDirection :: FixityInfo -> FixityDirection
fiPrecedence :: FixityInfo -> Double
fiDirection :: FixityDirection
fiPrecedence :: Double
..} =
  FixityApproximation
    { faDirection :: Maybe FixityDirection
faDirection = FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
fiDirection,
      faMinPrecedence :: Double
faMinPrecedence = Double
fiPrecedence,
      faMaxPrecedence :: Double
faMaxPrecedence = Double
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. HackageInfo -> Rep HackageInfo x)
-> (forall x. Rep HackageInfo x -> HackageInfo)
-> Generic HackageInfo
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
$cfrom :: forall x. HackageInfo -> Rep HackageInfo x
from :: forall x. HackageInfo -> Rep HackageInfo x
$cto :: forall x. Rep HackageInfo x -> HackageInfo
to :: forall x. Rep HackageInfo x -> HackageInfo
Generic)
  deriving anyclass (Get HackageInfo
[HackageInfo] -> Put
HackageInfo -> Put
(HackageInfo -> Put)
-> Get HackageInfo -> ([HackageInfo] -> Put) -> Binary HackageInfo
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: HackageInfo -> Put
put :: HackageInfo -> Put
$cget :: Get HackageInfo
get :: Get HackageInfo
$cputList :: [HackageInfo] -> Put
putList :: [HackageInfo] -> Put
Binary)

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

-- | Fixity overrides to use by default.
defaultFixityOverrides :: FixityOverrides
defaultFixityOverrides :: FixityOverrides
defaultFixityOverrides = Map OpName FixityInfo -> FixityOverrides
FixityOverrides Map OpName FixityInfo
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
(ModuleReexports -> ModuleReexports -> Bool)
-> (ModuleReexports -> ModuleReexports -> Bool)
-> Eq ModuleReexports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleReexports -> ModuleReexports -> Bool
== :: ModuleReexports -> ModuleReexports -> Bool
$c/= :: ModuleReexports -> ModuleReexports -> Bool
/= :: ModuleReexports -> ModuleReexports -> Bool
Eq, Int -> ModuleReexports -> ShowS
[ModuleReexports] -> ShowS
ModuleReexports -> [Char]
(Int -> ModuleReexports -> ShowS)
-> (ModuleReexports -> [Char])
-> ([ModuleReexports] -> ShowS)
-> Show ModuleReexports
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleReexports -> ShowS
showsPrec :: Int -> ModuleReexports -> ShowS
$cshow :: ModuleReexports -> [Char]
show :: ModuleReexports -> [Char]
$cshowList :: [ModuleReexports] -> ShowS
showList :: [ModuleReexports] -> ShowS
Show)

-- | Module re-exports to apply by default.
defaultModuleReexports :: ModuleReexports
defaultModuleReexports :: ModuleReexports
defaultModuleReexports =
  Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports
ModuleReexports (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
 -> ModuleReexports)
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
    -> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName)))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ModuleReexports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
 -> ModuleReexports)
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ModuleReexports
forall a b. (a -> b) -> a -> b
$
    [ ( ModuleName
"Control.Lens",
        PackageName
-> [ModuleName] -> NonEmpty (Maybe PackageName, ModuleName)
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",
        PackageName
-> [ModuleName] -> NonEmpty (Maybe PackageName, ModuleName)
forall {a} {a}. a -> [a] -> NonEmpty (Maybe a, a)
l
          PackageName
"servant"
          [ ModuleName
"Servant.API"
          ]
      ),
      ( ModuleName
"Optics",
        PackageName
-> [ModuleName] -> NonEmpty (Maybe PackageName, ModuleName)
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",
        PackageName
-> [ModuleName] -> NonEmpty (Maybe PackageName, ModuleName)
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 = (a -> Maybe a
forall a. a -> Maybe a
Just a
packageName,) (a -> (Maybe a, a)) -> NonEmpty a -> NonEmpty (Maybe a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> NonEmpty a
forall a. HasCallStack => [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
(PackageFixityMap -> PackageFixityMap -> Bool)
-> (PackageFixityMap -> PackageFixityMap -> Bool)
-> Eq PackageFixityMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageFixityMap -> PackageFixityMap -> Bool
== :: PackageFixityMap -> PackageFixityMap -> Bool
$c/= :: PackageFixityMap -> PackageFixityMap -> Bool
/= :: PackageFixityMap -> PackageFixityMap -> Bool
Eq, Int -> PackageFixityMap -> ShowS
[PackageFixityMap] -> ShowS
PackageFixityMap -> [Char]
(Int -> PackageFixityMap -> ShowS)
-> (PackageFixityMap -> [Char])
-> ([PackageFixityMap] -> ShowS)
-> Show PackageFixityMap
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageFixityMap -> ShowS
showsPrec :: Int -> PackageFixityMap -> ShowS
$cshow :: PackageFixityMap -> [Char]
show :: PackageFixityMap -> [Char]
$cshowList :: [PackageFixityMap] -> ShowS
showList :: [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
(ModuleFixityMap -> ModuleFixityMap -> Bool)
-> (ModuleFixityMap -> ModuleFixityMap -> Bool)
-> Eq ModuleFixityMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleFixityMap -> ModuleFixityMap -> Bool
== :: ModuleFixityMap -> ModuleFixityMap -> Bool
$c/= :: ModuleFixityMap -> ModuleFixityMap -> Bool
/= :: ModuleFixityMap -> ModuleFixityMap -> Bool
Eq, Int -> ModuleFixityMap -> ShowS
[ModuleFixityMap] -> ShowS
ModuleFixityMap -> [Char]
(Int -> ModuleFixityMap -> ShowS)
-> (ModuleFixityMap -> [Char])
-> ([ModuleFixityMap] -> ShowS)
-> Show ModuleFixityMap
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleFixityMap -> ShowS
showsPrec :: Int -> ModuleFixityMap -> ShowS
$cshow :: ModuleFixityMap -> [Char]
show :: ModuleFixityMap -> [Char]
$cshowList :: [ModuleFixityMap] -> ShowS
showList :: [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
(FixityProvenance -> FixityProvenance -> Bool)
-> (FixityProvenance -> FixityProvenance -> Bool)
-> Eq FixityProvenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityProvenance -> FixityProvenance -> Bool
== :: FixityProvenance -> FixityProvenance -> Bool
$c/= :: FixityProvenance -> FixityProvenance -> Bool
/= :: FixityProvenance -> FixityProvenance -> Bool
Eq, Int -> FixityProvenance -> ShowS
[FixityProvenance] -> ShowS
FixityProvenance -> [Char]
(Int -> FixityProvenance -> ShowS)
-> (FixityProvenance -> [Char])
-> ([FixityProvenance] -> ShowS)
-> Show FixityProvenance
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityProvenance -> ShowS
showsPrec :: Int -> FixityProvenance -> ShowS
$cshow :: FixityProvenance -> [Char]
show :: FixityProvenance -> [Char]
$cshowList :: [FixityProvenance] -> ShowS
showList :: [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
(FixityQualification -> FixityQualification -> Bool)
-> (FixityQualification -> FixityQualification -> Bool)
-> Eq FixityQualification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityQualification -> FixityQualification -> Bool
== :: FixityQualification -> FixityQualification -> Bool
$c/= :: FixityQualification -> FixityQualification -> Bool
/= :: FixityQualification -> FixityQualification -> Bool
Eq, Int -> FixityQualification -> ShowS
[FixityQualification] -> ShowS
FixityQualification -> [Char]
(Int -> FixityQualification -> ShowS)
-> (FixityQualification -> [Char])
-> ([FixityQualification] -> ShowS)
-> Show FixityQualification
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityQualification -> ShowS
showsPrec :: Int -> FixityQualification -> ShowS
$cshow :: FixityQualification -> [Char]
show :: FixityQualification -> [Char]
$cshowList :: [FixityQualification] -> ShowS
showList :: [FixityQualification] -> ShowS
Show)

-- | Get a 'FixityApproximation' of an operator.
inferFixity ::
  -- | Whether to print debug info regarding fixity inference
  Choice "debug" ->
  -- | Operator name
  RdrName ->
  -- | Module fixity map
  ModuleFixityMap ->
  -- | The resulting fixity approximation
  FixityApproximation
inferFixity :: Choice "debug" -> RdrName -> ModuleFixityMap -> FixityApproximation
inferFixity Choice "debug"
debug RdrName
rdrName (ModuleFixityMap Map OpName FixityProvenance
m) =
  if Choice "debug" -> Bool
forall (a :: Symbol). Choice a -> Bool
Choice.isTrue Choice "debug"
debug
    then
      [Char] -> FixityApproximation -> FixityApproximation
forall a. [Char] -> a -> a
trace
        (OpName
-> Maybe ModuleName
-> Map OpName FixityProvenance
-> FixityApproximation
-> [Char]
renderFixityJustification OpName
opName Maybe ModuleName
moduleName Map OpName FixityProvenance
m FixityApproximation
result)
        FixityApproximation
result
    else FixityApproximation
result
  where
    result :: FixityApproximation
result =
      case OpName -> Map OpName FixityProvenance -> Maybe FixityProvenance
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 ->
                    Bool -> (ModuleName -> Bool) -> Maybe ModuleName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
mn) Maybe ModuleName
moduleName
                  OnlyQualified ModuleName
mn ->
                    Bool -> (ModuleName -> Bool) -> Maybe ModuleName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
mn) Maybe ModuleName
moduleName
           in FixityApproximation
-> Maybe FixityApproximation -> FixityApproximation
forall a. a -> Maybe a -> a
fromMaybe FixityApproximation
defaultFixityApproximation
                (Maybe FixityApproximation -> FixityApproximation)
-> ([(FixityQualification, FixityInfo)]
    -> Maybe FixityApproximation)
-> [(FixityQualification, FixityInfo)]
-> FixityApproximation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FixityQualification, FixityInfo) -> Maybe FixityApproximation)
-> [(FixityQualification, FixityInfo)] -> Maybe FixityApproximation
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FixityApproximation -> Maybe FixityApproximation
forall a. a -> Maybe a
Just (FixityApproximation -> Maybe FixityApproximation)
-> ((FixityQualification, FixityInfo) -> FixityApproximation)
-> (FixityQualification, FixityInfo)
-> Maybe FixityApproximation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixityInfo -> FixityApproximation
fixityInfoToApproximation (FixityInfo -> FixityApproximation)
-> ((FixityQualification, FixityInfo) -> FixityInfo)
-> (FixityQualification, FixityInfo)
-> FixityApproximation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FixityQualification, FixityInfo) -> FixityInfo
forall a b. (a, b) -> b
snd)
                ([(FixityQualification, FixityInfo)] -> FixityApproximation)
-> [(FixityQualification, FixityInfo)] -> FixityApproximation
forall a b. (a -> b) -> a -> b
$ ((FixityQualification, FixityInfo) -> Bool)
-> NonEmpty (FixityQualification, FixityInfo)
-> [(FixityQualification, FixityInfo)]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (FixityQualification, FixityInfo) -> Bool
forall {b}. (FixityQualification, b) -> Bool
isMatching NonEmpty (FixityQualification, FixityInfo)
xs
    opName :: OpName
opName = OccName -> OpName
occOpName (RdrName -> OccName
rdrNameOcc RdrName
rdrName)
    moduleName :: Maybe ModuleName
moduleName = case RdrName
rdrName of
      Qual ModuleName
x OccName
_ -> ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> ModuleName
ghcModuleNameToCabal ModuleName
x)
      RdrName
_ -> Maybe ModuleName
forall a. Maybe a
Nothing

-- | Render a human-readable account of why a certain 'FixityApproximation'
-- was chosen for an operator.
renderFixityJustification ::
  -- | Operator name
  OpName ->
  -- | Qualification of the operator name
  Maybe ModuleName ->
  -- | Module fixity map
  Map OpName FixityProvenance ->
  -- | The chosen fixity approximation
  FixityApproximation ->
  String
renderFixityJustification :: OpName
-> Maybe ModuleName
-> Map OpName FixityProvenance
-> FixityApproximation
-> [Char]
renderFixityJustification OpName
opName Maybe ModuleName
mqualification Map OpName FixityProvenance
m FixityApproximation
approximation =
  [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
"FIXITY analysis of ",
      OpName -> [Char]
forall a. Show a => a -> [Char]
show OpName
opName,
      case Maybe ModuleName
mqualification of
        Maybe ModuleName
Nothing -> [Char]
""
        Just ModuleName
mn -> [Char]
" qualified in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
forall a. Show a => a -> [Char]
show ModuleName
mn,
      [Char]
"\n  Provenance: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe FixityProvenance -> [Char]
forall a. Show a => a -> [Char]
show (OpName -> Map OpName FixityProvenance -> Maybe FixityProvenance
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OpName
opName Map OpName FixityProvenance
m),
      [Char]
"\n  Inferred: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FixityApproximation -> [Char]
forall a. Show a => a -> [Char]
show FixityApproximation
approximation
    ]