comonad-extras 2.1.2 → 3.0
raw patch · 5 files changed
+196/−178 lines, 5 filesdep ~comonaddep ~comonad-transformersdep ~comonads-fdPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: comonad, comonad-transformers, comonads-fd, semigroupoids
API changes (from Hackage documentation)
Files
- Control/Comonad/Store/Pointer.hs +0/−119
- Control/Comonad/Store/Zipper.hs +0/−54
- comonad-extras.cabal +6/−5
- src/Control/Comonad/Store/Pointer.hs +125/−0
- src/Control/Comonad/Store/Zipper.hs +65/−0
− Control/Comonad/Store/Pointer.hs
@@ -1,119 +0,0 @@-{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Control.Comonad.Store.Pointer--- Copyright : (C) 2008-2011 Edward Kmett--- License : BSD-style (see the file LICENSE)------ Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ The array-backed store (state-in-context/costate) comonad transformer is--- subject to the laws:------ > x = seek (pos x) x--- > y = pos (seek y x)--- > seek y x = seek y (seek z x)------ Thanks go to Russell O'Connor and Daniel Peebles for their help--- formulating and proving the laws for this comonad transformer.------ This basic version of this transformer first appeared on Dan Piponi's blog--- at <http://blog.sigfpe.com/2008/03/comonadic-arrays.html>.------ Since this module relies on the non-Haskell 98 'arrays' package, it is--- located here instead of in comonad-transformers.------ NB: attempting to seek or peek out of bounds will yield an error.------------------------------------------------------------------------------module Control.Comonad.Store.Pointer- (- -- * The Pointer comonad- Pointer, pointer, runPointer- -- * The Pointer comonad transformer- , PointerT(..), runPointerT- , pointerBounds- , module Control.Comonad.Store.Class- ) where--import Control.Applicative-import Control.Comonad-import Control.Comonad.Hoist.Class-import Control.Comonad.Trans.Class-import Control.Comonad.Store.Class-import Control.Comonad.Traced.Class-import Control.Comonad.Env.Class-import Data.Functor.Identity-import Data.Array--#ifdef __GLASGOW_HASKELL__-import Data.Typeable-instance (Typeable i, Typeable1 w) => Typeable1 (PointerT i w) where- typeOf1 diwa = mkTyConApp storeTTyCon [typeOf (i diwa), typeOf1 (w diwa)]- where- i :: PointerT i w a -> i- i = undefined- w :: PointerT i w a -> w a- w = undefined--instance (Typeable i, Typeable1 w, Typeable a) => Typeable (PointerT i w a) where- typeOf = typeOfDefault--storeTTyCon :: TyCon-#if __GLASGOW_HASKELL__ < 704-storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT"-#else-storeTTyCon = mkTyCon3 "comonad-extras" "Control.Comonad.Trans.Store.Pointer" "PointerT"-#endif-{-# NOINLINE storeTTyCon #-}-#endif--type Pointer i = PointerT i Identity--pointer :: Array i a -> i -> Pointer i a-pointer f i = PointerT (Identity f) i--runPointer :: Pointer i a -> (Array i a, i)-runPointer (PointerT (Identity f) i) = (f, i)--data PointerT i w a = PointerT (w (Array i a)) i--runPointerT :: PointerT i w a -> (w (Array i a), i)-runPointerT (PointerT g i) = (g, i)--instance (Functor w, Ix i) => Functor (PointerT i w) where- fmap f (PointerT g i) = PointerT (fmap f <$> g) i--instance (Comonad w, Ix i) => Extend (PointerT i w) where- duplicate (PointerT g i) = PointerT (extend p g) i where- p wa = listArray b $ PointerT wa <$> range b where- b = bounds (extract wa)--instance (Comonad w, Ix i) => Comonad (PointerT i w) where- extract (PointerT g i) = extract g ! i--instance Ix i => ComonadTrans (PointerT i) where- lower (PointerT g i) = fmap (! i) g--instance Ix i => ComonadHoist (PointerT i) where- cohoist (PointerT g i) = PointerT (Identity (extract g)) i--instance (Comonad w, Ix i) => ComonadStore i (PointerT i w) where- pos (PointerT _ i) = i- seek i (PointerT g _) = PointerT g i- seeks f (PointerT g i) = PointerT g (f i)- peek i (PointerT g _) = extract g ! i- peeks f (PointerT g i) = extract g ! f i- experiment f (PointerT g i) = fmap (extract g !) (f i)---- | Extract the bounds of the currently focused array-pointerBounds :: (Comonad w, Ix i) => PointerT i w a -> (i,i)-pointerBounds (PointerT g _) = bounds (extract g)--instance (ComonadTraced m w, Ix i) => ComonadTraced m (PointerT i w) where- trace m = trace m . lower--instance (ComonadEnv m w, Ix i) => ComonadEnv m (PointerT i w) where- ask = ask . lower-
− Control/Comonad/Store/Zipper.hs
@@ -1,54 +0,0 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}---module Control.Comonad.Store.Zipper - ( Zipper, zipper, zipper1, unzipper, size) where--import Control.Applicative-import Control.Comonad (Extend(..), Comonad(..))--import Data.Foldable-import Data.Traversable-import Data.Semigroup.Traversable-import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import Control.Comonad.Store (ComonadStore(..))-import Data.Maybe (fromJust)--data Zipper t a = Zipper (forall b. Seq b -> t b) {-# UNPACK #-} !Int !(Seq a) --zipper :: Traversable t => t a -> Maybe (Zipper t a)-zipper t = case toList t of- [] -> Nothing- xs -> Just (Zipper (refill t) 0 (Seq.fromList xs)) - where refill bs as = snd (mapAccumL (\(a:as') _ -> (as', a)) (toList as) bs)--zipper1 :: Traversable1 t => t a -> Zipper t a-zipper1 = fromJust . zipper- -unzipper :: Zipper t a -> t a -unzipper (Zipper t _ s) = t s--size :: Zipper t a -> Int-size (Zipper _ _ s) = Seq.length s--instance ComonadStore Int (Zipper t) where- pos (Zipper _ i _) = i- peek j (Zipper _ _ s) = Seq.index s j- experiment f (Zipper _ i s) = Seq.index s <$> f i--instance Functor (Zipper t) where- fmap f (Zipper t i s) = Zipper t i (fmap f s)--instance Foldable (Zipper t) where- foldMap f (Zipper _ _ s) = foldMap f s--instance Traversable (Zipper t) where - traverse f (Zipper t i s) = Zipper t i <$> traverse f s--instance Extend (Zipper t) where- extend f (Zipper t i s) = Zipper t i (Seq.mapWithIndex (\j _ -> f (Zipper t j s)) s)--instance Comonad (Zipper t) where- extract (Zipper _ i s) = Seq.index s i
comonad-extras.cabal view
@@ -1,6 +1,6 @@ name: comonad-extras category: Control, Comonads-version: 2.1.2+version: 3.0 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -20,6 +20,7 @@ location: git://github.com/ekmett/comonad-extras.git library+ hs-source-dirs: src extensions: CPP other-extensions:@@ -34,11 +35,11 @@ array >= 0.3 && < 0.5, base >= 4 && < 5, containers >= 0.4 && < 0.6,- comonad >= 1.1.1.5 && < 1.2,- comonad-transformers >= 2.1.2 && < 2.2,- comonads-fd >= 2.1.2 && < 2.2,+ comonad >= 3.0 && < 3.1,+ comonad-transformers >= 3.0 && < 3.1,+ comonads-fd >= 3.0 && < 3.1, distributive >= 0.2.2 && < 0.3,- semigroupoids >= 1.3.1.2 && < 1.4,+ semigroupoids >= 3.0 && < 3.1, transformers >= 0.2 && < 0.4 exposed-modules:
+ src/Control/Comonad/Store/Pointer.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Control.Comonad.Store.Pointer+-- Copyright : (C) 2008-2012 Edward Kmett+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- The array-backed store (state-in-context/costate) comonad transformer is+-- subject to the laws:+--+-- > x = seek (pos x) x+-- > y = pos (seek y x)+-- > seek y x = seek y (seek z x)+--+-- Thanks go to Russell O'Connor and Daniel Peebles for their help+-- formulating and proving the laws for this comonad transformer.+--+-- This basic version of this transformer first appeared on Dan Piponi's blog+-- at <http://blog.sigfpe.com/2008/03/comonadic-arrays.html>.+--+-- Since this module relies on the non-Haskell 98 'arrays' package, it is+-- located here instead of in comonad-transformers.+--+-- NB: attempting to seek or peek out of bounds will yield an error.+----------------------------------------------------------------------------+module Control.Comonad.Store.Pointer+ (+ -- * The Pointer comonad+ Pointer, pointer, runPointer+ -- * The Pointer comonad transformer+ , PointerT(..), runPointerT+ , pointerBounds+ , module Control.Comonad.Store.Class+ ) where++import Control.Applicative+import Control.Comonad+import Control.Comonad.Hoist.Class+import Control.Comonad.Trans.Class+import Control.Comonad.Store.Class+import Control.Comonad.Traced.Class+import Control.Comonad.Env.Class+import Data.Functor.Identity+import Data.Functor.Extend+import Data.Array++#ifdef __GLASGOW_HASKELL__+import Data.Typeable+instance (Typeable i, Typeable1 w) => Typeable1 (PointerT i w) where+ typeOf1 diwa = mkTyConApp storeTTyCon [typeOf (i diwa), typeOf1 (w diwa)]+ where+ i :: PointerT i w a -> i+ i = undefined+ w :: PointerT i w a -> w a+ w = undefined++instance (Typeable i, Typeable1 w, Typeable a) => Typeable (PointerT i w a) where+ typeOf = typeOfDefault++storeTTyCon :: TyCon+#if __GLASGOW_HASKELL__ < 704+storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT"+#else+storeTTyCon = mkTyCon3 "comonad-extras" "Control.Comonad.Trans.Store.Pointer" "PointerT"+#endif+{-# NOINLINE storeTTyCon #-}+#endif++type Pointer i = PointerT i Identity++pointer :: Array i a -> i -> Pointer i a+pointer f i = PointerT (Identity f) i++runPointer :: Pointer i a -> (Array i a, i)+runPointer (PointerT (Identity f) i) = (f, i)++data PointerT i w a = PointerT (w (Array i a)) i++runPointerT :: PointerT i w a -> (w (Array i a), i)+runPointerT (PointerT g i) = (g, i)++instance (Functor w, Ix i) => Functor (PointerT i w) where+ fmap f (PointerT g i) = PointerT (fmap f <$> g) i++instance (Comonad w, Ix i) => Extend (PointerT i w) where+ duplicated = duplicate++instance (Comonad w, Ix i) => Comonad (PointerT i w) where+ duplicate (PointerT g i) = PointerT (extend p g) i where+ p wa = listArray b $ PointerT wa <$> range b where+ b = bounds (extract wa)+ extract (PointerT g i) = extract g ! i++instance Ix i => ComonadTrans (PointerT i) where+ lower (PointerT g i) = fmap (! i) g++instance Ix i => ComonadHoist (PointerT i) where+ cohoist (PointerT g i) = PointerT (Identity (extract g)) i++instance (Comonad w, Ix i) => ComonadStore i (PointerT i w) where+ pos (PointerT _ i) = i+ seek i (PointerT g _) = PointerT g i+ seeks f (PointerT g i) = PointerT g (f i)+ peek i (PointerT g _) = extract g ! i+ peeks f (PointerT g i) = extract g ! f i+ experiment f (PointerT g i) = fmap (extract g !) (f i)++-- | Extract the bounds of the currently focused array+pointerBounds :: (Comonad w, Ix i) => PointerT i w a -> (i,i)+pointerBounds (PointerT g _) = bounds (extract g)++instance (ComonadTraced m w, Ix i) => ComonadTraced m (PointerT i w) where+ trace m = trace m . lower++instance (ComonadEnv m w, Ix i) => ComonadEnv m (PointerT i w) where+ ask = ask . lower+
+ src/Control/Comonad/Store/Zipper.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+-----------------------------------------------------------------------------+-- |+-- Module : Control.Comonad.Store.Zipper+-- Copyright : (C) 2008-2012 Edward Kmett,+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : experimental+-- Portability : portable+--+----------------------------------------------------------------------------+module Control.Comonad.Store.Zipper+ ( Zipper, zipper, zipper1, unzipper, size) where++import Control.Applicative+import Control.Comonad (Comonad(..))+import Data.Functor.Extend+import Data.Foldable+import Data.Traversable+import Data.Semigroup.Traversable+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Control.Comonad.Store (ComonadStore(..))+import Data.Maybe (fromJust)++data Zipper t a = Zipper (forall b. Seq b -> t b) {-# UNPACK #-} !Int !(Seq a)++zipper :: Traversable t => t a -> Maybe (Zipper t a)+zipper t = case toList t of+ [] -> Nothing+ xs -> Just (Zipper (refill t) 0 (Seq.fromList xs))+ where refill bs as = snd (mapAccumL (\(a:as') _ -> (as', a)) (toList as) bs)++zipper1 :: Traversable1 t => t a -> Zipper t a+zipper1 = fromJust . zipper++unzipper :: Zipper t a -> t a+unzipper (Zipper t _ s) = t s++size :: Zipper t a -> Int+size (Zipper _ _ s) = Seq.length s++instance ComonadStore Int (Zipper t) where+ pos (Zipper _ i _) = i+ peek j (Zipper _ _ s) = Seq.index s j+ experiment f (Zipper _ i s) = Seq.index s <$> f i++instance Functor (Zipper t) where+ fmap f (Zipper t i s) = Zipper t i (fmap f s)++instance Foldable (Zipper t) where+ foldMap f (Zipper _ _ s) = foldMap f s++instance Traversable (Zipper t) where+ traverse f (Zipper t i s) = Zipper t i <$> traverse f s++instance Extend (Zipper t) where+ extended = extend++instance Comonad (Zipper t) where+ extend f (Zipper t i s) = Zipper t i (Seq.mapWithIndex (\j _ -> f (Zipper t j s)) s)+ extract (Zipper _ i s) = Seq.index s i