packages feed

free-functors (empty) → 0

raw patch · 8 files changed

+415/−0 lines, 8 filesdep +basedep +comonaddep +constraintssetup-changed

Dependencies added: base, comonad, constraints, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Sjoerd Visscher++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 Sjoerd Visscher 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Automaton.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE+    MultiParamTypeClasses+  , FlexibleInstances+  #-}+module Automaton where++import Data.Functor.Cofree++import Control.Comonad+import Data.Functor.Identity+import Data.Functor.Compose+++class Action i s where+  act :: i -> s -> s++type Automaton i = Cofree (Action i)+++instance Action i (Automaton i o) where+  act i (Cofree k s) = Cofree k (act i s)++instance Action i (Identity a) where+  act _ = id++instance Action i (Compose (Automaton i) (Automaton i) o) where+  act i = Compose . fmap (act i) . act i . getCompose+++data ActionD i s = ActionD (i -> s -> s) s+instance Action i (ActionD i s) where+  act i (ActionD f s) = ActionD f (f i s)++unfoldAutomaton :: (i -> s -> s) -> (s -> o) -> s -> Automaton i o+unfoldAutomaton fi fo = Cofree (\(ActionD _ s) -> fo s) . ActionD fi+++type Stream = Automaton ()++unfoldStream :: (s -> (a, s)) -> s -> Stream a+unfoldStream f = unfoldAutomaton (const (snd . f)) (fst . f)++headS :: Stream a -> a+headS = extract++tailS :: Stream a -> Stream a+tailS = act ()++fromStream :: Stream a -> [a]+fromStream = map headS . iterate tailS
+ examples/NonEmptyList.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE+    MultiParamTypeClasses+  , FlexibleInstances+  #-}+module NonEmptyList where++import Data.Functor.Free++import Data.Semigroup++import Control.Applicative+import Control.Comonad+import Data.Functor.Identity+import Data.Functor.Compose+++-- This declaration creates a Functor that is also Applicative.+type NonEmptyList = Free Semigroup++-- This instance makes NonEmptyList a Monad.+instance Semigroup (NonEmptyList a) where+  Free fa <> Free fb = Free $ liftA2 (<>) fa fb++-- This instance makes NonEmptyList Foldable and Traversable.+instance Applicative f => Semigroup (LiftAFree Semigroup f a) where+  LiftAFree fa <> LiftAFree fb = LiftAFree $ liftA2 (<>) fa fb++-- The next two instances make NonEmptyList a Comonad.+instance Semigroup (Identity a) where+  a <> _ = a++instance Semigroup (Compose NonEmptyList NonEmptyList a) where+  Compose l <> Compose r = Compose $ ((<> extract r) <$> l) <> r++  +  +fromList :: [a] -> NonEmptyList a+fromList = foldr1 (<>) . map return++toList :: NonEmptyList a -> [a]+toList = convert+++-- Test the comonad instance, returns [10,9,7,4].+test :: [Int]+test = toList $ extend (sum . toList) $ (pure 1 <> pure 2) <> (pure 3 <> pure 4)
+ free-functors.cabal view
@@ -0,0 +1,49 @@+name:                free-functors+version:             0+synopsis:            Provides free functors that are adjoint to functors that forget class constraints. +description:         A free functor is a left adjoint to a forgetful functor. It used to be the case+                     that the only category that was easy to work with in Haskell was Hask itself, so+                     there were no interesting forgetful functors.+                     .+                     But the new ConstraintKinds feature of GHC provides an easy way of creating+                     subclasses of Hask. That brings interesting opportunities for free (and cofree) functors.+                     .+                     The examples directory contains an implementation of non-empty lists as free semigroups,+                     and automata as free actions. The standard example of free higher order functors is free monads,+                     and this definition can be found in Data.Functor.HFree.+category:            Data, Math+license:             BSD3+license-file:        LICENSE+author:              Sjoerd Visscher+maintainer:          sjoerd@w3future.com+stability:           experimental+homepage:            http://github.com/sjoerdvisscher/free-functors+bug-reports:         http://github.com/sjoerdvisscher/free-functors/issues++build-type:          Simple+cabal-version:       >= 1.10++extra-source-files:+  examples/*.hs++Library+  HS-Source-Dirs:    +    src+  +  exposed-modules:   +    Data.Functor.Cofree,+    Data.Functor.Free,+    Data.Functor.HFree++  default-language:  +    Haskell2010++  build-depends:+    base >= 4.4 && < 5,+    constraints >= 0.3.2 && < 0.4,+    transformers >= 0.2.0.0 && < 0.4,+    comonad >= 3.0 && < 3.1++source-repository head+  type:     git+  location: git://github.com/sjoerdvisscher/free-functors.git
+ src/Data/Functor/Cofree.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE+    ConstraintKinds+  , RankNTypes+  , TypeOperators  +  , FlexibleInstances+  , GADTs+  , MultiParamTypeClasses+  , UndecidableInstances+  , ScopedTypeVariables+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Cofree+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- A cofree functor is right adjoint to a forgetful functor.+-- In this package the forgetful functor forgets class constraints.+-----------------------------------------------------------------------------+module Data.Functor.Cofree where+  +import Control.Monad+import Control.Comonad+import Control.Applicative++import Data.Constraint+import Data.Constraint.Forall++import Data.Functor.Identity+import Data.Functor.Compose+++-- | The cofree functor for constraint @c@.+data Cofree c b where+  Cofree :: c a => (a -> b) -> a -> Cofree c b++leftAdjunct :: c a => (a -> b) -> a -> Cofree c b+leftAdjunct f a = Cofree f a++rightAdjunct :: (a -> Cofree c b) -> a -> b+rightAdjunct f a = case f a of Cofree k a' -> k a'++leftAdjunct' :: ForallF c f => (f a -> b) -> f a -> Cofree c b+leftAdjunct' = h instF leftAdjunct+  where+    h :: ForallF c f+      => (ForallF c f :- c (f a))+      -> (c (f a) => (f a -> b) -> f a -> Cofree c b)+      -> (f a -> b) -> f a -> Cofree c b+    h (Sub Dict) f = f++instance Functor (Cofree c) where+  fmap f (Cofree k a) = Cofree (f . k) a++instance ForallF c (Cofree c) => Comonad (Cofree c) where+  extract = rightAdjunct id+  extend = leftAdjunct'++instance (ForallF c Identity, ForallF c (Cofree c), ForallF c (Compose (Cofree c) (Cofree c)))+  => Applicative (Cofree c) where+  pure = leftAdjunct' runIdentity . Identity+  (<*>) = ap++instance (ForallF c Identity, ForallF c (Cofree c), ForallF c (Compose (Cofree c) (Cofree c)))+  => Monad (Cofree c) where+  return = pure+  m >>= g = leftAdjunct' (extract . extract . getCompose) (Compose $ fmap g m)++convert :: (c (w a), Comonad w) => w a -> Cofree c a+convert wa = Cofree extract wa
+ src/Data/Functor/Free.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE+    ConstraintKinds+  , RankNTypes+  , TypeOperators  +  , FlexibleInstances+  , MultiParamTypeClasses+  , UndecidableInstances+  , ScopedTypeVariables+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Free+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- A free functor is left adjoint to a forgetful functor.+-- In this package the forgetful functor forgets class constraints.+-----------------------------------------------------------------------------+module Data.Functor.Free where+  +import Control.Applicative+import Control.Monad+import Control.Comonad++import Data.Constraint+import Data.Constraint.Forall++import Data.Functor.Identity+import Data.Functor.Compose+import Data.Foldable+import Data.Traversable+++-- | The free functor for constraint @c@.+newtype Free c a = Free { runFree :: forall b. c b => (a -> b) -> b }++leftAdjunct :: (Free c a -> b) -> a -> b+leftAdjunct f a = f (Free ($ a))++rightAdjunct :: c b => (a -> b) -> Free c a -> b+rightAdjunct f g = runFree g f++rightAdjunct' :: ForallF c f => (a -> f b) -> Free c a -> f b+rightAdjunct' = h instF rightAdjunct+  where+    h :: ForallF c f+      => (ForallF c f :- c (f b))+      -> (c (f b) => (a -> f b) -> Free c a -> f b)+      -> (a -> f b) -> Free c a -> f b+    h (Sub Dict) f = f++rightAdjunct'' :: ForallT c t => (a -> t f b) -> Free c a -> t f b+rightAdjunct'' = h instT rightAdjunct+  where+    h :: ForallT c t+      => (ForallT c t :- c (t f b))+      -> (c (t f b) => (a -> t f b) -> Free c a -> t f b)+      -> (a -> t f b) -> Free c a -> t f b+    h (Sub Dict) f = f++instance Functor (Free c) where+  fmap f (Free g) = Free (g . (. f))++instance Applicative (Free c) where+  pure = leftAdjunct id+  fs <*> as = Free $ \k -> runFree fs (\f -> runFree as (k . f))++instance ForallF c (Free c) => Monad (Free c) where+  return = pure+  (>>=) = flip rightAdjunct'++instance (ForallF c Identity, ForallF c (Free c), ForallF c (Compose (Free c) (Free c)))+  => Comonad (Free c) where+  extract = runIdentity . rightAdjunct' Identity+  extend g = fmap g . getCompose . rightAdjunct' (Compose . return . return)++newtype LiftAFree c f a = LiftAFree { getLiftAFree :: f (Free c a) }++instance ForallT c (LiftAFree c) => Foldable (Free c) where+  foldMap = foldMapDefault++instance ForallT c (LiftAFree c) => Traversable (Free c) where+  traverse f = getLiftAFree . rightAdjunct'' (LiftAFree . fmap pure . f)++convert :: (c (f a), Applicative f) => Free c a -> f a+convert = rightAdjunct pure+
+ src/Data/Functor/HFree.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE+    ConstraintKinds+  , RankNTypes+  , TypeOperators+  , FlexibleInstances+  , GADTs+  , MultiParamTypeClasses+  , UndecidableInstances+  , ScopedTypeVariables+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.HFree+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- A free functor is left adjoint to a forgetful functor.+-- In this package the forgetful functor forgets class constraints.+--+-- Compared to @Data.Functor.Free@ we're going up a level.+-- These free functors go between categories of functors and the natural+-- transformations between them.+-----------------------------------------------------------------------------+module Data.Functor.HFree where+  +import Control.Monad+import Control.Applicative+import Control.Monad.Trans.Class+++-- | Natural transformations.+type f :~> g = forall b. f b -> g b++-- | The higher order free functor for constraint @c@.+newtype HFree c f a = HFree { runHFree :: forall g. (c g, Functor g) => (f :~> g) -> g a }++leftAdjunct :: (HFree c f :~> g) -> f :~> g+leftAdjunct f fa = f (HFree $ \k -> k fa)++rightAdjunct :: (c g, Functor g) => (f :~> g) -> HFree c f :~> g+rightAdjunct f h = runHFree h f++instance Functor (HFree c f) where+  fmap f (HFree g) = HFree (fmap f . g)++hfmap :: (f :~> g) -> HFree c f :~> HFree c g+hfmap f (HFree g) = HFree $ \k -> g (k . f)++liftFree :: f a -> HFree c f a+liftFree = leftAdjunct id++lowerFree :: (c f, Functor f) => HFree c f a -> f a+lowerFree = rightAdjunct id++convert :: (c (t f), Functor (t f), Monad f, MonadTrans t) => HFree c f a -> t f a+convert = rightAdjunct lift++-- | The free monad of a functor.+instance Monad (HFree Monad f) where+  return a = HFree $ const (return a)+  HFree f >>= g = HFree $ \k -> f k >>= (\a -> runHFree (g a) k)++instance Applicative (HFree Applicative f) where+  pure a = HFree $ const (pure a)+  HFree f <*> HFree g = HFree $ \k -> f k <*> g k++instance Applicative (HFree Alternative f) where+  pure a = HFree $ const (pure a)+  HFree f <*> HFree g = HFree $ \k -> f k <*> g k+instance Alternative (HFree Alternative f) where+  empty = HFree $ const empty+  HFree f <|> HFree g = HFree $ \k -> f k <|> g k