Applicative-Monad Proposal fixes.

Flite/Fresh.hs

@@ -1,17 +1,32 @@
 module Flite.Fresh where
 
-import Control.Monad (replicateM)
+import Control.Applicative (Applicative(..))
+import Control.Monad (ap, liftM, replicateM)
 
 data Fresh a = Fresh { runFresh :: String -> Int -> (Int, a) }
 
 data FreshW a b = FreshW { runFreshW :: String -> Int -> ([a], Int, b) }
 
+instance Functor (FreshW a) where
+  fmap = liftM
+
+instance Applicative (FreshW a) where
+  pure  = return
+  (<*>) = ap
+
 instance Monad (FreshW a) where
   return a = FreshW (\s i -> ([], i, a))
   m >>= f  = FreshW (\s i -> case runFreshW m s i of
                                 (l, j, a) -> let (l', j', a') = runFreshW (f a) s j
                                              in (l ++ l', j', a'))
 
+instance Functor Fresh where
+  fmap = liftM
+
+instance Applicative Fresh where
+  pure  = return
+  (<*>) = ap
+
 instance Monad Fresh where
   return a = Fresh (\s i -> (i, a))
   m >>= f  = Fresh (\s i -> case runFresh m s i of

Flite/Identity.hs

@@ -1,7 +1,17 @@
 module Flite.Identity where
 
+import Control.Applicative (Applicative(..))
+
 newtype Identity a = I { runIdentity :: a }
 
+instance Functor Identity where
+  fmap f (I a) = I $ f a
+
+instance Applicative Identity where
+  pure a = I a
+
+  (I f) <*> (I a) = I $ f a
+
 instance Monad Identity where
   return a = I a
   I a >>= f = f a

Flite/Predex.hs

@@ -11,6 +11,7 @@ module Flite.Predex where
 
 import Data.List
 import Flite.Syntax
+import Control.Applicative (Applicative(..))
 import Control.Monad
 import Flite.Traversals
 import qualified Flite.RedSyntax as R
@@ -61,6 +62,13 @@ checkArg scope e = False
 -- transformations that are applied during a computation.
 data Count a = Count { runCount :: Int -> (Int, a) }
 
+instance Functor Count where
+  fmap = liftM
+
+instance Applicative Count where
+  pure  = return
+  (<*>) = ap
+
 instance Monad Count where
   return a = Count $ \n -> (n, a)
   x >>= f = Count $ \n -> case runCount x n of (m, y) -> runCount (f y) m

Flite/State.hs

@@ -1,7 +1,17 @@
 module Flite.State where
 
+import Control.Applicative (Applicative(..))
+import Control.Monad (ap, liftM)
+
 newtype State s a = S { runState :: s -> (s, a) }
 
+instance Functor (State s) where
+  fmap = liftM
+
+instance Applicative (State s) where
+  pure  = return
+  (<*>) = ap
+
 instance Monad (State s) where
   return a = S (\s -> (s, a))
   m >>= f = S (\s -> case runState m s of

Flite/WriterState.hs

@@ -1,5 +1,6 @@
 module Flite.WriterState where
 
+import Control.Applicative (Applicative(..))
 import Control.Monad
 
 newtype WriterState w s a = WS { runWS :: s -> (s, [w], a) }
@@ -14,6 +15,10 @@ instance Monad (WriterState w s) where
 instance Functor (WriterState w s) where
   fmap = liftM
 
+instance Applicative (WriterState w s) where
+  pure  = return
+  (<*>) = ap
+
 write :: w -> WriterState w s ()
 write w = WS $ \s -> (s, [w], ())