packages feed

free (empty) → 0.1.0

raw patch · 5 files changed

+318/−0 lines, 5 filesdep +basedep +comonaddep +distributivesetup-changed

Dependencies added: base, comonad, distributive, semigroupoids, semigroups, transformers

Files

+ Control/Comonad/Cofree.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Cofree+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Haskell 98 cofree comonads+--+----------------------------------------------------------------------------+module Control.Comonad.Cofree+  ( Cofree(..)+  , outCofree+  , coiter+  , unfold+  ) where++import Control.Applicative+import Control.Comonad+import Data.Functor.Bind+import Data.Distributive+import Data.Foldable+import Data.Semigroup+import Data.Monoid+import Data.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable++#ifdef GHC_TYPEABLE+import Data.Data+#endif++infixr 5 :<++data Cofree f a = a :< f (Cofree f a)++outCofree :: Cofree f a -> f (Cofree f a)+outCofree (_ :< as) = as++coiter :: Functor f => (a -> f a) -> a -> Cofree f a+coiter psi a = a :< (coiter psi <$> psi a)++unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a+unfold f c = case f c of +  (x, d) -> x :< fmap (unfold f) d++instance Distributive f => Distributive (Cofree f) where+  distribute w = fmap extract w :< fmap distribute (distribute (fmap outCofree w))++instance Functor f => Functor (Cofree f) where+  fmap f (a :< as) = f a :< fmap (fmap f) as+  b <$ (_ :< as) = b :< fmap (b <$) as++instance Functor f => Extend (Cofree f) where+  extend f w = f w :< fmap (extend f) (outCofree w)+  duplicate w = w :< fmap duplicate (outCofree w)++instance Functor f => Comonad (Cofree f) where+  extract (a :< _) = a++instance Apply f => Apply (Cofree f) where+  (f :< fs) <.> (a :< as) = f a :< ((<.>) <$> fs <.> as)+  (f :< fs) <.  (_ :< as) = f :< ((<. ) <$> fs <.> as)+  (_ :< fs)  .> (a :< as) = a :< (( .>) <$> fs <.> as)++instance Applicative f => Applicative (Cofree f) where+  pure a = as where as = a :< pure as+  (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as)+  (f :< fs) <*  (_ :< as) = f :< ((<* ) <$> fs <*> as)+  (_ :< fs)  *> (a :< as) = a :< (( *>) <$> fs <*> as)++instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a) where+  showsPrec d (a :< as) = showParen (d > 5) $ +    showsPrec 6 a . showString " :< " . showsPrec 5 as++instance (Read (f (Cofree f a)), Read a) => Read (Cofree f a) where+  readsPrec d r = readParen (d > 5)+                          (\r' -> [(u :< v,w) |+                                  (u, s) <- readsPrec 6 r',+                                  (":<", t) <- lex s,+                                  (v, w) <- readsPrec 5 t]) r++instance (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where+  a :< as == b :< bs = a == b && as == bs++instance (Ord (f (Cofree f a)), Ord a) => Ord (Cofree f a) where+  compare (a :< as) (b :< bs) = case compare a b of+    LT -> LT+    EQ -> compare as bs+    GT -> GT++instance Foldable f => Foldable (Cofree f) where+  foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as++instance Foldable1 f => Foldable1 (Cofree f) where+  foldMap1 f (a :< as) = f a <> foldMap1 (foldMap1 f) as++instance Traversable f => Traversable (Cofree f) where+  traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as++instance Traversable1 f => Traversable1 (Cofree f) where+  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 (traverse1 f) as+++#ifdef GHC_TYPEABLE++instance (Typeable1 f) => Typeable1 (Cofree f) where+  typeOf1 dfa = mkTyConApp cofreeTyCon [typeOf1 (f dfa)]+    where+      f :: Cofree f a -> f a+      f = undefined++instance (Typeable1 f, Typeable a) => Typeable (Cofree f a) where+  typeOf = typeOfDefault++cofreeTyCon :: TyCon+cofreeTyCon = mkTyCon "Control.Comonad.Cofree.Cofree"+{-# NOINLINE cofreeTyCon #-}++instance+  ( Typeable1 f+  , Data (f (Cofree f a))+  , Data a+  ) => Data (Cofree f a) where+    gfoldl f z (a :< as) = z (:<) `f` a `f` as+    toConstr _ = cofreeConstr+    gunfold k z c = case constrIndex c of+        1 -> k (k (z (:<)))+        _ -> error "gunfold"+    dataTypeOf _ = cofreeDataType+    dataCast1 f = gcast1 f++cofreeConstr :: Constr+cofreeConstr = mkConstr cofreeDataType ":<" [] Infix+{-# NOINLINE cofreeConstr #-}++cofreeDataType :: DataType+cofreeDataType = mkDataType "Control.Comonad.Cofree.Cofree" [cofreeConstr]+{-# NOINLINE cofreeDataType #-}++#endif
+ Control/Monad/Free.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Free+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Haskell 98 free monads+--+----------------------------------------------------------------------------+module Control.Monad.Free+  ( Free(..)+  , iter+  ) where++import Control.Applicative+import Data.Functor.Bind+import Data.Foldable+import Data.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable++data Free f a = Pure a | Free (f (Free f a))++iter :: Functor f => (f a -> a) -> Free f a -> a+iter _ (Pure a) = a+iter phi (Free m) = phi (iter phi <$> m)++instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where+  Pure a == Pure b = a == b+  Free fa == Free fb = fa == fb+  _ == _ = False++instance (Ord (f (Free f a)), Ord a) => Ord (Free f a) where+  Pure a `compare` Pure b = a `compare` b+  Pure _ `compare` Free _ = LT+  Free _ `compare` Pure _ = GT+  Free fa `compare` Free fb = fa `compare` fb++instance (Show (f (Free f a)), Show a) => Show (Free f a) where+  showsPrec d (Pure a) = showParen (d > 10) $+    showString "Pure " . showsPrec 11 a+  showsPrec d (Free m) = showParen (d > 10) $+    showString "Free " . showsPrec 11 m++instance (Read (f (Free f a)), Read a) => Read (Free f a) where+  readsPrec d r = readParen (d > 10)+      (\r' -> [ (Pure m, t) +             | ("Pure", s) <- lex r'+             , (m, t) <- readsPrec 11 s]) r+    ++ readParen (d > 10)+      (\r' -> [ (Free m, t)+             | ("Free", s) <- lex r'+             , (m, t) <- readsPrec 11 s]) r++instance Functor f => Functor (Free f) where+  fmap f (Pure a)  = Pure (f a)+  fmap f (Free fa) = Free (fmap f <$> fa)++instance Functor f => Apply (Free f) where+  Pure a  <.> Pure b = Pure (a b)+  Pure a  <.> Free fb = Free $ fmap a <$> fb+  Free fa <.> b = Free $ (<.> b) <$> fa+  +instance Functor f => Applicative (Free f) where+  pure = Pure+  Pure a <*> Pure b = Pure $ a b+  Pure a <*> Free mb = Free $ fmap a <$> mb+  Free ma <*> b = Free $ (<*> b) <$> ma++instance Functor f => Bind (Free f) where+  Pure a >>- f = f a+  Free m >>- f = Free ((>>- f) <$> m)+  +instance Functor f => Monad (Free f) where+  return = Pure+  Pure a >>= f = f a+  Free m >>= f = Free ((>>= f) <$> m)++instance Foldable f => Foldable (Free f) where+  foldMap f (Pure a) = f a+  foldMap f (Free fa) = foldMap (foldMap f) fa++instance Foldable1 f => Foldable1 (Free f) where+  foldMap1 f (Pure a) = f a+  foldMap1 f (Free fa) = foldMap1 (foldMap1 f) fa++instance Traversable f => Traversable (Free f) where+  traverse f (Pure a) = Pure <$> f a +  traverse f (Free fa) = Free <$> traverse (traverse f) fa++instance Traversable1 f => Traversable1 (Free f) where+  traverse1 f (Pure a) = Pure <$> f a+  traverse1 f (Free fa) = Free <$> traverse1 (traverse1 f) fa
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2008-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
+ free.cabal view
@@ -0,0 +1,38 @@+name:          free+category:      Control, Monads+version:       0.1.0+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      git://github.com/ekmett/free/+copyright:     Copyright (C) 2008-2011 Edward A. Kmett+synopsis:      Haskell 98 monads for free+description:   Haskell 98 monads for free+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/free.git++library+  build-depends: +    base >= 4 && < 4.4,+    distributive >= 0.1 && < 0.2,+    transformers >= 0.2.0 && <= 0.3,+    semigroupoids >= 1.1.1 && <= 1.2,+    comonad >= 1.0.1 && < 1.1,+    semigroups >= 0.3.4 && < 0.4++  if impl(ghc)+    cpp-options: -DGHC_TYPEABLE++  extensions: CPP++  exposed-modules:+    Control.Monad.Free+    Control.Comonad.Cofree++  ghc-options:      -Wall