content: {-# LANGUAGE ScopedTypeVariables #-}
  {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
  -- | Extra list functions
  --
  -- In separate module to aid testing.
  module Internal.List
      ( isPermutationBy
      , deleteBy
      , unorderedCompare
      ) where
  
  import Data.Maybe (fromMaybe)
  import Data.List (sortBy)
  import Data.Monoid
  import Prelude
  
  -- 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 f = go
    where
      f' = flip f
  
      go [] [] = True
      go (x : xs) (y : ys)
          | f x y         = go xs ys
          | otherwise     = fromMaybe False $ do
              xs' <- deleteBy f' y xs
              ys' <- deleteBy f x ys
              return (go xs' ys')
      go [] (_ : _) = False
      go (_ : _) [] = 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 c as bs = go (sortBy cmpA as) (sortBy cmpB bs)
    where
      go [] [] = EQ
      go [] (_ : _) = LT
      go (_ : _) [] = GT
      go (x : xs) (y : ys) = c x y `mappend` go xs ys
  
      cmpA a a' = compare (inB a) (inB a')
      cmpB b b' = compare (inA b) (inA b')
  
      inB a = (length $ filter (\b -> c a b == GT) bs, negate $ length $ filter (\b -> c a b == LT) bs)
      inA b = (length $ filter (\a -> c a b == LT) as, negate $ length $ filter (\a -> c a b == GT) as)
  
  -- Returns Nothing is nothing deleted
  deleteBy              :: (a -> b -> Bool) -> a -> [b] -> Maybe [b]
  deleteBy _  _ []      = Nothing
  deleteBy eq x (y:ys)  = if x `eq` y then Just ys else fmap (y :) (deleteBy eq x ys)
  