diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2019 Sergey Vinokurov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +This software is provided by the copyright holders and contributors +"as is" and any express or implied warranties, including, but not +limited to, the implied warranties of merchantability and fitness for +a particular purpose are disclaimed. In no event shall the authors or +contributors be liable for any direct, indirect, incidental, special, +exemplary, or consequential damages (including, but not limited to, +procurement of substitute goods or services; loss of use, data, or +profits; or business interruption) however caused and on any theory of +liability, whether in contract, strict liability, or tort (including +negligence or otherwise) arising in any way out of the use of this +software, even if advised of the possibility of such damage. diff --git a/constrained-platform-instances.cabal b/constrained-platform-instances.cabal new file mode 100644 --- /dev/null +++ b/constrained-platform-instances.cabal @@ -0,0 +1,61 @@ +cabal-version: + 2.0 +name: + constrained-platform-instances +version: + 0.1 +synopsis: + Instances of standard platform types for 'constrained' package. +description: + Instances for 'IntMap', 'Map', 'Set', 'Vector', etc of genealizations of + standard 'Functor', 'Foldable', and 'Traversable' classes. +license: + BSD2 +license-file: + LICENSE +author: + Sergey Vinokurov +maintainer: + Sergey Vinokurov +tested-with: + GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 +category: Data + +build-type: + Simple + +library + exposed-modules: + Data.Constrained.Instances + Data.Foldable.Constrained.Instances + Data.Functor.Constrained.Instances + Data.Traversable.Constrained.Instances + hs-source-dirs: + src + build-depends: + array, + -- 7.4.1 instroduced ConstraintKind + base >= 4.5 && < 5, + constrained, + containers, + vector + default-language: + Haskell2010 + ghc-options: + -Wall + -fwarn-name-shadowing + -fno-warn-type-defaults + if impl(ghc >= 8.0) + ghc-options: + -Wall-missed-specialisations + -Wcompat + -Whi-shadowing + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-exported-signatures + if impl(ghc >= 8.2) + ghc-options: + -Wcpp-undef + -Wmissing-home-modules + -Wunbanged-strict-patterns diff --git a/src/Data/Constrained/Instances.hs b/src/Data/Constrained/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Data/Constrained/Instances.hs @@ -0,0 +1,56 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Data.Constrained.Instances +-- Copyright : (c) Sergey Vinokurov 2019 +-- License : BSD-2 (see LICENSE) +-- Maintainer : sergey@debian +---------------------------------------------------------------------------- + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Constrained.Instances () where + +import qualified Data.Array as A +import qualified Data.Array.IArray as AIA +import qualified Data.Array.Unboxed as AU +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Set (Set) + +import qualified Data.Vector as V +import qualified Data.Vector.Primitive as VP +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU + +import Data.Constrained + +instance Constrained (A.Array i) where + type Constraints (A.Array i) = NoConstraints + +instance Constrained (AU.UArray i) where + type Constraints (AU.UArray i) = AIA.IArray AU.UArray + +instance Constrained IntMap where + type Constraints IntMap = NoConstraints + +instance Constrained (Map k) where + type Constraints (Map k) = NoConstraints + +instance Constrained Set where + type Constraints Set = Ord + +instance Constrained V.Vector where + type Constraints V.Vector = NoConstraints + +instance Constrained VP.Vector where + type Constraints VP.Vector = VP.Prim + +instance Constrained VS.Vector where + type Constraints VS.Vector = VS.Storable + +instance Constrained VU.Vector where + type Constraints VU.Vector = VU.Unbox + diff --git a/src/Data/Foldable/Constrained/Instances.hs b/src/Data/Foldable/Constrained/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Data/Foldable/Constrained/Instances.hs @@ -0,0 +1,295 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Data.Foldable.Constrained.Instances +-- Copyright : (c) Sergey Vinokurov 2019 +-- License : BSD-2 (see LICENSE) +-- Maintainer : sergey@debian +---------------------------------------------------------------------------- + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Foldable.Constrained.Instances () where + +import qualified Data.Array as A +import qualified Data.Array.Unboxed as AU +import qualified Data.Foldable as F +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Set (Set) + +import qualified Data.Vector as V +import qualified Data.Vector.Primitive as VP +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU + +import Data.Foldable.Constrained +import Data.Constrained.Instances () + +instance CFoldable (A.Array i) where + {-# INLINE cfold #-} + {-# INLINE cfoldMap #-} + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfold = F.fold + cfoldMap = F.foldMap + cfoldr = F.foldr + cfoldr' = F.foldr' + cfoldl = F.foldl + cfoldl' = F.foldl' + cfoldr1 = F.foldr1 + cfoldl1 = F.foldl1 + ctoList = F.toList + cnull = F.null + clength = F.length + celem = F.elem + cmaximum = F.maximum + cminimum = F.minimum + csum = F.sum + cproduct = F.product + +instance AU.Ix i => CFoldable (AU.UArray i) where + {-# INLINE cfoldMap #-} + {-# INLINE ctoList #-} + cfoldMap f = F.foldMap f . AU.elems + ctoList = AU.elems + +instance CFoldable IntMap where + {-# INLINE cfold #-} + {-# INLINE cfoldMap #-} + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfold = F.fold + cfoldMap = F.foldMap + cfoldr = F.foldr + cfoldr' = F.foldr' + cfoldl = F.foldl + cfoldl' = F.foldl' + cfoldr1 = F.foldr1 + cfoldl1 = F.foldl1 + ctoList = F.toList + cnull = F.null + clength = F.length + celem = F.elem + cmaximum = F.maximum + cminimum = F.minimum + csum = F.sum + cproduct = F.product + +instance CFoldable (Map k) where + {-# INLINE cfold #-} + {-# INLINE cfoldMap #-} + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfold = F.fold + cfoldMap = F.foldMap + cfoldr = F.foldr + cfoldr' = F.foldr' + cfoldl = F.foldl + cfoldl' = F.foldl' + cfoldr1 = F.foldr1 + cfoldl1 = F.foldl1 + ctoList = F.toList + cnull = F.null + clength = F.length + celem = F.elem + cmaximum = F.maximum + cminimum = F.minimum + csum = F.sum + cproduct = F.product + +instance CFoldable Set where + {-# INLINE cfold #-} + {-# INLINE cfoldMap #-} + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfold = F.fold + cfoldMap = F.foldMap + cfoldr = F.foldr + cfoldr' = F.foldr' + cfoldl = F.foldl + cfoldl' = F.foldl' + cfoldr1 = F.foldr1 + cfoldl1 = F.foldl1 + ctoList = F.toList + cnull = F.null + clength = F.length + celem = F.elem + cmaximum = F.maximum + cminimum = F.minimum + csum = F.sum + cproduct = F.product + +instance CFoldable V.Vector where + {-# INLINE cfold #-} + {-# INLINE cfoldMap #-} + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfold = F.fold + cfoldMap = F.foldMap + cfoldr = F.foldr + cfoldr' = F.foldr' + cfoldl = F.foldl + cfoldl' = F.foldl' + cfoldr1 = F.foldr1 + cfoldl1 = F.foldl1 + ctoList = F.toList + cnull = F.null + clength = F.length + celem = F.elem + cmaximum = F.maximum + cminimum = F.minimum + csum = F.sum + cproduct = F.product + +instance CFoldable VP.Vector where + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfoldr = VP.foldr + cfoldr' = VP.foldr' + cfoldl = VP.foldl + cfoldl' = VP.foldl' + cfoldr1 = VP.foldr1 + cfoldl1 = VP.foldl1 + ctoList = VP.toList + cnull = VP.null + clength = VP.length + celem = VP.elem + cmaximum = VP.maximum + cminimum = VP.minimum + csum = VP.sum + cproduct = VP.product + +instance CFoldable VS.Vector where + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfoldr = VS.foldr + cfoldr' = VS.foldr' + cfoldl = VS.foldl + cfoldl' = VS.foldl' + cfoldr1 = VS.foldr1 + cfoldl1 = VS.foldl1 + ctoList = VS.toList + cnull = VS.null + clength = VS.length + celem = VS.elem + cmaximum = VS.maximum + cminimum = VS.minimum + csum = VS.sum + cproduct = VS.product + +instance CFoldable VU.Vector where + {-# INLINE cfoldr #-} + {-# INLINE cfoldr' #-} + {-# INLINE cfoldl #-} + {-# INLINE cfoldl' #-} + {-# INLINE cfoldr1 #-} + {-# INLINE cfoldl1 #-} + {-# INLINE ctoList #-} + {-# INLINE cnull #-} + {-# INLINE clength #-} + {-# INLINE celem #-} + {-# INLINE cmaximum #-} + {-# INLINE cminimum #-} + {-# INLINE csum #-} + {-# INLINE cproduct #-} + cfoldr = VU.foldr + cfoldr' = VU.foldr' + cfoldl = VU.foldl + cfoldl' = VU.foldl' + cfoldr1 = VU.foldr1 + cfoldl1 = VU.foldl1 + ctoList = VU.toList + cnull = VU.null + clength = VU.length + celem = VU.elem + cmaximum = VU.maximum + cminimum = VU.minimum + csum = VU.sum + cproduct = VU.product diff --git a/src/Data/Functor/Constrained/Instances.hs b/src/Data/Functor/Constrained/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Data/Functor/Constrained/Instances.hs @@ -0,0 +1,72 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Data.Functor.Constrained.Instances +-- Copyright : (c) Sergey Vinokurov 2019 +-- License : BSD-2 (see LICENSE) +-- Maintainer : sergey@debian +---------------------------------------------------------------------------- + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Functor.Constrained.Instances () where + +import qualified Data.Array as A +import qualified Data.Array.IArray as AIA +import qualified Data.Array.Unboxed as AU +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Set (Set) +import qualified Data.Set as S + +import qualified Data.Vector as V +import qualified Data.Vector.Primitive as VP +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU + +import Data.Functor.Constrained +import Data.Constrained.Instances () + +instance CFunctor (A.Array i) + +instance AU.Ix i => CFunctor (AU.UArray i) where + {-# INLINE cmap #-} + cmap = AIA.amap + +instance CFunctor IntMap where + {-# INLINE cmap_ #-} + cmap_ = (<$) + +instance CFunctor (Map k) where + {-# INLINE cmap_ #-} + cmap_ = (<$) + +instance CFunctor Set where + {-# INLINE cmap #-} + {-# INLINE cmap_ #-} + cmap = S.map + cmap_ = const . S.singleton + +instance CFunctor V.Vector where + {-# INLINE cmap_ #-} + cmap_ = (<$) + +instance CFunctor VP.Vector where + {-# INLINE cmap #-} + {-# INLINE cmap_ #-} + cmap = VP.map + cmap_ x v = VP.replicate (VP.length v) x + +instance CFunctor VS.Vector where + {-# INLINE cmap #-} + {-# INLINE cmap_ #-} + cmap = VS.map + cmap_ x v = VS.replicate (VS.length v) x + +instance CFunctor VU.Vector where + {-# INLINE cmap #-} + {-# INLINE cmap_ #-} + cmap = VU.map + cmap_ x v = VU.replicate (VU.length v) x diff --git a/src/Data/Traversable/Constrained/Instances.hs b/src/Data/Traversable/Constrained/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Data/Traversable/Constrained/Instances.hs @@ -0,0 +1,62 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Data.Traversable.Constrained.Instances +-- Copyright : (c) Sergey Vinokurov 2019 +-- License : BSD-2 (see LICENSE) +-- Maintainer : sergey@debian +---------------------------------------------------------------------------- + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Traversable.Constrained.Instances () where + +import qualified Data.Array as A +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Set (Set) +import qualified Data.Set as S + +import qualified Data.Vector as V +import qualified Data.Vector.Primitive as VP +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU + +import Data.Constrained.Instances () +import Data.Foldable.Constrained.Instances () +import Data.Functor.Constrained.Instances () +import Data.Traversable.Constrained + +instance A.Ix i => CTraversable (A.Array i) where + {-# INLINE csequence #-} + csequence = sequenceA + +instance CTraversable IntMap where + {-# INLINE csequence #-} + csequence = sequenceA + +instance CTraversable (Map k) where + {-# INLINE csequence #-} + csequence = sequenceA + +instance CTraversable Set where + ctraverse f = S.foldr (\x rest -> S.insert <$> f x <*> rest) (pure S.empty) + +instance CTraversable V.Vector where + {-# INLINE csequence #-} + csequence = sequenceA + +instance CTraversable VP.Vector where + {-# INLINE ctraverse #-} + ctraverse = VP.mapM + +instance CTraversable VS.Vector where + {-# INLINE ctraverse #-} + ctraverse = VS.mapM + +instance CTraversable VU.Vector where + {-# INLINE ctraverse #-} + ctraverse = VU.mapM