data-functor-logistic-0.0/0000755000000000000000000000000007346545000013744 5ustar0000000000000000data-functor-logistic-0.0/CHANGELOG.md0000644000000000000000000000017407346545000015557 0ustar0000000000000000# Revision history for data-functor-logistic ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. data-functor-logistic-0.0/Data/Functor/0000755000000000000000000000000007346545000016235 5ustar0000000000000000data-functor-logistic-0.0/Data/Functor/Logistic.hs0000644000000000000000000000500707346545000020350 0ustar0000000000000000{-# 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 #-} data-functor-logistic-0.0/README.md0000644000000000000000000000411107346545000015220 0ustar0000000000000000Logistic 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-0.0/data-functor-logistic.cabal0000644000000000000000000000142707346545000021136 0ustar0000000000000000cabal-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