packages feed

bot 0.1 → 0.3

raw patch · 11 files changed

+497/−65 lines, 11 filesdep ~arrowsdep ~base

Dependency ranges changed: arrows, base

Files

+ COPYING view
@@ -0,0 +1,25 @@+Copyright (c) 2009 Conal Elliott+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. The names of the authors may not 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 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.+
Makefile view
@@ -1,3 +1,3 @@ # For special configuration, especially for docs.  Otherwise see README. -include ../my-cabal-make.inc+include ../cho-home-cabal-make.inc
bot.cabal view
@@ -1,5 +1,5 @@ Name:                bot-Version:             0.1+Version:             0.3 Synopsis: 	     bots for functional reactive programming Category:            reactivity, FRP Description:@@ -12,25 +12,32 @@   to wiki pages where you can read and contribute user comments.  Enjoy!   .   &#169; 2008 by Conal Elliott; BSD3 license.+Cabal-Version:       >= 1.2 Author:              Conal Elliott  Maintainer:          conal@conal.net Homepage:            http://haskell.org/haskellwiki/Bot-Package-Url:	     http://darcs.haskell.org/packages/bot-Copyright:           (c) 2007-2008 by Conal Elliott+Package-Url:	     http://code.haskell.org/~conal/code/bot+Copyright:           (c) 2007-2010 by Conal Elliott License:             BSD3+License-File:        COPYING+build-type:          Simple Stability:           experimental-Hs-Source-Dirs:      src-Extensions:          -Build-Depends:       base, arrows, Stream-Exposed-Modules:     -		     Data.Bot.Mutant-		     Data.Bot.Misc-		     Data.Bot.Chatter-		     Data.Bot.LeadFollow Extra-Source-Files:-		     Examples.Chatter-		     Examples.LeadFollow-ghc-options:         -Wall -O+                     Examples.Chatter+                     Examples.LeadFollow++Library+  Hs-Source-Dirs:      src+  Extensions:          +  Build-Depends:       base >= 4 && < 5, arrows >= 0.4, Stream+  Exposed-Modules:     +                       Data.Bot.Mutant+                       Data.Bot.Misc+                       Data.Bot.Chatter+                       Data.Bot.LeadFollow+                       Data.Bot.Edit+  ghc-options:         -Wall+  -- We could add TypeCompose to Build-Depends and uncomment the Pair instances -- in Data.Bot.LeadFollow.
src/Data/Bot/Chatter.hs view
@@ -21,7 +21,9 @@   , justC, filterC, scanlC, accumC   ) where -import Control.Arrow hiding (pure)+import Prelude hiding (id,(.))+import Control.Category+import Control.Arrow import Control.Applicative import Data.Monoid import Data.Maybe@@ -31,15 +33,31 @@  -- | Chatter-bots.  Can have any number of outputs per input.  'mappend' -- appends outputs.-newtype ChatterBot i o =-  Chatter { unChatter :: MutantBot i [o] } deriving Monoid+newtype ChatterBot i o = Chatter { unChatter :: MutantBot i [o] } +instance Monoid (ChatterBot i o) where+  mempty = Chatter (pure mempty)+  Chatter b `mappend` Chatter c = Chatter (liftA2 mappend b c)++instance Category ChatterBot where+  id = arr id+  Chatter bc . Chatter ab = Chatter (concatMB bc . ab)+ instance Arrow ChatterBot where   arr h = Chatter (arr (pure . h))-  Chatter ab >>> Chatter bc = Chatter (ab >>> concatMB bc)   first (Chatter f) = Chatter $     first f >>> arr (\ (bs,c) -> [(b,c) | b <- bs])     -- first f >>> arr (\ (bs,c) -> fmap (flip (,) c) bs)++instance ArrowZero ChatterBot where+  zeroArrow = mempty++instance ArrowPlus ChatterBot where+  (<+>) = mappend++instance Alternative (ChatterBot i) where+  empty = mempty+  (<|>) = mappend  -- Boilerplate Functor & Applicative for Arrow instance
+ src/Data/Bot/Edit.hs view
@@ -0,0 +1,179 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE GADTs, KindSignatures, TypeOperators, GeneralizedNewtypeDeriving+  , ScopedTypeVariables, Arrows #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Bot.Edit+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Edit-bots+----------------------------------------------------------------------++module Data.Bot.Edit where++import Prelude hiding (id,(.))+import Control.Category+import Control.Arrow++import Data.Maybe (fromMaybe)++-- import Control.Arrow.Transformer+import Control.Arrow.Transformer.Automaton++import Data.Stream hiding ()+import qualified Data.Stream as S++-- | An edit/change to a value.  Represents @a -> a@ but as data, to allow+-- analysis.+data Edit :: * -> * where+  Konst   :: a -> Edit a                     -- const+  Idy     :: Edit a                          -- id+  (:***)  :: Edit a -> Edit b -> Edit (a,b)  -- ***+  (:>>>)  :: Edit a -> Edit a -> Edit a      -- (>>>)++-- Note: why use *** instead of First?  Because the smart constructor+-- rewrite rules seem to come out more simply.++-- | Interpret an edit as an arrow value (e.g., function).+edit :: Arrow (~>) => Edit a -> (a ~> a)+edit (Konst a)      = arr (const a)+edit Idy            = arr id+edit (eda :*** edb) = edit eda *** edit edb+edit (ed :>>> ed')  = edit ed  >>> edit ed'++-- TODO: import Data.Pair.  Replace unzip* with unpair and zip* with+-- pair.  Would add a TypeCompose dependency.++-- | Zip up two edits into a pair edit+zipE :: Edit a -> Edit b -> Edit (a,b)+zipE = (***:)++-- Try splitting one edit @ed@ into two independent edits @eda@ and @edb@+-- such that @ed == eda *** edb@.+unzipE :: Edit (a,b) -> Maybe (Edit a, Edit b)++unzipE (Konst (a,b))  = Just (Konst a, Konst b)+unzipE Idy            = Just (Idy, Idy)+unzipE (eda :*** edb) = Just (eda, edb)+unzipE (_   :>>> _  ) = Nothing++-- | Smart constructor for '(:***)'.  Applies some rewrites.+(***:) :: Edit a -> Edit b -> Edit (a,b)++Idy     ***: Idy     = Idy+Konst a ***: Konst b = Konst (a,b)+ed      ***: ed'     = ed :*** ed'++-- | Smart constructor for '(:>>>)'.  Applies some rewrites.+(>>>:) :: Edit a -> Edit a -> Edit a++Idy        >>>: f            = f+f          >>>: Idy          = f+_          >>>: k@(Konst _)  = k+(f :*** g) >>>: (f' :*** g') = (f >>>: f') ***: (g >>>: g')+ed         >>>: ed'          = ed :>>> ed'+++-- | A tweak is an edit and a new value.  This new value can be computed+-- from the edit and a previous value.  It's stored here (lazily) so it+-- can be shared.+data Tweak a = Tweak (Edit a) a++-- | Simple 'Konst' tweaker.  A catch-all, but not helpful for performance.+tweak :: a -> Tweak a+tweak a = Tweak (Konst a) a++-- Zip up two tweaks into a pair tweak.+zipT :: Tweak a -> Tweak b -> Tweak (a,b)+zipT (Tweak ea a) (Tweak eb b) = Tweak (zipE ea eb) (a,b)++-- | Split a pair tweak in two.+unzipT :: Tweak (a,b) -> (Tweak a, Tweak b)+unzipT (Tweak ed (a,b)) = (Tweak eda a, Tweak edb b)+ where+   (eda,edb) = fromMaybe (Konst a, Konst b) (unzipE ed)++-- | Stream of tweaks+type Tweaks a = Stream (Tweak a)++-- Zip up two tweak streams into a pair-valued tweak stream.+zipTs :: Tweaks a -> Tweaks c -> Tweaks (a,c)+zipTs = (fmap.fmap.fmap) (uncurry zipT) S.zip++-- zipTs tas tcs = fmap (uncurry zipT) $ S.zip tas tcs++-- | Split a pair-valued tweak stream in two.+unzipTs :: Tweaks (a,c) -> (Tweaks a, Tweaks c)+unzipTs = S.unzip . fmap unzipT+++-- | Reactive (discretely varying) value.  An initial value and a stream+-- of tweaks.  +-- +-- Although 'Reactive' is a 'Functor', I don't recommend its use.  'fmap'+-- cannot do much optimization without knowing something about the+-- function being mapped.  Maybe better not to have the 'Functor'+-- instance.+data Reactive a = R a (Tweaks a)++-- Maybe punt Reactive and rely on the first stream element to have a Konst++instance Functor Reactive where+  fmap f (R a ts) = R b (fmapR' f b ts) where b = f a++-- Carry value along to re-use for identity edits.+fmapR' :: (a -> b) -> b -> Stream (Tweak a) -> Stream (Tweak b)+fmapR' f b (Cons (Tweak Idy _) ts) = Cons (Tweak Idy b) (fmapR' f b ts)+fmapR' f _ (Cons (Tweak _ a) ts) =+  Cons (tweak b') (fmapR' f b' ts) where b' = f a++-- | Zip up two reactive values into a reactive pair.+zipR :: Reactive a -> Reactive c -> Reactive (a,c)+zipR (R a tas) (R c tcs) = R (a,c) (zipTs tas tcs)++-- | Split a reactive pair into a pair of reactive values.+unzipR :: Reactive (a,c) -> (Reactive a, Reactive c)+unzipR (R (a,c) ts) = (R a tsa, R c tsc)+ where+   (tsa,tsc) = unzipTs ts+++-- | Arrow between two reactive values.+newtype ArrowReactive (~>) a b = AR (Reactive a ~> Reactive b)++instance Category (~>) => Category (ArrowReactive (~>)) where+  id          = AR id+  AR g . AR f = AR (g . f)++instance Arrow (~>) => Arrow (ArrowReactive (~>)) where+  arr f         = AR (arr (fmap f))+  first (AR  f) = AR (arr unzipR >>> first f >>> arr (uncurry zipR))+++-- | 'Automaton'-style tweak arrow.  Could be split into follow and lead.+data AutR (~>) a b = AutR (a ~> (b, Automaton (~>) (Tweak a) (Tweak b)))++instance Arrow (~>) => Category (AutR (~>)) where+  id = arr id+  AutR g . AutR f = AutR $ proc a -> do (b,ab) <- f -< a+                                        (c,bc) <- g -< b+                                        returnA -< (c, bc . ab)++instance Arrow (~>) => Arrow (AutR (~>)) where+  arr f = AutR (arr (\ a -> let b = f a in (b, arrAut f (f a))))+  first (AutR f) = AutR $+    proc (a,c) ->+      do (b,ab) <- f -< a+         returnA -< ((b,c), arr unzipT >>> first ab >>> arr (uncurry zipT))++arrAut :: Arrow (~>) => (a -> b) -> b -> Automaton (~>) (Tweak a) (Tweak b)+arrAut f b = aut+ where+   aut = Automaton (arr g)+   g (Tweak Idy _) = (Tweak Idy b, aut)+   g (Tweak _   a) = (tweak b', arrAut f b') where b' = f a+
src/Data/Bot/LeadFollow.hs view
@@ -29,8 +29,11 @@   , editPairL, editPairF   ) where +import Prelude hiding (id,(.)) import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Category++import Control.Arrow import Data.Maybe (maybeToList) import Data.Monoid @@ -95,13 +98,17 @@ -- through newtypes in this case.  -- Adapted from the Automaton Arrow instance-instance Arrow Follow where-  arr f = foll where foll = Follow (\ a -> Lead (f a, foll))-  Follow f >>> Follow g = Follow $++instance Category Follow where+  id = arr id+  Follow g . Follow f = Follow $     f >>>     arr unLead >>>     first g >>>-    arr (\ (Lead (z, cg), cf) -> Lead (z, cf >>> cg))+    arr (\ (Lead (z, cg), cf) -> Lead (z, cg . cf))++instance Arrow Follow where+  arr f = foll where foll = Follow (\ a -> Lead (f a, foll))   first (Follow f) = Follow $     first f >>>     arr (\(Lead (x', c), y) -> Lead ((x', y), first c))@@ -153,9 +160,12 @@ -- | Start out following (multi-output) newtype a :-> b = Follows { unFollows :: Follow a [b] } deriving Monoid +instance Category (:->) where+  id = arr id+  Follows bc . Follows ab = Follows (concatMB bc . ab)+ instance Arrow (:->) where   arr h = Follows (arr (pure . h))-  Follows ab >>> Follows bc = Follows (ab >>> concatMB bc)   first (Follows f) = Follows $     first f >>> arr (\ (bs,c) -> [(b,c) | b <- bs])     -- first f >>> arr (\ (bs,c) -> fmap (flip (,) c) bs)
src/Data/Bot/Misc.hs view
@@ -21,10 +21,9 @@   ) where  import Data.Monoid-import Control.Arrow hiding (pure) import Control.Applicative -import Data.Stream hiding (zip,unzip,map,scanl,tail)+import Data.Stream hiding (zip,unzip,map,tail)  import Control.Arrow.Transformer.Stream @@ -34,13 +33,13 @@ -- and 'Applicative' (partially applied for the latter two). type StreamBot = StreamArrow (->) -deriving instance Monoid o => Monoid (StreamBot i o)-- -- | Bots who can choose whether or not to react to an input.  The -- 'mappend' operation is left-biased in case of simultaneous reaction.-newtype ChoosyBot i o = Choosy (MutantBot i (First o)) deriving Monoid+newtype ChoosyBot i o = Choosy (MutantBot i (First o)) +instance Monoid (ChoosyBot i o) where+  mempty = Choosy (pure mempty)+  Choosy b `mappend` Choosy c = Choosy (liftA2 mappend b c)  ---- Move elsewhere @@ -49,12 +48,3 @@ instance Monoid o => Monoid (Stream o) where   mempty  = pure   mempty   mappend = liftA2 mappend----- Standard Functor & Applicative instances for arrows.  See WrappedArrow.--instance Arrow (~>) => Functor (StreamArrow (~>) i) where fmap = (^<<)--instance Arrow (~>) => Applicative (StreamArrow (~>) i) where-  pure x        = arr (const x)-  fbot <*> xbot = fbot &&& xbot >>> arr (uncurry ($))
src/Data/Bot/Mutant.hs view
@@ -20,9 +20,7 @@     MutantBot, steps, concatMB, scanlM, accumM   ) where -import Control.Arrow hiding (pure)-import Control.Applicative-import Data.Monoid+import Control.Arrow  import Control.Arrow.Transformer.Automaton @@ -33,10 +31,6 @@ -- Isomorphic to @a -> (b, a -> (b, a -> (b, ...)))@ type MutantBot = Automaton (->) -instance Monoid o => Monoid (MutantBot i o) where-  mempty  = pure   mempty-  mappend = liftA2 mappend- -- | Perform multiple steps, yielding the collected outputs and residual bot. steps :: ([i], MutantBot i o) -> ([o], MutantBot i o) steps (is,bot) =@@ -75,13 +69,3 @@  -- or -- accum a = tail . scanl (flip ($)) a------- Move elsewhere--instance Arrow (~>) => Functor (Automaton (~>) i) where fmap = (^<<)--instance Arrow (~>) => Applicative (Automaton (~>) i) where-  pure x        = arr (const x)-  fbot <*> xbot = fbot &&& xbot >>> arr (uncurry ($))-
+ src/Data/Bot/Part.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE MagicHash, GADTs, KindSignatures, ScopedTypeVariables+           , Rank2Types #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Bot.Part+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- +----------------------------------------------------------------------++module Data.Bot.Part where++import Control.Arrow hiding (pure)+import Control.Applicative+import Data.Maybe (fromMaybe)+import GHC.Base (unsafeCoerce#) -- used in partMatch and coerceV++-- | Part of a structure of nested pairs+data Part :: * -> * -> * where+  IdP     :: Part a a+  FirstP  :: Part c a -> Part (c,b) a+  SecondP :: Part c b -> Part (a,c) b++-- | Equality on parts+partEq :: Part i a -> Part i b -> Bool+IdP       `partEq` IdP       = True+FirstP  p `partEq` FirstP  q = p `partEq` q+SecondP p `partEq` SecondP q = p `partEq` q+_         `partEq` _         = False+ +-- | Leibniz equality+type Leibniz a a' = forall phi. phi a -> phi a'++--newtype Leibniz a a' = Leibniz (forall phi. phi a -> phi a')++-- | Try to match parts.  If successful, yield a proof of Leibniz+-- equality, i.e., a coercion.+partMatch :: Part c a -> Part c a' -> Maybe (Leibniz a a')+a `partMatch` a' +  | a `partEq` a' = Just unsafeCoerce#+  | otherwise     = Nothing+++-- | Extract part of a value.  Use staged to avoid interpretive overhead.+extract :: Part c a -> (c -> a)+extract IdP         = id+extract (FirstP  p) = extract p . fst+extract (SecondP p) = extract p . snd++-- | Change a part of a value.  Use staged to avoid interpretive overhead.+change :: Part c a -> ((a -> a) -> (c -> c))+change IdP         = id+change (FirstP  p) = first  . change p+change (SecondP p) = second . change p++-- I really only wanted constant @a@ values for 'change', but I like how the+-- definition mirrors @comp@'s in this slightly more general setting.+-- Also, 'extract' and 'change' relate 'Part' to composable references.++-- | Substitute for part of a value.  Use staged to avoid interpretive overhead.+subst :: Part c a -> (a -> (c -> c))+subst p = change p . const++-- About the staging comments:+-- +-- Because of the way I've defined 'extract', 'change', and 'subst',+-- the "syntactic" analysis of parts is done once rather than at each+-- substitution.  The extra parentheses in the type signature serve as+-- a reminder.  Will haddock remove the extra parens?+++-- | Compose parts.  Specification:+-- +-- @extract (comp p q) == extract q . extract p@+-- @change  (comp p q) == change  p . change  q@+comp :: Part c b -> (Part b a -> Part c a)+comp IdP         = id+comp (FirstP  p) = FirstP  . comp p+comp (SecondP p) = SecondP . comp p++-- comp IdP         q = q+-- comp (FirstP  p) q = FirstP  (comp p q)+-- comp (SecondP p) q = SecondP (comp p q)++--    extract (comp (FirstP p) q) +-- == extract q . extract (FirstP p)+-- == extract q . extract p . fst+-- == extract (FirstP (comp p q))++-- change p ::(b -> b) -> (c -> c)+-- change q ::(a -> a) -> (b -> b)+-- change p . change q :: (a -> a) -> (c -> c)++--    change (comp (FirstP p) q)+-- == change (FirstP p) . change q+-- == first . change p . change q+-- == first . change (comp p q)+-- == change (FirstP (comp p q))+++---- experiments++-- \ ((a,b),c) -> a*b + b*c+t1 :: ((Int,Int),Int) -> Int+t1 = liftA2 (+)+       (liftA2 (*) (fst>>>fst) (fst>>>snd))+       (liftA2 (*) (fst>>>snd) snd)++++-- Bot with top-level data+data DBot i o = DBot o (Bot i o)++-- Bot without top-level data+data Bot :: * -> * -> * where+  PureB :: Bot i o+  AppB  :: DBot i (a -> b) -> DBot i a -> Bot i b+  PartB :: Part i o -> Bot i o++instance Functor (DBot i) where+  fmap f = (pure f <*> )++instance Applicative (DBot i) where+  pure o = DBot o PureB+  fd@(DBot f _) <*> xd@(DBot x _) = DBot (f x) (fd `AppB` xd)++-- TODO: factor  the Applicative pattern from Bot & DBot.  Parameterize+-- by @Part i@.  The the general version has just one type argument.+++-- | An 'Applicative'-style tree of values.+data AppV :: * -> * where+  PureV :: a -> AppV a+  AppV  :: a -> AppV (b -> a) -> AppV b -> AppV a++-- Extract the top-level value from a tree.+vVal :: AppV a -> a+vVal (PureV    a) = a+vVal (AppV a _ _) = a++appV :: AppV (b -> a) -> AppV b -> AppV a+fv `appV` bv = AppV ((vVal fv) (vVal bv)) fv bv++instance Functor AppV where+  fmap f = (pure f <*> )++instance Applicative AppV where+  pure  = PureV+  (<*>) = appV++data AppF :: (* -> *) -> * -> * where+  PureF :: a -> AppF h a+  AppF  :: AppF h (b -> a) -> AppF h b -> AppF h a+  InF   :: h a -> AppF h a++instance Functor (AppF h) where+  fmap f = (pure f <*> )++instance Applicative (AppF h) where+  pure  = PureF+  (<*>) = AppF+++-- | Adaptive bot.+type Adapt i = AppF (Part i)++-- | Evaluate a Adapt at an input, yielding a caching structure that+-- matches the Adapt's shape.+eval :: Adapt i o -> i -> AppV o+eval (PureF a)        = const (PureV a)+eval (AppF fbot bbot) = liftA2 appV (eval fbot) (eval bbot)+eval (InF p)          = PureV . extract p++-- A possible means of substituting in an @a@ value.  A 'Nothing' means+-- that the substitution wouldn't make any change.+type MbSubst a b = Maybe (a -> AppV b -> AppV b)++-- | Make an update function for a bot.  To eliminate interpretive+-- overhead, apply 'update' in stages: first provide a bot.  Then each+-- part in turn.+update :: Adapt i o -> (Part i a -> MbSubst a o)++update (PureF _) = const Nothing++update (InF p) = \ q -> +  case q `partMatch` p of+    Just coerce -> Just (\ a _ -> coerce (PureV a))+    Nothing     -> Nothing++update (fun `AppF` arg) = \ q ->+  case (msubf q, msuba q) of+    (Nothing,Nothing) -> Nothing+    (repf,repb)       -> Just $ \ a (AppV _ vf vb) ->+      upd fun repf a vf `appV` upd arg repb a vb+ where+   msubf = update fun+   msuba = update arg++-- Apply a 'MbSubst' to a value and an 'AppV' that matches the given+-- 'AppF'.  Warning: this matching requirement is not statically checked,+-- and Very Bad Things can happen if it's violated.  See 'coerceV'.+upd :: AppF f b -> MbSubst a b -> a -> AppV b' -> AppV b+upd appf rep a v' = fromMaybe ((const.const) v) rep a v+ where+   v = coerceV appf v'++-- The 'eval' and 'update' functions maintain an invariant that+-- corresponding 'AppF' and 'AppV' have the same intermediate @b@ type.+-- This coercion function exploits that invariant.+-- +-- TODO: look for a statically checked alternative.+coerceV :: AppF f b -> AppV b' -> AppV b+coerceV = const unsafeCoerce#
src/Examples/Chatter.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE TypeOperators, ScopedTypeVariables #-} ---------------------------------------------------------------------- -- |--- Module      :  Examples.Bot+-- Module      :  Examples.Chatter -- Copyright   :  (c) Conal Elliott 2008 -- License     :  BSD3 -- @@ -12,14 +12,14 @@ -- Examples for "Data.Bot.Bot" ---------------------------------------------------------------------- -module Examples.Bot where+module Examples.Chatter where -import Control.Arrow hiding (pure)+import Control.Arrow import Control.Arrow.Transformer.Automaton import Control.Applicative import Data.Monoid -import Data.Bot.Bot+import Data.Bot.Chatter   type a :>- b = (b, a :-> b)@@ -46,8 +46,10 @@ -- bot.  updPair :: Either c d -> (c,d) -> (c,d)-updPair (Left  c') (_,d) = (c',d)-updPair (Right d') (c,_) = (c,d')+updPair = (first.const) `either` (second.const)++-- updPair (Left  c') (_,d) = (c',d)+-- updPair (Right d') (c,_) = (c,d')  pairbot :: (c,d) -> Either c d :>- (c,d) pairbot cd = (cd, updPair ^>> accumC cd)
src/Examples/LeadFollow.hs view
@@ -14,8 +14,7 @@  module Examples.LeadFollow where -import Control.Arrow hiding (pure)-import Control.Applicative+import Control.Arrow import Data.Monoid  import Data.Bot.LeadFollow