{-# LANGUAGE RecordWildCards, OverloadedStrings #-}

module Input.Reorder(reorderItems) where

import Input.Item
import Input.Settings
import Data.List.Extra
import Data.Tuple.Extra
import General.Util
import General.Str


pkgGhc :: PkgName
pkgGhc :: PkgName
pkgGhc = String -> PkgName
strPack String
"ghc"

packageOrderHacks :: (PkgName -> Int) -> PkgName -> Int
-- 'ghc' is the canonical module that both 'ghc-lib-parser' and 'ghc-lib' copy from, so better to pick that
-- even though ghc-lib-* are used more on Stackage (but a lot less on Hackage)
packageOrderHacks :: (PkgName -> Int) -> PkgName -> Int
packageOrderHacks PkgName -> Int
f PkgName
x | PkgName
x PkgName -> PkgName -> Bool
forall a. Eq a => a -> a -> Bool
== PkgName
pkgGhc = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (PkgName -> Int
f PkgName
x) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (PkgName -> Int
f (PkgName -> Int) -> PkgName -> Int
forall a b. (a -> b) -> a -> b
$ String -> PkgName
strPack String
"ghc-lib-parser") (PkgName -> Int
f (PkgName -> Int) -> PkgName -> Int
forall a b. (a -> b) -> a -> b
$ String -> PkgName
strPack String
"ghc-lib") Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
packageOrderHacks PkgName -> Int
f PkgName
x = PkgName -> Int
f PkgName
x


-- | Reorder items so the most popular ones are first, using reverse dependencies.
--   Low numbers for the PkgName function mean the package is more popular.
reorderItems :: Settings -> (PkgName -> Int) -> [(a, Item)] -> [(a, Item)]
reorderItems :: Settings -> (PkgName -> Int) -> [(a, Item)] -> [(a, Item)]
reorderItems Settings{String -> String
String -> String -> Int
reorderModule :: Settings -> String -> String -> Int
renameTag :: Settings -> String -> String
reorderModule :: String -> String -> Int
renameTag :: String -> String
..} PkgName -> Int
packageOrder [(a, Item)]
xs =
    ((PkgName, [(a, Item)]) -> [(a, Item)])
-> [(PkgName, [(a, Item)])] -> [(a, Item)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PkgName, [(a, Item)]) -> [(a, Item)]
forall a b. (a, b) -> b
snd ([(PkgName, [(a, Item)])] -> [(a, Item)])
-> [(PkgName, [(a, Item)])] -> [(a, Item)]
forall a b. (a -> b) -> a -> b
$ ((PkgName, [(a, Item)]) -> (Int, PkgName))
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((PkgName -> Int) -> PkgName -> Int
packageOrderHacks PkgName -> Int
packageOrder (PkgName -> Int)
-> (PkgName -> PkgName) -> PkgName -> (Int, PkgName)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& PkgName -> PkgName
forall a. a -> a
id) (PkgName -> (Int, PkgName))
-> ((PkgName, [(a, Item)]) -> PkgName)
-> (PkgName, [(a, Item)])
-> (Int, PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgName, [(a, Item)]) -> PkgName
forall a b. (a, b) -> a
fst) ([(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])])
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a b. (a -> b) -> a -> b
$ ((PkgName, [(a, Item)]) -> (PkgName, [(a, Item)]))
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a b. (a -> b) -> [a] -> [b]
map (PkgName, [(a, Item)]) -> (PkgName, [(a, Item)])
forall a. (PkgName, [(a, Item)]) -> (PkgName, [(a, Item)])
rebase ([(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])])
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a b. (a -> b) -> a -> b
$ [(a, Item)] -> [(PkgName, [(a, Item)])]
forall a. [(a, Item)] -> [(PkgName, [(a, Item)])]
splitIPackage [(a, Item)]
xs
    where
        refunc :: [(a, [(a, Item)])] -> [(a, [(a, Item)])]
refunc = ((a, [(a, Item)]) -> (a, [(a, Item)]))
-> [(a, [(a, Item)])] -> [(a, [(a, Item)])]
forall a b. (a -> b) -> [a] -> [b]
map (((a, [(a, Item)]) -> (a, [(a, Item)]))
 -> [(a, [(a, Item)])] -> [(a, [(a, Item)])])
-> ((a, [(a, Item)]) -> (a, [(a, Item)]))
-> [(a, [(a, Item)])]
-> [(a, [(a, Item)])]
forall a b. (a -> b) -> a -> b
$ ([(a, Item)] -> [(a, Item)])
-> (a, [(a, Item)]) -> (a, [(a, Item)])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (([(a, Item)] -> [(a, Item)])
 -> (a, [(a, Item)]) -> (a, [(a, Item)]))
-> ([(a, Item)] -> [(a, Item)])
-> (a, [(a, Item)])
-> (a, [(a, Item)])
forall a b. (a -> b) -> a -> b
$ \((a, Item)
x:[(a, Item)]
xs) -> (a, Item)
x (a, Item) -> [(a, Item)] -> [(a, Item)]
forall a. a -> [a] -> [a]
: ((a, Item) -> Maybe PkgName) -> [(a, Item)] -> [(a, Item)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Item -> Maybe PkgName
itemName (Item -> Maybe PkgName)
-> ((a, Item) -> Item) -> (a, Item) -> Maybe PkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Item) -> Item
forall a b. (a, b) -> b
snd) [(a, Item)]
xs
        rebase :: (PkgName, [(a, Item)]) -> (PkgName, [(a, Item)])
rebase (PkgName
x, [(a, Item)]
xs) = (PkgName
x, ((PkgName, [(a, Item)]) -> [(a, Item)])
-> [(PkgName, [(a, Item)])] -> [(a, Item)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PkgName, [(a, Item)]) -> [(a, Item)]
forall a b. (a, b) -> b
snd ([(PkgName, [(a, Item)])] -> [(a, Item)])
-> [(PkgName, [(a, Item)])] -> [(a, Item)]
forall a b. (a -> b) -> a -> b
$ ((PkgName, [(a, Item)]) -> (Int, PkgName))
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (PkgName -> Int) -> PkgName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
f (String -> Int) -> (PkgName -> String) -> PkgName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> String
strUnpack) (PkgName -> Int)
-> (PkgName -> PkgName) -> PkgName -> (Int, PkgName)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& PkgName -> PkgName
forall a. a -> a
id) (PkgName -> (Int, PkgName))
-> ((PkgName, [(a, Item)]) -> PkgName)
-> (PkgName, [(a, Item)])
-> (Int, PkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgName, [(a, Item)]) -> PkgName
forall a b. (a, b) -> a
fst) ([(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])])
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a b. (a -> b) -> a -> b
$ [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a a. [(a, [(a, Item)])] -> [(a, [(a, Item)])]
refunc ([(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])])
-> [(PkgName, [(a, Item)])] -> [(PkgName, [(a, Item)])]
forall a b. (a -> b) -> a -> b
$ [(a, Item)] -> [(PkgName, [(a, Item)])]
forall a. [(a, Item)] -> [(PkgName, [(a, Item)])]
splitIModule [(a, Item)]
xs)
            where f :: String -> Int
f = String -> String -> Int
reorderModule (PkgName -> String
strUnpack PkgName
x)