LeadFollow.hs

{-# OPTIONS -Wall #-}
{-# LANGUAGE TypeOperators, ScopedTypeVariables #-}
----------------------------------------------------------------------
-- |
-- Module      :  Examples.LeadFollow
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Examples for "Data.Bot.Bot"
----------------------------------------------------------------------

module Examples.LeadFollow where

import Control.Arrow hiding (pure)
import Control.Applicative
import Data.Monoid

import Data.Bot.LeadFollow


-- 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
   up, down :: a :-> (Int -> Int)
   up   = filterF isUp   >>> replace (+ 1)
   down = filterF isDown >>> replace (subtract 1)

-- Replace inputs with a fixed value
replace :: Arrow (~>) => b -> a ~> b
replace b = arr (const b)

-- Follow/lead composition
compFL :: a:->b -> b:>-c -> a:>-c
fab `compFL` lbc = leads cs0 (fab >>> fbc)
  where (cs0,fbc) = splitL lbc