comonad-extras (empty) → 0.1

raw patch · 5 files changed

+242/−0 lines, 5 filesdep +arraydep +basedep +comonadsetup-changed

Dependencies added: array, base, comonad, comonad-transformers, comonads-fd, containers, distributive, semigroupoids, semigroups, transformers

Files

Control/Comonad/Store/Pointer.hs +105/−0
Control/Comonad/Store/Zipper.hs +53/−0
LICENSE +30/−0
Setup.lhs +7/−0
comonad-extras.cabal +47/−0

+ Control/Comonad/Store/Pointer.hs view

@@ -0,0 +1,105 @@+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}+-----------------------------------------------------------------------------+-- |+-- 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 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+storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT"+{-# 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++-- | 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)

+ Control/Comonad/Store/Zipper.hs view

@@ -0,0 +1,53 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses #-}+++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.Functor.Apply+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++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

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright 2011 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.

+ Setup.lhs view

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

+ comonad-extras.cabal view

@@ -0,0 +1,47 @@+name:          comonad-extras+category:      Control, Comonads+version:       0.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     experimental+homepage:      git://github.com/ekmett/comonad-extras/+copyright:     Copyright (C) 2011 Edward A. Kmett+synopsis:      Comonad transformers requiring extensions to Haskell 98+description:   Comonads and comonad transformers that require extensions to Haskell 98+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/comonad-extras.git++flag DeriveDataTypeable+  manual: False+  default: True++library+  build-depends: +    array >= 0.3.0.2 && < 0.4,+    base >= 4 && < 4.4,+    containers >= 0.4 && < 0.5,+    comonad >= 1.0.1 && < 1.1,+    comonad-transformers >= 1.5.0.1 && < 1.6,+    comonads-fd >= 1.5.0.1 && < 1.6,+    distributive >= 0.1 && < 0.2,+    semigroupoids >= 1.0 && < 1.2,+    semigroups >= 0.3.4 && < 0.4,+    transformers >= 0.2.0 && <= 0.3++  if flag(DeriveDataTypeable)+    extensions: DeriveDataTypeable+    cpp-options: -DLANGUAGE_DeriveDataTypeable++  extensions: CPP++  exposed-modules:+    Control.Comonad.Store.Zipper+    Control.Comonad.Store.Pointer++  ghc-options:      -Wall