packages feed

bot 0.0 → 0.1

raw patch · 3 files changed

+121/−49 lines, 3 files

Files

bot.cabal view
@@ -1,5 +1,5 @@ Name:                bot-Version:             0.0+Version:             0.1 Synopsis: 	     bots for functional reactive programming Category:            reactivity, FRP Description:@@ -31,3 +31,6 @@ 		     Examples.Chatter 		     Examples.LeadFollow ghc-options:         -Wall -O++-- We could add TypeCompose to Build-Depends and uncomment the Pair instances+-- in Data.Bot.LeadFollow.
src/Data/Bot/LeadFollow.hs view
@@ -25,6 +25,8 @@   , justF, filterF     -- * Accumulation   , scanlF, scanlL, accumF, accumL+    -- * Pair editing+  , editPairL, editPairF   ) where  import Control.Applicative@@ -33,7 +35,11 @@ import Data.Monoid  +-- Experimental: nice but adds TypeCompose dependency+-- See pairL below.+-- import Data.Pair + {--------------------------------------------------------------------     Lead and follow -- single-output --------------------------------------------------------------------}@@ -144,9 +150,6 @@ concatMB bot = Follow $ \ bs -> Lead $ second concatMB $ steps (bs,bot)  --- | Start out leading (multi-output)-newtype a :>- b =   Leads { unLeads   ::   Lead a [b] } deriving Monoid- -- | Start out following (multi-output) newtype a :-> b = Follows { unFollows :: Follow a [b] } deriving Monoid @@ -157,16 +160,46 @@     first f >>> arr (\ (bs,c) -> [(b,c) | b <- bs])     -- first f >>> arr (\ (bs,c) -> fmap (flip (,) c) bs) ---- The other instances are boilerplate for composition of applicative--- functors.- instance Functor ((:->) i) where   fmap f (Follows z) = Follows ((fmap.fmap) f z) +-- | Output an updated pair whenever either element changes.+pairF :: (b,c) -> a :-> b -> a :-> c -> a :-> (b,c)+pairF bc ab ac = (Left <$> ab) `mappend` (Right <$> ac) >>> editPairF bc+++-- | Start out leading.  Multi-output after initial.+newtype a :>- b = Leads { unLeads :: (b, a :-> b) }+ instance Functor ((:>-) i) where-  fmap f (Leads   z) = Leads   ((fmap.fmap) f z)+  fmap f (Leads (b,fol)) = Leads (f b, fmap f fol) +instance Applicative ((:>-) i) where+  pure x = Leads (x,mempty)+  lf <*> lx = uncurry ($) <$> (lf `pairL` lx)++-- | Output an updated pair whenever either element changes.+pairL :: a :>- b -> a :>- c -> a :>- (b,c)+Leads (a,fa) `pairL` Leads (b,fb) =+  Leads ((a,b), pairF (a,b) fa fb)++-- instance Pair ((:>-) a) where pair = pairL+++++-- Previous version:+-- +--   newtype a :>- b = Leads { unLeads :: Lead a [b] } deriving Monoid++-- instance Functor ((:>-) i) where+--   fmap f (Leads   z) = Leads   ((fmap.fmap) f z)++{-++-- These two 'Applicative' instances are not very useful.  They require+-- simultaneous outputs.+ instance Applicative ((:->) i) where   pure x                  = Follows ((pure.pure) x)   Follows f <*> Follows x = Follows (liftA2 (<*>) f x)@@ -175,31 +208,70 @@   pure x                  = Leads   ((pure.pure) x)   Leads   f <*> Leads   x = Leads   (liftA2 (<*>) f x) +-} +-- This one works very differently.  @pure x@ is initially @x@ and then+-- empty, while @lf <*> lx@ changes when either changes.++-- instance Applicative ((:>-) i) where+--   pure x    = leads [x] mempty+--   lf <*> lx = uncurry ($) <$> (lf `pairL` lx)++-- -- | Output an updated pair whenever either element changes.+-- pairL :: a :>- b -> a :>- c -> a :>- (b,c)+-- ab `pairL` ac =+--   leads (liftA2 (,) bs cs) $ pairF (b,c) abf acf+--  where+--    (bs,abf) = splitL ab+--    (cs,acf) = splitL ac+--    -- Oh dear.  b & c might not be well-defined+--    b = last bs+--    c = last cs++ -- | Wrap single-out follow as multi-out follow1 :: Follow a b -> a :-> b  follow1 = Follows . fmap pure  -- | Wrap single-out lead as multi-out lead1   :: Lead a b -> a :>- b-lead1   = Leads   . fmap pure+lead1 (Lead (b,fol)) = Leads (b, follow1 fol)   -- | Start out leading-leads :: [b] -> a :-> b -> a :>- b-leads bs (Follows fol) = Leads (lead bs fol)+leads :: b -> a :-> b -> a :>- b+leads = curry Leads  -- | Start out following follows :: (a -> a :>- b) -> a :-> b-follows h = Follows (follow (unLeads . h))+follows h =+  Follows (Follow (Lead . (pure *** unFollows) . unLeads . h)) +-- h :: a -> a :>- b+-- unLeads . h :: a -> (b, a :-> b)+-- (pure *** unFollows) . unLeads . h+--   :: a -> ([b], a `Follow` [b])+-- Lead . (pure *** unFollows) . unLeads . h+--   :: a -> Lead a [b] +-- follows :: forall a b. (a -> a :>- b) -> a :-> b+-- follows h = Follows s+--  where+--    p :: a -> (b, a :-> b)+--    p = unLeads . h+--    q :: a -> ([b], a `Follow` [b])+--    q = (pure *** unFollows) . p+--    r :: a -> Lead a [b]+--    r = Lead . q+--    s :: Follow a [b]+--    s = Follow r+ -- | Split lead into initial outputs and follow-splitL :: a :>- b -> ([b], a :-> b)-splitL (Leads (Lead (bs,f))) = (bs,Follows f)+splitL :: a :>- b -> (b, a :-> b)+splitL = unLeads  -- | Initial outputs of a lead-initL :: a :>- b -> [b]+initL :: a :>- b -> b initL = fst . splitL  -- | The follow after initial outputs@@ -242,3 +314,27 @@ accumL :: a -> (a->a) :>- a accumL = scanlL (flip ($)) +++{--------------------------------------------------------------------+    Pair editing+--------------------------------------------------------------------}++-- | Decode a pair edit+updPair :: Either c d -> (c,d) -> (c,d)+updPair = (first.const) `either` (second.const)++-- updPair (Left  c') (_,d) = (c',d)+-- updPair (Right d') (c,_) = (c,d')++-- | Pair edit decoder lead.  The inputs say to edit first or second+-- element.  See 'editPairF'.+editPairL :: (c,d) -> Either c d :>- (c,d)+editPairL = leads <*> editPairF++-- editPairL cd = leads cd (editPairF cd)++-- | Pair edit decoder follow.  The inputs say to edit first or second+-- element.  See 'editPairL'.+editPairF :: (c,d) -> Either c d :-> (c,d)+editPairF cd = updPair ^>> accumF cd
src/Examples/LeadFollow.hs view
@@ -21,40 +21,28 @@ import Data.Bot.LeadFollow  --- Decode a pair edit-updPair :: Either c d -> (c,d) -> (c,d)-updPair = (first.const) `either` (second.const)---- updPair (Left  c') (_,d) = (c',d)--- updPair (Right d') (c,_) = (c,d')---- Pair edit decoder lead-editPairL :: (c,d) -> Either c d :>- (c,d)-editPairL = leads.pure <*> editPairF---- editPairL cd = leads [cd] (editPairF cd)---- Pair edit decoder follow-editPairF :: (c,d) -> Either c d :-> (c,d)-editPairF cd = updPair ^>> accumF cd- -- Product of varying ints prod :: (Int,Int) -> Either Int Int :>- Int prod = (fmap.fmap) (uncurry (*)) editPairL -+-- Running count of the number of inputs so far count :: a :>- Int count = scanlL (\ b _ -> b+1) 0 +-- Flip-flop between 'False' & 'True' on each input flipFlop :: a :>- Bool flipFlop = scanlL (\ b _ -> not b) False +-- Running sum of the inputs so far sum :: Num a => a :>- a sum = scanlL (+) 0 +-- How many odd numbers seen so far coundOdd :: Integral a => a :-> Int coundOdd = filterF odd >>> followL count +-- Increment/decrement a counter (possibly both or neither), depending on+-- whether inputs satisfy each of two predicates. upDown :: forall a. (a -> Bool) -> (a -> Bool) -> a :>- Int upDown isUp isDown = (up `mappend` down) `compFL` accumL 0  where@@ -70,18 +58,3 @@ compFL :: a:->b -> b:>-c -> a:>-c fab `compFL` lbc = leads cs0 (fab >>> fbc)   where (cs0,fbc) = splitL lbc---- compLF :: a:>-b -> b:->c -> a:>-c--- lab `compLF` fbc = leads cs0 (fab >>> fbc)---   where (bs0,fab) = splitL lab---         (---- fol >>>> Leads (Lead (cs0,bc)) =---   leads cs0 $ fol >>> Follows bc---- Follows fol >>>> Leads (Lead (cs0,bc)) =---   leads cs0 $ Follows (fol >>> concatMB bc)---- Follows fol >>>> Leads (Lead (cs0,bc)) =---   Leads (Lead (cs0, fol >>> concatMB bc))-