    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
    {-# OPTIONS_HADDOCK not-home #-}

    -- | = WARNING
    --
    -- This module is considered __internal__.
    --
    -- The Package Versioning Policy __does not apply__.
    --
    -- The contents of this module may change __in any way whatsoever__
    -- and __without any warning__ between minor versions of this package.
    --
    -- Authors importing this module are expected to track development
    -- closely.
    --
    -- = Description
    --
    -- Extra list functions
    --
    -- In separate module to aid testing.
    module Data.HashMap.Internal.List
        ( isPermutationBy
        , deleteBy
        , unorderedCompare
        ) where

    import Data.List  (sortBy)
    import Data.Maybe (fromMaybe)
    #if !MIN_VERSION_base(4,11,0)
    import Data.Semigroup ((<>))
    #endif

    -- Note: previous implementation isPermutation = null (as // bs)
    -- was O(n^2) too.
    --
    -- This assumes lists are of equal length
    isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool
    isPermutationBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    isPermutationBy a -> b -> Bool
    f = [a] -> [b] -> Bool
    go
      where
        f' :: b -> a -> Bool
    f' = (a -> b -> Bool) -> b -> a -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> b -> Bool
    f

        go :: [a] -> [b] -> Bool
    go [] [] = Bool
    True
        go (a
    x : [a]
    xs) (b
    y : [b]
    ys)
            | a -> b -> Bool
    f a
    x b
    y         = [a] -> [b] -> Bool
    go [a]
    xs [b]
    ys
            | Bool
    otherwise     = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
                xs' <- (b -> a -> Bool) -> b -> [a] -> Maybe [a]
    forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
    deleteBy b -> a -> Bool
    f' b
    y [a]
    xs
                ys' <- deleteBy f x ys
                return (go xs' ys')
        go [] (b
    _ : [b]
    _) = Bool
    False
        go (a
    _ : [a]
    _) [] = Bool
    False

    -- The idea:
    --
    -- Homogenous version
    --
    -- uc :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
    -- uc c as bs = compare (sortBy c as) (sortBy c bs)
    --
    -- But as we have only (a -> b -> Ordering), we cannot directly compare
    -- elements from the same list.
    --
    -- So when comparing elements from the list, we count how many elements are
    -- "less and greater" in the other list, and use the count as a metric.
    --
    unorderedCompare :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering
    unorderedCompare :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
    unorderedCompare a -> b -> Ordering
    c [a]
    as [b]
    bs = [a] -> [b] -> Ordering
    go ((a -> a -> Ordering) -> [a] -> [a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy a -> a -> Ordering
    cmpA [a]
    as) ((b -> b -> Ordering) -> [b] -> [b]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy b -> b -> Ordering
    cmpB [b]
    bs)
      where
        go :: [a] -> [b] -> Ordering
    go [] [] = Ordering
    EQ
        go [] (b
    _ : [b]
    _) = Ordering
    LT
        go (a
    _ : [a]
    _) [] = Ordering
    GT
        go (a
    x : [a]
    xs) (b
    y : [b]
    ys) = a -> b -> Ordering
    c a
    x b
    y Ordering -> Ordering -> Ordering
    forall a. Semigroup a => a -> a -> a
    <> [a] -> [b] -> Ordering
    go [a]
    xs [b]
    ys

        cmpA :: a -> a -> Ordering
    cmpA a
    a a
    a' = (Int, Int) -> (Int, Int) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a -> (Int, Int)
    inB a
    a) (a -> (Int, Int)
    inB a
    a')
        cmpB :: b -> b -> Ordering
    cmpB b
    b b
    b' = (Int, Int) -> (Int, Int) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (b -> (Int, Int)
    inA b
    b) (b -> (Int, Int)
    inA b
    b')

        inB :: a -> (Int, Int)
    inB a
    a = ([b] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([b] -> Int) -> [b] -> Int
    forall a b. (a -> b) -> a -> b
    $ (b -> Bool) -> [b] -> [b]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\b
    b -> a -> b -> Ordering
    c a
    a b
    b Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    GT) [b]
    bs, Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [b] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([b] -> Int) -> [b] -> Int
    forall a b. (a -> b) -> a -> b
    $ (b -> Bool) -> [b] -> [b]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\b
    b -> a -> b -> Ordering
    c a
    a b
    b Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    LT) [b]
    bs)
        inA :: b -> (Int, Int)
    inA b
    b = ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> Int) -> [a] -> Int
    forall a b. (a -> b) -> a -> b
    $ (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\a
    a -> a -> b -> Ordering
    c a
    a b
    b Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    LT) [a]
    as, Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([a] -> Int) -> [a] -> Int
    forall a b. (a -> b) -> a -> b
    $ (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\a
    a -> a -> b -> Ordering
    c a
    a b
    b Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    GT) [a]
    as)

    -- Returns Nothing is nothing deleted
    deleteBy              :: (a -> b -> Bool) -> a -> [b] -> Maybe [b]
    deleteBy :: forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
    deleteBy a -> b -> Bool
    _  a
    _ []      = Maybe [b]
    forall a. Maybe a
    Nothing
    deleteBy a -> b -> Bool
    eq a
    x (b
    y:[b]
    ys)  = if a
    x a -> b -> Bool
    `eq` b
    y then [b] -> Maybe [b]
    forall a. a -> Maybe a
    Just [b]
    ys else ([b] -> [b]) -> Maybe [b] -> Maybe [b]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (b
    y b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :) ((a -> b -> Bool) -> a -> [b] -> Maybe [b]
    forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
    deleteBy a -> b -> Bool
    eq a
    x [b]
    ys)