{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Fixity.Internal
( FixityDirection (..),
FixityInfo (..),
defaultFixityInfo,
colonFixityInfo,
HackageInfo (..),
FixityMap,
LazyFixityMap (..),
lookupFixity,
)
where
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
import qualified Data.Aeson as A
import Data.Foldable (asum)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import Instances.TH.Lift ()
import qualified Language.Haskell.TH.Syntax as TH
data FixityDirection
= InfixL
| InfixR
| InfixN
deriving (FixityDirection -> FixityDirection -> Bool
(FixityDirection -> FixityDirection -> Bool)
-> (FixityDirection -> FixityDirection -> Bool)
-> Eq FixityDirection
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
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
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
$cp1Ord :: Eq 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
showList :: [FixityDirection] -> ShowS
$cshowList :: [FixityDirection] -> ShowS
show :: FixityDirection -> String
$cshow :: FixityDirection -> String
showsPrec :: Int -> FixityDirection -> ShowS
$cshowsPrec :: Int -> FixityDirection -> ShowS
Show, FixityDirection -> Q Exp
FixityDirection -> Q (TExp FixityDirection)
(FixityDirection -> Q Exp)
-> (FixityDirection -> Q (TExp FixityDirection))
-> Lift FixityDirection
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FixityDirection -> Q (TExp FixityDirection)
$cliftTyped :: FixityDirection -> Q (TExp FixityDirection)
lift :: FixityDirection -> Q Exp
$clift :: FixityDirection -> Q Exp
TH.Lift)
instance FromJSON FixityDirection where
parseJSON :: Value -> Parser FixityDirection
parseJSON = String
-> (Text -> Parser FixityDirection)
-> Value
-> Parser FixityDirection
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FixityDirection" ((Text -> Parser FixityDirection)
-> Value -> Parser FixityDirection)
-> (Text -> Parser FixityDirection)
-> Value
-> Parser FixityDirection
forall a b. (a -> b) -> a -> b
$ \case
Text
"InfixL" -> FixityDirection -> Parser FixityDirection
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixL
Text
"InfixN" -> FixityDirection -> Parser FixityDirection
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixN
Text
"InfixR" -> FixityDirection -> Parser FixityDirection
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixR
Text
x -> String -> Parser FixityDirection
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a fixity direction")
instance ToJSON FixityDirection where
toJSON :: FixityDirection -> Value
toJSON FixityDirection
x =
Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case FixityDirection
x of
FixityDirection
InfixL -> Text
"InfixL" :: Text
FixityDirection
InfixN -> Text
"InfixN"
FixityDirection
InfixR -> Text
"InfixR"
data FixityInfo = FixityInfo
{
FixityInfo -> Maybe FixityDirection
fiDirection :: Maybe FixityDirection,
FixityInfo -> Int
fiMinPrecedence :: Int,
FixityInfo -> Int
fiMaxPrecedence :: Int
}
deriving (FixityInfo -> FixityInfo -> Bool
(FixityInfo -> FixityInfo -> Bool)
-> (FixityInfo -> FixityInfo -> Bool) -> Eq FixityInfo
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
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
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
$cp1Ord :: Eq 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
showList :: [FixityInfo] -> ShowS
$cshowList :: [FixityInfo] -> ShowS
show :: FixityInfo -> String
$cshow :: FixityInfo -> String
showsPrec :: Int -> FixityInfo -> ShowS
$cshowsPrec :: Int -> FixityInfo -> ShowS
Show, FixityInfo -> Q Exp
FixityInfo -> Q (TExp FixityInfo)
(FixityInfo -> Q Exp)
-> (FixityInfo -> Q (TExp FixityInfo)) -> Lift FixityInfo
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FixityInfo -> Q (TExp FixityInfo)
$cliftTyped :: FixityInfo -> Q (TExp FixityInfo)
lift :: FixityInfo -> Q Exp
$clift :: FixityInfo -> Q Exp
TH.Lift)
instance FromJSON FixityInfo where
parseJSON :: Value -> Parser FixityInfo
parseJSON = String
-> (Object -> Parser FixityInfo) -> Value -> Parser FixityInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FixitiyInfo" ((Object -> Parser FixityInfo) -> Value -> Parser FixityInfo)
-> (Object -> Parser FixityInfo) -> Value -> Parser FixityInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo
(Maybe FixityDirection -> Int -> Int -> FixityInfo)
-> Parser (Maybe FixityDirection)
-> Parser (Int -> Int -> FixityInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe FixityDirection)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dir")
Parser (Int -> Int -> FixityInfo)
-> Parser Int -> Parser (Int -> FixityInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min_prec"
Parser (Int -> FixityInfo) -> Parser Int -> Parser FixityInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_prec"
instance ToJSON FixityInfo where
toJSON :: FixityInfo -> Value
toJSON FixityInfo {Int
Maybe FixityDirection
fiMaxPrecedence :: Int
fiMinPrecedence :: Int
fiDirection :: Maybe FixityDirection
fiMaxPrecedence :: FixityInfo -> Int
fiMinPrecedence :: FixityInfo -> Int
fiDirection :: FixityInfo -> Maybe FixityDirection
..} =
[Pair] -> Value
A.object
[ Key
"dir" Key -> Maybe FixityDirection -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe FixityDirection
fiDirection,
Key
"min_prec" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
fiMinPrecedence,
Key
"max_prec" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
fiMaxPrecedence
]
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo =
FixityInfo :: Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo
{ fiDirection :: Maybe FixityDirection
fiDirection = Maybe FixityDirection
forall a. Maybe a
Nothing,
fiMinPrecedence :: Int
fiMinPrecedence = Int
0,
fiMaxPrecedence :: Int
fiMaxPrecedence = Int
9
}
colonFixityInfo :: FixityInfo
colonFixityInfo :: FixityInfo
colonFixityInfo =
FixityInfo :: Maybe FixityDirection -> Int -> Int -> FixityInfo
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 :: Maybe FixityDirection -> Int -> Int -> FixityInfo
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
type FixityMap = Map String 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
showList :: [LazyFixityMap] -> ShowS
$cshowList :: [LazyFixityMap] -> ShowS
show :: LazyFixityMap -> String
$cshow :: LazyFixityMap -> String
showsPrec :: Int -> LazyFixityMap -> ShowS
$cshowsPrec :: Int -> LazyFixityMap -> ShowS
Show)
lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
lookupFixity String
op (LazyFixityMap [FixityMap]
maps) = [Maybe FixityInfo] -> Maybe FixityInfo
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (String -> FixityMap -> Maybe FixityInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
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 String FixityMap)
(Map String Int)
deriving (HackageInfo -> Q Exp
HackageInfo -> Q (TExp HackageInfo)
(HackageInfo -> Q Exp)
-> (HackageInfo -> Q (TExp HackageInfo)) -> Lift HackageInfo
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: HackageInfo -> Q (TExp HackageInfo)
$cliftTyped :: HackageInfo -> Q (TExp HackageInfo)
lift :: HackageInfo -> Q Exp
$clift :: HackageInfo -> Q Exp
TH.Lift)
instance FromJSON HackageInfo where
parseJSON :: Value -> Parser HackageInfo
parseJSON = String
-> (Object -> Parser HackageInfo) -> Value -> Parser HackageInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HackageInfo" ((Object -> Parser HackageInfo) -> Value -> Parser HackageInfo)
-> (Object -> Parser HackageInfo) -> Value -> Parser HackageInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Map String FixityMap -> Map String Int -> HackageInfo
HackageInfo
(Map String FixityMap -> Map String Int -> HackageInfo)
-> Parser (Map String FixityMap)
-> Parser (Map String Int -> HackageInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Map String FixityMap)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operators"
Parser (Map String Int -> HackageInfo)
-> Parser (Map String Int) -> Parser HackageInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Map String Int)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"popularity"
instance ToJSON HackageInfo where
toJSON :: HackageInfo -> Value
toJSON (HackageInfo Map String FixityMap
operators Map String Int
popularity) =
[Pair] -> Value
A.object
[ Key
"operators" Key -> Map String FixityMap -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String FixityMap
operators,
Key
"popularity" Key -> Map String Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String Int
popularity
]