{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Mergeable.MergeMap ( MergeMap, toNonEmpty, partition, ) where import Control.Monad.Except (MonadError (..)) import qualified Data.List as L import qualified Data.List.NonEmpty as NE (partition) import qualified Data.List.NonEmpty as NM import Data.Mergeable.Internal.Merge ( Merge (..), recursiveMerge, ) import Data.Mergeable.IsMap (FromList (..), IsMap (..)) import Language.Haskell.TH.Syntax (Lift (..)) import Relude hiding (fromList) partition :: (a -> Bool) -> MergeMap dups k a -> (Maybe (MergeMap dups k a), Maybe (MergeMap dups k a)) partition :: forall a (dups :: Bool) k. (a -> Bool) -> MergeMap dups k a -> (Maybe (MergeMap dups k a), Maybe (MergeMap dups k a)) partition a -> Bool f (MergeMap NonEmpty (k, a) xs) = case forall a. (a -> Bool) -> NonEmpty a -> ([a], [a]) NE.partition (a -> Bool f forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> b snd) NonEmpty (k, a) xs of ([], [(k, a)] _) -> (forall a. Maybe a Nothing, forall a. a -> Maybe a Just (forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap NonEmpty (k, a) xs)) ([(k, a)] _, []) -> (forall a. a -> Maybe a Just (forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap NonEmpty (k, a) xs), forall a. Maybe a Nothing) ((k, a) a : [(k, a)] as, (k, a) b : [(k, a)] bs) -> (forall a. a -> Maybe a Just (forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap ((k, a) a forall a. a -> [a] -> NonEmpty a :| [(k, a)] as)), forall a. a -> Maybe a Just (forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap ((k, a) b forall a. a -> [a] -> NonEmpty a :| [(k, a)] bs))) newtype MergeMap (dups :: Bool) k a = MergeMap { forall (dups :: Bool) k a. MergeMap dups k a -> NonEmpty (k, a) unpack :: NonEmpty (k, a) } deriving ( Int -> MergeMap dups k a -> ShowS forall (dups :: Bool) k a. (Show k, Show a) => Int -> MergeMap dups k a -> ShowS forall (dups :: Bool) k a. (Show k, Show a) => [MergeMap dups k a] -> ShowS forall (dups :: Bool) k a. (Show k, Show a) => MergeMap dups k a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [MergeMap dups k a] -> ShowS $cshowList :: forall (dups :: Bool) k a. (Show k, Show a) => [MergeMap dups k a] -> ShowS show :: MergeMap dups k a -> String $cshow :: forall (dups :: Bool) k a. (Show k, Show a) => MergeMap dups k a -> String showsPrec :: Int -> MergeMap dups k a -> ShowS $cshowsPrec :: forall (dups :: Bool) k a. (Show k, Show a) => Int -> MergeMap dups k a -> ShowS Show, MergeMap dups k a -> MergeMap dups k a -> Bool forall (dups :: Bool) k a. (Eq k, Eq a) => MergeMap dups k a -> MergeMap dups k a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: MergeMap dups k a -> MergeMap dups k a -> Bool $c/= :: forall (dups :: Bool) k a. (Eq k, Eq a) => MergeMap dups k a -> MergeMap dups k a -> Bool == :: MergeMap dups k a -> MergeMap dups k a -> Bool $c== :: forall (dups :: Bool) k a. (Eq k, Eq a) => MergeMap dups k a -> MergeMap dups k a -> Bool Eq, forall (dups :: Bool) k a b. a -> MergeMap dups k b -> MergeMap dups k a forall (dups :: Bool) k a b. (a -> b) -> MergeMap dups k a -> MergeMap dups k b forall a b. a -> MergeMap dups k b -> MergeMap dups k a forall a b. (a -> b) -> MergeMap dups k a -> MergeMap dups k b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> MergeMap dups k b -> MergeMap dups k a $c<$ :: forall (dups :: Bool) k a b. a -> MergeMap dups k b -> MergeMap dups k a fmap :: forall a b. (a -> b) -> MergeMap dups k a -> MergeMap dups k b $cfmap :: forall (dups :: Bool) k a b. (a -> b) -> MergeMap dups k a -> MergeMap dups k b Functor, forall (dups :: Bool) k a. Eq a => a -> MergeMap dups k a -> Bool forall (dups :: Bool) k a. Num a => MergeMap dups k a -> a forall (dups :: Bool) k a. Ord a => MergeMap dups k a -> a forall (dups :: Bool) k m. Monoid m => MergeMap dups k m -> m forall (dups :: Bool) k a. MergeMap dups k a -> Bool forall (dups :: Bool) k a. MergeMap dups k a -> Int forall (dups :: Bool) k a. MergeMap dups k a -> [a] forall (dups :: Bool) k a. (a -> a -> a) -> MergeMap dups k a -> a forall (dups :: Bool) k m a. Monoid m => (a -> m) -> MergeMap dups k a -> m forall (dups :: Bool) k b a. (b -> a -> b) -> b -> MergeMap dups k a -> b forall (dups :: Bool) k a b. (a -> b -> b) -> b -> MergeMap dups k a -> b forall a. MergeMap dups k a -> Bool forall m a. Monoid m => (a -> m) -> MergeMap dups k a -> m forall a b. (a -> b -> b) -> b -> MergeMap dups k a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t product :: forall a. Num a => MergeMap dups k a -> a $cproduct :: forall (dups :: Bool) k a. Num a => MergeMap dups k a -> a sum :: forall a. Num a => MergeMap dups k a -> a $csum :: forall (dups :: Bool) k a. Num a => MergeMap dups k a -> a minimum :: forall a. Ord a => MergeMap dups k a -> a $cminimum :: forall (dups :: Bool) k a. Ord a => MergeMap dups k a -> a maximum :: forall a. Ord a => MergeMap dups k a -> a $cmaximum :: forall (dups :: Bool) k a. Ord a => MergeMap dups k a -> a elem :: forall a. Eq a => a -> MergeMap dups k a -> Bool $celem :: forall (dups :: Bool) k a. Eq a => a -> MergeMap dups k a -> Bool length :: forall a. MergeMap dups k a -> Int $clength :: forall (dups :: Bool) k a. MergeMap dups k a -> Int null :: forall a. MergeMap dups k a -> Bool $cnull :: forall (dups :: Bool) k a. MergeMap dups k a -> Bool toList :: forall a. MergeMap dups k a -> [a] $ctoList :: forall (dups :: Bool) k a. MergeMap dups k a -> [a] foldl1 :: forall a. (a -> a -> a) -> MergeMap dups k a -> a $cfoldl1 :: forall (dups :: Bool) k a. (a -> a -> a) -> MergeMap dups k a -> a foldr1 :: forall a. (a -> a -> a) -> MergeMap dups k a -> a $cfoldr1 :: forall (dups :: Bool) k a. (a -> a -> a) -> MergeMap dups k a -> a foldl' :: forall b a. (b -> a -> b) -> b -> MergeMap dups k a -> b $cfoldl' :: forall (dups :: Bool) k b a. (b -> a -> b) -> b -> MergeMap dups k a -> b foldl :: forall b a. (b -> a -> b) -> b -> MergeMap dups k a -> b $cfoldl :: forall (dups :: Bool) k b a. (b -> a -> b) -> b -> MergeMap dups k a -> b foldr' :: forall a b. (a -> b -> b) -> b -> MergeMap dups k a -> b $cfoldr' :: forall (dups :: Bool) k a b. (a -> b -> b) -> b -> MergeMap dups k a -> b foldr :: forall a b. (a -> b -> b) -> b -> MergeMap dups k a -> b $cfoldr :: forall (dups :: Bool) k a b. (a -> b -> b) -> b -> MergeMap dups k a -> b foldMap' :: forall m a. Monoid m => (a -> m) -> MergeMap dups k a -> m $cfoldMap' :: forall (dups :: Bool) k m a. Monoid m => (a -> m) -> MergeMap dups k a -> m foldMap :: forall m a. Monoid m => (a -> m) -> MergeMap dups k a -> m $cfoldMap :: forall (dups :: Bool) k m a. Monoid m => (a -> m) -> MergeMap dups k a -> m fold :: forall m. Monoid m => MergeMap dups k m -> m $cfold :: forall (dups :: Bool) k m. Monoid m => MergeMap dups k m -> m Foldable, forall (dups :: Bool) k. Functor (MergeMap dups k) forall (dups :: Bool) k. Foldable (MergeMap dups k) forall (dups :: Bool) k (m :: * -> *) a. Monad m => MergeMap dups k (m a) -> m (MergeMap dups k a) forall (dups :: Bool) k (f :: * -> *) a. Applicative f => MergeMap dups k (f a) -> f (MergeMap dups k a) forall (dups :: Bool) k (m :: * -> *) a b. Monad m => (a -> m b) -> MergeMap dups k a -> m (MergeMap dups k b) forall (dups :: Bool) k (f :: * -> *) a b. Applicative f => (a -> f b) -> MergeMap dups k a -> f (MergeMap dups k b) forall (t :: * -> *). Functor t -> Foldable t -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (f :: * -> *) a b. Applicative f => (a -> f b) -> MergeMap dups k a -> f (MergeMap dups k b) sequence :: forall (m :: * -> *) a. Monad m => MergeMap dups k (m a) -> m (MergeMap dups k a) $csequence :: forall (dups :: Bool) k (m :: * -> *) a. Monad m => MergeMap dups k (m a) -> m (MergeMap dups k a) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> MergeMap dups k a -> m (MergeMap dups k b) $cmapM :: forall (dups :: Bool) k (m :: * -> *) a b. Monad m => (a -> m b) -> MergeMap dups k a -> m (MergeMap dups k b) sequenceA :: forall (f :: * -> *) a. Applicative f => MergeMap dups k (f a) -> f (MergeMap dups k a) $csequenceA :: forall (dups :: Bool) k (f :: * -> *) a. Applicative f => MergeMap dups k (f a) -> f (MergeMap dups k a) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> MergeMap dups k a -> f (MergeMap dups k b) $ctraverse :: forall (dups :: Bool) k (f :: * -> *) a b. Applicative f => (a -> f b) -> MergeMap dups k a -> f (MergeMap dups k b) Traversable, Int -> MergeMap dups k a -> Int MergeMap dups k a -> Int forall {dups :: Bool} {k} {a}. (Hashable k, Hashable a) => Eq (MergeMap dups k a) forall (dups :: Bool) k a. (Hashable k, Hashable a) => Int -> MergeMap dups k a -> Int forall (dups :: Bool) k a. (Hashable k, Hashable a) => MergeMap dups k a -> Int forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a hash :: MergeMap dups k a -> Int $chash :: forall (dups :: Bool) k a. (Hashable k, Hashable a) => MergeMap dups k a -> Int hashWithSalt :: Int -> MergeMap dups k a -> Int $chashWithSalt :: forall (dups :: Bool) k a. (Hashable k, Hashable a) => Int -> MergeMap dups k a -> Int Hashable ) instance (Lift a, Lift k) => Lift (MergeMap dups k a) where lift :: forall (m :: * -> *). Quote m => MergeMap dups k a -> m Exp lift (MergeMap ((k, a) x :| [(k, a)] xs)) = [|MergeMap (x :| xs)|] #if MIN_VERSION_template_haskell(2,16,0) liftTyped :: forall (m :: * -> *). Quote m => MergeMap dups k a -> Code m (MergeMap dups k a) liftTyped (MergeMap ((k, a) x :| [(k, a)] xs)) = [|| MergeMap (x :| xs) ||] #endif instance (Hashable k, Eq k) => IsMap k (MergeMap dups k) where unsafeFromList :: forall a. [(k, a)] -> MergeMap dups k a unsafeFromList ((k, a) x : [(k, a)] xs) = forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap ((k, a) x forall a. a -> [a] -> NonEmpty a :| [(k, a)] xs) unsafeFromList [] = forall a t. (HasCallStack, IsText t) => t -> a error Text "empty selection sets are not supported." singleton :: forall a. k -> a -> MergeMap dups k a singleton k k a x = forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap ((k k, a x) forall a. a -> [a] -> NonEmpty a :| []) lookup :: forall a. k -> MergeMap dups k a -> Maybe a lookup k key (MergeMap ((k, a) x :| [(k, a)] xs)) = forall a b. Eq a => a -> [(a, b)] -> Maybe b L.lookup k key ((k, a) x forall a. a -> [a] -> [a] : [(k, a)] xs) toAssoc :: forall a. MergeMap dups k a -> [(k, a)] toAssoc (MergeMap ((k, a) x :| [(k, a)] xs)) = (k, a) x forall a. a -> [a] -> [a] : [(k, a)] xs instance ( Monad m, Eq a, Merge m a, Hashable k, Eq k ) => Merge m (MergeMap 'False k a) where merge :: Monad m => MergeMap 'False k a -> MergeMap 'False k a -> m (MergeMap 'False k a) merge (MergeMap NonEmpty (k, a) x) (MergeMap NonEmpty (k, a) y) = forall (m :: * -> *) a k (dups :: Bool). (Monad m, Eq a, Merge m a, Hashable k, Eq k) => NonEmpty (k, a) -> m (MergeMap dups k a) resolveMergeable (NonEmpty (k, a) x forall a. Semigroup a => a -> a -> a <> NonEmpty (k, a) y) instance Monad m => Merge m (MergeMap 'True k a) where merge :: Monad m => MergeMap 'True k a -> MergeMap 'True k a -> m (MergeMap 'True k a) merge (MergeMap NonEmpty (k, a) x) (MergeMap NonEmpty (k, a) y) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap forall a b. (a -> b) -> a -> b $ NonEmpty (k, a) x forall a. Semigroup a => a -> a -> a <> NonEmpty (k, a) y resolveMergeable :: ( Monad m, Eq a, Merge m a, Hashable k, Eq k ) => NonEmpty (k, a) -> m (MergeMap dups k a) resolveMergeable :: forall (m :: * -> *) a k (dups :: Bool). (Monad m, Eq a, Merge m a, Hashable k, Eq k) => NonEmpty (k, a) -> m (MergeMap dups k a) resolveMergeable ((k, a) x :| [(k, a)] xs) = forall k a (m :: * -> *) b. (Eq k, Eq a, Hashable k, Monad m, Merge m a) => ([(k, a)] -> b) -> [(k, a)] -> m b recursiveMerge (forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> NonEmpty a NM.fromList) ((k, a) x forall a. a -> [a] -> [a] : [(k, a)] xs) toNonEmpty :: (IsString e, MonadError e f) => [a] -> f (NonEmpty a) toNonEmpty :: forall e (f :: * -> *) a. (IsString e, MonadError e f) => [a] -> f (NonEmpty a) toNonEmpty [] = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError e "empty selection sets are not supported." toNonEmpty (a x : [a] xs) = forall (f :: * -> *) a. Applicative f => a -> f a pure (a x forall a. a -> [a] -> NonEmpty a :| [a] xs) instance ( Hashable k, Eq k, Eq a, IsString e, MonadError e m, Merge m a ) => FromList m (MergeMap 'False) k a where fromList :: Monad m => [(k, a)] -> m (MergeMap 'False k a) fromList = forall (m :: * -> *) a k (dups :: Bool). (Monad m, Eq a, Merge m a, Hashable k, Eq k) => NonEmpty (k, a) -> m (MergeMap dups k a) resolveMergeable forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall e (f :: * -> *) a. (IsString e, MonadError e f) => [a] -> f (NonEmpty a) toNonEmpty instance ( IsString e, MonadError e m ) => FromList m (MergeMap 'True) k a where fromList :: Monad m => [(k, a)] -> m (MergeMap 'True k a) fromList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall (dups :: Bool) k a. NonEmpty (k, a) -> MergeMap dups k a MergeMap forall b c a. (b -> c) -> (a -> b) -> a -> c . forall e (f :: * -> *) a. (IsString e, MonadError e f) => [a] -> f (NonEmpty a) toNonEmpty