-- | Constructing singleton collections.

module Agda.Utils.Singleton where

import Data.Semigroup (Semigroup(..))
import Data.Monoid (Endo(..))

import Data.DList (DList)
import qualified Data.DList as DL
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List.NonEmpty (NonEmpty(..))

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set

-- | A create-only possibly empty collection is a monoid with the possibility
--   to inject elements.

class (Semigroup coll, Monoid coll, Singleton el coll) => Collection el coll
    | coll -> el where
  fromList :: [el] -> coll
  fromList = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall el coll. Singleton el coll => el -> coll
singleton

instance Collection a       [a]           where fromList :: [a] -> [a]
fromList = forall a. a -> a
id
instance Collection a       ([a] -> [a])  where fromList :: [a] -> [a] -> [a]
fromList = forall a. [a] -> [a] -> [a]
(++)
instance Collection a       (Endo [a])    where fromList :: [a] -> Endo [a]
fromList = forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall el coll. Collection el coll => [el] -> coll
fromList
instance Collection a       (DList a)     where fromList :: [a] -> DList a
fromList = forall a. [a] -> DList a
DL.fromList
instance Collection a       (Seq a)       where fromList :: [a] -> Seq a
fromList = forall a. [a] -> Seq a
Seq.fromList
instance Collection Int     IntSet        where fromList :: [Int] -> IntSet
fromList = [Int] -> IntSet
IntSet.fromList
instance Collection (Int,a) (IntMap a)    where fromList :: [(Int, a)] -> IntMap a
fromList = forall a. [(Int, a)] -> IntMap a
IntMap.fromList

instance Ord a =>
         Collection a       (Set a)       where fromList :: [a] -> Set a
fromList = forall a. Ord a => [a] -> Set a
Set.fromList

instance Ord k =>
         Collection (k, a)  (Map k a)     where fromList :: [(k, a)] -> Map k a
fromList = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

instance (Eq a, Hashable a) =>
         Collection a       (HashSet a)   where fromList :: [a] -> HashSet a
fromList = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList

instance (Eq k, Hashable k) =>
         Collection (k, a)  (HashMap k a) where fromList :: [(k, a)] -> HashMap k a
fromList = forall k a. (Eq k, Hashable k) => [(k, a)] -> HashMap k a
HashMap.fromList

-- | Overloaded @singleton@ constructor for collections.

class Singleton el coll | coll -> el where
  singleton :: el -> coll

instance Singleton a   (Maybe a)   where singleton :: a -> Maybe a
singleton = forall a. a -> Maybe a
Just
instance Singleton a   [a]         where singleton :: a -> [a]
singleton = (forall a. a -> [a] -> [a]
:[])
instance Singleton a  ([a] -> [a]) where singleton :: a -> [a] -> [a]
singleton = (:)
instance Singleton a   (Endo [a])  where singleton :: a -> Endo [a]
singleton = forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
instance Singleton a   (DList a)   where singleton :: a -> DList a
singleton = forall a. a -> DList a
DL.singleton
instance Singleton a   (NonEmpty a)
                                   where singleton :: a -> NonEmpty a
singleton = (forall a. a -> [a] -> NonEmpty a
:| [])
instance Singleton a   (Seq a)     where singleton :: a -> Seq a
singleton = forall a. a -> Seq a
Seq.singleton
instance Singleton a   (Set a)     where singleton :: a -> Set a
singleton = forall a. a -> Set a
Set.singleton
instance Singleton Int IntSet      where singleton :: Int -> IntSet
singleton = Int -> IntSet
IntSet.singleton

instance Singleton (k  ,a) (Map  k a) where singleton :: (k, a) -> Map k a
singleton = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. k -> a -> Map k a
Map.singleton
instance Singleton (Int,a) (IntMap a) where singleton :: (Int, a) -> IntMap a
singleton = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Int -> a -> IntMap a
IntMap.singleton

instance Hashable a => Singleton a     (HashSet   a) where singleton :: a -> HashSet a
singleton = forall a. Hashable a => a -> HashSet a
HashSet.singleton
instance Hashable k => Singleton (k,a) (HashMap k a) where singleton :: (k, a) -> HashMap k a
singleton = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton

-- Testing newtype-deriving:

-- newtype Wrap c = Wrap c
--   deriving (Singleton k)  -- Succeeds

-- Type family version:

-- class Singleton c where
--   type Elem c
--   singleton :: Elem c -> c

-- instance Singleton [a] where
--   type Elem [a] = a
--   singleton = (:[])

-- instance Singleton (Maybe a) where
--   type Elem (Maybe a) = a
--   singleton = Just

-- instance Singleton (Set a) where
--   type Elem (Set a) = a
--   singleton = Set.singleton

-- instance Singleton (Map k a) where
--   type Elem (Map k a) = (k,a)
--   singleton = uncurry Map.singleton

-- newtype Wrap a = Wrap a
--   deriving (Singleton)  -- Fails