functional-arrow (empty) → 0.0
raw patch · 6 files changed
+274/−0 lines, 6 filesdep +HListdep +basesetup-changed
Dependencies added: HList, base
Files
- LICENSE +31/−0
- Setup.lhs +3/−0
- functional-arrow.cabal +55/−0
- src/Control/Arrow/Let.hs +49/−0
- src/Control/Arrow/Monad.hs +90/−0
- src/Control/Arrow/MonadExample.hs +46/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2010, Henning Thielemann++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.++ * The names of contributors may not 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.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ functional-arrow.cabal view
@@ -0,0 +1,55 @@+Name: functional-arrow+Version: 0.0+License: BSD3+License-File: LICENSE+Author: Henning Thielemann <haskell@henning-thielemann.de>+Maintainer: Henning Thielemann <haskell@henning-thielemann.de>+-- Homepage: http://www.haskell.org/haskellwiki/FunctionalArrow+Category: Combinators+Build-Type: Simple+Synopsis: Combinators that allow for a more functional/monadic style of Arrow programming+Description:+ If you program with Arrows you have two choices:+ Use the plain Arrow combinators, that are cumbersome to use,+ or use special Arrow syntax, that is built into all Haskell compilers+ and is still not very functional programming style.+ The arrow syntax still forces you to introduce temporary names,+ that you would not need in a functional notation.+ .+ Where you would write things like+ .+ > mix <<< (id &&& delay) <<< lowpass+ .+ using plain Arrow combinators, you can now write+ .+ > lowpass >>>= \x ->+ > mix <<< (listen x &&& (delay <<< listen x))+ .+ where the @(>>>=)@ resembles the monadic bind+ and allows you for shared access to an arrow result.+ Thus it can be used like a @let@.+Tested-With: GHC==6.10.4+Cabal-Version: >=1.6+Build-Type: Simple+Source-Repository head+ type: darcs+ location: http://code.haskell.org/~thielema/functional-arrow/++Source-Repository this+ type: darcs+ location: http://code.haskell.org/~thielema/functional-arrow/+ tag: 0.0++Library+ Build-Depends:+ HList >=0.2 && <0.3,+ base >=3 && <5++ GHC-Options: -Wall+ Hs-Source-Dirs: src+ Exposed-Modules:+ Control.Arrow.Let+ Control.Arrow.Monad+ Other-Modules:+ Control.Arrow.MonadExample+-- Control.Arrow.Functional
+ src/Control/Arrow/Let.hs view
@@ -0,0 +1,49 @@+{-+Following a suggestion by oleg@okmij.org, 2010-08-06+-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverlappingInstances #-}+module Control.Arrow.Let where++import Control.Arrow (Arrow, arr, (&&&), (<<<), (^<<), (^>>), (>>^), )+++class Index t envi envo where+ ref :: Arrow arr => arr envi t -> arr envo t++instance Index t envi (t,envi) where+ ref _ = arr fst++instance Index t envi envo => Index t envi (h,envo) where+ ref (ai :: arr envi t) = snd ^>> (ref ai :: arr envo t)+++infixl 1 <<<&++(<<<&) :: Arrow arrow =>+ arrow (b,a) c -> arrow a b -> arrow a c+x <<<& y = x <<< y &&& arr id+++input :: Arrow arrow => arrow () Int+f :: Arrow arrow => arrow (Int,()) Char+g :: Arrow arrow => arrow (Char,(Int,())) Bool++input = undefined+f = undefined+g = undefined+++c1 :: Arrow arrow => arrow (Int,()) Bool+c1 = let inp1 = ref input >>^ ( > 1)+ inp2 = ref f >>^ ( == 'a')+ in (uncurry (&&) ^<< inp1 &&& inp2) <<<& f++c2 :: Arrow arrow =>+ arrow (Int,()) Bool+c2 = let inp1 = ref input >>^ ( > 1)+ inp2 = ref f >>^ (== 'a')+ h = uncurry (||) ^<< ref g &&& (uncurry (&&) ^<< inp1 &&& inp2)+ in h <<<& g <<<& f
+ src/Control/Arrow/Monad.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+This module is an attempt to simplify the use of arrow combinators.+If I have @f :: arrow a b@,+then subsequent arrows can only access the @b@,+but often I also want to access the @a@.+Thus I often write++> f &&& arr id :: arrow a (b,a) .++If I repeat this, it yields++> g &&& arr id <<< f &&& arr id :: arrow a (c,(b,a))+> h &&& arr id <<< g &&& arr id <<< f &&& arr id :: arrow a (d,(c,(b,a))) .++However accessing the particular inputs of type @d@, @c@, @b@+from within @h@ and @g@ is cumbersome.+Thus I wrote a little support for this style of arrow programming.+First I use @HList@ instead of nested pairs.+Using type level Peano numbers and reverse @HList@ index access+I can use the same expression (say @listen x@) in both @g@ and @h@+although in both contexts they refer to different @HLists@.+E.g. @g@ expects the @b@ input at the @HList@ head,+whereas @h@ gets it one position later.+-}+module Control.Arrow.Monad where++import qualified Data.HList as HL+import qualified Data.HList.HArray as HA+import qualified Data.HList.FakePrelude as HN++import Control.Arrow (Arrow, arr, (&&&), (<<<), (^<<), )+++infixl 1 >>>=++{- |+This @bind@-like operator allows you to a share an interim arrow result+between various following arrow inputs.++Instead of++> mix <<< id &&& delay <<< lowpass++you can write++> (\x -> HL.hCons x HL.hNil) ^>>+> ((HL.hHead ^>> lowpass) >>>= \x ->+> mix <<< listen x &&& (delay <<< listen x))+-}+(>>>=) ::+ (Arrow arrow, HA.HLength list n) =>+ arrow list a ->+ (n -> arrow (HL.HCons a list) b) ->+ arrow list b+(>>>=) x k =+ let len :: (HA.HLength list n) => arrow list a -> list -> n+ len _ = HA.hLength+ in k (len x undefined) <<< uncurry HL.HCons ^<< (x &&& arr id)+++infixr 1 =<<<++(=<<<) ::+ (Arrow arrow, HA.HLength list n) =>+ (n -> arrow (HL.HCons a list) b) ->+ arrow list a ->+ arrow list b+(=<<<) = flip (>>>=)+++class (HL.HNat x, HL.HNat y, HL.HNat z) => HAdd x y z+ | x y -> z, x z -> y {- , y z -> x -} where++instance (HL.HNat x) => HAdd HN.HZero x x where+instance (HAdd x y z) => HAdd (HN.HSucc x) y (HN.HSucc z) where++listen ::+ (Arrow arrow,+ HA.HLength list len, HAdd n m len, HA.HLookupByHNat m list a) =>+ n -> arrow list a+listen =+ let aux ::+ (HA.HLength list len, HAdd n m len, HA.HLookupByHNat m list a) =>+ m -> n -> list -> a+ aux m _ = HA.hLookupByHNat m+ in arr . aux undefined
+ src/Control/Arrow/MonadExample.hs view
@@ -0,0 +1,46 @@+module Control.Arrow.MonadExample where++import Control.Arrow.Monad ((>>>=), listen, )+import Control.Arrow.Let ((<<<&), )++import qualified Data.HList as HL++import qualified Control.Arrow.Let as CAL++import Control.Arrow (Arrow, (&&&), (<<<), (<<^), (^>>), )+import Control.Category (id, )++import Prelude hiding (id, )+++mix :: Arrow arrow => arrow (a,a) a+mix = undefined++delay :: Arrow arrow => arrow a a+delay = undefined++lowpass :: Arrow arrow => arrow a a+lowpass = undefined+++exampleCombinators, exampleBind,+ exampleLet, exampleCase :: Arrow arrow => arrow a a+exampleCombinators =+ mix <<< id &&& delay <<< lowpass++exampleBind =+ (\x -> HL.hCons x HL.hNil) ^>>+ ((HL.hHead ^>> lowpass) >>>= \x ->+ mix <<< listen x &&& (delay <<< listen x))++exampleLet =+ let x :: Arrow arrow => arrow (a,()) a+ x = lowpass <<^ fst+ in ((mix <<< CAL.ref x &&& (delay <<< CAL.ref x)) <<<& x)+ <<^ (\i -> (i,()))++exampleCase =+ case lowpass <<^ fst of+ x ->+ ((mix <<< CAL.ref x &&& (delay <<< CAL.ref x)) <<<& x)+ <<^ (\i -> (i,()))