data-functor-logistic (empty) → 0.0

raw patch · 4 files changed

+179/−0 lines, 4 filesdep +basedep +distributive

Dependencies added: base, distributive

Files

CHANGELOG.md +5/−0
Data/Functor/Logistic.hs +80/−0
README.md +71/−0
data-functor-logistic.cabal +23/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for data-functor-logistic++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ Data/Functor/Logistic.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module Data.Functor.Logistic+  ( Logistic(..)+  , setters+  ) where++import Data.Distributive+import Data.Functor.Identity+import Data.Functor.Contravariant+import Data.Functor.Compose+import Data.Functor.Product+import Data.Proxy+import Data.Complex+import GHC.Generics++class Functor t => Logistic t where+  deliver :: Contravariant f => f (t a -> t a) -> t (f (a -> a))+  default deliver :: (Generic1 t, Logistic (Rep1 t), Contravariant f) => f (t a -> t a) -> t (f (a -> a))+  deliver f = to1 $ deliver $ contramap (\g -> to1 . g . from1) f++instance Logistic Identity where+  deliver f = Identity (contramap fmap f)++instance Logistic Par1 where+  deliver f = Par1 (contramap fmap f)++instance Logistic f => Logistic (M1 i c f) where+  deliver f = M1 $ deliver $ contramap (\g -> M1 . g . unM1) f++instance Logistic f => Logistic (Rec1 f) where+  deliver f = Rec1 $ deliver $ contramap (\g -> Rec1 . g . unRec1) f++instance Logistic Proxy where+  deliver _ = Proxy++instance Logistic U1 where+  deliver _ = U1++-- | Update only if the argument matches+instance Eq r => Logistic ((->) r) where+  deliver f x = contramap (\u g r -> if r == x then u (g r) else g r) f++instance (Logistic f, Logistic g) => Logistic (Product f g) where+  deliver f = Pair+    (deliver (contramap (\u (Pair a b) -> Pair (u a) b) f))+    (deliver (contramap (\u (Pair a b) -> Pair a (u b)) f))++instance (Logistic f, Logistic g) => Logistic (f :*: g) where+  deliver f+    = deliver (contramap (\u (a :*: b) -> u a :*: b) f)+    :*: deliver (contramap (\u (a :*: b) -> a :*: u b) f)++instance (Logistic f, Logistic g, Applicative f, Traversable g, Distributive g) => Logistic (Compose f g) where+  deliver f = Compose+    $ fmap getCompose+    $ deliver+    $ Compose+    $ deliver+    $ contramap go f+    where+      go p = Compose . sequenceA . p . distribute . getCompose++instance (Logistic f, Logistic g, Applicative f, Traversable g, Distributive g) => Logistic (f :.: g) where+  deliver f = Comp1 $ fmap unComp1 $ deliver $ Comp1 $ deliver $ contramap go f+    where+      go p = Comp1 . sequenceA . p . distribute . unComp1++instance Logistic Complex where+  deliver f+    = contramap (\g (a :+ b) -> g a :+ b) f+    :+ contramap (\g (a :+ b) -> a :+ g b) f++setters :: Logistic t => t ((a -> a) -> t a -> t a)+setters = getOp <$> deliver (Op id)+{-# INLINE setters #-}

+ README.md view

@@ -0,0 +1,71 @@+Logistic is to setters as Distributive is to getters+----++Distributive functors are containers where getters can be enumerated as their own types.++This is the definition of the `Distributive` class:++```haskell+class Functor g => Distributive g where+  distribute :: Functor f => f (g a) -> g (f a)+```++One easy-to-understand instance is `Complex`.++```haskell+data Complex a = !a :+ !a++realPart :: Complex a -> a+realPart (x :+ _) =  x++imagPart :: Complex a -> a+imagPart (_ :+ y) =  y++instance Distributive Complex where+  distribute wc = fmap realPart wc :+ fmap imagPart wc+```++Given any functor-wrapped value, `distribute` fmaps the getters of `Complex` to it.+`distribute id` instantiates it as the function (`(->) r`) functor. In this case, `distribute id` is equal to `realPart :+ imagPart`.++However, we cannot modify the elements this way because `distribute` passes getters but not setters.++Here we introduce a new `Logistic` class to provide settability to containers:++```haskell+class Functor t => Logistic t where+  deliver :: Contravariant f => f (t a -> t a) -> t (f (a -> a))+```++While the type of `deliver` is slightly more intimidating, it's actually very close to the `distribute`;+the `Functor` constraint is `Contravariant` instead and the contents are endomorphisms.++Here's the instance for `Complex`. `deliver f` contramaps a setter function to `f` for each field:++```haskell+instance Logistic Complex where+  deliver f+    = contramap (\g (a :+ b) -> g a :+ b) f+    :+ contramap (\g (a :+ b) -> a :+ g b) f+ ```++Instantiating the `Op` contravariant functor, it is trivial to obtain a collection of setters.++```haskell+newtype Op a b = Op { getOp :: b -> a }++setters :: Logistic t => t ((a -> a) -> t a -> t a)+setters = getOp <$> deliver (Op id)+```++```haskell+ghci> let setR :+ setI = setters+ghci> setR (+1) (0 :+ 1)+1 :+ 1+ghci> setI (+1) (0 :+ 1)+0 :+ 2+```++`deliver` has a generic default implementation which works for any single-constructor products.++This class can be useful to complement `Distributive`. Generalisation to higher-kinded data would also be interesting.

+ data-functor-logistic.cabal view

@@ -0,0 +1,23 @@+cabal-version:      2.4+name:               data-functor-logistic+version:            0.0+synopsis:           Updatable analogue of Distributive functors+description:        See README.md+bug-reports:        https://github.com/fumieval/data-functor-logistic+license:            BSD-3-Clause+author:             Fumiaki Kinoshita+maintainer:         fumiexcel@gmail.com+copyright:          Copyright (c) 2021 Fumiaki Kinoshita+category:           Data Structures+extra-source-files: CHANGELOG.md, README.md++library+    exposed-modules:+        Data.Functor.Logistic+    build-depends:    base >= 4.9 && <4.17, distributive+    default-language: Haskell2010+    ghc-options: -Wall -Wcompat++source-repository head+  type: git+  location: https://github.com/fumieval/data-functor-logistic.git