Fun.hs

----------------------------------------------------------------------
-- |
-- Module      :  Data.Fun
-- Copyright   :  (c) Conal Elliott 2007
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Functions, with constant functions optimized.  With instances of
-- 'Functor', 'Applicative', 'Monad', and 'Arrow'
----------------------------------------------------------------------

module Data.Fun (Fun(..), apply) where

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

-- | Constant-optimized functions
data Fun t a = K a                      -- ^ constant function
             | Fun (t -> a)             -- ^ non-constant function

-- | 'Fun' as a function
apply :: Fun t a -> (t -> a)
apply (K   a) = const a
apply (Fun f) = f

instance Functor (Fun t) where
  fmap f (K   a) = K   (f a)
  fmap f (Fun g) = Fun (f.g)
  -- Or use
  --  fmap f = (pure f <*>)

instance Applicative (Fun t) where
  pure        = K
  K f <*> K x = K   (f x)
  cf  <*> cx  = Fun (apply cf <*> apply cx)

instance Monad (Fun t) where
  return = pure
  K   a >>= h = h a
  Fun f >>= h = Fun (f >>= apply . h)

instance Arrow Fun where
  arr             = Fun
  _     >>> K b   = K   b
  K a   >>> Fun g = K   (g a)
  Fun g >>> Fun f = Fun (g >>> f)
  first           = Fun . first  . apply
  second          = Fun . second . apply
  K a'  *** K b'  = K (a',b')
  f     *** g     = first f >>> second g