DeepArrow 0.0 → 0.0.1
raw patch · 10 files changed
+536/−534 lines, 10 filessetup-changed
Files
- CHANGES +2/−0
- DeepArrow.cabal +49/−49
- Makefile +12/−12
- README +14/−14
- Setup.lhs +2/−2
- TODO +0/−0
- src/Control/Arrow/DeepArrow.hs +247/−247
- src/Control/Arrow/DeepArrow/Examples.hs +91/−91
- src/Data/FunArr.hs +53/−53
- src/Data/Tupler.hs +66/−66
+ CHANGES view
@@ -0,0 +1,2 @@+Version 0.1.1:+* Changed all files to *nix-style line endings.
DeepArrow.cabal view
@@ -1,49 +1,49 @@-Name: DeepArrow -Version: 0.0 -Synopsis: Arrows for "deep application" -Category: Composition -Description: - This library provides a framework for type-directed composition of value - editors (non-syntactic transformations). The tools enable \"deep function - application\" in two senses: deep application of functions and - application of deep functions. These tools generalize beyond values and - functions, via the @DeepArrow@ subclass of the @Arrow@ type class. - . - For more information see: - . - * The project wiki page <http://haskell.org/haskellwiki/DeepArrow> - . - * Application of deep arrows for composable interfaces in the TV library: - <http://haskell.org/haskellwiki/TV> - . - * The motivating idea and paper "Functional Programming by Interacting - with Tangible Values": <http://conal.net/papers/Eros> - . - This page and the module documentation pages have links to colorized - source code and to wiki pages where you can read and contribute /user - comments/. Enjoy! - . - The primary module is "Control.Arrow.DeepArrow". Examples in - "Control.Arrow.DeepArrow.Examples". - . - /Note/: Many of the type signatures use infix type operators (as in - @a~>b@), a recent extension to GHC. In reading the documentation and - code, be aware that infix operators bind more tightly than @->@. - . - © 2007 by Conal Elliott (<http://conal.net>); BSD3 license. -Author: Conal Elliott <conal@conal.net> -Maintainer: conal@conal.net -Homepage: http://haskell.org/haskellwiki/DeepArrow -Package-Url: http://darcs.haskell.org/packages/DeepArrow -License: BSD3 -Stability: experimental -Copyright: (c) 2007 by Conal Elliott -Hs-Source-Dirs: src -Build-Depends: base, mtl -Extensions: CPP, UndecidableInstances -Exposed-Modules: - Control.Arrow.DeepArrow - Data.Tupler - Data.FunArr - Control.Arrow.DeepArrow.Examples -ghc-options: -O -Wall +Name: DeepArrow+Version: 0.0.1+Synopsis: Arrows for "deep application"+Category: Composition+Description:+ This library provides a framework for type-directed composition of value+ editors (non-syntactic transformations). The tools enable \"deep function+ application\" in two senses: deep application of functions and+ application of deep functions. These tools generalize beyond values and+ functions, via the @DeepArrow@ subclass of the @Arrow@ type class.+ .+ For more information see:+ .+ * The project wiki page <http://haskell.org/haskellwiki/DeepArrow>+ .+ * Application of deep arrows for composable interfaces in the TV library:+ <http://haskell.org/haskellwiki/TV>+ .+ * The motivating idea and paper "Functional Programming by Interacting+ with Tangible Values": <http://conal.net/papers/Eros>+ .+ This page and the module documentation pages have links to colorized+ source code and to wiki pages where you can read and contribute /user+ comments/. Enjoy!+ .+ The primary module is "Control.Arrow.DeepArrow". Examples in+ "Control.Arrow.DeepArrow.Examples".+ .+ /Note/: Many of the type signatures use infix type operators (as in+ @a~>b@), a recent extension to GHC. In reading the documentation and+ code, be aware that infix operators bind more tightly than @->@.+ .+ © 2007 by Conal Elliott (<http://conal.net>); BSD3 license.+Author: Conal Elliott <conal@conal.net>+Maintainer: conal@conal.net+Homepage: http://haskell.org/haskellwiki/DeepArrow+Package-Url: http://darcs.haskell.org/packages/DeepArrow+License: BSD3+Stability: experimental+Copyright: (c) 2007 by Conal Elliott+Hs-Source-Dirs: src+Build-Depends: base, mtl+Extensions: CPP, UndecidableInstances+Exposed-Modules:+ Control.Arrow.DeepArrow+ Data.Tupler+ Data.FunArr+ Control.Arrow.DeepArrow.Examples+ghc-options: -O -Wall
Makefile view
@@ -1,12 +1,12 @@-# See README for Cabal-based building. Other fancy stuff (like haddock) here. - -user = conal -package = DeepArrow - -haddock_args=\ - --no-use-packages \ - --haddock-arg=--read-interface=http://haskell.org/ghc/docs/latest/html/libraries/base,c:/ghc/ghc-6.6/doc/html/libraries/base/base.haddock \ - --haddock-arg=--read-interface=http://haskell.org/ghc/docs/latest/html/libraries/mtl,c:/ghc/ghc-6.6/doc/html/libraries/mtl/mtl.haddock \ - # enough, already! - -include ../my-cabal-make.inc +# See README for Cabal-based building. Other fancy stuff (like haddock) here.++user = conal++configure_args=--disable-use-packages --haddock-args="\+ --read-interface=http://haskell.org/ghc/docs/latest/html/libraries/base,c:/ghc/ghc-6.6/doc/html/libraries/base/base.haddock \+ --read-interface=http://haskell.org/ghc/docs/latest/html/libraries/mtl,c:/ghc/ghc-6.6/doc/html/libraries/mtl/mtl.haddock \+ $(source_args)\+ $(comments_args)\+ "++include ../my-cabal-make.inc
README view
@@ -1,14 +1,14 @@-This library provides a framework for type-directed composition of value -editors. For a fuller description and link to documentation, please see -the Haskell wiki page: - - http://haskell.org/haskellwiki/DeepArrow - -You can configure, build, and install all in the usual way with Cabal -commands. - - runhaskell Setup.lhs configure - runhaskell Setup.lhs build - runhaskell Setup.lhs install - -See src/Control/Arrow/DeepArrow/Examples.hs for examples. +The DeepArrow library provides a framework for type-directed composition+of value editors. For a fuller description and link to documentation,+please see the Haskell wiki page:++ http://haskell.org/haskellwiki/DeepArrow++You can configure, build, and install all in the usual way with Cabal+commands.++ runhaskell Setup.lhs configure+ runhaskell Setup.lhs build+ runhaskell Setup.lhs install++See src/Control/Arrow/DeepArrow/Examples.hs for examples.
Setup.lhs view
@@ -1,3 +1,3 @@-#!/usr/bin/env runhaskell -> import Distribution.Simple +#!/usr/bin/env runhaskell+> import Distribution.Simple > main = defaultMain
+ TODO view
src/Control/Arrow/DeepArrow.hs view
@@ -1,247 +1,247 @@-{-# OPTIONS -fglasgow-exts #-} - ----------------------------------------------------------------------- --- | --- Module : Control.Arrow.DeepArrow --- Copyright : (c) Conal Elliott 2006 --- License : LGPL --- --- Maintainer : conal@conal.net --- Stability : experimental --- Portability : portable --- --- \"Deep arrows\" as an 'Arrow' subclass. ----------------------------------------------------------------------- - -module Control.Arrow.DeepArrow - ( - -- * The DeepArrow class - DeepArrow(..) - -- * Composable function extractors - , funFirst, funSecond, funResult - -- * Composable input extractors - , inpF, inpS, inpFirst, inpSecond - -- * Misc functions - , flipA, unzipA - -- * Some utilities - , (->|) - ) where - -import Control.Arrow - -import Data.Tupler (Pair2(..)) -import Data.FunArr - - -{---------------------------------------------------------- - The "deep arrow class" -----------------------------------------------------------} - -{- | - -Arrows for deep application. Most of these methods could be defined -using 'arr', but 'arr' is not definable for some types. If your -'DeepArrow' instance has 'arr', you might want to use these -implementations - -@ - 'idA' = 'arr' 'id' - 'fstA' = 'arr' 'fst' - 'dupA' = 'arr' (\\ x -> (x,x)) - 'sndA' = 'arr' 'snd' - 'funF' = 'arr' (\\ (f,b) -> \\ c -> (f c, b)) - 'funS' = 'arr' (\\ (a,f) -> \\ c -> (a, f c)) - 'funR' = 'arr' 'flip' - 'curryA' = 'arr' 'curry' - 'uncurryA' = 'arr' 'uncurry' - 'swapA' = 'arr' (\\ (a,b) -> (b,a)) - 'lAssocA' = 'arr' (\\ (a,(b,c)) -> ((a,b),c)) - 'rAssocA' = 'arr' (\\ ((a,b),c) -> (a,(b,c))) -@ - -If your 'DeepArrow' instance /does not/ have 'arr', you'll have to come up -with other definitions. In any case, I recommend the following -definitions, which mirror 'Arrow' defaults while avoiding 'arr'. Be sure -also to define 'arr' or 'pure' to yield an error message (rather than -ping-ponging infinitely between them via the 'Arrow' default definitions). - -@ - 'second' f = 'swapA' '>>>' 'first' f '>>>' 'swapA' - f '&&&' g = 'dupA' '>>>' f '***' g -@ - -In a few cases, there are default methods, as noted below. The -defaults do not use 'arr'. - --} - -class Arrow (~>) => DeepArrow (~>) where - -- | Apply arrow in a function's result. Analogous to 'first' and - -- 'second'. - result :: (b ~> b') -> ((a->b) ~> (a->b')) - -- Complicates OFun considerably and not used. - -- Apply arrow in a function's argument. Note contravariance. - -- argument :: (a' ~> a ) -> ((a->b) ~> (a'->b)) - -- | Identity. - idA :: a ~> a - -- | Duplicate. - dupA :: a ~> (a,a) - -- | Extract first. - fstA :: (a,b) ~> a - -- | Extract second. - sndA :: (a,b) ~> b - -- | Extract function from first element. - funF :: (c->a, b) ~> (c->(a,b)) - -- | Extract function from second element. - funS :: (a, c->b) ~> (c->(a,b)) -- Could default via swapA & funF - -- | Extract function from result. - funR :: (a->c->b) ~> (c->a->b) - -- | Curry arrow. - curryA :: ((a,b)->c) ~> (a->b->c) - -- | Uncurry arrow. - uncurryA :: (a->b->c) ~> ((a,b)->c) - -- | Swap elements. Has default. - swapA :: (a,b) ~> (b,a) - swapA = sndA &&& fstA - -- | Left-associate. Has default. - lAssocA :: (a,(b,c)) ~> ((a,b),c) - lAssocA = (idA***fstA) &&& (sndA>>>sndA) - -- | Right-associate. Has default. - rAssocA :: ((a,b),c) ~> (a,(b,c)) - rAssocA = (fstA>>>fstA) &&& (sndA *** idA) - -- I don't think this one is used. - -- composeA :: Arrow (~~>) => (a ~~> b, b ~~> c) ~> (a ~~>c) - -- composeA = arr (uncurry (>>>)) - - -{---------------------------------------------------------- - Composable function extractors -----------------------------------------------------------} - --- | Promote a function extractor into one that reaches into the first --- element of a pair. -funFirst :: DeepArrow (~>) => (d ~> (c->a)) -> ((d, b) ~> (c->(a, b))) - --- | Promote a function extractor into one that reaches into the second --- element of a pair. -funSecond :: DeepArrow (~>) => (d ~> (c->b)) -> ((a, d) ~> (c->(a, b))) - --- | Promote a function extractor into one that reaches into the result --- element of a function. -funResult :: DeepArrow (~>) => (d ~> (c->b)) -> ((a->d) ~> (c->(a->b))) - -funFirst h = first h >>> funF -funSecond h = second h >>> funS -funResult h = result h >>> funR - - -{---------------------------------------------------------- - Composable input extractors -----------------------------------------------------------} - --- | Extract the first component of a pair input. -inpF :: DeepArrow (~>) => ((a,b) -> c) ~> (a -> (b->c)) -inpF = curryA - --- | Extract the second component of a pair input. -inpS :: DeepArrow (~>) => ((a,b) -> c) ~> (b -> (a->c)) -inpS = curryA >>> flipA - - --- Given a way to extract a @d@ input from an @a@ input, leaving an @a'@ --- residual input, 'inpFirst' yields a way to extract a @d@ input from an --- @(a,b)@ input, leaving an @(a',b)@ residual input. -inpFirst :: DeepArrow (~>) => - (( a ->c) ~> (d -> ( a' ->c))) - -> (((a,b)->c) ~> (d -> ((a',b)->c))) - --- Analogous to 'inpFirst'. -inpSecond :: DeepArrow (~>) => - (( b ->c) ~> (d -> ( b' ->c))) - -> (((a,b)->c) ~> (d -> ((a,b')->c))) - - --- See ICFP submission for the derivation of inpFirst and inpSecond - -inpFirst h = curryA >>> flipA >>> result h >>> flipA >>> - result (flipA>>>uncurryA) - -inpSecond h = curryA >>> result h >>> flipA >>> - result uncurryA - - -{---------------------------------------------------------- - Misc functions -----------------------------------------------------------} - --- | Flip argument order -flipA :: DeepArrow (~>) => (a->c->b) ~> (c->a->b) -flipA = funR - --- | Like 'unzip' but for 'DeepArrow' arrows instead of lists. -unzipA :: DeepArrow (~>) => (a ~> (b,c)) -> (a ~> b, a ~> c) -unzipA f = (f >>> fstA, f >>> sndA) - - -{---------------------------------------------------------- - Some 'DeepArrow' instances -----------------------------------------------------------} - -instance DeepArrow (->) where - result = (.) - -- argument = flip (.) - -- Since (->) implements 'arr', use the recommended defaults for the rest. - idA = arr id - fstA = arr fst - dupA = arr (\x->(x,x)) - sndA = arr snd - funF = arr (\ (f,b) -> \ c -> (f c, b)) - funS = arr (\ (a,f) -> \ c -> (a, f c)) - funR = arr flip - curryA = arr curry - uncurryA = arr uncurry - swapA = arr (\ (a,b) -> (b,a)) - lAssocA = arr (\ (a,(b,c)) -> ((a,b),c)) - rAssocA = arr (\ ((a,b),c) -> (a,(b,c))) - - --- Arrow "pairs" are arrows -instance (Arrow f, Arrow f') => Arrow (Pair2 f f') where - arr h = Pair2 (arr h , arr h ) - Pair2 (f,f') >>> Pair2 (g,g') = Pair2 (f>>>g , f'>>>g' ) - first (Pair2 (f,f')) = Pair2 (first f , first f' ) - second (Pair2 (f,f')) = Pair2 (second f, second f') - Pair2 (f,f') *** Pair2 (g,g') = Pair2 (f***g , f'***g' ) - Pair2 (f,f') &&& Pair2 (g,g') = Pair2 (f&&&g , f'&&&g' ) - --- and DeepArrow "pairs" are deep arrows - -instance (DeepArrow ar, DeepArrow ar') => DeepArrow (Pair2 ar ar') where - idA = Pair2 (idA, idA) - dupA = Pair2 (dupA, dupA) - fstA = Pair2 (fstA, fstA) - sndA = Pair2 (sndA, sndA) - funF = Pair2 (funF, funF) - funS = Pair2 (funS, funS) - funR = Pair2 (funR, funR) - curryA = Pair2 (curryA, curryA) - uncurryA = Pair2 (uncurryA, uncurryA) - swapA = Pair2 (swapA, swapA) - lAssocA = Pair2 (lAssocA, lAssocA) - rAssocA = Pair2 (rAssocA, rAssocA) - - result (Pair2 (f,f')) = Pair2 (result f, result f') - - -- composeA = Pair2 (composeA, composeA) - -- argument (Pair2 (f,f')) = Pair2 (argument f, argument f') - - -{---------------------------------------------------------- - Some utilities -----------------------------------------------------------} - --- | Compose wrapped functions -(->|) :: (DeepArrow (~>), FunArr (~>) w) => - w (a->b) -> w (b->c) -> w (a->c) -(->|) f g = result (toArr g) $$ f - +{-# OPTIONS -fglasgow-exts #-}++----------------------------------------------------------------------+-- |+-- Module : Control.Arrow.DeepArrow+-- Copyright : (c) Conal Elliott 2006+-- License : LGPL+-- +-- Maintainer : conal@conal.net+-- Stability : experimental+-- Portability : portable+--+-- \"Deep arrows\" as an 'Arrow' subclass.+----------------------------------------------------------------------++module Control.Arrow.DeepArrow+ (+ -- * The DeepArrow class+ DeepArrow(..)+ -- * Composable function extractors+ , funFirst, funSecond, funResult+ -- * Composable input extractors+ , inpF, inpS, inpFirst, inpSecond+ -- * Misc functions+ , flipA, unzipA+ -- * Some utilities+ , (->|)+ ) where++import Control.Arrow++import Data.Tupler (Pair2(..))+import Data.FunArr+++{----------------------------------------------------------+ The "deep arrow class"+----------------------------------------------------------}++{- | ++Arrows for deep application. Most of these methods could be defined+using 'arr', but 'arr' is not definable for some types. If your+'DeepArrow' instance has 'arr', you might want to use these+implementations++@+ 'idA' = 'arr' 'id'+ 'fstA' = 'arr' 'fst'+ 'dupA' = 'arr' (\\ x -> (x,x))+ 'sndA' = 'arr' 'snd'+ 'funF' = 'arr' (\\ (f,b) -> \\ c -> (f c, b))+ 'funS' = 'arr' (\\ (a,f) -> \\ c -> (a, f c))+ 'funR' = 'arr' 'flip'+ 'curryA' = 'arr' 'curry'+ 'uncurryA' = 'arr' 'uncurry'+ 'swapA' = 'arr' (\\ (a,b) -> (b,a))+ 'lAssocA' = 'arr' (\\ (a,(b,c)) -> ((a,b),c))+ 'rAssocA' = 'arr' (\\ ((a,b),c) -> (a,(b,c)))+@++If your 'DeepArrow' instance /does not/ have 'arr', you'll have to come up+with other definitions. In any case, I recommend the following+definitions, which mirror 'Arrow' defaults while avoiding 'arr'. Be sure+also to define 'arr' or 'pure' to yield an error message (rather than+ping-ponging infinitely between them via the 'Arrow' default definitions).++@+ 'second' f = 'swapA' '>>>' 'first' f '>>>' 'swapA'+ f '&&&' g = 'dupA' '>>>' f '***' g+@++In a few cases, there are default methods, as noted below. The+defaults do not use 'arr'.++-}++class Arrow (~>) => DeepArrow (~>) where+ -- | Direct arrow into a function's result. Analogous to 'first' and+ -- 'second'.+ result :: (b ~> b') -> ((a->b) ~> (a->b'))+ -- Complicates OFun considerably and not used.+ -- Direct arrow into a function's argument. Note contravariance.+ -- argument :: (a' ~> a ) -> ((a->b) ~> (a'->b))+ -- | Identity.+ idA :: a ~> a+ -- | Duplicate.+ dupA :: a ~> (a,a)+ -- | Extract first.+ fstA :: (a,b) ~> a+ -- | Extract second.+ sndA :: (a,b) ~> b+ -- | Extract function from first element.+ funF :: (c->a, b) ~> (c->(a,b))+ -- | Extract function from second element.+ funS :: (a, c->b) ~> (c->(a,b)) -- Could default via swapA & funF+ -- | Extract function from result.+ funR :: (a->c->b) ~> (c->a->b)+ -- | Curry arrow.+ curryA :: ((a,b)->c) ~> (a->b->c)+ -- | Uncurry arrow.+ uncurryA :: (a->b->c) ~> ((a,b)->c)+ -- | Swap elements. Has default.+ swapA :: (a,b) ~> (b,a)+ swapA = sndA &&& fstA+ -- | Left-associate. Has default.+ lAssocA :: (a,(b,c)) ~> ((a,b),c)+ lAssocA = (idA***fstA) &&& (sndA>>>sndA)+ -- | Right-associate. Has default.+ rAssocA :: ((a,b),c) ~> (a,(b,c))+ rAssocA = (fstA>>>fstA) &&& (sndA *** idA)+ -- I don't think this one is used.+ -- composeA :: Arrow (~~>) => (a ~~> b, b ~~> c) ~> (a ~~>c)+ -- composeA = arr (uncurry (>>>))+++{----------------------------------------------------------+ Composable function extractors+----------------------------------------------------------}++-- | Promote a function extractor into one that reaches into the first+-- element of a pair.+funFirst :: DeepArrow (~>) => (d ~> (c->a)) -> ((d, b) ~> (c->(a, b)))++-- | Promote a function extractor into one that reaches into the second+-- element of a pair.+funSecond :: DeepArrow (~>) => (d ~> (c->b)) -> ((a, d) ~> (c->(a, b)))++-- | Promote a function extractor into one that reaches into the result+-- element of a function.+funResult :: DeepArrow (~>) => (d ~> (c->b)) -> ((a->d) ~> (c->(a->b)))++funFirst h = first h >>> funF+funSecond h = second h >>> funS+funResult h = result h >>> funR+++{----------------------------------------------------------+ Composable input extractors+----------------------------------------------------------}++-- | Extract the first component of a pair input.+inpF :: DeepArrow (~>) => ((a,b) -> c) ~> (a -> (b->c))+inpF = curryA++-- | Extract the second component of a pair input.+inpS :: DeepArrow (~>) => ((a,b) -> c) ~> (b -> (a->c))+inpS = curryA >>> flipA+++-- Given a way to extract a @d@ input from an @a@ input, leaving an @a'@+-- residual input, 'inpFirst' yields a way to extract a @d@ input from an+-- @(a,b)@ input, leaving an @(a',b)@ residual input.+inpFirst :: DeepArrow (~>) =>+ (( a ->c) ~> (d -> ( a' ->c)))+ -> (((a,b)->c) ~> (d -> ((a',b)->c)))++-- Analogous to 'inpFirst'.+inpSecond :: DeepArrow (~>) =>+ (( b ->c) ~> (d -> ( b' ->c)))+ -> (((a,b)->c) ~> (d -> ((a,b')->c)))+++-- See ICFP submission for the derivation of inpFirst and inpSecond++inpFirst h = curryA >>> flipA >>> result h >>> flipA >>>+ result (flipA>>>uncurryA)++inpSecond h = curryA >>> result h >>> flipA >>>+ result uncurryA+++{----------------------------------------------------------+ Misc functions+----------------------------------------------------------}++-- | Flip argument order+flipA :: DeepArrow (~>) => (a->c->b) ~> (c->a->b)+flipA = funR++-- | Like 'unzip' but for 'DeepArrow' arrows instead of lists.+unzipA :: DeepArrow (~>) => (a ~> (b,c)) -> (a ~> b, a ~> c)+unzipA f = (f >>> fstA, f >>> sndA)+++{----------------------------------------------------------+ Some 'DeepArrow' instances+----------------------------------------------------------}++instance DeepArrow (->) where+ result = (.)+ -- argument = flip (.)+ -- Since (->) implements 'arr', use the recommended defaults for the rest.+ idA = arr id+ fstA = arr fst+ dupA = arr (\x->(x,x))+ sndA = arr snd+ funF = arr (\ (f,b) -> \ c -> (f c, b))+ funS = arr (\ (a,f) -> \ c -> (a, f c))+ funR = arr flip+ curryA = arr curry+ uncurryA = arr uncurry+ swapA = arr (\ (a,b) -> (b,a))+ lAssocA = arr (\ (a,(b,c)) -> ((a,b),c))+ rAssocA = arr (\ ((a,b),c) -> (a,(b,c)))+++-- Arrow "pairs" are arrows+instance (Arrow f, Arrow f') => Arrow (Pair2 f f') where+ arr h = Pair2 (arr h , arr h )+ Pair2 (f,f') >>> Pair2 (g,g') = Pair2 (f>>>g , f'>>>g' )+ first (Pair2 (f,f')) = Pair2 (first f , first f' )+ second (Pair2 (f,f')) = Pair2 (second f, second f')+ Pair2 (f,f') *** Pair2 (g,g') = Pair2 (f***g , f'***g' )+ Pair2 (f,f') &&& Pair2 (g,g') = Pair2 (f&&&g , f'&&&g' )++-- and DeepArrow "pairs" are deep arrows++instance (DeepArrow ar, DeepArrow ar') => DeepArrow (Pair2 ar ar') where+ idA = Pair2 (idA, idA)+ dupA = Pair2 (dupA, dupA)+ fstA = Pair2 (fstA, fstA)+ sndA = Pair2 (sndA, sndA)+ funF = Pair2 (funF, funF)+ funS = Pair2 (funS, funS)+ funR = Pair2 (funR, funR)+ curryA = Pair2 (curryA, curryA)+ uncurryA = Pair2 (uncurryA, uncurryA)+ swapA = Pair2 (swapA, swapA)+ lAssocA = Pair2 (lAssocA, lAssocA)+ rAssocA = Pair2 (rAssocA, rAssocA)++ result (Pair2 (f,f')) = Pair2 (result f, result f')++ -- composeA = Pair2 (composeA, composeA)+ -- argument (Pair2 (f,f')) = Pair2 (argument f, argument f')+++{----------------------------------------------------------+ Some utilities+----------------------------------------------------------}++-- | Compose wrapped functions+(->|) :: (DeepArrow (~>), FunArr (~>) w) =>+ w (a->b) -> w (b->c) -> w (a->c)+(->|) f g = result (toArr g) $$ f+
src/Control/Arrow/DeepArrow/Examples.hs view
@@ -1,91 +1,91 @@-{-# OPTIONS -fglasgow-exts #-} - ----------------------------------------------------------------------- --- | --- Module : Examples --- Copyright : (c) Conal Elliott 2007 --- License : LGPL --- --- Maintainer : conal@conal.net --- Stability : experimental --- Portability : portable --- --- DeepArrow examples. --- --- The types in the source code are formatted for easier reading. ----------------------------------------------------------------------- - -module Control.Arrow.DeepArrow.Examples - ( - -- * Deep application - deep - -- * Function extraction - , extF - -- * Input etraction - , extI, extFI - ) where - -import Control.Arrow -import Control.Arrow.DeepArrow - - -{---------------------------------------------------------- - Deep application -----------------------------------------------------------} - --- | Given a value of type @(a -> (f,b -> (c,g)),e)@, apply a function to --- just the @c@ part and leave the rest intact. --- --- @deep = 'first' . 'result' . 'second' . 'result' . 'first' @ -deep :: DeepArrow (~>) => (c ~> c') -> - (a -> (f,b -> (c ,g)),e) - ~> (a -> (f,b -> (c',g)),e) -deep = first.result.second.result.first - - - -{---------------------------------------------------------- - Function extraction -----------------------------------------------------------} - --- | Given a way to extract a function from a @d@ value, create a way to --- extract a function from a @(e -> (a,d), f)@ value. --- --- @extF = 'funFirst' . 'funResult' . 'funSecond'@ - -extF :: DeepArrow (~>) => (d ~> (c -> b)) -> - (e -> (a,d), f) - ~> (c -> (e -> (a,b), f)) -extF = funFirst.funResult.funSecond - --- | To make an extractor, simply apply the extractor-transformer 'extF' --- to the identity arrow. --- --- @'extFF' = 'extF' 'idA'@ -extFF :: DeepArrow (~>) => - (e -> (a,(c-> b)),f) - ~> (c -> (e -> (a, b),f)) -extFF = extF idA - - -{---------------------------------------------------------- - Input extraction -----------------------------------------------------------} - --- | Extract a @b@ input from a @((a,(b,e)),c)@ argument. --- --- @extI = ('inpFirst' . 'inpSecond') 'inpF'@ -extI :: DeepArrow (~>) => - ( ((a,(b,e)),c) -> d) - ~> (b -> ((a, e ),c) -> d) -extI = (inpFirst.inpSecond) inpF - - --- | Typically, we will have to combine function and input extractors. --- For instance, combine 'extF' and 'extI'. --- --- @extFI = 'extF' 'extI'@ -extFI :: DeepArrow (~>) => - (e -> (g,(((a,(b,e)),c) -> d)), f) - ~> (b -> (e -> (g,(((a, e) ,c) -> d)), f)) -extFI = extF extI +{-# OPTIONS -fglasgow-exts #-}++----------------------------------------------------------------------+-- |+-- Module : Control.Arrow.DeepArrow.Examples+-- Copyright : (c) Conal Elliott 2007+-- License : LGPL+-- +-- Maintainer : conal@conal.net+-- Stability : experimental+-- Portability : portable+-- +-- DeepArrow examples.+-- +-- The types in the source code are formatted for easier reading.+----------------------------------------------------------------------++module Control.Arrow.DeepArrow.Examples+ (+ -- * Deep application+ deep+ -- * Function extraction+ , extF, extFF+ -- * Input etraction+ , extI, extFI+ ) where++import Control.Arrow+import Control.Arrow.DeepArrow+++{----------------------------------------------------------+ Deep application +----------------------------------------------------------}++-- | Given a value of type @(a -> (f,b -> (c,g)),e)@, apply a function to+-- just the @c@ part and leave the rest intact.+-- +-- @deep = 'first' . 'result' . 'second' . 'result' . 'first' @+deep :: DeepArrow (~>) => (c ~> c') ->+ (a -> (f,b -> (c ,g)),e)+ ~> (a -> (f,b -> (c',g)),e)+deep = first.result.second.result.first++++{----------------------------------------------------------+ Function extraction+----------------------------------------------------------}++-- | Given a way to extract a function from a @d@ value, create a way to+-- extract a function from a @(e -> (a,d), f)@ value.+-- +-- @extF = 'funFirst' . 'funResult' . 'funSecond'@++extF :: DeepArrow (~>) => (d ~> (c -> b)) ->+ (e -> (a,d), f)+ ~> (c -> (e -> (a,b), f))+extF = funFirst.funResult.funSecond++-- | To make an extractor, simply apply the extractor-transformer 'extF'+-- to the identity arrow.+-- +-- @'extFF' = 'extF' 'idA'@+extFF :: DeepArrow (~>) =>+ (e -> (a,(c-> b)),f)+ ~> (c -> (e -> (a, b),f))+extFF = extF idA+++{----------------------------------------------------------+ Input extraction+----------------------------------------------------------}++-- | Extract a @b@ input from a @((a,(b,e)),c)@ argument.+-- +-- @extI = ('inpFirst' . 'inpSecond') 'inpF'@+extI :: DeepArrow (~>) =>+ ( ((a,(b,e)),c) -> d)+ ~> (b -> ((a, e ),c) -> d)+extI = (inpFirst.inpSecond) inpF+++-- | Typically, we will have to combine function and input extractors.+-- For instance, combine 'extF' and 'extI'.+-- +-- @extFI = 'extF' 'extI'@+extFI :: DeepArrow (~>) =>+ (e -> (g,(((a,(b,e)),c) -> d)), f)+ ~> (b -> (e -> (g,(((a, e) ,c) -> d)), f))+extFI = extF extI
src/Data/FunArr.hs view
@@ -1,53 +1,53 @@-{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-} - ----------------------------------------------------------------------- --- | --- Module : Data.FunArr --- Copyright : (c) Conal Elliott 2007 --- License : LGPL --- --- Maintainer : conal@conal.net --- Stability : experimental --- Portability : portable --- --- Conversion between arrow values and wrapped functions. ----------------------------------------------------------------------- - -module Data.FunArr - ( - FunArr(..), wapl - ) where - -import Control.Monad.Identity -import Data.Tupler - -infixr 0 $$ -- FunArr application - --- | Convert between an arrow value and a \"wrapped function\". The \"arrow\" --- doesn't really have to be an arrow. I'd appreciate ideas for names & --- uses. -class FunArr (~>) w | (~>)->w, w->(~>) where - -- | Convert a @w@-wrapped function to an arrow value - toArr :: w (a->b) -> (a ~> b) - -- | Apply an arrow to a @w@-wrapped value - ($$) :: (a ~> b) -> w a -> w b - --- | Apply a wrapped function to a wrapped value -wapl :: FunArr (~>) w => w (a->b) -> w a -> w b -wapl f a = toArr f $$ a - --- Function/Id instance -instance FunArr (->) Identity where - toArr = runIdentity - f $$ ida = return (f (runIdentity ida)) - -- ($$) f = return . f . runIdentity - --- The following instance violates the "coverage condition" and so --- requires -fallow-undecidable-instances. - -instance (FunArr ar w, FunArr ar' w') - => FunArr (Pair2 ar ar') (Pair1 w w') where - toArr (Pair1 (f,f')) = Pair2 (toArr f, toArr f') - Pair2 (f,f') $$ Pair1 (w,w') = Pair1 (f $$ w, f' $$ w') - - +{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}++----------------------------------------------------------------------+-- |+-- Module : Data.FunArr+-- Copyright : (c) Conal Elliott 2007+-- License : LGPL+-- +-- Maintainer : conal@conal.net+-- Stability : experimental+-- Portability : portable+-- +-- Conversion between arrow values and wrapped functions.+----------------------------------------------------------------------++module Data.FunArr+ (+ FunArr(..), wapl+ ) where++import Control.Monad.Identity+import Data.Tupler++infixr 0 $$ -- FunArr application++-- | Convert between an arrow value and a \"wrapped function\". The \"arrow\"+-- doesn't really have to be an arrow. I'd appreciate ideas for names &+-- uses.+class FunArr (~>) w | (~>)->w, w->(~>) where+ -- | Convert a @w@-wrapped function to an arrow value+ toArr :: w (a->b) -> (a ~> b)+ -- | Apply an arrow to a @w@-wrapped value+ ($$) :: (a ~> b) -> w a -> w b++-- | Apply a wrapped function to a wrapped value+wapl :: FunArr (~>) w => w (a->b) -> w a -> w b+wapl f a = toArr f $$ a++-- Function/Id instance+instance FunArr (->) Identity where+ toArr = runIdentity+ f $$ ida = return (f (runIdentity ida))+ -- ($$) f = return . f . runIdentity++-- The following instance violates the "coverage condition" and so+-- requires -fallow-undecidable-instances.++instance (FunArr ar w, FunArr ar' w')+ => FunArr (Pair2 ar ar') (Pair1 w w') where+ toArr (Pair1 (f,f')) = Pair2 (toArr f, toArr f')+ Pair2 (f,f') $$ Pair1 (w,w') = Pair1 (f $$ w, f' $$ w')++
src/Data/Tupler.hs view
@@ -1,66 +1,66 @@-{-# OPTIONS -fglasgow-exts #-} - ----------------------------------------------------------------------- --- | --- Module : Data.Tupler --- Copyright : (c) Conal Elliott 2007 --- License : LGPL --- --- Maintainer : conal@conal.net --- Stability : experimental --- Portability : portable --- --- The tuple type constructors (i.e., (,), (,,), etc) are to value types, --- as the /tupler/ type constructors are to type constructors. ----------------------------------------------------------------------- - -module Data.Tupler - ( - Pair1(..), Pair2(..) - ) where - - -import Data.Typeable -- or AltData.Typeable ? - --- | Pairing for unary type constructors. -newtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)} - deriving (Eq, Ord, Show) - -instance (Typeable1 f, Typeable1 g) => Typeable1 (Pair1 f g) where - typeOf1 = const $ mkTyConApp (mkTyCon tyConStr) [] - where - tyConStr = "Data.Tupler.Pair1" - ++ tcStringSP (undefined :: f Bool) - ++ tcStringSP (undefined :: g Bool) - --- | Pairing for binary type constructors. -newtype Pair2 f g a b = Pair2 {unPair2 :: (f a b, g a b)} - deriving (Eq, Ord, Show) - -instance (Typeable2 f, Typeable2 g) => Typeable2 (Pair2 f g) where - typeOf2 = const $ mkTyConApp (mkTyCon tyConStr) [] - where - tyConStr = "Data.Tupler.Pair2" - ++ tcStringSP (undefined :: f Bool Bool) - ++ tcStringSP (undefined :: g Bool Bool) - - ----- Misc - --- | Disambuating hack for a function argument. Wrap parens around a string --- if it contains a space. -parensIfSpace :: String -> String -parensIfSpace str | ' ' `elem` str = "("++str++")" - | otherwise = str - --- | Extract the type constructor as a string -tcString :: Typeable a => a -> String -tcString = tyConString . typeRepTyCon . typeOf - --- | 'tcString' with disambiguating optional parens -tcStringP :: Typeable a => a -> String -tcStringP = parensIfSpace . tcString - --- | 'tcString' with leading space and optional parens -tcStringSP :: Typeable a => a -> String -tcStringSP = (' ':) . tcStringP +{-# OPTIONS -fglasgow-exts #-}++----------------------------------------------------------------------+-- |+-- Module : Data.Tupler+-- Copyright : (c) Conal Elliott 2007+-- License : LGPL+-- +-- Maintainer : conal@conal.net+-- Stability : experimental+-- Portability : portable+-- +-- The tuple type constructors (i.e., (,), (,,), etc) are to value types,+-- as the /tupler/ type constructors are to type constructors.+----------------------------------------------------------------------++module Data.Tupler+ (+ Pair1(..), Pair2(..)+ ) where+++import Data.Typeable -- or AltData.Typeable ?++-- | Pairing for unary type constructors.+newtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)}+ deriving (Eq, Ord, Show)++instance (Typeable1 f, Typeable1 g) => Typeable1 (Pair1 f g) where+ typeOf1 = const $ mkTyConApp (mkTyCon tyConStr) []+ where+ tyConStr = "Data.Tupler.Pair1"+ ++ tcStringSP (undefined :: f Bool)+ ++ tcStringSP (undefined :: g Bool)++-- | Pairing for binary type constructors.+newtype Pair2 f g a b = Pair2 {unPair2 :: (f a b, g a b)}+ deriving (Eq, Ord, Show)++instance (Typeable2 f, Typeable2 g) => Typeable2 (Pair2 f g) where+ typeOf2 = const $ mkTyConApp (mkTyCon tyConStr) []+ where+ tyConStr = "Data.Tupler.Pair2"+ ++ tcStringSP (undefined :: f Bool Bool)+ ++ tcStringSP (undefined :: g Bool Bool)+++---- Misc++-- | Disambuating hack for a function argument. Wrap parens around a string+-- if it contains a space.+parensIfSpace :: String -> String+parensIfSpace str | ' ' `elem` str = "("++str++")"+ | otherwise = str++-- | Extract the type constructor as a string+tcString :: Typeable a => a -> String+tcString = tyConString . typeRepTyCon . typeOf++-- | 'tcString' with disambiguating optional parens+tcStringP :: Typeable a => a -> String+tcStringP = parensIfSpace . tcString++-- | 'tcString' with leading space and optional parens+tcStringSP :: Typeable a => a -> String+tcStringSP = (' ':) . tcStringP