module Database.PostgreSQL.PQTypes.Utils.NubList
( NubList
, toNubList
, fromNubList
, overNubList
) where
import Data.Typeable
import qualified Text.Read as R
import qualified Data.Set as Set
import qualified Data.Semigroup as SG
newtype NubList a =
NubList { NubList a -> [a]
fromNubList :: [a] }
deriving (NubList a -> NubList a -> Bool
(NubList a -> NubList a -> Bool)
-> (NubList a -> NubList a -> Bool) -> Eq (NubList a)
forall a. Eq a => NubList a -> NubList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NubList a -> NubList a -> Bool
$c/= :: forall a. Eq a => NubList a -> NubList a -> Bool
== :: NubList a -> NubList a -> Bool
$c== :: forall a. Eq a => NubList a -> NubList a -> Bool
Eq, Typeable)
toNubList :: Ord a => [a] -> NubList a
toNubList :: [a] -> NubList a
toNubList [a]
list = [a] -> NubList a
forall a. [a] -> NubList a
NubList ([a] -> NubList a) -> [a] -> NubList a
forall a b. (a -> b) -> a -> b
$ ((a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy a -> a
forall a. a -> a
id) [a]
list
overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList :: ([a] -> [a]) -> NubList a -> NubList a
overNubList [a] -> [a]
f (NubList [a]
list) = [a] -> NubList a
forall a. Ord a => [a] -> NubList a
toNubList ([a] -> NubList a) -> ([a] -> [a]) -> [a] -> NubList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f ([a] -> NubList a) -> [a] -> NubList a
forall a b. (a -> b) -> a -> b
$ [a]
list
instance Ord a => SG.Semigroup (NubList a) where
(NubList [a]
xs) <> :: NubList a -> NubList a -> NubList a
<> (NubList [a]
ys) = [a] -> NubList a
forall a. [a] -> NubList a
NubList ([a] -> NubList a) -> [a] -> NubList a
forall a b. (a -> b) -> a -> b
$ [a]
xs Ord a => [a] -> [a] -> [a]
[a] -> [a] -> [a]
`listUnion` [a]
ys
where
listUnion :: (Ord a) => [a] -> [a] -> [a]
listUnion :: [a] -> [a] -> [a]
listUnion [a]
a [a]
b = [a]
a
[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy a -> a
forall a. a -> a
id ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
a)) [a]
b)
instance Ord a => Monoid (NubList a) where
mempty :: NubList a
mempty = [a] -> NubList a
forall a. [a] -> NubList a
NubList []
mappend :: NubList a -> NubList a -> NubList a
mappend = NubList a -> NubList a -> NubList a
forall a. Semigroup a => a -> a -> a
(SG.<>)
instance Show a => Show (NubList a) where
show :: NubList a -> String
show (NubList [a]
list) = [a] -> String
forall a. Show a => a -> String
show [a]
list
instance (Ord a, Read a) => Read (NubList a) where
readPrec :: ReadPrec (NubList a)
readPrec = ([a] -> NubList a) -> ReadPrec (NubList a)
forall a (l :: * -> *). Read a => ([a] -> l a) -> ReadPrec (l a)
readNubList [a] -> NubList a
forall a. Ord a => [a] -> NubList a
toNubList
readNubList :: (Read a) => ([a] -> l a) -> R.ReadPrec (l a)
readNubList :: ([a] -> l a) -> ReadPrec (l a)
readNubList [a] -> l a
toList = ReadPrec (l a) -> ReadPrec (l a)
forall a. ReadPrec a -> ReadPrec a
R.parens (ReadPrec (l a) -> ReadPrec (l a))
-> (ReadPrec (l a) -> ReadPrec (l a))
-> ReadPrec (l a)
-> ReadPrec (l a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec (l a) -> ReadPrec (l a)
forall a. Int -> ReadPrec a -> ReadPrec a
R.prec Int
10 (ReadPrec (l a) -> ReadPrec (l a))
-> ReadPrec (l a) -> ReadPrec (l a)
forall a b. (a -> b) -> a -> b
$ ([a] -> l a) -> ReadPrec [a] -> ReadPrec (l a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> l a
toList ReadPrec [a]
forall a. Read a => ReadPrec a
R.readPrec
ordNubBy :: Ord b => (a -> b) -> [a] -> [a]
ordNubBy :: (a -> b) -> [a] -> [a]
ordNubBy a -> b
f [a]
l = Set b -> [a] -> [a]
go Set b
forall a. Set a
Set.empty [a]
l
where
go :: Set b -> [a] -> [a]
go !Set b
_ [] = []
go !Set b
s (a
x:[a]
xs)
| b
y b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set b
s = Set b -> [a] -> [a]
go Set b
s [a]
xs
| Bool
otherwise = let !s' :: Set b
s' = b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
y Set b
s
in a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set b -> [a] -> [a]
go Set b
s' [a]
xs
where
y :: b
y = a -> b
f a
x