-- SPDX-FileCopyrightText: Copyright Preetham Gujjula
-- SPDX-License-Identifier: BSD-3-Clause
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module: Data.List.NonEmpty.ApplyMerge
-- License: BSD-3-Clause
-- Maintainer: Preetham Gujjula <libraries@mail.preetham.io>
-- Stability: experimental
module Data.List.NonEmpty.ApplyMerge
  ( applyMerge,
    applyMergeBy,
    applyMergeOn,
  )
where

import ApplyMerge.IntSet qualified
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Proxy (Proxy (..))
import Data.Reflection (Reifies, reflect, reify)
import Data.Semigroup (Arg (..))

-- | Like 'Data.List.ApplyMerge.applyMerge', but operates on 'NonEmpty's instead
--   of lists.
applyMerge :: (Ord c) => (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMerge :: forall c a b.
Ord c =>
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMerge = (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall c a b.
Ord c =>
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
ApplyMerge.IntSet.applyMergeNonEmpty

-- | Like 'applyMerge', but uses a custom comparison function.
applyMergeBy ::
  (c -> c -> Ordering) ->
  (a -> b -> c) ->
  NonEmpty a ->
  NonEmpty b ->
  NonEmpty c
applyMergeBy :: forall c a b.
(c -> c -> Ordering)
-> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMergeBy = (c -> c -> Ordering)
-> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall a b c.
(c -> c -> Ordering)
-> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMergeBy_

-- Reflection logic in applyMerge_ is based on "All about reflection: a
-- tutorial" [1] by Arnaud Spiwack, licensed under CC BY 4.0 [2].
--
-- [1]: https://www.tweag.io/blog/2017-12-21-reflection-tutorial/
-- [2]: https://creativecommons.org/licenses/by/4.0/
applyMergeBy_ ::
  forall a b c.
  (c -> c -> Ordering) ->
  (a -> b -> c) ->
  NonEmpty a ->
  NonEmpty b ->
  NonEmpty c
applyMergeBy_ :: forall a b c.
(c -> c -> Ordering)
-> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMergeBy_ c -> c -> Ordering
cmp a -> b -> c
f NonEmpty a
as NonEmpty b
bs =
  (c -> c -> Ordering)
-> (forall {s}.
    Reifies s (c -> c -> Ordering) =>
    Proxy s -> NonEmpty c)
-> NonEmpty c
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify c -> c -> Ordering
cmp ((forall {s}.
  Reifies s (c -> c -> Ordering) =>
  Proxy s -> NonEmpty c)
 -> NonEmpty c)
-> (forall {s}.
    Reifies s (c -> c -> Ordering) =>
    Proxy s -> NonEmpty c)
-> NonEmpty c
forall a b. (a -> b) -> a -> b
$ \(Proxy s
_ :: Proxy s) ->
    let f' :: a -> b -> ReflectedOrd s c
        f' :: a -> b -> ReflectedOrd s c
f' a
a b
b = c -> ReflectedOrd s c
forall {k} (s :: k) a. a -> ReflectedOrd s a
ReflectedOrd (a -> b -> c
f a
a b
b)
     in (ReflectedOrd s c -> c)
-> NonEmpty (ReflectedOrd s c) -> NonEmpty c
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ReflectedOrd s c -> c
forall {k} (s :: k) a. ReflectedOrd s a -> a
unReflectedOrd ((a -> b -> ReflectedOrd s c)
-> NonEmpty a -> NonEmpty b -> NonEmpty (ReflectedOrd s c)
forall c a b.
Ord c =>
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMerge a -> b -> ReflectedOrd s c
f' NonEmpty a
as NonEmpty b
bs)

newtype ReflectedOrd s a = ReflectedOrd {forall {k} (s :: k) a. ReflectedOrd s a -> a
unReflectedOrd :: a}

instance (Reifies s (a -> a -> Ordering)) => Eq (ReflectedOrd s a) where
  == :: ReflectedOrd s a -> ReflectedOrd s a -> Bool
(==) (ReflectedOrd a
x) (ReflectedOrd a
y) =
    let cmp :: a -> a -> Ordering
cmp = Proxy s -> a -> a -> Ordering
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s -> a -> a -> Ordering
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
     in a -> a -> Ordering
cmp a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance (Reifies s (a -> a -> Ordering)) => Ord (ReflectedOrd s a) where
  compare :: ReflectedOrd s a -> ReflectedOrd s a -> Ordering
compare (ReflectedOrd a
x) (ReflectedOrd a
y) =
    let cmp :: a -> a -> Ordering
cmp = Proxy s -> a -> a -> Ordering
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: k -> *). proxy s -> a -> a -> Ordering
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)
     in a -> a -> Ordering
cmp a
x a
y

-- | Like 'applyMerge', but applies a custom projection function before
--   performing comparisons.
applyMergeOn ::
  (Ord d) => (c -> d) -> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMergeOn :: forall d c a b.
Ord d =>
(c -> d) -> (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMergeOn c -> d
p a -> b -> c
f NonEmpty a
as NonEmpty b
bs =
  let f' :: a -> b -> Arg d c
f' a
a b
b =
        let c :: c
c = a -> b -> c
f a
a b
b
         in d -> c -> Arg d c
forall a b. a -> b -> Arg a b
Arg (c -> d
p c
c) c
c
   in (Arg d c -> c) -> NonEmpty (Arg d c) -> NonEmpty c
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(Arg d
_ c
c) -> c
c) ((a -> b -> Arg d c)
-> NonEmpty a -> NonEmpty b -> NonEmpty (Arg d c)
forall c a b.
Ord c =>
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
applyMerge a -> b -> Arg d c
f' NonEmpty a
as NonEmpty b
bs)