----------------------------------------------------------------------------
-- |
-- Module : Data.Constrained
-- Copyright : (c) Sergey Vinokurov 2019
-- License : BSD-2 (see LICENSE)
-- Maintainer : sergey@debian
----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Data.Constrained
( Constrained(..)
, NoConstraints
, UnionConstraints
, ComposeConstraints
) where
import Control.Applicative (ZipList(..))
import Data.Functor.Compose (Compose(..))
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Product (Product(..))
import Data.Functor.Sum (Sum(..))
import Data.Kind
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Monoid as Monoid
import qualified Data.Semigroup as Semigroup
-- | Specification of constrains that a functor might impose on its elements.
-- For example, sets typically require that their elements are ordered and
-- unboxed vectors require elements to have an instance of special class
-- that allows them to be packed in memory.
--
-- NB The 'Constraints' type family is associated with a typeclass in
-- order to improve type inference. Whenever a typeclass constraint
-- will be present, instance is guaranteed to exist and typechecker is
-- going to take advantage of that.
class Constrained (f :: k2 -> k1) where
type Constraints (f :: k2 -> k1) :: k2 -> Constraint
-- | Used to specify values for 'Constraints' type family to indicate
-- absence of any constraints (i.e. empty 'Constraint').
class NoConstraints (a :: k)
instance NoConstraints a
-- | Combine constraints of two functors together to form a bigger set
-- of constraints.
class (Constraints f a, Constraints g a) => UnionConstraints (f :: k1 -> k2) (g :: k1 -> k2) (a :: k1)
instance (Constraints f a, Constraints g a) => UnionConstraints f g a
-- | Combine constraints for a case when one functors contains the other one.
class (Constraints f (g a), Constraints g a) => ComposeConstraints (f :: k2 -> k1) (g :: k3 -> k2) (a :: k3)
instance (Constraints f (g a), Constraints g a) => ComposeConstraints f g a
instance Constrained [] where
type Constraints [] = NoConstraints
instance Constrained NonEmpty where
type Constraints NonEmpty = NoConstraints
instance Constrained Identity where
type Constraints Identity = NoConstraints
instance Constrained ((,) a) where
type Constraints ((,) a) = NoConstraints
instance Constrained Maybe where
type Constraints Maybe = NoConstraints
instance Constrained (Either a) where
type Constraints (Either a) = NoConstraints
instance Constrained (Const a) where
type Constraints (Const a) = NoConstraints
instance Constrained ZipList where
type Constraints ZipList = NoConstraints
instance Constrained Semigroup.Min where
type Constraints Semigroup.Min = NoConstraints
instance Constrained Semigroup.Max where
type Constraints Semigroup.Max = NoConstraints
instance Constrained Semigroup.First where
type Constraints Semigroup.First = NoConstraints
instance Constrained Semigroup.Last where
type Constraints Semigroup.Last = NoConstraints
instance Constrained Semigroup.Dual where
type Constraints Semigroup.Dual = NoConstraints
instance Constrained Semigroup.Sum where
type Constraints Semigroup.Sum = NoConstraints
instance Constrained Semigroup.Product where
type Constraints Semigroup.Product = NoConstraints
#if MIN_VERSION_base(4,12,0)
instance Constrained f => Constrained (Monoid.Ap f) where
type Constraints (Monoid.Ap f) = Constraints f
#endif
instance Constrained f => Constrained (Monoid.Alt f) where
type Constraints (Monoid.Alt f) = Constraints f
instance (Constrained f, Constrained g) => Constrained (Compose f g) where
type Constraints (Compose f g) = ComposeConstraints f g
instance (Constrained f, Constrained g) => Constrained (Product f g) where
type Constraints (Product f g) = UnionConstraints f g
instance (Constrained f, Constrained g) => Constrained (Sum f g) where
type Constraints (Sum f g) = UnionConstraints f g