Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}-- The RULES for the methods of class Arrow may never fire-- e.g. compose/arr;  see Trac #10528------------------------------------------------------------------------------- |-- Module      :  Control.Arrow-- Copyright   :  (c) Ross Paterson 2002-- License     :  BSD-style (see the LICENSE file in the distribution)---- Maintainer  :  libraries@haskell.org-- Stability   :  provisional-- Portability :  portable---- Basic arrow definitions, based on----  * /Generalising Monads to Arrows/, by John Hughes,--    /Science of Computer Programming/ 37, pp67-111, May 2000.---- plus a couple of definitions ('returnA' and 'loop') from----  * /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,--    Firenze, Italy, pp229-240.---- These papers and more information on arrows can be found at-- <http://www.haskell.org/arrows/>.moduleControl.Arrow(-- * ArrowsArrow(..),Kleisli(..),-- ** Derived combinatorsreturnA,(^>>),(>>^),(>>>),(<<<),-- reexported-- ** Right-to-left variants(<<^),(^<<),-- * Monoid operationsArrowZero(..),ArrowPlus(..),-- * ConditionalsArrowChoice(..),-- * Arrow applicationArrowApply(..),ArrowMonad(..),leftApp,-- * FeedbackArrowLoop(..))whereimportData.Tuple(fst,snd,uncurry)importData.EitherimportControl.Monad.FiximportControl.CategoryimportGHC.Basehiding((.),id)infixr5<+>infixr3***infixr3&&&infixr2+++infixr2|||infixr1^>>,>>^infixr1^<<,<<^-- | The basic arrow class.---- Instances should satisfy the following laws:----  * @'arr' id = 'id'@----  * @'arr' (f >>> g) = 'arr' f >>> 'arr' g@----  * @'first' ('arr' f) = 'arr' ('first' f)@----  * @'first' (f >>> g) = 'first' f >>> 'first' g@----  * @'first' f >>> 'arr' 'fst' = 'arr' 'fst' >>> f@----  * @'first' f >>> 'arr' ('id' *** g) = 'arr' ('id' *** g) >>> 'first' f@----  * @'first' ('first' f) >>> 'arr' 'assoc' = 'arr' 'assoc' >>> 'first' f@---- where---- > assoc ((a,b),c) = (a,(b,c))---- The other combinators have sensible default definitions,-- which may be overridden for efficiency.classCategorya=>Arrowawhere{-# MINIMALarr,(first|(***))#-}-- | Lift a function to an arrow.arr::(b->c)->abc-- | Send the first component of the input through the argument--   arrow, and copy the rest unchanged to the output.first::abc->a(b,d)(c,d)first=(***id)-- | A mirror image of 'first'.----   The default definition may be overridden with a more efficient--   version if desired.second::abc->a(d,b)(d,c)second=(id***)-- | Split the input between the two argument arrows and combine--   their output.  Note that this is in general not a functor.----   The default definition may be overridden with a more efficient--   version if desired.(***)::abc->ab'c'->a(b,b')(c,c')f***g=firstf>>>arrswap>>>firstg>>>arrswapwhereswap~(x,y)=(y,x)-- | Fanout: send the input to both argument arrows and combine--   their output.----   The default definition may be overridden with a more efficient--   version if desired.(&&&)::abc->abc'->ab(c,c')f&&&g=arr(\b->(b,b))>>>f***g{-# RULES"compose/arr"forallfg.(arrf).(arrg)=arr(f.g)"first/arr"forallf.first(arrf)=arr(firstf)"second/arr"forallf.second(arrf)=arr(secondf)"product/arr"forallfg.arrf***arrg=arr(f***g)"fanout/arr"forallfg.arrf&&&arrg=arr(f&&&g)"compose/first"forallfg.(firstf).(firstg)=first(f.g)"compose/second"forallfg.(secondf).(secondg)=second(f.g)#-}-- Ordinary functions are arrows.-- | @since 2.01instanceArrow(->)wherearrf=f--  (f *** g) ~(x,y) = (f x, g y)--  sorry, although the above defn is fully H'98, nhc98 can't parse it.(***)fg~(x,y)=(fx,gy)-- | Kleisli arrows of a monad.newtypeKleislimab=Kleisli{runKleisli::a->mb}-- | @since 3.0instanceMonadm=>Category(Kleislim)whereid=Kleislireturn(Kleislif).(Kleislig)=Kleisli(\b->gb>>=f)-- | @since 2.01instanceMonadm=>Arrow(Kleislim)wherearrf=Kleisli(return.f)first(Kleislif)=Kleisli(\~(b,d)->fb>>=\c->return(c,d))second(Kleislif)=Kleisli(\~(d,b)->fb>>=\c->return(d,c))-- | The identity arrow, which plays the role of 'return' in arrow notation.returnA::Arrowa=>abbreturnA=arrid-- | Precomposition with a pure function.(^>>)::Arrowa=>(b->c)->acd->abdf^>>a=arrf>>>a-- | Postcomposition with a pure function.(>>^)::Arrowa=>abc->(c->d)->abda>>^f=a>>>arrf-- | Precomposition with a pure function (right-to-left variant).(<<^)::Arrowa=>acd->(b->c)->abda<<^f=a<<<arrf-- | Postcomposition with a pure function (right-to-left variant).(^<<)::Arrowa=>(c->d)->abc->abdf^<<a=arrf<<<aclassArrowa=>ArrowZeroawherezeroArrow::abc-- | @since 2.01instanceMonadPlusm=>ArrowZero(Kleislim)wherezeroArrow=Kleisli(\_->mzero)-- | A monoid on arrows.classArrowZeroa=>ArrowPlusawhere-- | An associative operation with identity 'zeroArrow'.(<+>)::abc->abc->abc-- | @since 2.01instanceMonadPlusm=>ArrowPlus(Kleislim)whereKleislif<+>Kleislig=Kleisli(\x->fx`mplus`gx)-- | Choice, for arrows that support it.  This class underlies the-- @if@ and @case@ constructs in arrow notation.---- Instances should satisfy the following laws:----  * @'left' ('arr' f) = 'arr' ('left' f)@----  * @'left' (f >>> g) = 'left' f >>> 'left' g@----  * @f >>> 'arr' 'Left' = 'arr' 'Left' >>> 'left' f@----  * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@----  * @'left' ('left' f) >>> 'arr' 'assocsum' = 'arr' 'assocsum' >>> 'left' f@---- where---- > assocsum (Left (Left x)) = Left x-- > assocsum (Left (Right y)) = Right (Left y)-- > assocsum (Right z) = Right (Right z)---- The other combinators have sensible default definitions, which may-- be overridden for efficiency.classArrowa=>ArrowChoiceawhere{-# MINIMAL(left|(+++))#-}-- | Feed marked inputs through the argument arrow, passing the--   rest through unchanged to the output.left::abc->a(Eitherbd)(Eithercd)left=(+++id)-- | A mirror image of 'left'.----   The default definition may be overridden with a more efficient--   version if desired.right::abc->a(Eitherdb)(Eitherdc)right=(id+++)-- | Split the input between the two argument arrows, retagging--   and merging their outputs.--   Note that this is in general not a functor.----   The default definition may be overridden with a more efficient--   version if desired.(+++)::abc->ab'c'->a(Eitherbb')(Eithercc')f+++g=leftf>>>arrmirror>>>leftg>>>arrmirrorwheremirror::Eitherxy->Eitheryxmirror(Leftx)=Rightxmirror(Righty)=Lefty-- | Fanin: Split the input between the two argument arrows and--   merge their outputs.----   The default definition may be overridden with a more efficient--   version if desired.(|||)::abd->acd->a(Eitherbc)df|||g=f+++g>>>arruntagwhereuntag(Leftx)=xuntag(Righty)=y{-# RULES"left/arr"forallf.left(arrf)=arr(leftf)"right/arr"forallf.right(arrf)=arr(rightf)"sum/arr"forallfg.arrf+++arrg=arr(f+++g)"fanin/arr"forallfg.arrf|||arrg=arr(f|||g)"compose/left"forallfg.leftf.leftg=left(f.g)"compose/right"forallfg.rightf.rightg=right(f.g)#-}-- | @since 2.01instanceArrowChoice(->)whereleftf=f+++idrightf=id+++ff+++g=(Left.f)|||(Right.g)(|||)=either-- | @since 2.01instanceMonadm=>ArrowChoice(Kleislim)whereleftf=f+++arridrightf=arrid+++ff+++g=(f>>>arrLeft)|||(g>>>arrRight)Kleislif|||Kleislig=Kleisli(eitherfg)-- | Some arrows allow application of arrow inputs to other inputs.-- Instances should satisfy the following laws:----  * @'first' ('arr' (\\x -> 'arr' (\\y -> (x,y)))) >>> 'app' = 'id'@----  * @'first' ('arr' (g >>>)) >>> 'app' = 'second' g >>> 'app'@----  * @'first' ('arr' (>>> h)) >>> 'app' = 'app' >>> h@---- Such arrows are equivalent to monads (see 'ArrowMonad').classArrowa=>ArrowApplyawhereapp::a(abc,b)c-- | @since 2.01instanceArrowApply(->)whereapp(f,x)=fx-- | @since 2.01instanceMonadm=>ArrowApply(Kleislim)whereapp=Kleisli(\(Kleislif,x)->fx)-- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise--   to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad.newtypeArrowMonadab=ArrowMonad(a()b)-- | @since 4.6.0.0instanceArrowa=>Functor(ArrowMonada)wherefmapf(ArrowMonadm)=ArrowMonad$m>>>arrf-- | @since 4.6.0.0instanceArrowa=>Applicative(ArrowMonada)wherepurex=ArrowMonad(arr(constx))ArrowMonadf<*>ArrowMonadx=ArrowMonad(f&&&x>>>arr(uncurryid))-- | @since 2.01instanceArrowApplya=>Monad(ArrowMonada)whereArrowMonadm>>=f=ArrowMonad$m>>>arr(\x->letArrowMonadh=fxin(h,()))>>>app-- | @since 4.6.0.0instanceArrowPlusa=>Alternative(ArrowMonada)whereempty=ArrowMonadzeroArrowArrowMonadx<|>ArrowMonady=ArrowMonad(x<+>y)-- | @since 4.6.0.0instance(ArrowApplya,ArrowPlusa)=>MonadPlus(ArrowMonada)-- | Any instance of 'ArrowApply' can be made into an instance of--   'ArrowChoice' by defining 'left' = 'leftApp'.leftApp::ArrowApplya=>abc->a(Eitherbd)(Eithercd)leftAppf=arr((\b->(arr(\()->b)>>>f>>>arrLeft,()))|||(\d->(arr(\()->d)>>>arrRight,())))>>>app-- | The 'loop' operator expresses computations in which an output value-- is fed back as input, although the computation occurs only once.-- It underlies the @rec@ value recursion construct in arrow notation.-- 'loop' should satisfy the following laws:---- [/extension/]--      @'loop' ('arr' f) = 'arr' (\\ b -> 'fst' ('fix' (\\ (c,d) -> f (b,d))))@---- [/left tightening/]--      @'loop' ('first' h >>> f) = h >>> 'loop' f@---- [/right tightening/]--      @'loop' (f >>> 'first' h) = 'loop' f >>> h@---- [/sliding/]--      @'loop' (f >>> 'arr' ('id' *** k)) = 'loop' ('arr' ('id' *** k) >>> f)@---- [/vanishing/]--      @'loop' ('loop' f) = 'loop' ('arr' unassoc >>> f >>> 'arr' assoc)@---- [/superposing/]--      @'second' ('loop' f) = 'loop' ('arr' assoc >>> 'second' f >>> 'arr' unassoc)@---- where---- > assoc ((a,b),c) = (a,(b,c))-- > unassoc (a,(b,c)) = ((a,b),c)--classArrowa=>ArrowLoopawhereloop::a(b,d)(c,d)->abc-- | @since 2.01instanceArrowLoop(->)whereloopfb=let(c,d)=f(b,d)inc-- | Beware that for many monads (those for which the '>>=' operation-- is strict) this instance will /not/ satisfy the right-tightening law-- required by the 'ArrowLoop' class.---- @since 2.01instanceMonadFixm=>ArrowLoop(Kleislim)whereloop(Kleislif)=Kleisli(liftMfst.mfix.f')wheref'xy=f(x,sndy)