naperian (empty) → 0.1.0.0

raw patch · 7 files changed

+438/−0 lines, 7 filesdep +adjunctionsdep +basedep +comonadsetup-changed

Dependencies added: adjunctions, base, comonad, distributive, free, streams, transformers

Files

LICENSE +30/−0
README.md +62/−0
Setup.hs +2/−0
naperian.cabal +43/−0
src/Data/Functor1.hs +29/−0
src/Data/Functor1/Applied.hs +8/−0
src/Data/Naperian.hs +264/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Aaron Vargo (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 Aaron Vargo 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,62 @@+# naperian++This package provides `Naperian` functors, a more powerful form of+`Distributive` functor which is equal in power to a `Representable` functor (for+some `Rep`), but which can be implemented asymptotically more efficiently for+instances which don't support random access.++`Distributive` functors allow distribution of `Functor`s:++```haskell+distribute :: (Distributive f, Functor g) => g (f a) -> f (g a)+```++With `Distributive`, you can, for example, zip two containers by distributing+the `Pair` `Functor`:++```haskell+data Pair a = Pair a a deriving Functor++zipDistributive :: Distributive f => f a -> f a -> f (a, a)+zipDistributive xs ys = fmap f $ distribute (Pair xs ys)+  where f (Pair x y) = (x, y)+```++Note that the two containers must have elements of the same type. `Naperian`,+however, allows the containers to have elements of different types:++```haskell+zipNaperian :: Naperian f => f a -> f b -> f (a, b)+```++It does so by allowing distribution of *`Functor1`s*, where a `Functor1` is a+functor from `Hask -> Hask` to `Hask`:++```haskell+class Functor1 w where+  map1 :: (forall a. f a -> g a) -> w f -> w g++distribute1 :: (Naperian f, Functor1 w) => w f -> f (w Identity)+```++The more polymorphic zip can then be implemented by distributing the `Pair1` `Functor1`:++```haskell+data Pair1 a b f = Pair1 (f a) (f b)+instance Functor1 (Pair1 a b) where ...++zipNaperian :: Naperian f => f a -> f b -> f (a, b)+zipNaperian as bs = fmap f $ distribute1 (Pair1 as bs)+  where f (Pair1 (Identity a) (Identity b)) = (a, b)+```++`Naperian` functors can be shown to be equivalent to `Representable` functors,+for some `Rep`, by selecting `Rep f = ∀x. f x -> x`. That is, a position in a+`Naperian` container can be represented as a function which gets the value at+that position. `tabulate` can then be derived using the `Functor1`:++```haskell+newtype TabulateArg a f = TabulateArg ((forall x. f x -> x) -> a)+```++The rest is left as an exercise for the reader.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ naperian.cabal view

@@ -0,0 +1,43 @@+name:                naperian+version:             0.1.0.0+synopsis:            Efficient representable functors+description: See the readme at <https://github.com/aaronvargo/naperian#readme>+homepage:            https://github.com/aaronvargo/naperian#readme+license:             BSD3+license-file:        LICENSE+author:              Aaron Vargo+maintainer:          Aaron Vargo <fpfundamentalist@gmail.com>+copyright:           Aaron Vargo 2017+category:            Data Structures+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src++  exposed-modules:     Data.Naperian+                     , Data.Functor1+                     , Data.Functor1.Applied++  build-depends:       base >= 4.7 && < 4.11+                     , distributive >= 0.4.4+                     , adjunctions >= 4.2.1+                     , transformers >= 0.3.0+                     , streams >= 3.2.1+                     , free >= 4.11+                     , comonad >= 4.2.7++  default-language:    Haskell2010+  other-extensions:    CPP+                     , DefaultSignatures+                     , FlexibleContexts+                     , KindSignatures+                     , RankNTypes+                     , TypeOperators++  ghc-options:         -Wall -fno-warn-unused-imports++source-repository head+  type:     git+  location: https://github.com/aaronvargo/naperian

+ src/Data/Functor1.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE RankNTypes #-}++module Data.Functor1 where++import           Control.Applicative  (Const (..))+import           Data.Proxy+import           Data.Type.Coercion++-- | Objects in the category @(Hask -> Hask) -> Hask@+class Functor1 w where+  -- | @+  -- map1 f . map1 g = map1 (f . g)+  -- map1 id = id+  -- @+  map1 :: (forall a. f a -> g a) -> w f -> w g++  -- | mapCoerce1 c = map1 (coerceWith c)+  mapCoerce1 :: (forall x. Coercion (f x) (g x)) -> w f -> w g+  mapCoerce1 f = map1 (coerceWith f)++instance Functor1 Proxy where+  map1 _ Proxy = Proxy++#if MIN_VERSION_base(4,9,0)+-- | since base-4.9+instance Functor1 (Const a) where+  map1 _ = Const . getConst+#endif

+ src/Data/Functor1/Applied.hs view

@@ -0,0 +1,8 @@+module Data.Functor1.Applied where++import Data.Functor1++newtype Applied a f = Applied { runApplied :: f a } deriving (Show, Eq)++instance Functor1 (Applied a) where+  map1 f = Applied . f . runApplied

+ src/Data/Naperian.hs view

@@ -0,0 +1,264 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Data.Naperian+  ( module Data.Functor1+  , Naperian(..)+  , nindex+  -- * Default Definitions+  -- ** Naperian+  , Distribute1+  , distributeTabulate+  , distributeRepresentable+  , distributeIso+  , distributeCoerce+  -- ** Functor+  , fmapCotraverse1+  -- ** Apply/Applicative\/MonadZip+  , zipWithNap+  , apNap+  , pureNap+  -- ** Bind/Monad+  , bindNap+  -- ** Distributive+  , distributeNap+  , collectNap+  -- ** Representable+  , Logarithm(..)+  , tabulateLog+  , indexLog+  ) where++import Control.Applicative+import Control.Comonad.Cofree+import Control.Comonad.Trans.Traced+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Reader+import Data.Distributive+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Rep+import Data.Functor1+import Data.Functor1.Applied+import Data.Stream.Infinite+import Data.Type.Coercion+import GHC.Generics hiding (Rep)++{- |++A more powerful form of 'Distributive' functor, which is equal in power to a+'Representable' functor (for some 'Rep'), but which can be implemented+asymptotically more efficiently for instances which don't support random access.++A functor is Naperian/Representable iff it's isomorphic to @(->) r@ for some+@r@. Such a functor can be thought of as a container of a fixed size, where @r@+is the type of positions in the container. By representing a position as a+function of type @forall x. f x -> x@, which gets the value at that position, a+Naperian/Representable functor can equivalently be shown to be one for which @f@+is isomorphic to @(->) (forall x. f x -> x)@++These isomorphisms are equivalent to 'distribute1' + 'fmap', but the latter can+be implemented more efficiently for containers which don't support random+access.++-}++class Distributive f => Naperian f where+  {-# MINIMAL distribute1 #-}++  -- |+  -- @+  -- 'distribute1' . 'Applied' = 'fmap' ('Applied' . 'Identity')+  -- 'distribute1' ('Const' x) = 'Const' x '<$' xs+  -- @+  distribute1 :: Functor1 w => w f -> f (w Identity)+  default distribute1 ::+    (Generic1 f, Naperian (Rep1 f), Functor1 w)+    => w f -> f (w Identity)+  distribute1 = distributeIso (from1 :: f a -> Rep1 f a) to1++  -- | @'cotraverse1' f = 'fmap' f . 'distribute1'@+  cotraverse1 :: Functor1 w => (w Identity -> a) -> w f -> f a+  cotraverse1 f = fmap f . distribute1++  -- | @'collect1' f = 'distribute1' . 'map1' f@+  collect1 :: Functor1 w => (forall x. g x -> f x) -> w g -> f (w Identity)+  collect1 f = distribute1 . map1 f++  -- | @'twiddle1' f g = 'fmap' f . 'distribute1' . 'map1' g@+  twiddle1 ::+       Functor1 w => (w Identity -> a) -> (forall x. g x -> f x) -> w g -> f a+  twiddle1 f g = fmap f . distribute1 . map1 g++  -- | @+  -- 'ntabulate' . 'nindex' = 'id'+  -- 'nindex' . 'ntabulate' = 'id'+  -- @+  ntabulate :: ((forall x. f x -> x) -> a) -> f a+  ntabulate f = cotraverse1 (\(TabulateArg g) -> g runIdentity) (TabulateArg f)++newtype TabulateArg a f = TabulateArg ((forall x. f x -> x) -> a)+instance Functor1 (TabulateArg a) where+  map1 f (TabulateArg g) = TabulateArg $ \h -> g (h . f)++-- | Inverse of 'ntabulate'+nindex :: f a -> (forall x. f x -> x) -> a+nindex x f = f x++-- * Default Definitions++-- | Alias for the type of 'distribute1'+type Distribute1 f = forall w. Functor1 w => w f -> f (w Identity)++-- | Derive 'distribute1' given an implementation of 'ntabulate'+distributeTabulate :: Naperian f => Distribute1 f+distributeTabulate w = ntabulate $ \f -> map1 (Identity . f) w++-- | Derive 'distribute1' given an instance of 'Representable'+distributeRepresentable :: Representable f => Distribute1 f+distributeRepresentable w = tabulate $ \f -> map1 (Identity . (`index` f)) w++-- | Derive 'distribute1' via an isomorphism+distributeIso ::+     Naperian g+  => (forall x. f x -> g x)+  -> (forall x. g x -> f x)+  -> Distribute1 f+distributeIso t frm = frm . distribute1 . map1 t++-- | Derive 'distribute1' via a coercion+distributeCoerce ::+     forall g f. Naperian g+  => (forall x. Coercion (g x) (f x))+  -> Distribute1 f+distributeCoerce x = coerceWith x . distribute1 . mapCoerce1 (sym x)++-- | Derive 'fmap' given an implementation of 'cotraverse1'. Note that an+-- implementation of 'distribute1' is /not/ sufficient!+fmapCotraverse1 :: Naperian f => (a -> b) -> f a -> f b+fmapCotraverse1 f = cotraverse1 (f . runIdentity . runApplied) . Applied++data PairOf a b f = PairOf (f a) (f b)+instance Functor1 (PairOf a b) where+  map1 f (PairOf x y) = PairOf (f x) (f y)++zipWithNap :: Naperian f => (a -> b -> c) -> f a -> f b -> f c+zipWithNap f as bs =+  cotraverse1 (\(PairOf (Identity a) (Identity b)) -> f a b) (PairOf as bs)++apNap :: Naperian f => f (a -> b) -> f a -> f b+apNap = zipWithNap ($)++-- Used instead of Const for compatibility with base < 4.9+newtype Const1 a (f :: * -> *) = Const1 { runConst1 :: a }+instance Functor1 (Const1 a) where+  map1 _ (Const1 x) = Const1 x++pureNap :: Naperian f => a -> f a+pureNap = cotraverse1 runConst1 . Const1++data BindArgs a b f = BindArgs (f a) (a -> f b)+instance Functor1 (BindArgs a b) where+  map1 f (BindArgs x g) = BindArgs (f x) (f . g)++bindNap :: Naperian f => f a -> (a -> f b) -> f b+bindNap as f =+  cotraverse1 (\(BindArgs (Identity a) g) -> runIdentity (g a)) (BindArgs as f)++newtype Composed g a f = Composed { runComposed :: g (f a) }+instance Functor g => Functor1 (Composed g a) where+  map1 f = Composed . fmap f . runComposed++distributeNap :: (Naperian f, Functor w) => w (f a) -> f (w a)+distributeNap = cotraverse1 (fmap runIdentity . runComposed) . Composed++collectNap :: (Naperian f, Functor w) => (a -> f b) -> w a -> f (w b)+collectNap f = distributeNap . fmap f++newtype Logarithm f = Logarithm { runLogarithm :: forall x. f x -> x }++tabulateLog :: Naperian f => (Logarithm f -> a) -> f a+tabulateLog f = ntabulate $ \x -> f (Logarithm x)++indexLog :: f a -> Logarithm f -> a+indexLog x (Logarithm f) = f x++-- * Instances++instance Naperian Identity where+  distribute1 = Identity++instance Naperian ((->) e) where+  distribute1 w e = map1 (Identity . ($ e)) w++instance (Naperian f, Naperian g) => Naperian (Product f g) where+  distribute1 =+    Pair <$> collect1 (\(Pair x _) -> x) <*> collect1 (\(Pair _ y) -> y)++newtype AppCompose w g f = AppCompose { runAppCompose :: w (Compose f g) }+instance Functor1 w => Functor1 (AppCompose w g) where+  map1 f = AppCompose . map1 (Compose . f . getCompose) . runAppCompose++instance (Naperian f, Naperian g) => Naperian (Compose f g) where+  distribute1 =+    Compose .+    cotraverse1 (collect1 (runIdentity . getCompose) . runAppCompose) .+    AppCompose++instance Naperian f => Naperian (IdentityT f) where+  distribute1 = distributeCoerce (Coercion :: Coercion (f x) (IdentityT f x))++instance Naperian f => Naperian (ReaderT e f) where+  distribute1 =+    distributeCoerce+      (Coercion :: Coercion (Compose ((->) e) f x) (ReaderT e f x))++instance Naperian w => Naperian (TracedT s w) where+  distribute1 =+    distributeCoerce+      (Coercion :: Coercion (Compose w ((->) s) x) (TracedT s w x))++instance Naperian f => Naperian (Cofree f) where+  distribute1 =+    distributeIso+      (\(x :< xs) -> Pair (Identity x) (Compose xs))+      (\(Pair (Identity x) (Compose xs)) -> x :< xs)++instance Naperian Stream where+  distribute1 =+    distributeIso+      (\(x :> xs) -> Pair (Identity x) xs)+      (\(Pair (Identity x) xs) -> x :> xs)++#if MIN_VERSION_distributive(0,5,1)+-- | since distributive-0.5.1+instance Naperian U1 where+  distribute1 _ = U1++-- | since distributive-0.5.1+instance (Naperian f, Naperian g) => Naperian (f :*: g) where+  distribute1 = distributeIso (\(x :*: y) -> Pair x y) (\(Pair x y) -> x :*: y)++-- | since distributive-0.5.1+instance (Naperian f, Naperian g) => Naperian (f :.: g) where+  distribute1 =+    distributeCoerce (Coercion :: Coercion (Compose f g x) ((:.:) f g x))++-- | since distributive-0.5.1+instance Naperian Par1 where+  distribute1 = distributeCoerce (Coercion :: Coercion (Identity x) (Par1 x))++-- | since distributive-0.5.1+instance Naperian f => Naperian (Rec1 f) where+  distribute1 = distributeCoerce (Coercion :: Coercion (f x) (Rec1 f x))++-- | since distributive-0.5.1+instance Naperian f => Naperian (M1 i c f) where+  distribute1 = distributeCoerce (Coercion :: Coercion (f x) (M1 i c f x))+#endif