{-# 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

-- | Fixity direction.
data FixityDirection
  = InfixL
  | InfixR
  | InfixN
  deriving (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 t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FixityDirection -> m Exp
forall (m :: * -> *).
Quote m =>
FixityDirection -> Code m FixityDirection
liftTyped :: forall (m :: * -> *).
Quote m =>
FixityDirection -> Code m FixityDirection
$cliftTyped :: forall (m :: * -> *).
Quote m =>
FixityDirection -> Code m FixityDirection
lift :: forall (m :: * -> *). Quote m => FixityDirection -> m Exp
$clift :: forall (m :: * -> *). Quote m => FixityDirection -> m Exp
TH.Lift)

instance FromJSON FixityDirection where
  parseJSON :: Value -> Parser FixityDirection
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"FixityDirection" forall a b. (a -> b) -> a -> b
$ \case
    Text
"InfixL" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixL
    Text
"InfixN" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixN
    Text
"InfixR" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityDirection
InfixR
    Text
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
x forall a. [a] -> [a] -> [a]
++ String
" is not a fixity direction")

instance ToJSON FixityDirection where
  toJSON :: FixityDirection -> Value
toJSON FixityDirection
x =
    forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ case FixityDirection
x of
      FixityDirection
InfixL -> Text
"InfixL" :: Text
      FixityDirection
InfixN -> Text
"InfixN"
      FixityDirection
InfixR -> Text
"InfixR"

-- | Fixity information about an infix operator that takes the uncertainty
-- that can arise from conflicting definitions into account.
data FixityInfo = FixityInfo
  { -- | Fixity direction if it is known
    FixityInfo -> Maybe FixityDirection
fiDirection :: Maybe FixityDirection,
    -- | Minimum precedence level found in the (maybe conflicting)
    -- definitions for the operator (inclusive)
    FixityInfo -> Int
fiMinPrecedence :: Int,
    -- | Maximum precedence level found in the (maybe conflicting)
    -- definitions for the operator (inclusive)
    FixityInfo -> Int
fiMaxPrecedence :: Int
  }
  deriving (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 t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FixityInfo -> m Exp
forall (m :: * -> *). Quote m => FixityInfo -> Code m FixityInfo
liftTyped :: forall (m :: * -> *). Quote m => FixityInfo -> Code m FixityInfo
$cliftTyped :: forall (m :: * -> *). Quote m => FixityInfo -> Code m FixityInfo
lift :: forall (m :: * -> *). Quote m => FixityInfo -> m Exp
$clift :: forall (m :: * -> *). Quote m => FixityInfo -> m Exp
TH.Lift)

instance FromJSON FixityInfo where
  parseJSON :: Value -> Parser FixityInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FixitiyInfo" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dir")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min_prec"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe FixityDirection
fiDirection,
        Key
"min_prec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
fiMinPrecedence,
        Key
"max_prec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
fiMaxPrecedence
      ]

-- | The lowest level of information we can have about an operator.
defaultFixityInfo :: FixityInfo
defaultFixityInfo :: FixityInfo
defaultFixityInfo =
  FixityInfo
    { fiDirection :: Maybe FixityDirection
fiDirection = forall a. Maybe a
Nothing,
      fiMinPrecedence :: Int
fiMinPrecedence = Int
0,
      fiMaxPrecedence :: Int
fiMaxPrecedence = Int
9
    }

-- | Fixity info of the built-in colon data constructor.
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
    }

-- | Gives the ability to merge two (maybe conflicting) definitions for an
-- operator, keeping the higher level of compatible information from both.
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

-- | Map from the operator name to its 'FixityInfo'.
type FixityMap = Map String FixityInfo

-- | A variant of 'FixityMap', represented as a lazy union of several
-- 'FixityMap's.
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)

-- | Lookup a 'FixityInfo' of an operator. This might have drastically
-- different performance depending on whether this is an "unusal"
-- operator.
lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
lookupFixity String
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 String
op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FixityMap]
maps)

-- | The map of operators declared by each package and the popularity of
-- each package, if available.
data HackageInfo
  = HackageInfo
      (Map String FixityMap)
      -- ^ Map from package name to a map from operator name to its fixity
      (Map String Int)
      -- ^ Map from package name to its 30-days download count from Hackage
  deriving (forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => HackageInfo -> m Exp
forall (m :: * -> *). Quote m => HackageInfo -> Code m HackageInfo
liftTyped :: forall (m :: * -> *). Quote m => HackageInfo -> Code m HackageInfo
$cliftTyped :: forall (m :: * -> *). Quote m => HackageInfo -> Code m HackageInfo
lift :: forall (m :: * -> *). Quote m => HackageInfo -> m Exp
$clift :: forall (m :: * -> *). Quote m => HackageInfo -> m Exp
TH.Lift)

instance FromJSON HackageInfo where
  parseJSON :: Value -> Parser HackageInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"HackageInfo" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Map String FixityMap -> Map String Int -> HackageInfo
HackageInfo
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operators"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String FixityMap
operators,
        Key
"popularity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map String Int
popularity
      ]