{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
module Ormolu.Fixity
( FixityDirection (..),
FixityInfo (..),
FixityMap,
LazyFixityMap,
lookupFixity,
HackageInfo (..),
defaultStrategyThreshold,
defaultFixityInfo,
buildFixityMap,
buildFixityMap',
bootPackages,
packageToOps,
packageToPopularity,
)
where
import qualified Data.Aeson as A
import Data.Foldable (foldl')
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.MemoTrie (HasTrie, memo)
import Data.Semigroup (sconcat)
import Data.Set (Set)
import qualified Data.Set as Set
import Ormolu.Fixity.Internal
#if FIXITY_TH
import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Language.Haskell.TH.Syntax as TH
#else
import Data.FileEmbed (embedFile)
import Data.Maybe (fromJust)
#endif
packageToOps :: Map String FixityMap
packageToPopularity :: Map String Int
#if FIXITY_TH
HackageInfo Map String FixityMap
packageToOps Map String Int
packageToPopularity =
$( do
let path = "extract-hackage-info/hackage-info.json"
info <- liftIO $ either fail pure =<< A.eitherDecodeFileStrict' path
TH.lift (info :: HackageInfo)
)
#else
HackageInfo packageToOps packageToPopularity =
fromJust $ A.decodeStrict $(embedFile "extract-hackage-info/hackage-info.json")
#endif
bootPackages :: Set String
bootPackages :: Set String
bootPackages =
forall a. Ord a => [a] -> Set a
Set.fromList
[ String
"array",
String
"binary",
String
"bytestring",
String
"containers",
String
"deepseq",
String
"directory",
String
"exceptions",
String
"filepath",
String
"ghc-binary",
String
"mtl",
String
"parsec",
String
"process",
String
"stm",
String
"template-haskell",
String
"terminfo",
String
"text",
String
"time",
String
"transformers",
String
"unix",
String
"Win32"
]
defaultStrategyThreshold :: Float
defaultStrategyThreshold :: Float
defaultStrategyThreshold = Float
0.9
buildFixityMap ::
Float ->
Set String ->
LazyFixityMap
buildFixityMap :: Float -> Set String -> LazyFixityMap
buildFixityMap = Map String FixityMap
-> Map String Int
-> Set String
-> Float
-> Set String
-> LazyFixityMap
buildFixityMap' Map String FixityMap
packageToOps Map String Int
packageToPopularity Set String
bootPackages
buildFixityMap' ::
Map String FixityMap ->
Map String Int ->
Set String ->
Float ->
Set String ->
LazyFixityMap
buildFixityMap' :: Map String FixityMap
-> Map String Int
-> Set String
-> Float
-> Set String
-> LazyFixityMap
buildFixityMap'
Map String FixityMap
operatorMap
Map String Int
popularityMap
Set String
higherPriorityPackages
Float
strategyThreshold = forall a v. (HasTrie a, Eq a) => (Set a -> v) -> Set a -> v
memoSet forall a b. (a -> b) -> a -> b
$ \Set String
dependencies ->
let baseFixityMap :: FixityMap
baseFixityMap =
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
":" FixityInfo
colonFixityInfo forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"base" Map String FixityMap
operatorMap
cabalFixityMap :: FixityMap
cabalFixityMap =
[(String, FixityMap)] -> FixityMap
mergeAll (String -> (String, FixityMap)
buildPackageFixityMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set String
dependencies)
higherPriorityFixityMap :: FixityMap
higherPriorityFixityMap =
[(String, FixityMap)] -> FixityMap
mergeAll (String -> (String, FixityMap)
buildPackageFixityMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set String
higherPriorityPackages)
remainingFixityMap :: FixityMap
remainingFixityMap =
Map String Int -> Float -> [(String, FixityMap)] -> FixityMap
mergeFixityMaps
Map String Int
popularityMap
Float
strategyThreshold
(String -> (String, FixityMap)
buildPackageFixityMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set String
remainingPackages)
remainingPackages :: Set String
remainingPackages =
forall k a. Map k a -> Set k
Map.keysSet Map String FixityMap
operatorMap
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall a. Ord a => Set a -> Set a -> Set a
Set.union Set String
dependencies Set String
higherPriorityPackages
buildPackageFixityMap :: String -> (String, FixityMap)
buildPackageFixityMap String
packageName =
( String
packageName,
forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
packageName Map String FixityMap
operatorMap
)
mergeAll :: [(String, FixityMap)] -> FixityMap
mergeAll = Map String Int -> Float -> [(String, FixityMap)] -> FixityMap
mergeFixityMaps forall k a. Map k a
Map.empty Float
10.0
in [FixityMap] -> LazyFixityMap
LazyFixityMap
[ FixityMap
baseFixityMap,
FixityMap
cabalFixityMap,
FixityMap
higherPriorityFixityMap,
FixityMap
remainingFixityMap
]
memoSet :: (HasTrie a, Eq a) => (Set a -> v) -> Set a -> v
memoSet :: forall a v. (HasTrie a, Eq a) => (Set a -> v) -> Set a -> v
memoSet Set a -> v
f = forall t a. HasTrie t => (t -> a) -> t -> a
memo (Set a -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> Set a
Set.fromAscList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
mergeFixityMaps ::
Map String Int ->
Float ->
[(String, FixityMap)] ->
FixityMap
mergeFixityMaps :: Map String Int -> Float -> [(String, FixityMap)] -> FixityMap
mergeFixityMaps Map String Int
popularityMap Float
threshold [(String, FixityMap)]
packageMaps =
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
(Float -> NonEmpty (FixityInfo, Int) -> FixityInfo
useThreshold Float
threshold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList)
Map String (Map FixityInfo Int)
scoredMap
where
scoredMap :: Map String (Map FixityInfo Int)
scoredMap = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Map FixityInfo (NonEmpty String) -> Map FixityInfo Int
getScores Map String (Map FixityInfo (NonEmpty String))
opFixityMap
opFixityMap :: Map String (Map FixityInfo (NonEmpty String))
opFixityMap =
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith
(forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>))
((String, FixityMap)
-> Map String (Map FixityInfo (NonEmpty String))
opFixityMapFrom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, FixityMap)]
packageMaps)
useThreshold ::
Float ->
NonEmpty (FixityInfo, Int) ->
FixityInfo
useThreshold :: Float -> NonEmpty (FixityInfo, Int) -> FixityInfo
useThreshold Float
t NonEmpty (FixityInfo, Int)
fixScores =
if forall {a}. Integral a => a -> Float
toFloat Int
maxScore forall a. Fractional a => a -> a -> a
/ forall {a}. Integral a => a -> Float
toFloat Int
sumScores forall a. Ord a => a -> a -> Bool
>= Float
t
then forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ NonEmpty (FixityInfo, Int)
maxs
else forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ NonEmpty (FixityInfo, Int)
fixScores
where
toFloat :: a -> Float
toFloat a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Float
maxs :: NonEmpty (FixityInfo, Int)
maxs = forall b a. Ord b => (a -> b) -> NonEmpty a -> NonEmpty a
maxWith forall a b. (a, b) -> b
snd NonEmpty (FixityInfo, Int)
fixScores
maxScore :: Int
maxScore = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty (FixityInfo, Int)
maxs
sumScores :: Int
sumScores = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) Int
0 (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (FixityInfo, Int)
fixScores)
getScores ::
Map FixityInfo (NonEmpty String) ->
Map FixityInfo Int
getScores :: Map FixityInfo (NonEmpty String) -> Map FixityInfo Int
getScores =
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
(forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map String Int
popularityMap))
opFixityMapFrom ::
(String, FixityMap) ->
Map String (Map FixityInfo (NonEmpty String))
opFixityMapFrom :: (String, FixityMap)
-> Map String (Map FixityInfo (NonEmpty String))
opFixityMapFrom (String
packageName, FixityMap
opsMap) =
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. k -> a -> Map k a
Map.singleton (String
packageName forall a. a -> [a] -> NonEmpty a
:| []))
FixityMap
opsMap
maxWith :: Ord b => (a -> b) -> NonEmpty a -> NonEmpty a
maxWith :: forall b a. Ord b => (a -> b) -> NonEmpty a -> NonEmpty a
maxWith a -> b
f NonEmpty a
xs = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (b, NonEmpty a) -> a -> (b, NonEmpty a)
comp (a -> b
f a
h, a
h forall a. a -> [a] -> NonEmpty a
:| []) [a]
t
where
a
h :| [a]
t = NonEmpty a
xs
comp :: (b, NonEmpty a) -> a -> (b, NonEmpty a)
comp (b
fMax, NonEmpty a
maxs) a
x =
let fX :: b
fX = a -> b
f a
x
in if
| b
fMax forall a. Ord a => a -> a -> Bool
< b
fX -> (b
fX, a
x forall a. a -> [a] -> NonEmpty a
:| [])
| b
fMax forall a. Eq a => a -> a -> Bool
== b
fX -> (b
fMax, forall a. a -> NonEmpty a -> NonEmpty a
NE.cons a
x NonEmpty a
maxs)
| Bool
otherwise -> (b
fMax, NonEmpty a
maxs)