ZipFold 0.1 → 0.1.4

raw patch · 4 files changed

+182/−43 lines, 4 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ZipFold.cabal +4/−5
• src/Data/WithCont.hs +87/−0
• src/Data/Zip/FoldL.hs +38/−38
• src/Data/Zip/FoldR.hs +53/−0

@@ -1,5 +1,5 @@ Name:                ZipFold-Version:             0.1+Version:             0.1.4 Cabal-Version:       >= 1.2 Synopsis:            Zipping folds Category:            Data@@ -10,9 +10,6 @@   .   Project wiki page: <http://haskell.org/haskellwiki/ZipFold>   .-  The module documentation pages have links to colorized source code and-  to wiki pages where you can read and contribute user comments.  Enjoy!-  .   &#169; 2008 by Conal Elliott; BSD3 license. Author:              Conal Elliott  Maintainer:          conal@conal.net@@ -26,9 +23,11 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base, TypeCompose >= 0.5.2+  Build-Depends:       base < 5, TypeCompose >= 0.5.2   Exposed-Modules:     +                       Data.WithCont                        Data.Zip.FoldL+                       Data.Zip.FoldR                           ghc-options:         -Wall 

@@ -0,0 +1,87 @@+{-# LANGUAGE ExistentialQuantification, FlexibleContexts #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.WithCont+-- Copyright   :  (c) Conal Elliott 2009+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Add continuation+----------------------------------------------------------------------++module Data.WithCont (WithCont(..)) where+++import Prelude hiding (zip)++import Control.Arrow+import Control.Applicative++import Data.Zip++++-- | Add a continuation.+data WithCont z c = forall a. WC (z a) (a -> c)++-- TODO: generalize the continuation to an arbitrary arrow.++instance Functor (WithCont z) where+  fmap g (WC f k) = WC f (arr k >>> g)++instance Zip z => Zip (WithCont z) where+  WC fa ka `zip` WC fb kb =+    WC (fa `zip` fb) (ka *** kb)++-- TODO: merge unit into Zip++--- Another interface:++class (Functor f, Zip f) => Monoidal f where+  unit :: f ()++instance Monoidal ((->) a) where unit = const ()++instance Zip z => Monoidal (WithCont z) where+  unit = WC (error "unneeded pre-cont") unit+++-- Standard Applicative instance for |Monoidal|+instance Zip z => Applicative (WithCont z) where+  pure a    = fmap (const a) unit+  wf <*> wx = app <$> (wf `zip` wx)+++--------------------+++--   A lazy (~) pattern cannot bind existential type variables+--+-- instance Functor (WithCont z) where+--   fmap g ~(WC f k) = WC f (fmap g k)++--   My brain just exploded.+--   I can't handle pattern bindings for existentially-quantified constructors.+--   Instead, use a case-expression, or do-notation, to unpack the constructor.++-- instance Zip (z) => Applicative (WithCont z) where+--   pure a = WC (error "unneeded pre-cont") (pure a)+--   WC hf hk <*> WC xf xk =+--     WC (hf `zip` xf) (\ (a,a') -> (hk a) (xk a'))++-- instance Functor (WithCont z) where+--   fmap g = \ (WC f k) -> WC f (fmap g k)+++-- instance Zip (z) => Applicative (WithCont z) where+--   pure a = WC (error "unneeded pre-cont") (pure a)+--   ~(WC hf hk) <*> ~(WC xf xk) =+--     WC (hf `zip` xf) (\ (a,a') -> (hk a) (xk a'))++-- instance Zip (z) => Applicative (WithCont z) where+--   pure a = WC (error "unneeded pre-cont") (pure a)+--   (<*>) = \ (WC hf hk) (WC xf xk) ->+--     WC (hf `zip` xf) (\ (a,a') -> (hk a) (xk a'))

@@ -11,15 +11,15 @@ --  -- Zipping of non-strict left folds. -- --- See <http://conal.net/blog/tag/zip>.  Inspired by "Beautiful Folds" by+-- See <http://conal.net/blog/tag/zip>.  Inspired by "Beautiful FoldLs" by -- Max Rabkin <http://squing.blogspot.com/2008/11/beautiful-folding.html> ----------------------------------------------------------------------  module Data.Zip.FoldL-  ( Fold(..), cfoldl, cfoldl'-  , WithCont , FoldC , cfoldlc-  , WithCont', FoldC', cfoldlc'-  , Zip'(..), P+  ( FoldL(..), cfoldl, cfoldl', unitL+  , WithCont , FoldLC , cfoldlc+  , WithCont', FoldLC', cfoldlc'+  , Zip'(..), P(..)   ) where  import Prelude hiding (zip)@@ -30,71 +30,71 @@  import Data.Zip +import Data.WithCont++-- foldl :: (a -> b -> a) -> a -> [b] -> a+ -- | Data representation of a left fold-data Fold b a = F (a -> b -> a) a+data FoldL b a = F (a -> b -> a) a --- | Interpretation of a 'Fold' as non-strict-cfoldl :: Fold b a -> [b] -> a-cfoldl (F op e) = foldl op e+-- TODO: merge unit into Zip. +unitL :: FoldL b ()+unitL = F const ()+++-- | Interpretation of a 'FoldL' as non-strict+cfoldl :: FoldL b a -> [b] -> a+cfoldl ~(F op e) = foldl op e+ -- Non-strict left-fold zipping-zipF :: Fold b a -> Fold b a' -> Fold b (a,a')-F op e `zipF` F op' e' = F op'' (e,e')+zipF :: FoldL b a -> FoldL b a' -> FoldL b (a,a')+~(F op e) `zipF` ~(F op' e') = F op'' (e,e')  where-   (a,a') `op''` b = (a `op` b, a' `op'` b)+   ~(a,a') `op''` b = (a `op` b, a' `op'` b) -instance Zip (Fold b) where zip = zipF+instance Zip (FoldL b) where zip = zipF --- | Interpretation of a 'Fold' as non-strict-cfoldl' :: Fold b a -> [b] -> a+-- | Interpretation of a 'FoldL' as non-strict+cfoldl' :: FoldL b a -> [b] -> a cfoldl' (F op e) = foldl' op e  -- Strict left-fold zipping-zipF' :: Fold b a -> Fold b a' -> Fold b (P a a')-F op e `zipF'` F op' e' = F op'' (P e e')+zipF' :: FoldL b a -> FoldL b a' -> FoldL b (P a a')+~(F op e) `zipF'` ~(F op' e') = F op'' (P e e')  where    P a a' `op''` b = P (a `op` b) (a' `op'` b)  -instance Zip' (Fold b) where zip' = zipF'+instance Zip' (FoldL b) where zip' = zipF'  --- | Add a continuation.-data WithCont h b c = forall a. WC (h b a) (a -> c)--instance Functor (WithCont h b) where-  fmap g (WC f k) = WC f (fmap g k)--instance Zip (h b) => Applicative (WithCont h b) where-  pure a = WC (error "unneeded pre-cont") (pure a)-  WC hf hk <*> WC xf xk =-    WC (hf `zip` xf) (\ (a,a') -> (hk a) (xk a'))- -- | Non-strict left fold with continuation.-type FoldC = WithCont Fold+type FoldLC b = WithCont (FoldL b) --- | Interpretation of a 'FoldC'-cfoldlc :: FoldC b a -> [b] -> a+-- | Interpretation of a 'FoldLC'+cfoldlc :: FoldLC b a -> [b] -> a cfoldlc (WC f k) = fmap k (cfoldl f)    -- | Like 'WithCont' but with pair-strict '(<*>)'-data WithCont' h b c = forall a. WC' (h b a) (a -> c)+data WithCont' z c = forall a. WC' (z a) (a -> c) -instance Functor (WithCont' h b) where+instance Functor (WithCont' z) where   fmap g (WC' f k) = WC' f (fmap g k) -instance Zip' (h b) => Applicative (WithCont' h b) where++instance Zip' z => Applicative (WithCont' z) where   pure a = WC' (error "unneeded pre-cont") (pure a)   WC' hf hk <*> WC' xf xk =     WC' (hf `zip'` xf) (\ (P a a') -> (hk a) (xk a'))  -- | Strict left fold with continuation.-type FoldC' = WithCont' Fold+type FoldLC' b = WithCont' (FoldL b) --- | Interpretation of a 'FoldC'-cfoldlc' :: FoldC' b a -> [b] -> a+-- | Interpretation of a 'FoldLC'+cfoldlc' :: FoldLC' b a -> [b] -> a cfoldlc' (WC' f k) = fmap k (cfoldl' f)  

@@ -0,0 +1,53 @@+{-# LANGUAGE ExistentialQuantification, FlexibleContexts #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Zip.FoldR+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Zipping of non-strict right folds.+-- +-- See <http://conal.net/blog/tag/zip>.  Inspired by "Beautiful Folds" by+-- Max Rabkin <http://squing.blogspot.com/2008/11/beautiful-folding.html>+----------------------------------------------------------------------++module Data.Zip.FoldR+  ( FoldR(..), cfoldr+  , WithCont, FoldRC, cfoldrc+  ) where++import Prelude hiding (zip)++-- From TypeCompose+import Data.Zip++import Data.WithCont++-- foldr :: (b -> a -> a) -> a -> [b] -> a++-- | Data representation of a right fold+data FoldR b a = F (b -> a -> a) a++-- | Interpretation of a 'FoldR' as non-strict+cfoldr :: FoldR b a -> [b] -> a+cfoldr ~(F op e) = foldr op e++-- Non-strict right-fold zipping+zipF :: FoldR b a -> FoldR b a' -> FoldR b (a,a')+~(F op e) `zipF` ~(F op' e') = F op'' (e,e')+ where+   b `op''` ~(a,a') = (b `op` a, b `op'` a')++instance Zip (FoldR b) where zip = zipF+++-- | Non-strict right fold with continuation.+type FoldRC b = WithCont (FoldR b)++-- | Interpretation of a 'FoldRC'+cfoldrc :: FoldRC b a -> [b] -> a+cfoldrc (WC f k) = fmap k (cfoldr f)