---------------------------------------------------------------------------- -- | -- 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