packages feed

kindly-functors (empty) → 0.1.0.0

raw patch · 13 files changed

+1159/−0 lines, 13 filesdep +basedep +hspecdep +kindly-functors

Dependencies added: base, hspec, kindly-functors, mtl, profunctors, semigroupoids, these, witherable

Files

+ .gitignore view
@@ -0,0 +1,4 @@+/dist-newstyle/+/.envrc.local+/result+/.direnv/
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for kindly-functors++## Upcoming++## 0.1.0.0 -- 2024-02-04++* Initial Release.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Solomon Bothwell++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,99 @@+Kindly Functors+===============++🚨 **WORK IN PROGRESS** 🚨++[![kindly-functors::CI](https://github.com/solomon-b/kindly-functors/actions/workflows/nix.yml/badge.svg)](https://github.com/solomon-b/kindly-functors/actions/workflows/nix.yml)+[![kindly-functors::CI](https://github.com/solomon-b/kindly-functors/actions/workflows/cabal.yml/badge.svg)](https://github.com/solomon-b/kindly-functors/actions/workflows/cabal.yml)+++A category polymorphic `Functor` typeclass based on the work of [IcelandJack](https://www.reddit.com/r/haskell/comments/eoo16m/base_category_polymorphic_functor_and_functorof/?utm_source=reddit&utm_medium=usertext&utm_name=haskell&utm_content=t1_khkwtph) and [Ed Kmett](https://gist.github.com/ekmett/b26363fc0f38777a637d) allowing you to pick out arbitrary kinds and variances for your functors.++This library offers direct access to the `FunctorOf` and `Functor` classes defined in the above work but also a slightly more familiar API for one, two, and three parameter functors.+```haskell+type Functor f = FunctorOf (->) (->)+type Contravariant f = FunctorOf Op (->)+type Invariant f = FunctorOf (<->) (->)+type Filterable f = FunctorOf (Star Maybe) (->)+type Bifunctor p = FunctorOf (->) (Nat (->) (->))+type Profunctor p = FunctorOf Op (Nat (->) (->))+type Trifunctor p = FunctorOf cat1 (Nat cat2 (Nat cat3 cat4))+```++`fmap`, `bimap`, `lmap`, and `rmap` have been made polymorphic over variances:+```+> fmap show (Identity True)+Identity "True"++> getPredicate (fmap (Op read) (Predicate not)) "True"+False++> lmap show (True, False)+("True",False)++> lmap (Op read) not "True"+False++> rmap show (True, False)+(True,"False")++> bimap show read (Left True)+Left "True"++> bimap (read @Int) show ("1", True)+(1,"True")++> bimap (Op (read @Int)) show (+1) "0"+"1"++> trimap show show show (True, False, ())+("True","False","()")+```++# How does this work?++The above functions are all just instantions of `map1`, `map2`, and `map3`:+```+> map1 show (True, False, ())+(True,False,"()")++> map1 show (Left True)+Left True++> map2 show (True, False, ())+(True,"False",())++> map3 show (True, False, ())+("True",False,())+```++Becareful when using these directly as GHC might pick out a surprising instance:+```+> map2 show (Left True)+Left "True"+```++These functions themselves are a frontend for `map` from the (kindly) `Functor` class:++```haskell+type Functor :: (from -> to) -> Constraint+class (Category (Dom f), Category (Cod f)) => Functor (f :: from -> to) where+  type Dom f :: from -> from -> Type+  type Cod f :: to -> to -> Type++  map :: Dom f a b -> Cod f (f a) (f b)++-- NOTE: These these classes are labeled from right to left:+k+class (FunctorOf cat (->) p) => MapArg1 cat p | p -> cat where+  map1 :: (a `cat` b) -> p a -> p b+  map1 = map++class (FunctorOf cat1 (cat2 ~> (->)) p) => MapArg2 cat1 cat2 p | p -> cat2 cat2 where+  map2 :: (a `cat1` b) -> forall x. p a x -> p b x+  map2 = runNat . map++class (FunctorOf cat1 (cat2 ~> cat3 ~> (->)) p) => MapArg3 cat1 cat2 cat3 p | p -> cat1 cat2 cat3 where+  map3 :: (a `cat1` b) -> forall x y. p a x y -> p b x y+  map3 f = runNat (runNat (map f))+```
+ kindly-functors.cabal view
@@ -0,0 +1,90 @@+cabal-version:   3.4+name:            kindly-functors+category:        Control, Categories+version:         0.1.0.0+synopsis:        A category polymorphic `Functor` typeclass+description:     A category polymorphic `Functor` typeclass.+homepage:        https://www.github.com/solomon-b/kindly-functors+license:         MIT+license-file:    LICENSE+author:          Solomon Bothwell+maintainer:      ssbothwell@gmail.com+-- copyright:+build-type:      Simple+extra-doc-files: CHANGELOG.md+                 README.md+                 .gitignore+tested-with:     GHC == 9.0.2,+                 GHC == 9.2.8,+                 GHC == 9.4.8,+                 GHC == 9.6.3,++--------------------------------------------------------------------------------++common warnings+    ghc-options: -Wall++--------------------------------------------------------------------------------++common common-extensions+  default-extensions:+    ConstraintKinds+    DataKinds+    DerivingVia+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    ImportQualifiedPost+    InstanceSigs+    MultiParamTypeClasses+    NoImplicitPrelude+    PolyKinds+    QuantifiedConstraints+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    StandaloneKindSignatures+    TypeApplications+    TypeFamilies+    TypeOperators+    UndecidableInstances++--------------------------------------------------------------------------------++library+    import:           common-extensions, warnings+    exposed-modules:+      Kindly+      Kindly.Class+      Kindly.Bifunctor+      Kindly.Functor+      Kindly.Iso+      Kindly.Rank2+      Kindly.Trifunctor+    build-depends:+      base > 4 && < 5,+      mtl                           >= 2.2.2 && < 2.4,+      profunctors                   >= 5.6.2 && < 5.7,+      semigroupoids                 >= 6.0.0 && < 6.1,+      these                         >= 1.2 && < 1.3,+      witherable                    >= 0.4.2 && < 0.5,+    hs-source-dirs:   src+    default-language: Haskell2010++--------------------------------------------------------------------------------++test-suite kindly-functors-test+    import:           warnings+    default-language: Haskell2010+    -- other-modules:+    -- other-extensions:+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base > 4 && < 5,+        hspec,+        kindly-functors
+ src/Kindly.hs view
@@ -0,0 +1,13 @@+module Kindly+  ( module M,+  )+where++--------------------------------------------------------------------------------++import Kindly.Bifunctor as M+import Kindly.Class as M+import Kindly.Functor as M+import Kindly.Iso as M+import Kindly.Rank2 as M+import Kindly.Trifunctor as M
+ src/Kindly/Bifunctor.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Two Parameter Functors of arbitrary categories.+module Kindly.Bifunctor+  ( Bifunctor,+    bimap,+    lmap,+    rmap,+  )+where++--------------------------------------------------------------------------------++import Control.Category+import Data.Bifunctor qualified as Hask+import Data.Either (Either)+import Data.Function (flip)+import Data.Functor qualified as Hask+import Data.Functor.Const (Const)+import Data.Functor.Contravariant (Op (..))+import Data.Kind (Constraint, Type)+import Data.Profunctor qualified as Hask+import Data.Semigroup qualified as Semigroup+import Data.These (These)+import GHC.Generics (K1)+import Kindly.Class+import Kindly.Functor ()++--------------------------------------------------------------------------------++-- | A 'CategoricalFunctor' of kind @Type -> Type@ mapping from an+-- arbitrary category @cat1@ to a functor category @cat2 ~> (->)@.+type Bifunctor :: (Type -> Type -> Type) -> (Type -> Type -> Type) -> (Type -> Type -> Type) -> Constraint+type Bifunctor cat1 cat2 p = (MapArg2 cat1 cat2 p, forall x. MapArg1 cat2 (p x))++-- | Lift a morphism @cat1 a a'@ and a morphism @cat2 b b'@ into a+-- function @p a b -> p a' b'@.+bimap :: forall cat1 cat2 p. (Bifunctor cat1 cat2 p) => forall a b a' b'. (a `cat1` a') -> (b `cat2` b') -> p a b -> p a' b'+bimap f g = map2 f . map1 g++-- | Lift a morphism @cat1 a b@ into a function @p a x -> p b x@.+lmap :: (Category cat2, Bifunctor cat1 cat2 p) => (a `cat1` b) -> p a x -> p b x+lmap = flip bimap id++-- | Lift a morphism @cat2 a b@ into a function @p x a -> p x b@.+rmap :: (Bifunctor cat1 cat2 p) => (a `cat2` b) -> p x a -> p x b+rmap = bimap id++--------------------------------------------------------------------------------++newtype FromBifunctor f a b = FromBifunctor (f a b)+  deriving newtype (Hask.Functor, Hask.Bifunctor)++instance (Hask.Bifunctor p, FunctorOf (->) (->) (p x)) => CategoricalFunctor (FromBifunctor p x) where+  type Dom (FromBifunctor p x) = (->)+  type Cod (FromBifunctor p x) = (->)++  map :: (a -> b) -> FromBifunctor p x a -> FromBifunctor p x b+  map f (FromBifunctor pab) = FromBifunctor (map f pab)++instance (Hask.Bifunctor p, forall x. FunctorOf (->) (->) (p x)) => CategoricalFunctor (FromBifunctor p) where+  type Dom (FromBifunctor p) = (->)+  type Cod (FromBifunctor p) = (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->)) (FromBifunctor p a) (FromBifunctor p b)+  map f = Nat (\(FromBifunctor pax) -> FromBifunctor (Hask.first f pax))++--------------------------------------------------------------------------------+-- Covariant (Bi)Functor instances++deriving via (FromBifunctor (,)) instance CategoricalFunctor (,)++deriving via (FromBifunctor ((,,) a)) instance CategoricalFunctor ((,,) a)++deriving via (FromBifunctor ((,,,) a b)) instance CategoricalFunctor ((,,,) a b)++deriving via (FromBifunctor ((,,,,) a b c)) instance CategoricalFunctor ((,,,,) a b c)++deriving via (FromBifunctor ((,,,,,) a b c d)) instance CategoricalFunctor ((,,,,,) a b c d)++deriving via (FromBifunctor ((,,,,,,) a b c d e)) instance CategoricalFunctor ((,,,,,,) a b c d e)++deriving via (FromBifunctor Either) instance CategoricalFunctor Either++deriving via (FromBifunctor These) instance CategoricalFunctor These++deriving via (FromBifunctor Semigroup.Arg) instance CategoricalFunctor Semigroup.Arg++deriving via (FromBifunctor (Const :: Type -> Type -> Type)) instance CategoricalFunctor (Const :: Type -> Type -> Type)++deriving via (FromBifunctor (K1 i :: Type -> Type -> Type)) instance CategoricalFunctor (K1 i :: Type -> Type -> Type)++--------------------------------------------------------------------------------+-- Covariant MapArg2 instances++instance MapArg2 (->) (->) (,)++instance MapArg2 (->) (->) ((,,) a)++instance MapArg2 (->) (->) ((,,,) a b)++instance MapArg2 (->) (->) ((,,,,) a b c)++instance MapArg2 (->) (->) ((,,,,,) a b c d)++instance MapArg2 (->) (->) ((,,,,,,) a b c d e)++instance MapArg2 (->) (->) Either++-- instance MapArg2 (->) (->) These++instance MapArg2 (->) (->) Semigroup.Arg++instance MapArg2 (->) (->) (Const :: Type -> Type -> Type)++instance MapArg2 (->) (->) (K1 i :: Type -> Type -> Type)++--------------------------------------------------------------------------------++newtype FromProfunctor f a b = FromProfunctor (f a b)+  deriving newtype (Hask.Functor, Hask.Profunctor)++instance (Hask.Profunctor p, FunctorOf (->) (->) (p x)) => CategoricalFunctor (FromProfunctor p x) where+  type Dom (FromProfunctor p x) = (->)+  type Cod (FromProfunctor p x) = (->)++  map :: (a -> b) -> Cod (FromProfunctor p x) (FromProfunctor p x a) (FromProfunctor p x b)+  map f (FromProfunctor pxa) = FromProfunctor (map f pxa)++instance (Hask.Profunctor p) => CategoricalFunctor (FromProfunctor p) where+  type Dom (FromProfunctor p) = Op+  type Cod (FromProfunctor p) = (->) ~> (->)++  map :: Op a b -> ((->) ~> (->)) ((FromProfunctor p) a) ((FromProfunctor p) b)+  map (Op f) = Nat (\(FromProfunctor pax) -> FromProfunctor (Hask.lmap f pax))++--------------------------------------------------------------------------------+-- Profunctorial Functor instances++deriving via (FromProfunctor (->)) instance CategoricalFunctor (->)++-- TODO: Add remaining Profunctor instances++--------------------------------------------------------------------------------+-- Profunctorial MapArg2 instances++instance MapArg2 Op (->) (->)++-- TODO: Add remaining Profunctor instances
+ src/Kindly/Class.hs view
@@ -0,0 +1,73 @@+module Kindly.Class where++--------------------------------------------------------------------------------++import Control.Category+import Data.Kind (Constraint)+import Data.Semigroupoid (Semigroupoid (..))+import GHC.Base (Type)++--------------------------------------------------------------------------------++-- | A functor @f@ between categories @from@ and @to@ sends objects in+-- @Dom f@ to objects in @Cod f@ and morphisms in @Dom f@ to+-- morphisms in @Dom f@.+--+-- === Laws+--+-- [Identity]    @'map' 'id' == 'id'@+-- [Composition] @'map' (f . g) == 'map' f . 'map' g@+type CategoricalFunctor :: (from -> to) -> Constraint+class (Category (Dom f), Category (Cod f)) => CategoricalFunctor (f :: from -> to) where+  -- | @Dom f@ is the source category for the functor @f@.+  type Dom f :: from -> from -> Type++  -- | @Cod f@ is the target category for the functor @f@.+  type Cod f :: to -> to -> Type++  -- | Lift a function of type @Dom f a b@ into a function of type @Cod f (f a) (f b)@.+  map :: Dom f a b -> Cod f (f a) (f b)++type Cat i = i -> i -> Type++-- | A Natural Transformation betweeen two functors @f@ and @g@.+type Nat :: Cat s -> Cat t -> Cat (s -> t)+newtype Nat source target f g where+  Nat :: (forall x. target (f x) (g x)) -> Nat source target f g++runNat :: Nat source target f g -> (forall x. target (f x) (g x))+runNat (Nat f) = f++infixr 0 ~>++type (~>) c1 c2 = Nat c1 c2++instance (Semigroupoid c1, Semigroupoid c2) => Semigroupoid (Nat c1 c2) where+  o :: Nat c1 c2 j k1 -> Nat c1 c2 i j -> Nat c1 c2 i k1+  Nat c1 `o` Nat c2 = Nat (c1 `o` c2)++instance (Semigroupoid c1, Semigroupoid c2, Category c1, Category c2) => Category (c1 ~> c2) where+  id :: (c1 ~> c2) a a+  id = Nat id++  (.) = o++type FunctorOf :: Cat from -> Cat to -> (from -> to) -> Constraint+class (CategoricalFunctor f, dom ~ Dom f, cod ~ Cod f) => FunctorOf dom cod f++instance (CategoricalFunctor f, dom ~ Dom f, cod ~ Cod f) => FunctorOf dom cod f++--------------------------------------------------------------------------------+-- NOTE: These these classes go from right to left:++class (FunctorOf cat1 (->) p) => MapArg1 cat1 p | p -> cat1 where+  map1 :: (a `cat1` b) -> p a -> p b+  map1 = map++class (FunctorOf cat1 (cat2 ~> (->)) p, forall x. MapArg1 cat2 (p x)) => MapArg2 cat1 cat2 p | p -> cat2 cat2 where+  map2 :: (a `cat1` b) -> forall x. p a x -> p b x+  map2 = runNat . map++class (FunctorOf cat1 (cat2 ~> cat3 ~> (->)) p, forall x. MapArg2 cat2 cat3 (p x)) => MapArg3 cat1 cat2 cat3 p | p -> cat1 cat2 cat3 where+  map3 :: (a `cat1` b) -> forall x y. p a x y -> p b x y+  map3 f = runNat (runNat (map f))
+ src/Kindly/Functor.hs view
@@ -0,0 +1,491 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Single Parameter Functors of arbitrary categories.+module Kindly.Functor+  ( Functor,+    fmap,+    contramap,+    invmap,+    Filterable,+    mapMaybe,+    catMaybes,+    filter,+  )+where++--------------------------------------------------------------------------------++import Control.Applicative (Const, WrappedArrow, WrappedMonad, ZipList)+import Control.Arrow (Arrow, ArrowMonad, Kleisli (..))+import Control.Category (Category (..))+import Control.Exception (Handler)+import Control.Monad (Monad)+import Control.Monad.ST (ST)+import Control.Monad.ST.Lazy qualified as Lazy+import Data.Complex (Complex)+import Data.Either (Either)+import Data.Functor qualified as Hask+import Data.Functor.Compose (Compose (..))+import Data.Functor.Contravariant (Op (..), Predicate)+import Data.Functor.Contravariant qualified as Hask+import Data.Functor.Identity (Identity (..))+import Data.Functor.Product (Product (..))+import Data.Functor.Sum (Sum (..))+import Data.Kind (Constraint, Type)+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (Maybe (..))+import Data.Monoid qualified as Monoid+import Data.Ord (Down)+import Data.Profunctor qualified as Hask.Profunctor+import Data.Proxy (Proxy)+import Data.Semigroup qualified as Semigroup+import Data.These (These)+import Data.Tuple (Solo)+import Foreign (Ptr)+import GHC.Arr (Array)+import GHC.Base (Char, Double, IO, Int, Word, ($))+import GHC.Conc (STM)+import GHC.Exts (Float)+import GHC.Generics (K1, M1 (..), Par1, Rec1 (..), U1, URec, V1, (:*:) (..), (:+:) (..), (:.:) (..))+import Kindly.Class+import Kindly.Iso+import System.Console.GetOpt (ArgDescr, ArgOrder, OptDescr)+import Text.ParserCombinators.ReadP (ReadP)+import Text.ParserCombinators.ReadPrec (ReadPrec)+import Witherable qualified as Hask+import Prelude (Bool)++--------------------------------------------------------------------------------++-- | A 'CategoricalFunctor' of kind @Type -> Type@ mapping from an+-- arbitrary category @cat@ to @->@.+type Functor :: (Type -> Type -> Type) -> (Type -> Type) -> Constraint+type Functor cat p = (MapArg1 cat p)++-- | Lift a function @cat a b@ into a function @f a -> f b@.+fmap :: forall cat f. (Functor cat f) => forall a b. (a `cat` b) -> f a -> f b+fmap = map1++-- | A specialization of 'fmap' for contravariant functors as defined+-- in 'Data.Functor.Contravariant.'+--+-- TODO: Do we keep this around? This is nice to have so that library+-- users don't have to manually pack functions in 'Op'.+contramap :: (Functor Op p) => (a -> b) -> p b -> p a+contramap = fmap . Op++-- | A specialization of 'fmap' for invariant functors as defined+-- in 'Data.Functor.Invariant.'+--+-- TODO: Do we keep this around? This is nice to have so that library+-- users don't have to manually pack functions in 'Iso'.+invmap :: (Functor (<->) f) => (a -> b) -> (b -> a) -> f a -> f b+invmap f g = fmap (Iso f g)++-- TODO: 'Filterable' is currently unusable due to fundeps. This can+-- be fixed by making it @FunctorOf (Hask.Star Maybe) (->) p@, but I+-- think we can do better by switching away from associated types.+type Filterable p = Functor (Hask.Profunctor.Star Maybe) p++-- | A specialization of 'fmap' for filterable functors as defined+-- in 'Witherable'+--+-- TODO: Do we keep this around? This is nice to have so that library+-- users don't have to manually pack functions in 'Hask.Star'.+mapMaybe :: (Filterable f) => (a -> Maybe b) -> f a -> f b+mapMaybe f = map (Hask.Profunctor.Star f)++-- | The 'catMaybes' function takes a list of 'Maybe's and returns+-- a list of all the 'Just' values.+--+-- TODO: Do we keep this around? This is nice to have so that library+-- users don't have to manually pack functions in 'Hask.Star'.+catMaybes :: (Filterable f) => f (Maybe a) -> f a+catMaybes = map (Hask.Profunctor.Star id)++-- | Applied to a predicate and a functor @f a@, returns the those+-- elements that satisfy the predicate.+--+-- TODO: Do we keep this around? This is nice to have so that library+-- users don't have to manually pack functions in 'Hask.Star'.+filter :: (Filterable f) => (a -> Bool) -> f a -> f a+filter f = map (Hask.Profunctor.Star (\a -> if f a then Just a else Nothing))++--------------------------------------------------------------------------------++newtype FromFunctor f a = FromFunctor (f a)+  deriving newtype (Hask.Functor)++instance (Hask.Functor f) => CategoricalFunctor (FromFunctor f) where+  type Dom (FromFunctor f) = (->)+  type Cod (FromFunctor f) = (->)++  map :: (a -> b) -> FromFunctor f a -> FromFunctor f b+  map = Hask.fmap++--------------------------------------------------------------------------------+-- Covariant Functor instances++deriving via (FromFunctor ZipList) instance CategoricalFunctor ZipList++deriving via (FromFunctor Handler) instance CategoricalFunctor Handler++deriving via (FromFunctor Complex) instance CategoricalFunctor Complex++deriving via (FromFunctor Identity) instance CategoricalFunctor Identity++deriving via (FromFunctor Monoid.First) instance CategoricalFunctor Monoid.First++deriving via (FromFunctor Monoid.Last) instance CategoricalFunctor Monoid.Last++deriving via (FromFunctor Down) instance CategoricalFunctor Down++deriving via (FromFunctor Semigroup.First) instance CategoricalFunctor Semigroup.First++deriving via (FromFunctor Semigroup.Last) instance CategoricalFunctor Semigroup.Last++deriving via (FromFunctor Semigroup.Max) instance CategoricalFunctor Semigroup.Max++deriving via (FromFunctor Semigroup.Min) instance CategoricalFunctor Semigroup.Min++deriving via (FromFunctor Semigroup.Dual) instance CategoricalFunctor Semigroup.Dual++deriving via (FromFunctor Semigroup.Product) instance CategoricalFunctor Semigroup.Product++deriving via (FromFunctor Semigroup.Sum) instance CategoricalFunctor Semigroup.Sum++deriving via (FromFunctor NonEmpty) instance CategoricalFunctor NonEmpty++deriving via (FromFunctor STM) instance CategoricalFunctor STM++deriving via (FromFunctor Par1) instance CategoricalFunctor Par1++deriving via (FromFunctor ArgDescr) instance CategoricalFunctor ArgDescr++deriving via (FromFunctor ArgOrder) instance CategoricalFunctor ArgOrder++deriving via (FromFunctor OptDescr) instance CategoricalFunctor OptDescr++deriving via (FromFunctor ReadP) instance CategoricalFunctor ReadP++deriving via (FromFunctor ReadPrec) instance CategoricalFunctor ReadPrec++deriving via (FromFunctor IO) instance CategoricalFunctor IO++deriving via (FromFunctor Maybe) instance CategoricalFunctor Maybe++deriving via (FromFunctor Solo) instance CategoricalFunctor Solo++deriving via (FromFunctor []) instance CategoricalFunctor []++deriving via (FromFunctor (WrappedMonad m)) instance (Monad m) => CategoricalFunctor (WrappedMonad m)++deriving via (FromFunctor (ArrowMonad a)) instance (Arrow a) => CategoricalFunctor (ArrowMonad a)++deriving via (FromFunctor (Lazy.ST s)) instance CategoricalFunctor (Lazy.ST s)++deriving via (FromFunctor (Either a)) instance CategoricalFunctor (Either a)++deriving via (FromFunctor (These a)) instance CategoricalFunctor (These a)++deriving via (FromFunctor Proxy) instance CategoricalFunctor (Proxy :: Type -> Type)++deriving via (FromFunctor (Semigroup.Arg a)) instance CategoricalFunctor (Semigroup.Arg a)++deriving via (FromFunctor (Array i)) instance CategoricalFunctor (Array i)++deriving via (FromFunctor U1) instance CategoricalFunctor (U1 :: Type -> Type)++deriving via (FromFunctor V1) instance CategoricalFunctor (V1 :: Type -> Type)++deriving via (FromFunctor (ST s)) instance CategoricalFunctor (ST s)++deriving via (FromFunctor ((,) a)) instance CategoricalFunctor ((,) a)++deriving via (FromFunctor (WrappedArrow a b)) instance (Arrow a) => CategoricalFunctor (WrappedArrow a b)++-- TODO: Figure out if these instances be written with Deriving Via.+instance (FunctorOf (->) (->) m) => CategoricalFunctor (Kleisli m a) where+  type Dom (Kleisli m a) = (->)+  type Cod (Kleisli m a) = (->)++  map :: (a1 -> b) -> Kleisli m a a1 -> Kleisli m a b+  map f (Kleisli m) = Kleisli $ \a -> map f (m a)++deriving via (FromFunctor (Const m)) instance CategoricalFunctor (Const m :: Type -> Type)++instance (FunctorOf (->) (->) f) => CategoricalFunctor (Monoid.Ap f) where+  type Dom (Monoid.Ap f) = (->)+  type Cod (Monoid.Ap f) = (->)++  map f (Monoid.Ap m) = Monoid.Ap $ map f m++instance (FunctorOf (->) (->) f) => CategoricalFunctor (Monoid.Alt f) where+  type Dom (Monoid.Alt f) = (->)+  type Cod (Monoid.Alt f) = (->)++  map f (Monoid.Alt m) = Monoid.Alt $ map f m++instance (FunctorOf (->) (->) f) => CategoricalFunctor (Rec1 f) where+  type Dom (Rec1 f) = (->)+  type Cod (Rec1 f) = (->)++  map f (Rec1 m) = Rec1 $ map f m++deriving via (FromFunctor (URec (Ptr ()))) instance CategoricalFunctor (URec (Ptr ()) :: Type -> Type)++deriving via (FromFunctor (URec Char)) instance CategoricalFunctor (URec Char :: Type -> Type)++deriving via (FromFunctor (URec Double)) instance CategoricalFunctor (URec Double :: Type -> Type)++deriving via (FromFunctor (URec Float)) instance CategoricalFunctor (URec Float :: Type -> Type)++deriving via (FromFunctor (URec Int)) instance CategoricalFunctor (URec Int :: Type -> Type)++deriving via (FromFunctor (URec Word)) instance CategoricalFunctor (URec Word :: Type -> Type)++deriving via (FromFunctor ((,,) a b)) instance CategoricalFunctor ((,,) a b)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (Product f g) where+  type Dom (Product f g) = (->)+  type Cod (Product f g) = (->)++  map f (Pair m1 m2) = Pair (map f m1) (map f m2)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (Sum f g) where+  type Dom (Sum f g) = (->)+  type Cod (Sum f g) = (->)++  map f (InL m1) = InL $ map f m1+  map f (InR m2) = InR $ map f m2++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (f :*: g) where+  type Dom (f :*: g) = (->)+  type Cod (f :*: g) = (->)++  map f (m1 :*: m2) = map f m1 :*: map f m2++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (f :+: g) where+  type Dom (f :+: g) = (->)+  type Cod (f :+: g) = (->)++  map f (L1 m1) = L1 $ map f m1+  map f (R1 m2) = R1 $ map f m2++deriving via (FromFunctor (K1 i c)) instance CategoricalFunctor (K1 i c :: Type -> Type)++deriving via (FromFunctor ((,,,) a b c)) instance CategoricalFunctor ((,,,) a b c)++deriving via (FromFunctor ((->) r)) instance CategoricalFunctor ((->) r)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (Compose f g) where+  type Dom (Compose f g) = (->)+  type Cod (Compose f g) = (->)++  map f (Compose fga) = Compose $ map (map f) fga++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => CategoricalFunctor (f :.: g) where+  type Dom (f :.: g) = (->)+  type Cod (f :.: g) = (->)++  map f (Comp1 fga) = Comp1 $ map (map f) fga++instance (FunctorOf (->) (->) f) => CategoricalFunctor (M1 i c f) where+  type Dom (M1 i c f) = (->)+  type Cod (M1 i c f) = (->)++  map f (M1 fp) = M1 $ map f fp++deriving via (FromFunctor ((,,,,) a b c d)) instance CategoricalFunctor ((,,,,) a b c d)++deriving via (FromFunctor ((,,,,,) a b c d e)) instance CategoricalFunctor ((,,,,,) a b c d e)++deriving via (FromFunctor ((,,,,,,) a b c d e f)) instance CategoricalFunctor ((,,,,,,) a b c d e f)++--------------------------------------------------------------------------------+-- Covariant MapArg1 instances++instance MapArg1 (->) ZipList++instance MapArg1 (->) Handler++instance MapArg1 (->) Complex++instance MapArg1 (->) Identity++instance MapArg1 (->) Monoid.First++instance MapArg1 (->) Monoid.Last++instance MapArg1 (->) Down++instance MapArg1 (->) Semigroup.First++instance MapArg1 (->) Semigroup.Last++instance MapArg1 (->) Semigroup.Max++instance MapArg1 (->) Semigroup.Min++instance MapArg1 (->) Semigroup.Dual++instance MapArg1 (->) Semigroup.Product++instance MapArg1 (->) Semigroup.Sum++instance MapArg1 (->) NonEmpty++instance MapArg1 (->) STM++instance MapArg1 (->) Par1++instance MapArg1 (->) ArgDescr++instance MapArg1 (->) ArgOrder++instance MapArg1 (->) OptDescr++instance MapArg1 (->) ReadP++instance MapArg1 (->) ReadPrec++instance MapArg1 (->) IO++instance MapArg1 (->) Maybe++instance MapArg1 (->) Solo++instance MapArg1 (->) []++instance (Monad m) => MapArg1 (->) (WrappedMonad m)++instance (Arrow a) => MapArg1 (->) (ArrowMonad a)++instance MapArg1 (->) (Lazy.ST s)++instance MapArg1 (->) (Either a)++instance MapArg1 (->) (Proxy :: Type -> Type)++instance MapArg1 (->) (Semigroup.Arg a)++instance MapArg1 (->) (Array i)++instance MapArg1 (->) (U1 :: Type -> Type)++instance MapArg1 (->) (V1 :: Type -> Type)++instance MapArg1 (->) (ST s)++instance MapArg1 (->) ((,) a)++instance (Arrow a) => MapArg1 (->) (WrappedArrow a b)++instance (FunctorOf (->) (->) m) => MapArg1 (->) (Kleisli m a)++instance MapArg1 (->) (Const m :: Type -> Type)++instance (FunctorOf (->) (->) f) => MapArg1 (->) (Monoid.Ap f)++instance (FunctorOf (->) (->) f) => MapArg1 (->) (Monoid.Alt f)++instance (FunctorOf (->) (->) f) => MapArg1 (->) (Rec1 f)++instance MapArg1 (->) (URec (Ptr ()) :: Type -> Type)++instance MapArg1 (->) (URec Char :: Type -> Type)++instance MapArg1 (->) (URec Double :: Type -> Type)++instance MapArg1 (->) (URec Float :: Type -> Type)++instance MapArg1 (->) (URec Int :: Type -> Type)++instance MapArg1 (->) (URec Word :: Type -> Type)++instance MapArg1 (->) ((,,) a b)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (Product f g)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (Sum f g)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (f :*: g)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (f :+: g)++instance MapArg1 (->) (K1 i c :: Type -> Type)++instance MapArg1 (->) ((,,,) a b c)++instance MapArg1 (->) ((->) r)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (Compose f g)++instance (FunctorOf (->) (->) f, FunctorOf (->) (->) g) => MapArg1 (->) (f :.: g)++instance (FunctorOf (->) (->) f) => MapArg1 (->) (M1 i c f)++instance MapArg1 (->) ((,,,,) a b c d)++instance MapArg1 (->) ((,,,,,) a b c d e)++instance MapArg1 (->) ((,,,,,,) a b c d e f)++--------------------------------------------------------------------------------++newtype FromContra f a = FromContra (f a)+  deriving newtype (Hask.Contravariant)++instance (Hask.Contravariant f) => CategoricalFunctor (FromContra f) where+  type Dom (FromContra f) = Op+  type Cod (FromContra f) = (->)++  map :: Dom (FromContra f) a b -> Cod (FromContra f) ((FromContra f) a) ((FromContra f) b)+  map = Hask.contramap . getOp++--------------------------------------------------------------------------------+-- Contravariant Functor instances++deriving via (FromContra Predicate) instance CategoricalFunctor Predicate++-- TODO: Add remaining Contravariant instances++--------------------------------------------------------------------------------+-- Contravariant MapArg1 instances++instance MapArg1 Op Predicate++-- TODO: Add remaining Contravariant instances++--------------------------------------------------------------------------------++instance CategoricalFunctor Monoid.Endo where+  type Dom Monoid.Endo = (<->)+  type Cod Monoid.Endo = (->)++  map :: (a <-> b) -> Monoid.Endo a -> Monoid.Endo b+  map Iso {..} (Monoid.Endo f) = Monoid.Endo (fwd . f . bwd)++instance MapArg1 (<->) Monoid.Endo++--------------------------------------------------------------------------------++newtype FromFilterable f a = FromFilterable (f a)+  deriving newtype (Hask.Functor, Hask.Filterable)++instance (Hask.Filterable f) => CategoricalFunctor (FromFilterable f) where+  type Dom (FromFilterable f) = (Hask.Profunctor.Star Maybe)+  type Cod (FromFilterable f) = (->)++  map :: Hask.Profunctor.Star Maybe a b -> FromFilterable f a -> FromFilterable f b+  map (Hask.Profunctor.Star f) (FromFilterable fa) = FromFilterable (Hask.mapMaybe f fa)++--------------------------------------------------------------------------------++-- NOTE: These instances conflict with our Covariant Functor+-- instances. Switching from associated types to Multi Parameter type+-- classes would fix this:++-- deriving via (FromFilterable []) instance Functor []++-- deriving via (FromFilterable Maybe) instance Functor Maybe
+ src/Kindly/Iso.hs view
@@ -0,0 +1,29 @@+module Kindly.Iso where++--------------------------------------------------------------------------------++import Control.Category (Category (..))+import Data.Kind (Type)+import Kindly.Class (Cat)++--------------------------------------------------------------------------------++-- | An invertible mapping between 'a' and 'b' in category 'cat'.+--+-- === Laws+--+-- @+-- 'fwd' '.' 'bwd' ≡ 'id'+-- 'bwd' '.' 'fwd' ≡ 'id'+-- @+data Iso cat a b = Iso {fwd :: a `cat` b, bwd :: b `cat` a}++instance (Category cat) => Category (Iso cat) where+  id :: (Category cat) => Iso cat a a+  id = Iso id id++  (.) :: Iso cat b c -> Iso cat a b -> Iso cat a c+  Iso fwd bwd . Iso fwd' bwd' = Iso (fwd . fwd') (bwd' . bwd)++type (<->) :: Cat Type+type (<->) = Iso (->)
+ src/Kindly/Rank2.hs view
@@ -0,0 +1,25 @@+-- | Work in Progress.+module Kindly.Rank2+  ( BFunctor,+    bmap,+    BFunctor2,+    bmap2,+  )+where++--------------------------------------------------------------------------------++import Kindly.Class++--------------------------------------------------------------------------------++type BFunctor b = FunctorOf ((->) ~> (->)) (->) b++bmap :: BFunctor b => forall f g. (forall x. f x -> g x) -> b f -> b g +bmap nat = map (Nat nat)++type BFunctor2 b = FunctorOf ((->) ~> (->) ~> (->)) (->) b++bmap2 :: BFunctor2 b => forall f g. (forall x x'. f x x' -> g x x') -> b f -> b g +bmap2 nat = map (Nat (Nat nat))+
+ src/Kindly/Trifunctor.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Three Parameter Functors of arbitrary varience.+module Kindly.Trifunctor+  ( Trifunctor,+    trimap,+  )+where++--------------------------------------------------------------------------------++import Control.Category+import Data.Kind (Constraint, Type)+import Kindly.Bifunctor ()+import Kindly.Class++--------------------------------------------------------------------------------++-- | A 'CategoricalFunctor' of kind @Type -> Type -> Type@ mapping from an+-- arbitrary category @cat1@ to a functor category @cat2 ~> cat3 ~> (->)@.+type Trifunctor :: (Type -> Type -> Type) -> (Type -> Type -> Type) -> (Type -> Type -> Type) -> (Type -> Type -> Type -> Type) -> Constraint+type Trifunctor cat1 cat2 cat3 p = (MapArg3 cat3 cat2 cat1 p, forall x. MapArg2 cat2 cat1 (p x), forall x y. MapArg1 cat1 (p x y))++-- | Lift a morphism @cat1 a a'@, a morphism @cat2 b b'@, and a morphism @cat3 c c'@ into a -- function @p a b c -> p a' b' c'@.+trimap :: forall cat1 cat2 cat3 p. (Trifunctor cat1 cat2 cat3 p) => forall a b c a' b' c'. (a `cat3` a') -> (b `cat2` b') -> (c `cat1` c') -> p a b c -> p a' b' c'+trimap f g h = map3 f . map2 @_ @cat1 g . map1 h++--------------------------------------------------------------------------------++instance CategoricalFunctor (,,) where+  type Dom (,,) = (->)+  type Cod (,,) = (->) ~> (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->) ~> (->)) ((,,) a) ((,,) b)+  map f = Nat (Nat (\(x, y, z) -> (f x, y, z)))++instance CategoricalFunctor ((,,,) x) where+  type Dom ((,,,) x) = (->)+  type Cod ((,,,) x) = (->) ~> (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->) ~> (->)) ((,,,) x a) ((,,,) x b)+  map f = Nat (Nat (\(a, b, c, d) -> (a, f b, c, d)))++instance CategoricalFunctor ((,,,,) x x') where+  type Dom ((,,,,) x x') = (->)+  type Cod ((,,,,) x x') = (->) ~> (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->) ~> (->)) ((,,,,) x x' a) ((,,,,) x x' b)+  map f = Nat (Nat (\(a, b, c, d, e) -> (a, b, f c, d, e)))++instance CategoricalFunctor ((,,,,,) x x' x'') where+  type Dom ((,,,,,) x x' x'') = (->)+  type Cod ((,,,,,) x x' x'') = (->) ~> (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->) ~> (->)) ((,,,,,) x x' x'' a) ((,,,,,) x x' x'' b)+  map f' = Nat (Nat (\(a, b, c, d, e, f) -> (a, b, c, f' d, e, f)))++instance CategoricalFunctor ((,,,,,,) x x' x'' x''') where+  type Dom ((,,,,,,) x x' x'' x''') = (->)+  type Cod ((,,,,,,) x x' x'' x''') = (->) ~> (->) ~> (->)++  map :: (a -> b) -> ((->) ~> (->) ~> (->)) ((,,,,,,) x x' x'' x''' a) ((,,,,,,) x x' x'' x''' b)+  map f' = Nat (Nat (\(a, b, c, d, e, f, g) -> (a, b, c, d, f' e, f, g)))++--------------------------------------------------------------------------------++instance MapArg3 (->) (->) (->) (,,)++instance MapArg3 (->) (->) (->) ((,,,) x)++instance MapArg3 (->) (->) (->) ((,,,,) x x')++instance MapArg3 (->) (->) (->) ((,,,,,) x x' x'')++instance MapArg3 (->) (->) (->) ((,,,,,,) x x' x'' x''')
+ test/Main.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE InstanceSigs #-}++module Main (main) where++--------------------------------------------------------------------------------++import Data.Functor.Contravariant (Op (..), Predicate (..))+import Data.Functor.Identity (Identity (..))+import Kindly qualified as UUT+import Test.Hspec (describe, hspec, it, shouldBe)+import Data.Maybe (maybeToList)+import Data.Functor.Classes (Show1, Eq1)++--------------------------------------------------------------------------------++main :: IO ()+main = hspec $ do+  describe "fmap" $ do+    it "works covariantly" $ do+      UUT.fmap show (Identity True) `shouldBe` Identity "True"+    it "works contravariantly" $ do+      getPredicate (UUT.fmap (Op read) (Predicate not)) "True" `shouldBe` False+    it "composes" $ do+      (UUT.fmap . UUT.fmap) show (Just (Just True)) `shouldBe` Just (Just "True")+      UUT.fmap ((\f -> f "True") . getPredicate) ((UUT.fmap . UUT.fmap) (Op read) (Just (Predicate not))) `shouldBe` Just False++  describe "lmap" $ do+    it "works covariantly" $ do+      UUT.lmap show (True, False) `shouldBe` ("True", False)+    it "works contravariantly" $ do+      UUT.lmap (Op read) not "True" `shouldBe` False++  describe "rmap" $ do+    it "works covariantly" $ do+      UUT.rmap show (True, False) `shouldBe` (True, "False")++  describe "bimap" $ do+    it "works covariantly" $ do+      UUT.bimap show (read @()) (Left True) `shouldBe` Left "True"+      UUT.bimap (read @Int) show ("1", True) `shouldBe` (1, "True")+    it "works contravariantly" $ do+      UUT.bimap (Op (read @Int)) show (+ 1) "0" `shouldBe` "1"++  describe "bimap" $ do+    it "works covariantly" $ do+      UUT.trimap show show show (True, False, ()) `shouldBe` ("True", "False", "()")+++  describe "bmap" $ do+    it "works" $ do+      let hkd = MyHKD (Just True) Nothing+      UUT.bmap maybeToList hkd `shouldBe` MyHKD [True] []+++data MyHKD f = MyHKD {one :: f Bool, two :: f ()}++instance Show1 f => Show (MyHKD f) where+  show MyHKD {..} = "MyHKD {one = " <> show one <> ", two = " <> show two <> "}"++instance Eq1 f => Eq (MyHKD f) where+  (MyHKD a b) == (MyHKD a' b') = a == a' && b == b'  ++instance UUT.CategoricalFunctor MyHKD where+  type Dom MyHKD = (->) UUT.~> (->)+  type Cod MyHKD = (->)++  map :: (UUT.Nat (->) (->)) f g -> MyHKD f -> MyHKD g+  map (UUT.Nat nat) MyHKD {..} = MyHKD (nat one) (nat two)++newtype MyHKD2 p = MyHKD2 {field :: p () Bool}++instance UUT.CategoricalFunctor MyHKD2 where+  type Dom MyHKD2 = (->) UUT.~> ((->) UUT.~> (->))+  type Cod MyHKD2 = (->)++  map :: UUT.Dom MyHKD2 p q -> MyHKD2 p -> MyHKD2 q+  map (UUT.Nat (UUT.Nat nat)) MyHKD2 {..} = MyHKD2 (nat field)