{-# OPTIONS -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aviary.Functional -- Copyright : (c) Stephen Peter Tetley 2010 -- License : BSD3 -- -- Maintainer : stephen.tetley@gmail.com -- Stability : experimental -- Portability : to be determined -- -- Functor, Applicative, Monad operations /specialized/ to -- the functional type. -- -- This is for reference (obviously) and is not intended for use. -- ----------------------------------------------------------------------------- module Data.Aviary.Functional ( -- * Functor fmap -- * Applicative , (<$>) , (<$) , pure , (<*>) , (*>) , (<*) , (<**>) , liftA, liftA2, liftA3 -- * Category , id , (.) , (<<<) , (>>>) -- * Monad , (>>=) , (>>) , return , fail , mapM, mapM_ , forM, forM_ , sequence, sequence_ , (=<<) , (>=>), (<=<) , forever , join , filterM , mapAndUnzipM , zipWithM, zipWithM_ , foldM, foldM_ , replicateM, replicateM_ , when , unless , liftM, liftM2, liftM3, liftM4, liftM5 , ap -- * Arrow , arr , first , second , (***) , (&&&) , returnA , (^>>), (>>^) , (<<^), (^<<) , left, right , (+++), (|||) , app, leftApp , loop -- * Comonad , extract , duplicate , extend , liftW , (=>>), (.>>) , liftCtx , mapW , parallelW , unfoldW , sequenceW ) where import qualified Control.Applicative as Ap import qualified Control.Arrow as Arr import qualified Control.Category as Cat import qualified Control.Monad as Mon import Data.Monoid ( Monoid(..) ) import Prelude ( String, Bool, Int, Either, head, tail, fst, snd ) -------------------------------------------------------------------------------- -- Functor -- ((->) r) replaces the type variable f fmap :: (a -> b) -> (r -> a) -> (r -> b) fmap = Mon.fmap -------------------------------------------------------------------------------- -- Control.Applicative -- ((->) r) replaces the type variable f (<$>) :: (a -> b) -> (r -> a) -> (r -> b) (<$>) = Mon.fmap (<$) :: a -> (r -> b) -> (r -> a) (<$) = (Ap.<$) -- Applicative class pure :: a -> (r -> a) pure = Ap.pure (<*>) :: (r -> a -> b) -> (r -> a) -> (r -> b) (<*>) = (Ap.<*>) (*>) :: (r -> a) -> (r -> b) -> (r -> b) (*>) = (Ap.*>) (<*) :: (r -> a) -> (r -> b) -> (r -> a) (<*) = (Ap.<*) -- No function instance of Alternative. (<**>) :: (r -> a) -> (r -> a -> b) -> (r -> b) (<**>) = (Ap.<**>) liftA :: (a -> b) -> (r -> a) -> (r -> b) liftA = Ap.liftA liftA2 :: (a -> b -> c) -> (r -> a) -> (r -> b) -> (r -> c) liftA2 = Ap.liftA2 liftA3 :: (a -> b -> c -> d) -> (r -> a) -> (r -> b) -> (r -> c) -> (r -> d) liftA3 = Ap.liftA3 -- No optional (due to no Alternative instance) -------------------------------------------------------------------------------- -- Control.Category -- (->) replaces the type variable cat id :: a -> a id = Cat.id (.) :: (b -> c) -> (a -> b) -> (a -> c) (.) = (Cat..) (<<<) :: (b -> c) -> (a -> b) -> (a -> c) (<<<) = (Cat.<<<) (>>>) :: (a -> b) -> (b -> c) -> (a -> c) (>>>) = (Cat.>>>) -------------------------------------------------------------------------------- -- Control.Monad -- The monad here is the environent monad (aka reader) -- ((->) r) replaces the type variable m (>>=) :: (r -> a) -> (a -> r -> b) -> (r -> b) (>>=) = (Mon.>>=) (>>) :: (r -> a) -> (r -> b) -> (r -> b) (>>) = (Mon.>>) return :: a -> (r -> a) return = Mon.return fail :: String -> (r -> a) fail = Mon.fail -- No function instance of MonadPlus mapM :: (a -> r -> b) -> [a] -> r -> [b] mapM = Mon.mapM mapM_ :: (a -> r -> b) -> [a] -> r -> () mapM_ = Mon.mapM_ forM :: [a] -> (a -> r -> b) -> r -> [b] forM = Mon.forM forM_ :: [a] -> (a -> r -> b) -> r -> () forM_ = Mon.forM_ sequence :: [r -> a] -> r -> [a] sequence = Mon.sequence sequence_ :: [r -> a] -> r -> () sequence_ = Mon.sequence_ (=<<) :: (a -> r -> b) -> (r -> a) -> r -> b (=<<) = (Mon.=<<) (>=>) :: (a -> r -> b) -> (b -> r -> c) -> a -> r -> c (>=>) = (Mon.>=>) (<=<) :: (b -> r -> c) -> (a -> r -> b) -> a -> r -> c (<=<) = (Mon.<=<) forever :: (r -> a) -> (r -> b) forever = Mon.forever join :: (r -> (r -> a)) -> r -> a join = Mon.join filterM :: (a -> r -> Bool) -> [a] -> r -> [a] filterM = Mon.filterM mapAndUnzipM :: (a -> r -> (b, c)) -> [a] -> r -> ([b], [c]) mapAndUnzipM = Mon.mapAndUnzipM zipWithM :: (a -> b -> r -> c) -> [a] -> [b] -> r -> [c] zipWithM = Mon.zipWithM zipWithM_ :: (a -> b -> r -> c) -> [a] -> [b] -> r -> () zipWithM_ = Mon.zipWithM_ foldM :: (a -> b -> r -> a) -> a -> [b] -> r -> a foldM = Mon.foldM foldM_ :: (a -> b -> r -> a) -> a -> [b] -> r -> () foldM_ = Mon.foldM_ replicateM :: Int -> (r -> a) -> r -> [a] replicateM = Mon.replicateM replicateM_ :: Int -> (r -> a) -> r -> () replicateM_ = Mon.replicateM_ when :: Bool -> (r -> ()) -> r -> () when = Mon.when unless :: Bool -> (r -> ()) -> r -> () unless = Mon.unless liftM :: (a -> b) -> (r -> a) -> r -> b liftM = Mon.liftM liftM2 :: (a -> b -> c) -> (r -> a) -> (r -> b) -> r -> c liftM2 = Mon.liftM2 liftM3 :: (a -> b -> c -> d) -> (r -> a) -> (r -> b) -> (r -> c) -> r -> d liftM3 = Mon.liftM3 liftM4 :: (a -> b -> c -> d -> e) -> (r -> a) -> (r -> b) -> (r -> c) -> (r -> d) -> r -> e liftM4 = Mon.liftM4 liftM5 :: (a -> b -> c -> d -> e -> f) -> (r -> a) -> (r -> b) -> (r -> c) -> (r -> d) -> (r -> e) -> r -> f liftM5 = Mon.liftM5 ap :: (r -> a -> b) -> (r -> a) -> r -> b ap = Mon.ap -------------------------------------------------------------------------------- -- Control.Arrow -- (->) replaces the type variable a arr :: (b -> c) -> b -> c arr = Arr.arr first :: (b -> c) -> (b, d) -> (c, d) first = Arr.first second :: (b -> c) -> (d, b) -> (d, c) second = Arr.second (***) :: (b -> c) -> (b' -> c') -> (b, b') -> (c, c') (***) = (Arr.***) (&&&) :: (b -> c) -> (b -> c') -> b -> (c, c') (&&&) = (Arr.&&&) returnA :: (b -> b) returnA = Arr.returnA (^>>) :: (b -> c) -> (c -> d) -> (b -> d) (^>>) = (Arr.^>>) (>>^) :: (b -> c) -> (c -> d) -> (b -> d) (>>^) = (Arr.>>^) (<<^) :: (c -> d) -> (b -> c) -> (b -> d) (<<^) = (Arr.<<^) (^<<) :: (c -> d) -> (b -> c) -> (b -> d) (^<<) = (Arr.^<<) -- ArrowChoice left :: (b -> c) -> (Either b d) -> (Either c d) left = Arr.left right :: (b -> c) -> (Either d b) -> (Either d c) right = Arr.right (+++) :: (b -> c) -> (b' -> c') -> (Either b b') -> (Either c c') (+++) = (Arr.+++) (|||) :: (b -> d) -> (c -> d) -> (Either b c) -> d (|||) = (Arr.|||) -- ArrowApply app :: (b -> c, b) -> c app = Arr.app leftApp :: (b -> c) -> (Either b d) -> (Either c d) leftApp = Arr.leftApp -- ArrowLoop loop :: ((b, d) -> (c, d)) -> b -> c loop = Arr.loop -------------------------------------------------------------------------------- -- Comonad -- Acknowledgement - the type signatures and definitions are from -- Category.Extras. -- The comonad here is the 'anonymous exponent' comonad -- ((->) m) where m is an instance of Monoid, replaces w extract :: Monoid m => (m -> a) -> a extract w = w mempty duplicate :: Monoid m => (m -> a) -> m -> (m -> a) duplicate w m = w . mappend m extend :: Monoid m => ((m -> a) -> b) -> (m -> a) -> m -> b extend wf w m = wf ((duplicate w) m) liftW :: Monoid m => (a -> b) -> (m -> a) -> m -> b liftW f w m = f (w m) (=>>) :: Monoid m => (m -> a) -> ((m -> a) -> b) -> m -> b (=>>) w wf m = wf ((duplicate w) m) (.>>) :: Monoid m => (m -> a) -> b -> m -> b (.>>) w b = extend (\_ -> b) w liftCtx :: Monoid m => (a -> b) -> (m -> a) -> b liftCtx f w = extract (fmap f w) mapW :: Monoid m => ((m -> a) -> b) -> (m -> [a]) -> [b] mapW wf w = step (extract w) where step [] = [] step _ = wf (fmap head w) : mapW wf (fmap tail w) parallelW :: Monoid m => (m -> [a]) -> [m -> a] parallelW ws = step (extract ws) where step [] = [] step _ = (fmap head ws) : parallelW (fmap tail ws) unfoldW :: Monoid m => ((m -> b) -> (a, b)) -> (m -> b) -> [a] unfoldW wf w = fst (wf w) : unfoldW wf (extend (snd . wf) w) sequenceW :: Monoid m => [(m -> a) -> b] -> (m -> a) -> [b] sequenceW [] _ = [] sequenceW (f:fs) w = f w : sequenceW fs w