packages feed

freelude (empty) → 0.1.0.0

raw patch · 15 files changed

+1295/−0 lines, 15 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, doctest, indextype, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Clinton Mead (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Clinton Mead nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++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 COPYRIGHT+OWNER 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.
+ README.md view
@@ -0,0 +1,1 @@+# freelude
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ freelude.cabal view
@@ -0,0 +1,64 @@+name:                freelude+version:             0.1.0.0+synopsis:            A generalisation of the Category->Functor->Applicative->Monad hierarchy and more+description:+  This package generalises classes like Category, Functor etc to allow them to be defined on more data types,+  for example, tuples and sets, whilst still attempting to maintain backward compatability.++  See the module "Freelude" for more details.+homepage:            https://github.com/clintonmead/freelude#readme+license:             BSD3+license-file:        LICENSE+author:              Clinton Mead+maintainer:          clintonmead@gmail.com+copyright:           Copyright: (c) 2017 Clinton Mead+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+    Freelude+    Freelude.FunctionRestrictedFunctor+    Freelude.Impl.Category+    Freelude.Impl.CategoryAsMonoid+    Freelude.Impl.ExoFunctor+    Freelude.Impl.MonoidAsCategory+    Freelude.Impl.MakeFunctor+    Freelude.Impl.RestrictedFunctor+    Freelude.Impl.ToKind+  build-depends:       base == 4.10.*, indextype == 0.3.*, containers, transformers, array+  default-language:    Haskell2010+  ghc-options: -Wall -fprint-explicit-kinds++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test, src+  main-is:             Test.hs+  other-modules:+    Freelude+    Freelude.FunctionRestrictedFunctor+    Freelude.Impl.Category+    Freelude.Impl.CategoryAsMonoid+    Freelude.Impl.ExoFunctor+    Freelude.Impl.MonoidAsCategory+    Freelude.Impl.MakeFunctor+    Freelude.Impl.RestrictedFunctor+    Freelude.Impl.ToKind+  build-depends:       base == 4.10.*, indextype == 0.3.*, containers, transformers, array+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++test-suite doctests+  type:          exitcode-stdio-1.0+  hs-source-dirs:      test, src+  ghc-options:   -threaded+  main-is:       DocTest.hs+  build-depends: base == 4.10.*, doctest >= 0.8+  default-language: Haskell2010++source-repository head+  type:     git+  location: https://github.com/clintonmead/freelude
+ src/Freelude.hs view
@@ -0,0 +1,289 @@+{-|+Module      : Freelude+Description : Tutorial in this module+Copyright   : (c) Clinton Mead 2017+License     : BSD3+Maintainer  : clintonmead@gmail.com+Stability   : experimental+Portability : POSIX++= Overview++Freelude is a replacement prelude which generalises classes like Category and Functor,+that is, allows one to make more types Categories and Functors than before.++The structure and design is a bit of a work in progress.++This package also includes classes like Applicative and Monad, but they are not as generalised as Functor,+as I'm as yet unsure of a sensible way to generalise them.++I've tried to implement a lot of the ordinary instances in base and other GHC supplied modules,+but I'm probably missing some, so feel free to mention those which are missing or better still, just submit a patch.++This module itself simply reimports Prelude but overrides a bunch of functions and classes, and also adds a number of classes and functions.++Later on I'll probably develop a finer-grained approach.++= Motivation++Wouldn't it be nice if we could write something like this:++> (f1,f2) . (g1,g1)++And get what we expect, namely (f1 . g1, f2 . g2).++So lets try to write a 'Control.Category' instance for pairs:++@+instance Category ???+@++There's nothing sensible we can replace the ???s with.++This package resolves the above issue, and many others.++For the moment, this documentation will just show some examples of how these new versions of+'Category', 'Functor' etc can be used.++= Usage++Firstly, we want to ignore the normal "Prelude" and instead import "Freelude":++> {-# LANGUAGE NoImplicitPrelude #-}+> import Freelude++== Category++Here's how to run categorical compostion on pairs:++>>> :{+let+  f_pair :: (Read a, Enum b) => (String -> a, b -> b)+  f_pair = (read, succ)+  g_pair :: (Show b) => (Int -> Int, b -> String)+  g_pair = ((*3), show)+  applyPair (f1,f2) (x1,x2) = (f1 x1, f2 x2)+:}++>>> let h_pair = g_pair . f_pair+>>> applyPair h_pair ("5",'a')+(15,"'b'")++Note that we've successfully made @f@ and @g@, both tuples, into categories.++It's not just tuples we can turn into categories.++>>> :{+let+  f_list :: Num a => [a -> a]+  f_list = [(+2), (*3)]+  g_list :: Num a => [a -> a]+  g_list = [(+4), (*5)]+:}++>>> let h_list = f_list . g_list+>>> h_list <*> [6,7]+[12,13,32,37,30,33,90,105]++Also, here's a 'Maybe' category:++>>> ((Just (*2)) . Nothing) <*> (Just 4)+Nothing++>>> ((Just (*2)) . (Just (*3))) <*> (Just 4)+Just 24++It's worth noting that we have also extended the '$' operator to work for non ordinary functions:++>>> h_pair $ ("5",'a')+(15,"'b'")++>>> h_list $ [6,7]+[12,13,32,37,30,33,90,105]++>>> ((Just (*2)) . Nothing) $ (Just 4)+Nothing++>>> ((Just (*2)) . (Just (*3))) $ (Just 4)+Just 24++In cases where the category is also a functor (like 'Maybe', '[]'), '$' is generally just '<*>',+but '$' is somewhat more general (it's defined for 'Control.Arrow.Kleisli' arrows for example).++We can also nest categories:++>>> :{+let+  f_list_maybe :: Num a => [Maybe (a -> a)]+  f_list_maybe = [Just (+2), Just (*3)]+  g_list_maybe :: Num a => [Maybe (a -> a)]+  g_list_maybe = [Just (+4), Nothing]+:}++>>> let h_list_maybe = f_list_maybe . g_list_maybe+>>> h_list_maybe $ [Just 6,Nothing]+[Just 12,Nothing,Nothing,Nothing,Just 30,Nothing,Nothing,Nothing]++Above is also an example of how '$' is more general than '<*>'.++== Functor++Whilst we have 'Prelude.Functor's on pairs in the usual "Prelude", their definition is a little bit weird, namely the below:++@fmap f (x,y) = (x, f y)@++For example:++>>> Prelude.fmap (*3) (1,2)+(1,6)++This does have some uses but I consider it surprising. arguably a more sensible definition is as follows:++@fmap f (x,y) = (f x, f y)@++>>> :set -XTypeFamilies+>>> :set -XFlexibleContexts+>>> fmap (*3) (1,2)+(3,6)++The above definition can not be defined with the normal instance of 'Prelude.Functor', but it be defined using "Freelude"s 'Functor'++We can also define functors over things like 'Data.Set', which we couldn't before.++>>> import qualified Data.Set as Set+>>> fmap (\x -> x * x) (Data.Set.fromList [1,-1,2,-2,3])+fromList [1,4,9]++And even unboxed arrays!++>>> import Data.Array.Unboxed (UArray)+>>> import Data.Array.IArray as IArray+>>> let a = (IArray.array (1,3) [(1,4),(2,5),(3,6)]) :: UArray Int Int+>>> fmap (*3) a+array (1,3) [(1,12),(2,15),(3,18)]++Note that both in the case of sets and unboxed arrays, ordinary 'Prelude.Functor' instances+can not be defined for them as there are constraints on their parameters.++We also further generalise 'Functor'. Instead of thinking of 'Functor'+as a function between functions, we think of it as a function between categories.+So `fmap` can be defined on other categories.++For example, we can define `fmap` on the category of a list of categories, like so:++>>> let f_l = (fmap [(+2),(*3),(+4)]) :: Num a => [Maybe a -> Maybe a]+>>> :t f_l+f_l :: Num a => [Maybe a -> Maybe a]++And indeed, this works roughly how we would expect:++>>> f_l <*> [Just 3, Nothing]+[Just 5,Nothing,Just 9,Nothing,Just 7,Nothing]++== Applicatives++"Freelude" splits 'Prelude.Applicative' into three classes, namely:++1. 'Lift' ('liftA2')+2. 'Pure' ('pure')+3. 'Apply' ('<*>')++In the ordinary prelude, 'Prelude.<*>' is the primary function to be defined,+which has a signature as follows:++> f (a -> b) -> f a -> f b++But notice how the structure is required to be able to contain functions.+But we've already mentioned two strutures that can't: sets and unboxed arrays.++As a result, whereas in the "Prelude", 'Prelude.<*>' is the primary function and+'Control.Applicative.liftA2' is defined in terms of it, for "Freelude" we've switched that around.++In "Freelude", 'liftA2' is the primary definition+and '<*>' is optionally defined in terms of 'liftA2',+but only automatically when there is no restrictions on the type.++Note that unlike `Functor' I haven't generalised 'Lift', 'Pure' and 'Apply'+to non function categories. This perhaps could be done in the future but there's some+thinking to do about the best and most useful way forward with this.++Here's an example of 'liftA2' on sets:++>>> liftA2 (*) (Data.Set.fromList [1,2,3,4]) (Data.Set.fromList [1,2,3,4])+fromList [1,2,3,4,6,8,9,12,16]++And we have full applicative on tuples:+>>> (*) <$> (2,3) <*> (4,5)+(8,15)++== Monad++Monad is defined as a subclass of 'Lift' and 'Pure', instead of 'Apply' and 'Pure' (i.e. @Applicative@).+The reason for this is that interestingly, although you can't+define @<*>@ for @Set@ as discussed above, you can define @>>=@.++This is because the definition of @>>=@ is as follows:++> f a -> (a -> f b) -> f b++Note we don't have any of @f (a -> b)@ arguments that got us caught up trying to define @<*>@ for sets.++>>> (Data.Set.fromList [1,2,3]) >>= (\x -> Data.Set.fromList [x,x*x,x+2])+fromList [1,2,3,4,5,9]++== Rebindable syntax++You can use the extension @RebindableSyntax@ to use do-notation:++>>> :set -XRebindableSyntax+>>> :{+do+  set_x <- Data.Set.fromList [1,2,3]+  set_y <-(\x -> Data.Set.fromList [x,x*x,x+2]) set_x+  pure set_y+:}+fromList [1,2,3,4,5,9]++= Defining your own instances++I'll put a tutorial here at some point, but there's plenty of examples in "Freelude.Impl.Category"++= Rationale behind design++I'll fill this out at some point also, noting that it currently makes quite significant use of+injective type families and constraint kinds. Since the design is still in a state of flux+it's probably not detailling yet anyway (I welcome suggestions/patches).++It worth noting that some of the reasons for the design is to maintain the ability for the+type system to recognise certain invariants, which I will detail with examples in future.++= Notes++You'll probably want GHC 8.2. Some things will work with 8.0, indeed the library itself should compile,+but the tests won't.++In developing this library I've occasionally experienced GHC panics.+One thing that occasionally resolved this was including the extension @TypeInType@ in code that+uses the library. If you get a GHC panic perhaps try adding the extension @TypeInType@+and trying again.++A number of libraries that this depend on are build for and have dependencies on base for GHC 8.0,+This will cause dependency hell, but building this library with '--allow-newer' should fix all issues.++-}++module Freelude (+  module Prelude,+  module Freelude.Impl.Category,+  module Freelude.Impl.ExoFunctor+) where++import Freelude.Impl.Category+import Freelude.Impl.ExoFunctor+import Prelude hiding (+  Functor(fmap), (<$>), (<$),+  Applicative((<*>), pure), (<*), (*>),+  Monad(return, (>>=), (>>)), (=<<),+  (.), id, const,+  ($), ($!)+  )
+ src/Freelude/FunctionRestrictedFunctor.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts #-}++module Freelude.FunctionRestrictedFunctor (fmap) where++import Prelude hiding (fmap)+import Freelude.Impl.RestrictedFunctor+import Freelude.Impl.Category hiding (fmap)++fmap ::+  (Freelude.Impl.Category.Functor FunctionP p, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC FunctionP a b, CategoryC FunctionP ra rb, FunctorSrcC p a, FunctorDstC p b) =>+  CategoryT FunctionP a b -> CategoryT FunctionP ra rb+fmap = restrictedfmap
+ src/Freelude/Impl/Category.hs view
@@ -0,0 +1,686 @@+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}++module Freelude.Impl.Category (+  Semigroupoid((.)), (<<<), (>>>),+  Category(id),+  Const(const),+  Arr(arr),+  FunctionP,+  CategoryT, ExoCategoryT,+  CategorySrcC, CategorySrcC', ExoCategorySrcC,+  CategoryDstC, CategoryDstC', ExoCategoryDstC,+  CategoryC, ExoCategoryC,+  IsSemigroupoid, ExoIsSemigroupoid,+  IsCategory, ExoIsCategory,+  FunctorT, FunctorSrcC, FunctorDstC, FunctorSrcC', FunctorDstC',+  FromMaybeConstraintFunc,+  UnconstrainedFunctor,+  BasicFunctorP, FunctorCategoryP,+  Functor(fmap), (<$>),+  ConstFunctor((<$)),+  Pure(pure),+  Lift(liftA2, (<*), (*>)),+  Apply((<*>)), (<**>),+  Applicative,+  Monad((>>=), (>>)), return, (=<<)+) where++import qualified Control.Category+import qualified Control.Applicative++import Data.Type.Equality ((:~:))+import Data.Type.Coercion (Coercion)+import Control.Arrow (Kleisli)+import Data.Monoid (Dual(Dual))+import qualified Control.Arrow++import Control.IndexT.Tuple (TupleConstraint)+import Control.IndexT (IndexT)+import Control.IndexT.Constructor (IndexC, IndexCK)++import Data.Functor.Identity (Identity(Identity))+import Prelude hiding (Functor(fmap), (<$>), Applicative((<*>), pure), Monad(return, (>>=), (>>)), (=<<), (.), id, const)+import qualified Prelude+import GHC.Exts (Constraint)+import Data.Kind (Type)+import Data.Set (Set)+import qualified Data.Set+import Data.Functor.Constant (Constant)+import Freelude.Impl.ToKind (ToType)+import Data.List.NonEmpty (NonEmpty)+import Data.Tree (Tree)+import Data.Semigroup (Option, Min, Max, Last, First)+import GHC.TypeLits (Nat)++import Data.Array (Array, Ix)+import qualified Data.Array.IArray+import Data.Array.IArray (IArray)+import Data.Array.Unboxed (UArray)++type family CategoryT (p :: Type) (a :: Type) (b :: Type) = (f :: Type) | f -> p a b+type family ExoCategoryT (p :: Type) (a :: Type) (b :: Type) = (f :: Type) | f -> p a b+type family CategorySrcC' (p :: Type) :: Maybe (Type -> Constraint)+type family CategoryDstC' (p :: Type) :: Maybe (Type -> Constraint)+type family ExoCategorySrcC (p :: Type) (a :: Type) :: Constraint+type family ExoCategoryDstC (p :: Type) (b :: Type) :: Constraint++class EmptyConstraint a+instance EmptyConstraint a++type family FromMaybeConstraintFunc (p :: Maybe (Type -> Constraint)) :: Type -> Constraint where+  FromMaybeConstraintFunc 'Nothing = EmptyConstraint+  FromMaybeConstraintFunc ('Just c) = c++type CategorySrcC p a = (FromMaybeConstraintFunc (CategorySrcC' p)) a+type CategoryDstC p a = (FromMaybeConstraintFunc (CategoryDstC' p)) a++type CategoryC p a b = (CategorySrcC p a, CategoryDstC p b)+type ExoCategoryC p a b = (ExoCategorySrcC p a, ExoCategoryDstC p b)+type IsSemigroupoid t p a b = (Semigroupoid p, t ~ CategoryT p a b, CategoryC p a b)+type ExoIsSemigroupoid t p a b = (Semigroupoid p, t ~ ExoCategoryT p a b, ExoCategoryC p a b)+type IsCategory t p a b = (IsSemigroupoid t p a b, Category p)+type ExoIsCategory t p a b = (ExoIsSemigroupoid t p a b, Category p)++class Semigroupoid p where+  (.) :: (CategoryC p b c, CategoryC p a b, CategoryC p a c) => CategoryT p b c -> CategoryT p a b -> CategoryT p a c++class Semigroupoid p => Category p where+  id :: (CategoryC p a a, ExoCategoryC p a a, t ~ CategoryT p a a, t ~ ExoCategoryT p a a) => t++class Semigroupoid p => Const p where+  const :: CategoryC p a b => b -> CategoryT p a b+  default const :: (Arr p, CategoryC p a b) => b -> CategoryT p a b+  const = arr Prelude.. Prelude.const+-- * Instances from 'Control.Category'+-- ** '->'+instance {-# OVERLAPPABLE #-} (Semigroupoid p, Arr p) => Const p++class (Category p, Const p) => Arr p where+  arr :: CategoryC p a b => (a -> b) -> CategoryT p a b+++data FunctionP++type instance CategoryT FunctionP a b = (->) a b+type instance ExoCategoryT FunctionP a b = (->) a b+type instance CategorySrcC' FunctionP = 'Nothing+type instance CategoryDstC' FunctionP = 'Nothing+type instance ExoCategorySrcC FunctionP a = ()+type instance ExoCategoryDstC FunctionP b = ()++infixr 9  .+instance Semigroupoid FunctionP where+  (.) = (Prelude..)+instance Category FunctionP where+  id = Prelude.id+instance Const FunctionP+instance Arr FunctionP where+  arr = id++(<<<) :: (Semigroupoid p, CategoryC p b c, CategoryC p a b, CategoryC p a c) => CategoryT p b c -> CategoryT p a b -> CategoryT p a c+(<<<) = (.)++(>>>) :: (Semigroupoid p, CategoryC p a b, CategoryC p b c, CategoryC p a c) => CategoryT p a b -> CategoryT p b c -> CategoryT p a c+(>>>) = flip (.)++-- ** 'Data.Equality.:-:'+data ProxyK k (a :: k)+data TypeEqP (k :: Type)++class (a ~ ProxyK k (IndexCK k 2 1 a)) => ProxyC k a+instance (a ~ ProxyK k (IndexCK k 2 1 a)) => ProxyC k a++type instance CategoryT (TypeEqP k) (ProxyK k a) (ProxyK k b) = (:~:) a b+type instance ExoCategoryT (TypeEqP k) (ProxyK k a) (ProxyK k b) = (:~:) a b+type instance CategorySrcC' (TypeEqP k) = 'Just (ProxyC k)+type instance CategoryDstC' (TypeEqP k) = 'Just (ProxyC k)+type instance ExoCategorySrcC (TypeEqP k) a = CategorySrcC (TypeEqP k) a+type instance ExoCategoryDstC (TypeEqP k) a = CategoryDstC (TypeEqP k) a++instance Semigroupoid (TypeEqP k) where+  (.) = (Control.Category..)+instance Category (TypeEqP k) where+  id = Control.Category.id++data CoercionP (k :: Type)++type instance CategoryT (CoercionP k) (ProxyK k a) (ProxyK k b) = Coercion a b+type instance CategorySrcC' (CoercionP k) = 'Just (ProxyC k)+type instance CategoryDstC' (CoercionP k) = 'Just (ProxyC k)+type instance ExoCategoryT (CoercionP k) (ProxyK k a) (ProxyK k b) = Coercion a b+type instance ExoCategorySrcC (CoercionP k) a = CategorySrcC (TypeEqP k) a+type instance ExoCategoryDstC (CoercionP k) a = CategoryDstC (TypeEqP k) a++instance Semigroupoid (CoercionP k) where+  (.) = (Control.Category..)+instance Category (CoercionP k) where+  id = Control.Category.id++-- ** 'Control.Category.Kleisli'++data KleisliP (m :: Type -> Type)++type instance CategoryT (KleisliP m) a b = Kleisli m a b+type instance CategorySrcC' (KleisliP _) = 'Nothing+type instance CategoryDstC' (KleisliP _) = 'Nothing+type instance ExoCategoryT (KleisliP m) (m a) (m b) = Kleisli m a b+type instance ExoCategorySrcC (KleisliP _) _ = ()+type instance ExoCategoryDstC (KleisliP _) _ = ()++instance Prelude.Monad m => Semigroupoid (KleisliP m)  where+  (.) = (Control.Category..)+instance Prelude.Monad m => Category (KleisliP m) where+  id = Control.Category.id+instance Prelude.Monad m => Const (KleisliP m)+instance Prelude.Monad m => Arr (KleisliP m) where+  arr = Control.Arrow.arr+-- * Data.Semigroup++data FunctorCategoryP (functorP :: Type) (p :: Type)++type instance CategorySrcC' (FunctorCategoryP _ p) = CategorySrcC' p+type instance CategoryDstC' (FunctorCategoryP _ p) = CategoryDstC' p+type instance ExoCategorySrcC (FunctorCategoryP functorP p) a = (ExoCategorySrcC p (IndexC 1 0 a), a ~ FunctorT functorP (IndexC 1 0 a))+type instance ExoCategoryDstC (FunctorCategoryP functorP p) b = (ExoCategoryDstC p (IndexC 1 0 b), b ~ FunctorT functorP (IndexC 1 0 b))++-- ** 'Maybe'+type instance CategoryT (FunctorCategoryP (BasicFunctorP Maybe) p) a b = Maybe (CategoryT p a b)+type instance ExoCategoryT (FunctorCategoryP (BasicFunctorP Maybe) p) (Maybe a) (Maybe b) = Maybe (ExoCategoryT p a b)++instance Semigroupoid p => Semigroupoid (FunctorCategoryP (BasicFunctorP Maybe) p) where+  x . y = (.) <$> x <*> y+instance Semigroupoid p => Category (FunctorCategoryP (BasicFunctorP Maybe) p) where+  id = Nothing+instance Const (FunctorCategoryP (BasicFunctorP Maybe) FunctionP)+instance Arr (FunctorCategoryP (BasicFunctorP Maybe) FunctionP) where+  arr = pure++-- ** Lists++type instance CategoryT (FunctorCategoryP (BasicFunctorP []) p) a b = [CategoryT p a b]+type instance ExoCategoryT (FunctorCategoryP (BasicFunctorP []) p) [a] [b] = [ExoCategoryT p a b]++instance Semigroupoid p => Semigroupoid (FunctorCategoryP (BasicFunctorP []) p) where+  x . y = (.) <$> x <*> y+instance Semigroupoid p => Category (FunctorCategoryP (BasicFunctorP []) p) where+  id = mempty+instance Const (FunctorCategoryP (BasicFunctorP []) FunctionP) where+instance Arr (FunctorCategoryP (BasicFunctorP []) FunctionP) where+  arr = pure++-- ** Identity++type instance CategoryT (Identity p) a b = Identity (CategoryT p a b)+type instance CategorySrcC' (Identity p) = CategorySrcC' p+type instance CategoryDstC' (Identity p) = CategoryDstC' p+type instance ExoCategoryT (Identity p) a b = Identity (ExoCategoryT p a b)+type instance ExoCategorySrcC (Identity p) a = ExoCategorySrcC p a+type instance ExoCategoryDstC (Identity p) b = ExoCategoryDstC p b++instance Semigroupoid p => Semigroupoid (Identity p) where+  x . y = (.) <$> x <*> y++instance Category p => Category (Identity p) where+  id = Identity id++instance Const (Identity FunctionP)+instance Arr (Identity FunctionP) where+  arr = pure++-- ** Dual++type instance CategoryT (Dual p) a b = Dual (CategoryT p b a)+type instance CategorySrcC' (Dual p) = CategoryDstC' p+type instance CategoryDstC' (Dual p) = CategorySrcC' p+type instance ExoCategoryT (Dual p) a b = Dual (ExoCategoryT p b a)+type instance ExoCategorySrcC (Dual p) a = ExoCategoryDstC p a+type instance ExoCategoryDstC (Dual p) b = ExoCategorySrcC p b++instance Semigroupoid p => Semigroupoid (Dual p) where+  Dual x . Dual y = Dual (y . x)++instance Category p => Category (Dual p) where+  id = Dual id++-- ** Tuples++class (TupleConstraint 2 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a)) => Tuple2SrcC p1 p2 a+instance (TupleConstraint 2 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a)) => Tuple2SrcC p1 p2 a++class (TupleConstraint 2 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b)) => Tuple2DstC p1 p2 b+instance (TupleConstraint 2 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b)) => Tuple2DstC p1 p2 b++type instance CategoryT (p1, p2) (a1, a2) (b1, b2) = (CategoryT p1 a1 b1, CategoryT p2 a2 b2)+type instance CategorySrcC' (p1, p2) = 'Just (Tuple2SrcC p1 p2)+type instance CategoryDstC' (p1, p2) = 'Just (Tuple2DstC p1 p2)+type instance ExoCategoryT (p1, p2) (a1, a2) (b1, b2) = (ExoCategoryT p1 a1 b1, ExoCategoryT p2 a2 b2)+type instance ExoCategorySrcC (p1, p2) a = (TupleConstraint 2 a, ExoCategorySrcC p1 (IndexT 0 a), ExoCategorySrcC p2 (IndexT 1 a))+type instance ExoCategoryDstC (p1, p2) b = (TupleConstraint 2 b, ExoCategoryDstC p1 (IndexT 0 b), ExoCategoryDstC p2 (IndexT 1 b))++instance (Semigroupoid p1, Semigroupoid p2) => Semigroupoid (p1, p2) where+  (x1, x2) . (y1, y2) = (x1 . y1, x2 . y2)++class (TupleConstraint 3 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a)) => Tuple3SrcC p1 p2 p3 a+instance (TupleConstraint 3 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a)) => Tuple3SrcC p1 p2 p3 a++class (TupleConstraint 3 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b)) => Tuple3DstC p1 p2 p3 b+instance (TupleConstraint 3 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b)) => Tuple3DstC p1 p2 p3 b++type instance CategoryT (p1, p2, p3) (a1, a2, a3) (b1, b2, b3) = (CategoryT p1 a1 b1, CategoryT p2 a2 b2, CategoryT p3 a3 b3)+type instance CategorySrcC' (p1, p2, p3) = 'Just (Tuple3SrcC p1 p2 p3)+type instance CategoryDstC' (p1, p2, p3) = 'Just (Tuple3DstC p1 p2 p3)+type instance ExoCategoryT (p1, p2, p3) (a1, a2, a3) (b1, b2, b3) = (ExoCategoryT p1 a1 b1, ExoCategoryT p2 a2 b2, ExoCategoryT p3 a3 b3)+type instance ExoCategorySrcC (p1, p2, p3) a = (TupleConstraint 3 a, ExoCategorySrcC p1 (IndexT 0 a), ExoCategorySrcC p2 (IndexT 1 a), ExoCategorySrcC p3 (IndexT 2 a))+type instance ExoCategoryDstC (p1, p2, p3) b = (TupleConstraint 3 b, ExoCategoryDstC p1 (IndexT 0 b), ExoCategoryDstC p2 (IndexT 1 b), ExoCategoryDstC p3 (IndexT 2 b))++instance (Semigroupoid p1, Semigroupoid p2, Semigroupoid p3) => Semigroupoid (p1, p2, p3) where+  (x1, x2, x3) . (y1, y2, y3) = (x1 . y1, x2 . y2, x3 . y3)++class (TupleConstraint 4 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a), CategorySrcC p4 (IndexT 3 a)) => Tuple4SrcC p1 p2 p3 p4 a+instance (TupleConstraint 4 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a), CategorySrcC p4 (IndexT 3 a)) => Tuple4SrcC p1 p2 p3 p4 a++class (TupleConstraint 4 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b), CategoryDstC p4 (IndexT 3 b)) => Tuple4DstC p1 p2 p3 p4 b+instance (TupleConstraint 4 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b), CategoryDstC p4 (IndexT 3 b)) => Tuple4DstC p1 p2 p3 p4 b++type instance CategoryT (p1, p2, p3, p4) (a1, a2, a3, a4) (b1, b2, b3, b4) = (CategoryT p1 a1 b1, CategoryT p2 a2 b2, CategoryT p3 a3 b3, CategoryT p4 a4 b4)+type instance CategorySrcC' (p1, p2, p3, p4) = 'Just (Tuple4SrcC p1 p2 p3 p4)+type instance CategoryDstC' (p1, p2, p3, p4) = 'Just (Tuple4DstC p1 p2 p3 p4)+type instance ExoCategoryT (p1, p2, p3, p4) (a1, a2, a3, a4) (b1, b2, b3, b4) = (ExoCategoryT p1 a1 b1, ExoCategoryT p2 a2 b2, ExoCategoryT p3 a3 b3, ExoCategoryT p4 a4 b4)+type instance ExoCategorySrcC (p1, p2, p3, p4) a = (TupleConstraint 4 a, ExoCategorySrcC p1 (IndexT 0 a), ExoCategorySrcC p2 (IndexT 1 a), ExoCategorySrcC p3 (IndexT 2 a), ExoCategorySrcC p4 (IndexT 3 a))+type instance ExoCategoryDstC (p1, p2, p3, p4) b = (TupleConstraint 4 b, ExoCategoryDstC p1 (IndexT 0 b), ExoCategoryDstC p2 (IndexT 1 b), ExoCategoryDstC p3 (IndexT 2 b), ExoCategoryDstC p4 (IndexT 3 b))++instance (Semigroupoid p1, Semigroupoid p2, Semigroupoid p3, Semigroupoid p4) => Semigroupoid (p1, p2, p3, p4) where+  (x1, x2, x3, x4) . (y1, y2, y3, y4) = (x1 . y1, x2 . y2, x3 . y3, x4 . y4)++class (TupleConstraint 5 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a), CategorySrcC p4 (IndexT 3 a), CategorySrcC p5 (IndexT 4 a)) => Tuple5SrcC p1 p2 p3 p4 p5 a+instance (TupleConstraint 5 a, CategorySrcC p1 (IndexT 0 a), CategorySrcC p2 (IndexT 1 a), CategorySrcC p3 (IndexT 2 a), CategorySrcC p4 (IndexT 3 a), CategorySrcC p5 (IndexT 4 a)) => Tuple5SrcC p1 p2 p3 p4 p5 a++class (TupleConstraint 5 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b), CategoryDstC p4 (IndexT 3 b), CategoryDstC p5 (IndexT 4 b)) => Tuple5DstC p1 p2 p3 p4 p5 b+instance (TupleConstraint 5 b, CategoryDstC p1 (IndexT 0 b), CategoryDstC p2 (IndexT 1 b), CategoryDstC p3 (IndexT 2 b), CategoryDstC p4 (IndexT 3 b), CategoryDstC p5 (IndexT 4 b)) => Tuple5DstC p1 p2 p3 p4 p5 b++type instance CategoryT (p1, p2, p3, p4, p5) (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) = (CategoryT p1 a1 b1, CategoryT p2 a2 b2, CategoryT p3 a3 b3, CategoryT p4 a4 b4, CategoryT p5 a5 b5)+type instance CategorySrcC' (p1, p2, p3, p4, p5) = 'Just (Tuple5SrcC p1 p2 p3 p4 p5)+type instance CategoryDstC' (p1, p2, p3, p4, p5) = 'Just (Tuple5DstC p1 p2 p3 p4 p5)+type instance ExoCategoryT (p1, p2, p3, p4, p5) (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) = (ExoCategoryT p1 a1 b1, ExoCategoryT p2 a2 b2, ExoCategoryT p3 a3 b3, ExoCategoryT p4 a4 b4, ExoCategoryT p5 a5 b5)+type instance ExoCategorySrcC (p1, p2, p3, p4, p5) a = (TupleConstraint 5 a, ExoCategorySrcC p1 (IndexT 0 a), ExoCategorySrcC p2 (IndexT 1 a), ExoCategorySrcC p3 (IndexT 2 a), ExoCategorySrcC p4 (IndexT 3 a), ExoCategorySrcC p5 (IndexT 4 a))+type instance ExoCategoryDstC (p1, p2, p3, p4, p5) b = (TupleConstraint 5 b, ExoCategoryDstC p1 (IndexT 0 b), ExoCategoryDstC p2 (IndexT 1 b), ExoCategoryDstC p3 (IndexT 2 b), ExoCategoryDstC p4 (IndexT 3 b), ExoCategoryDstC p5 (IndexT 4 b))++instance (Semigroupoid p1, Semigroupoid p2, Semigroupoid p3, Semigroupoid p4, Semigroupoid p5) => Semigroupoid (p1, p2, p3, p4, p5) where+  (x1, x2, x3, x4, x5) . (y1, y2, y3, y4, y5) = (x1 . y1, x2 . y2, x3 . y3, x4 . y4, x5 . y5)++-- Functor++type family FunctorT (p :: Type) (a :: Type) = (b :: Type) | b -> p a++type family FunctorSrcC' (p :: Type) :: Maybe (Type -> Constraint)+type family FunctorDstC' (p :: Type) :: Maybe (Type -> Constraint)++type FunctorSrcC p a = FromMaybeConstraintFunc (FunctorSrcC' p) a+type FunctorDstC p a = FromMaybeConstraintFunc (FunctorDstC' p) a++--type FunctorC cat p a b ra rb = (ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b)++class Semigroupoid cat => Functor cat p where+  fmap ::+    (ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b) =>+    CategoryT cat a b -> CategoryT cat ra rb++  default fmap ::+    (Lift p, Pure p, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b, cat ~ FunctionP, FunctorSrcC' p ~ 'Nothing, FunctorDstC' p ~ 'Nothing) =>+    CategoryT cat a b -> CategoryT cat ra rb+--    (Applicative p, cat ~ FunctionP, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC' p ~ 'Nothing, FunctorDstC' p ~ 'Nothing) =>+--    CategoryT cat a b -> CategoryT cat ra rb+  fmap f x = liftA2 (const f) (pure x) x++type UnconstrainedFunctor cat p = (Functor cat p, FunctorSrcC' p ~ 'Nothing, FunctorDstC' p ~ 'Nothing)++infixl 4 <$>+(<$>) ::+  (Functor cat p, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b) =>+  CategoryT cat a b -> CategoryT cat ra rb+(<$>) = fmap++infixl 4 <$+class Functor cat p => ConstFunctor cat p where+  (<$) ::+    (ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b) =>+    b -> CategoryT cat ra rb+  default (<$) ::+    (Const cat, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC cat a b, CategoryC cat ra rb, FunctorSrcC p a, FunctorDstC p b) =>+    b -> CategoryT cat ra rb+  (<$) = fmap . const++instance {-# OVERLAPPABLE #-} (Functor cat p, Const cat) => ConstFunctor cat p++infixl 4 <*>, <*, *>, <**>++class Functor FunctionP p => Lift p where+  liftA2 ::+    (FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p c) =>+    (a -> b -> c) -> FunctorT p a -> FunctorT p b -> FunctorT p c+  default liftA2 ::+    (Monad p, Pure p, FunctorSrcC' p ~ 'Nothing, FunctorDstC' p ~ 'Nothing) =>+    (a -> b -> c) -> FunctorT p a -> FunctorT p b -> FunctorT p c+  liftA2 f x y = (pure f >>= g x) >>= g y where+    g x' y' = x' >>= (pure . y')+  (*>) :: (FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p b) => FunctorT p a -> FunctorT p b -> FunctorT p b+  (*>) = liftA2 (flip const)+  (<*) :: (FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p a) => FunctorT p a -> FunctorT p b -> FunctorT p a+  (<*) = liftA2 const++class Lift p => Apply p where+  (<*>) :: FunctorT p (a -> b) -> FunctorT p a -> FunctorT p b+  default (<*>) :: (FunctorSrcC' p ~ 'Nothing, FunctorDstC' p ~ 'Nothing) => FunctorT p (a -> b) -> FunctorT p a -> FunctorT p b+  (<*>) = liftA2 id++(<**>) :: Apply p => FunctorT p a -> FunctorT p (a -> b) -> FunctorT p b+(<**>) = flip (<*>)++class Pure p where+  pure :: (FunctorDstC p a) => a -> FunctorT p a++type Applicative p = (Apply p, Pure p)++infixl 1 >>, >>=+class (Lift p, Pure p) => Monad p where+  (>>=) :: (FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p b) => FunctorT p a -> (a -> FunctorT p b) -> FunctorT p b+  (>>) :: (FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p b) => FunctorT p a -> FunctorT p b -> FunctorT p b+  m >> k = m >>= Prelude.const k++return :: (Monad p, FunctorDstC p a) => a -> FunctorT p a+return = pure++infixr 1  =<<+(=<<) :: (Monad p, FunctorSrcC p a, FunctorSrcC p b, FunctorDstC p b) => (a -> FunctorT p b) -> FunctorT p a -> FunctorT p b+(=<<) = flip (>>=)+++data BasicFunctorP f+type instance FunctorSrcC' (BasicFunctorP _) = 'Nothing+type instance FunctorDstC' (BasicFunctorP _) = 'Nothing++data ConstantP (a :: Type)+type instance FunctorT (BasicFunctorP (ConstantP a)) b = Constant a b+instance Functor FunctionP (BasicFunctorP (ConstantP a)) where+  fmap = Prelude.fmap++type instance FunctorT (BasicFunctorP Maybe) a = Maybe a+instance Functor FunctionP (BasicFunctorP Maybe) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Maybe) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Maybe) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Maybe) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Maybe) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Identity) a = Identity a+instance Functor FunctionP (BasicFunctorP Identity) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Identity) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Identity) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Identity) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Identity) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP NonEmpty) a = NonEmpty a+instance Functor FunctionP (BasicFunctorP NonEmpty) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP NonEmpty) where+  pure = Prelude.pure+instance Lift (BasicFunctorP NonEmpty) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP NonEmpty) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP NonEmpty) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP (Either a)) b = Either a b+instance Functor FunctionP (BasicFunctorP (Either a)) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP (Either a)) where+  pure = Prelude.pure+instance Lift (BasicFunctorP (Either a)) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP (Either a)) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP (Either a)) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP []) a = [a]+instance Functor FunctionP (BasicFunctorP []) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP []) where+  pure = Prelude.pure+instance Lift (BasicFunctorP []) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP []) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP []) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP IO) a = IO a+instance Functor FunctionP (BasicFunctorP IO) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP IO) where+  pure = Prelude.pure+instance Lift (BasicFunctorP IO) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP IO) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP IO) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Option) a = Option a+instance Functor FunctionP (BasicFunctorP Option) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Option) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Option) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Option) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Option) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Tree) a = Tree a+instance Functor FunctionP (BasicFunctorP Tree) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Tree) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Tree) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Tree) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Tree) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Min) a = Min a+instance Functor FunctionP (BasicFunctorP Min) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Min) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Min) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Min) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Min) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Max) a = Max a+instance Functor FunctionP (BasicFunctorP Max) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Max) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Max) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Max) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Max) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP Last) a = Last a+instance Functor FunctionP (BasicFunctorP Last) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP Last) where+  pure = Prelude.pure+instance Lift (BasicFunctorP Last) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP Last) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP Last) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++type instance FunctorT (BasicFunctorP First) a = First a+instance Functor FunctionP (BasicFunctorP First) where+  fmap = Prelude.fmap+instance Pure (BasicFunctorP First) where+  pure = Prelude.pure+instance Lift (BasicFunctorP First) where+  liftA2 = Control.Applicative.liftA2+instance Apply (BasicFunctorP First) where+  (<*>) = (Prelude.<*>)+instance Monad (BasicFunctorP First) where+  (>>=) = (Prelude.>>=)+  (>>) = (Prelude.>>)++-- Arrays++arrayFmap :: (IArray a e1, IArray a e2, Ix i) => (e1 -> e2) -> a i e1 -> a i e2+arrayFmap = Data.Array.IArray.amap++arrayPure :: (IArray a e, Ix i, Num i) => e -> a i e+arrayPure x = Data.Array.IArray.listArray (0,0) [x]++arrayLiftA2 :: (IArray a e1, IArray a e2, IArray a e3, Ix i, Num i) => (e1 -> e2 -> e3) -> a i e1 -> a i e2 -> a i e3+arrayLiftA2 f x y = Data.Array.IArray.array (lbound, ubound) [(index_f x_i y_i, f x_e y_e) | (x_i,x_e) <- Data.Array.IArray.assocs x, (y_i, y_e) <- Data.Array.IArray.assocs y] where+  (x_l, x_u) = Data.Array.IArray.bounds x+  (y_l, y_u) = Data.Array.IArray.bounds y+  step = y_u - y_l + 1+  index_f x_i y_i = x_i * step + y_i+  lbound = index_f x_l y_l+  ubound = index_f x_u y_u++type instance FunctorT (BasicFunctorP (Array i)) e = Array i e+instance (Ix i) => Functor FunctionP (BasicFunctorP (Array i)) where+  fmap = arrayFmap+instance (Ix i, Num i) => Pure (BasicFunctorP (Array i)) where+  pure = arrayPure+instance (Ix i, Num i) => Lift (BasicFunctorP (Array i)) where+  liftA2 = arrayLiftA2++data UArrayP (indexT :: Type)++class (IArray UArray e) => UArrayC e+instance (IArray UArray e) => UArrayC e++type instance FunctorT (UArrayP i) e = UArray i e+type instance FunctorSrcC' (UArrayP i) = 'Just UArrayC+type instance FunctorDstC' (UArrayP i) = 'Just UArrayC++instance (Ix i) => Functor FunctionP (UArrayP i) where+  fmap = arrayFmap+instance (Ix i, Num i) => Pure (UArrayP i) where+  pure = arrayPure+instance (Ix i, Num i) => Lift (UArrayP i) where+  liftA2 = arrayLiftA2++-- Sets++data SetP++class (Ord (ToType b)) => SetDstC b+instance (Ord (ToType b)) => SetDstC b++type instance FunctorT SetP a = Set a+type instance FunctorSrcC' SetP = 'Nothing+type instance FunctorDstC' SetP = 'Just SetDstC++instance Functor FunctionP SetP where+  fmap = Data.Set.map+instance Pure SetP where+  pure = Data.Set.singleton+instance Lift SetP where+  liftA2 f x y = Data.Set.fromList (Control.Applicative.liftA2 f (Data.Set.toList x) (Data.Set.toList y))+instance Monad SetP where+  x >>= f = Data.Set.fromList (Data.Set.toList x >>= (Data.Set.toList . f))++data TupleP (n :: Nat)+type instance FunctorSrcC' (TupleP _) = 'Nothing+type instance FunctorDstC' (TupleP _) = 'Nothing++-- Tuple+type instance FunctorT (TupleP 2) a = (a,a)+instance Functor FunctionP (TupleP 2) where+  fmap f (x1,x2) = (f x1, f x2)+instance Pure (TupleP 2) where+  pure x = (x,x)+instance Lift (TupleP 2) where+  liftA2 f (x1,x2) (y1,y2) = (f x1 y1, f x2 y2)+instance Apply (TupleP 2) where+  (<*>) (f1,f2) (x1,x2) = (f1 x1, f2 x2)++type instance FunctorT (TupleP 3) a = (a,a,a)+instance Functor FunctionP (TupleP 3) where+  fmap f (x1,x2,x3) = (f x1, f x2, f x3)+instance Lift (TupleP 3) where+  liftA2 f (x1,x2,x3) (y1,y2,y3) = (f x1 y1, f x2 y2, f x3 y3)+instance Pure (TupleP 3) where+  pure x = (x,x,x)+instance Apply (TupleP 3) where+  (<*>) (f1,f2,f3) (x1,x2,x3) = (f1 x1, f2 x2, f3 x3)++type instance FunctorT (TupleP 4) a = (a,a,a,a)+instance Functor FunctionP (TupleP 4) where+  fmap f (x1,x2,x3,x4) = (f x1, f x2, f x3, f x4)+instance Pure (TupleP 4) where+  pure x = (x,x,x,x)+instance Lift (TupleP 4) where+  liftA2 f (x1,x2,x3,x4) (y1,y2,y3,y4) = (f x1 y1, f x2 y2, f x3 y3, f x4 y4)+instance Apply (TupleP 4) where+  (<*>) (f1,f2,f3,f4) (x1,x2,x3,x4) = (f1 x1, f2 x2, f3 x3, f4 x4)++type instance FunctorT (TupleP 5) a = (a,a,a,a,a)+instance Functor FunctionP (TupleP 5) where+  fmap f (x1,x2,x3,x4,x5) = (f x1, f x2, f x3, f x4, f x5)+instance Pure (TupleP 5) where+  pure x = (x,x,x,x,x)+instance Lift (TupleP 5) where+  liftA2 f (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (f x1 y1, f x2 y2, f x3 y3, f x4 y4, f x5 y5)+instance Apply (TupleP 5) where+  (<*>) (f1,f2,f3,f4,f5) (x1,x2,x3,x4,x5) = (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5)++-- Non function category functors++instance Functor cat p => Functor (FunctorCategoryP (BasicFunctorP Maybe) cat) p where+  fmap = fmap fmap++instance Functor cat p => Functor (FunctorCategoryP (BasicFunctorP []) cat) p where+  fmap = fmap fmap++instance Functor cat p => Functor (Identity cat) p where+  fmap = fmap fmap
+ src/Freelude/Impl/CategoryAsMonoid.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Freelude.Impl.CategoryAsMonoid (+  CategoryAsMonoid(getCategoryAsMonoid)+) where++import Prelude hiding ((.), id)+import Freelude.Impl.Category+import Data.Semigroup (Semigroup((<>)))++newtype CategoryAsMonoid a = CategoryAsMonoid { getCategoryAsMonoid :: a }++instance (IsSemigroupoid t p a a) => Semigroup (CategoryAsMonoid t) where+  CategoryAsMonoid x <> CategoryAsMonoid y = CategoryAsMonoid (x . y)++instance (IsCategory t p a a, ExoIsCategory t p a a) => Monoid (CategoryAsMonoid t) where+  mempty = CategoryAsMonoid id+  mappend = (<>)
+ src/Freelude/Impl/ExoFunctor.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}++module Freelude.Impl.ExoFunctor (+  ExoFunctor(exomap), ($), ($!)+) where++import Freelude.Impl.Category+import Prelude hiding (id, ($), ($!), (<*>), (<$>))+import Data.Functor.Identity (Identity(Identity))++{-# ANN module "HLint: ignore Redundant $" #-}++class ExoFunctor c1 c2 where+  exomap :: (ExoCategoryC c1 a b, ExoCategoryC c2 a b) => ExoCategoryT c1 a b -> ExoCategoryT c2 a b++infixr 0  $, $!+($) :: (ExoFunctor c1 c2, ExoCategoryC c1 a b, ExoCategoryC c2 a b) => ExoCategoryT c1 a b -> ExoCategoryT c2 a b+($) = exomap++($!) :: (ExoFunctor c1 FunctionP, ExoCategoryC c1 a b) => ExoCategoryT c1 a b -> (a -> b)+f $! x = let !vx = x in f $ vx++instance ExoFunctor c c where+  exomap = id++instance ExoFunctor c1 c2 => ExoFunctor (Identity c1) c2 where+  exomap (Identity x) = exomap x++instance ExoFunctor c1 c2 => ExoFunctor c1 (Identity c2) where+  exomap x = Identity (exomap x)++instance ExoFunctor c1 c2 => ExoFunctor (Identity c1) (Identity c2) where+  exomap (Identity x) = Identity (exomap x)++instance (ExoFunctor p1 FunctionP, ExoFunctor p2 FunctionP) => ExoFunctor (p1, p2) FunctionP where+  exomap (f1, f2) (x1, x2) = (f1 $ x1, f2 $ x2)++instance (ExoFunctor p1 FunctionP, ExoFunctor p2 FunctionP, ExoFunctor p3 FunctionP) => ExoFunctor (p1, p2, p3) FunctionP where+  exomap (f1, f2, f3) (x1, x2, x3) = (f1 $ x1, f2 $ x2, f3 $ x3)++instance (ExoFunctor p1 FunctionP, ExoFunctor p2 FunctionP, ExoFunctor p3 FunctionP, ExoFunctor p4 FunctionP) => ExoFunctor (p1, p2, p3, p4) FunctionP where+  exomap (f1, f2, f3, f4) (x1, x2, x3, x4) = (f1 $ x1, f2 $ x2, f3 $ x3, f4 $ x4)++instance (ExoFunctor p1 FunctionP, ExoFunctor p2 FunctionP, ExoFunctor p3 FunctionP, ExoFunctor p4 FunctionP, ExoFunctor p5 FunctionP) => ExoFunctor (p1, p2, p3, p4, p5) FunctionP where+  exomap (f1, f2, f3, f4, f5) (x1, x2, x3, x4, x5) = (f1 $ x1, f2 $ x2, f3 $ x3, f4 $ x4, f5 $ x5)++instance (ExoFunctor p FunctionP) => ExoFunctor (FunctorCategoryP (BasicFunctorP Maybe) p) FunctionP where+  exomap f x = exomap <$> f <*> x++instance (ExoFunctor p FunctionP) => ExoFunctor (FunctorCategoryP (BasicFunctorP []) p) FunctionP where+  exomap f x = exomap <$> f <*> x
+ src/Freelude/Impl/MakeFunctor.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Freelude.Impl.MakeFunctor (+  MakeFunctor(getFunctor)+) where++import Prelude hiding (Functor, fmap, Monad)+import qualified Prelude+import Data.Kind (Type)+import Freelude.Impl.Category+import qualified Control.Applicative++newtype MakeFunctor f a = MakeFunctor { getFunctor :: f a }++data MakeFunctorP (f :: Type -> Type)++type instance FunctorT (MakeFunctorP f) a = MakeFunctor f a+type instance FunctorSrcC' (MakeFunctorP _) = 'Nothing+type instance FunctorDstC' (MakeFunctorP _) = 'Nothing++instance Prelude.Functor f => Functor FunctionP (MakeFunctorP f) where+  fmap f (MakeFunctor x) = MakeFunctor (Prelude.fmap f x)++instance Prelude.Applicative f => Lift (MakeFunctorP f) where+  liftA2 f (MakeFunctor x) (MakeFunctor y) = MakeFunctor (Control.Applicative.liftA2 f x y)++instance Prelude.Applicative f => Apply (MakeFunctorP f) where+  (MakeFunctor f) <*> (MakeFunctor x) = MakeFunctor (f Prelude.<*> x)++instance Prelude.Applicative f => Pure (MakeFunctorP f) where+  pure x = MakeFunctor (Prelude.pure x)++instance Prelude.Monad f => Monad (MakeFunctorP f) where+  (MakeFunctor x) >>= f = MakeFunctor (x Prelude.>>= f') where+    f' x' = getFunctor (f x')
+ src/Freelude/Impl/MonoidAsCategory.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds #-}++module Freelude.Impl.MonoidAsCategory (+  MonoidAsCategory(MonoidAsCategory, getMonoidAsCategory)+  ) where++import Freelude.Impl.Category+import Data.Void (Void)+import Data.Semigroup (Semigroup((<>)))+import Data.Monoid (Monoid(mempty))+import Data.Type.Equality (type (~~))++newtype MonoidAsCategory a = MonoidAsCategory { getMonoidAsCategory :: a }++class (a ~~ Void) => VoidC a+instance (a ~~ Void) => VoidC a++type instance CategoryT (MonoidAsCategory a) Void Void = MonoidAsCategory a+type instance CategorySrcC' (MonoidAsCategory _) = 'Just VoidC+type instance CategoryDstC' (MonoidAsCategory _) = 'Just VoidC++instance Semigroup m => Semigroupoid (MonoidAsCategory m) where+  (MonoidAsCategory x) . (MonoidAsCategory y) = MonoidAsCategory (x <> y)++instance (Semigroup m, Monoid m) => Category (MonoidAsCategory m) where+  id = MonoidAsCategory mempty
+ src/Freelude/Impl/RestrictedFunctor.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE FlexibleContexts #-}++module Freelude.Impl.RestrictedFunctor (+  restrictedfmap+  ) where++import Prelude hiding (Functor(fmap), (<$>))+import Freelude.Impl.Category hiding (Functor(fmap), (<$>))+import qualified Freelude.Impl.Category++restrictedfmap ::+  (Freelude.Impl.Category.Functor FunctionP p, ra ~ FunctorT p a, rb ~ FunctorT p b, CategoryC FunctionP a b, CategoryC FunctionP ra rb, FunctorSrcC p a, FunctorDstC p b) =>+  CategoryT FunctionP a b -> CategoryT FunctionP ra rb+restrictedfmap = Freelude.Impl.Category.fmap
+ src/Freelude/Impl/ToKind.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeFamilies #-}++module Freelude.Impl.ToKind (ToType, ToKind) where++import Data.Kind (Type)++type ToType a = ToKind Type a+type ToKind toK (a :: k) = ToKind' toK k a++type family ToKind' toK k (a :: k) where+  ToKind' k k a = a
+ test/DocTest.hs view
@@ -0,0 +1,2 @@+import Test.DocTest+main = doctest ["-isrc", "src/Freelude.hs"]
+ test/Test.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeInType #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}++module Main where++import Freelude.Impl.Category+import Freelude.Impl.ExoFunctor+import Prelude hiding ((.), fmap, pure, (=<<))++main :: IO ()+main = pure ()++f1 :: (IsSemigroupoid t1 p a2 a3,  IsSemigroupoid t2 p a1 a2, IsSemigroupoid t3 p a1 a3) => t1 -> t2 -> t3+f1 x y = x . y+f1' x y = x . y++f2 :: (IsSemigroupoid t1 p a3 a4, IsSemigroupoid t2 p a2 a3, IsSemigroupoid t3 p a1 a2, IsSemigroupoid t4 p a1 a4) => t1 -> t2 -> t3 -> t4+f2 x y z = x . y . z+f2' x y z = x . y . z++f3 x y = fmap x . fmap y+f3' x y = fmap x . fmap y++f4 x y = fmap (x . y)+f4' x y = fmap (x . y)++g :: a -> a -> a+g = undefined++f5 x y = g (f3 x y) (f4 x y)++f6 x y = exomap x . exomap y+f6' x y = exomap x . exomap y++f7 x y = exomap (x . y)+f7' x y = exomap (x . y)++f8 x y = g (f6 x y) (f7 x y)