{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Fixity.Internal
( OpName,
pattern OpName,
unOpName,
occOpName,
FixityDirection (..),
FixityInfo (..),
defaultFixityInfo,
colonFixityInfo,
HackageInfo (..),
FixityMap,
LazyFixityMap (..),
lookupFixity,
)
where
import Control.DeepSeq (NFData)
import Data.Binary (Binary)
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as SBS
import Data.Foldable (asum)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified 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
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)
data FixityInfo = FixityInfo
{
FixityInfo -> Maybe FixityDirection
fiDirection :: Maybe FixityDirection,
FixityInfo -> Int
fiMinPrecedence :: Int,
FixityInfo -> Int
fiMaxPrecedence :: 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)
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo =
FixityInfo
{ fiDirection :: Maybe FixityDirection
fiDirection = 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 = 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 = forall a. Ord a => a -> a -> a
min Int
min1 Int
min2,
fiMaxPrecedence :: Int
fiMaxPrecedence = 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
newtype OpName = MkOpName
{
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)
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 #-}
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
type FixityMap = Map OpName FixityInfo
newtype LazyFixityMap = LazyFixityMap [FixityMap]
deriving (Int -> LazyFixityMap -> ShowS
[LazyFixityMap] -> ShowS
LazyFixityMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LazyFixityMap] -> ShowS
$cshowList :: [LazyFixityMap] -> ShowS
show :: LazyFixityMap -> String
$cshow :: LazyFixityMap -> String
showsPrec :: Int -> LazyFixityMap -> ShowS
$cshowsPrec :: Int -> LazyFixityMap -> ShowS
Show)
lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
lookupFixity OpName
op (LazyFixityMap [FixityMap]
maps) = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup OpName
op 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. 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)