Misc.hs

{-# OPTIONS -Wall -fno-warn-orphans #-}
{-# LANGUAGE StandaloneDeriving, TypeSynonymInstances
  , GeneralizedNewtypeDeriving
  #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Bot.Misc
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Misc bot alternatives.  See
-- <http://conal.net/blog/posts/functional-reactive-chatter-bots/>.
----------------------------------------------------------------------

module Data.Bot.Misc
  (
   StreamBot, ChoosyBot(..)
  ) where

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

import Data.Stream hiding (zip,unzip,map,scanl,tail)

import Control.Arrow.Transformer.Stream

import Data.Bot.Mutant

-- | Function from streams to streams.  Instance of 'Arrow', 'Functor',
-- 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


---- Move elsewhere

-- data Stream a = Cons a (Stream a) deriving (Show, Eq)

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 ($))