-- | Constructing singleton collections. module BNFC.Utils.Singleton where import Prelude (id, (.), uncurry, (++), map, Maybe(..), Monoid(..), Ord) import Data.Semigroup (Semigroup) -- for ghc-8.0 import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Set (Set) import qualified Data.Map as Map 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 = mconcat . map singleton instance Collection a [a] where fromList = id instance Collection a ([a] -> [a]) where fromList = (++) instance Ord a => Collection a (Set a) where fromList = Set.fromList instance Ord k => Collection (k, a) (Map k a) where fromList = Map.fromList -- | Overloaded @singleton@ constructor for collections. class Singleton el coll | coll -> el where singleton :: el -> coll instance Singleton a (Maybe a) where singleton = Just instance Singleton a [a] where singleton = (:[]) instance Singleton a ([a] -> [a]) where singleton = (:) instance Singleton a (NonEmpty a) where singleton = (:| []) instance Singleton a (Set a) where singleton = Set.singleton instance Singleton (k,a) (Map k a) where singleton = uncurry Map.singleton