{-# 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.Strict.HashMap.Autogen.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 implemenation 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' = 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     = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
            [a]
xs' <- forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
deleteBy b -> a -> Bool
f' b
y [a]
xs
            [b]
ys' <- forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
deleteBy a -> b -> Bool
f a
x [b]
ys
            forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [b] -> Bool
go [a]
xs' [b]
ys')
    go [] (b
_ : [b]
_) = Bool
False
    go (a
_ : [a]
_) [] = Bool
False

-- The idea:
--
-- Homogeonous 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 (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmpA [a]
as) (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 forall a. Semigroup a => a -> a -> a
<> [a] -> [b] -> Ordering
go [a]
xs [b]
ys

    cmpA :: a -> a -> Ordering
cmpA a
a a
a' = 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' = 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 = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\b
b -> a -> b -> Ordering
c a
a b
b forall a. Eq a => a -> a -> Bool
== Ordering
GT) [b]
bs, forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\b
b -> a -> b -> Ordering
c a
a b
b forall a. Eq a => a -> a -> Bool
== Ordering
LT) [b]
bs)
    inA :: b -> (Int, Int)
inA b
b = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\a
a -> a -> b -> Ordering
c a
a b
b forall a. Eq a => a -> a -> Bool
== Ordering
LT) [a]
as, forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\a
a -> a -> b -> Ordering
c a
a b
b 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
_ []      = 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 forall a. a -> Maybe a
Just [b]
ys else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b
y forall a. a -> [a] -> [a]
:) (forall a b. (a -> b -> Bool) -> a -> [b] -> Maybe [b]
deleteBy a -> b -> Bool
eq a
x [b]
ys)