{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Fixity.Internal
( OpName,
pattern OpName,
unOpName,
occOpName,
FixityDirection (..),
FixityInfo (..),
defaultFixityInfo,
colonFixityInfo,
HackageInfo (..),
FixityMap,
LazyFixityMap (..),
lookupFixity,
)
where
import Data.Binary (Binary)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as SBS
import Data.Foldable (asum)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Distribution.Types.PackageName (PackageName)
import GHC.Data.FastString (fs_sbs)
import GHC.Generics (Generic)
import GHC.Types.Name (OccName (occNameFS))
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 -> String
(Int -> FixityDirection -> ShowS)
-> (FixityDirection -> String)
-> ([FixityDirection] -> ShowS)
-> Show FixityDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityDirection -> ShowS
showsPrec :: Int -> FixityDirection -> ShowS
$cshow :: FixityDirection -> String
show :: FixityDirection -> String
$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)
data FixityInfo = FixityInfo
{
FixityInfo -> Maybe FixityDirection
fiDirection :: Maybe FixityDirection,
FixityInfo -> Int
fiMinPrecedence :: Int,
FixityInfo -> Int
fiMaxPrecedence :: Int
}
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 -> String
(Int -> FixityInfo -> ShowS)
-> (FixityInfo -> String)
-> ([FixityInfo] -> ShowS)
-> Show FixityInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityInfo -> ShowS
showsPrec :: Int -> FixityInfo -> ShowS
$cshow :: FixityInfo -> String
show :: FixityInfo -> String
$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)
deriving anyclass (Get FixityInfo
[FixityInfo] -> Put
FixityInfo -> Put
(FixityInfo -> Put)
-> Get FixityInfo -> ([FixityInfo] -> Put) -> Binary FixityInfo
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: FixityInfo -> Put
put :: FixityInfo -> Put
$cget :: Get FixityInfo
get :: Get FixityInfo
$cputList :: [FixityInfo] -> Put
putList :: [FixityInfo] -> Put
Binary)
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo =
FixityInfo
{ fiDirection :: Maybe FixityDirection
fiDirection = FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
InfixL,
fiMinPrecedence :: Int
fiMinPrecedence = Int
9,
fiMaxPrecedence :: Int
fiMaxPrecedence = Int
9
}
colonFixityInfo :: FixityInfo
colonFixityInfo :: FixityInfo
colonFixityInfo =
FixityInfo
{ fiDirection :: Maybe FixityDirection
fiDirection = FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just FixityDirection
InfixR,
fiMinPrecedence :: Int
fiMinPrecedence = Int
5,
fiMaxPrecedence :: Int
fiMaxPrecedence = Int
5
}
instance Semigroup FixityInfo where
FixityInfo {fiDirection :: FixityInfo -> Maybe FixityDirection
fiDirection = Maybe FixityDirection
dir1, fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min1, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = Int
max1}
<> :: FixityInfo -> FixityInfo -> FixityInfo
<> FixityInfo {fiDirection :: FixityInfo -> Maybe FixityDirection
fiDirection = Maybe FixityDirection
dir2, fiMinPrecedence :: FixityInfo -> Int
fiMinPrecedence = Int
min2, fiMaxPrecedence :: FixityInfo -> Int
fiMaxPrecedence = Int
max2} =
FixityInfo
{ fiDirection :: Maybe FixityDirection
fiDirection = Maybe FixityDirection
dir',
fiMinPrecedence :: Int
fiMinPrecedence = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
min1 Int
min2,
fiMaxPrecedence :: Int
fiMaxPrecedence = Int -> Int -> Int
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 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
newtype OpName = MkOpName
{
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)
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 #-}
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 -> String
show = Text -> String
T.unpack (Text -> String) -> (OpName -> Text) -> OpName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpName -> Text
unOpName
instance IsString OpName where
fromString :: String -> OpName
fromString = Text -> OpName
OpName (Text -> OpName) -> (String -> Text) -> String -> OpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
type FixityMap = Map OpName FixityInfo
newtype LazyFixityMap = LazyFixityMap [FixityMap]
deriving (Int -> LazyFixityMap -> ShowS
[LazyFixityMap] -> ShowS
LazyFixityMap -> String
(Int -> LazyFixityMap -> ShowS)
-> (LazyFixityMap -> String)
-> ([LazyFixityMap] -> ShowS)
-> Show LazyFixityMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LazyFixityMap -> ShowS
showsPrec :: Int -> LazyFixityMap -> ShowS
$cshow :: LazyFixityMap -> String
show :: LazyFixityMap -> String
$cshowList :: [LazyFixityMap] -> ShowS
showList :: [LazyFixityMap] -> ShowS
Show)
lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
lookupFixity OpName
op (LazyFixityMap [FixityMap]
maps) = [Maybe FixityInfo] -> Maybe FixityInfo
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (OpName -> FixityMap -> Maybe FixityInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OpName
op (FixityMap -> Maybe FixityInfo)
-> [FixityMap] -> [Maybe FixityInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FixityMap]
maps)
data HackageInfo
= HackageInfo
(Map PackageName FixityMap)
(Map PackageName Int)
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)