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 { forall a. NubList a -> [a]
fromNubList :: [a] }
deriving (NubList a -> NubList a -> Bool
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 :: forall a. Ord a => [a] -> NubList a
toNubList [a]
list = forall a. [a] -> NubList a
NubList forall a b. (a -> b) -> a -> b
$ (forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy forall a. a -> a
id) [a]
list
overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList :: forall a. Ord a => ([a] -> [a]) -> NubList a -> NubList a
overNubList [a] -> [a]
f (NubList [a]
list) = forall a. Ord a => [a] -> NubList a
toNubList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f 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) = forall a. [a] -> NubList a
NubList forall a b. (a -> b) -> a -> b
$ [a]
xs Ord a => [a] -> [a] -> [a]
`listUnion` [a]
ys
where
listUnion :: (Ord a) => [a] -> [a] -> [a]
listUnion :: Ord a => [a] -> [a] -> [a]
listUnion [a]
a [a]
b = [a]
a
forall a. [a] -> [a] -> [a]
++ forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy forall a. a -> a
id (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`Set.notMember` (forall a. Ord a => [a] -> Set a
Set.fromList [a]
a)) [a]
b)
instance Ord a => Monoid (NubList a) where
mempty :: NubList a
mempty = forall a. [a] -> NubList a
NubList []
mappend :: NubList a -> NubList a -> NubList a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
instance Show a => Show (NubList a) where
show :: NubList a -> String
show (NubList [a]
list) = forall a. Show a => a -> String
show [a]
list
instance (Ord a, Read a) => Read (NubList a) where
readPrec :: ReadPrec (NubList a)
readPrec = forall a (l :: * -> *). Read a => ([a] -> l a) -> ReadPrec (l a)
readNubList forall a. Ord a => [a] -> NubList a
toNubList
readNubList :: (Read a) => ([a] -> l a) -> R.ReadPrec (l a)
readNubList :: forall a (l :: * -> *). Read a => ([a] -> l a) -> ReadPrec (l a)
readNubList [a] -> l a
toList = forall a. ReadPrec a -> ReadPrec a
R.parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
R.prec Int
10 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> l a
toList forall a. Read a => ReadPrec a
R.readPrec
ordNubBy :: Ord b => (a -> b) -> [a] -> [a]
ordNubBy :: forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy a -> b
f [a]
l = Set b -> [a] -> [a]
go 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 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' = forall a. Ord a => a -> Set a -> Set a
Set.insert b
y Set b
s
in a
x forall a. a -> [a] -> [a]
: Set b -> [a] -> [a]
go Set b
s' [a]
xs
where
y :: b
y = a -> b
f a
x