Commit 0b1bea43 authored by thoughtpolice's avatar thoughtpolice

Fix most AMP warnings.

Authored-by: quchen's avatarDavid Luposchainsky <dluposchainsky@gmail.com>
Signed-off-by: thoughtpolice's avatarAustin Seipp <aseipp@pobox.com>
parent 8859e1e3
......@@ -50,6 +50,9 @@ module DriverPipeline (compileFile) where
import Control.Exception
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data Phase
= Unlit ()
| Ccpp
......@@ -75,6 +78,13 @@ data PipeState = PipeState {
newtype CompPipeline a = P { unP :: PipeState -> IO (PipeState, a) }
instance Functor CompPipeline where
fmap = liftM
instance Applicative CompPipeline where
pure = return
(<*>) = ap
instance Monad CompPipeline where
return a = P $ \state -> return (state, a)
P m >>= k = P $ \state -> do (state',a) <- m state
......
......@@ -2,6 +2,9 @@
module Cpr001_imp where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data MS = MS { instr :: String
, pc :: Int
, mem :: String
......@@ -18,6 +21,13 @@ newtype StateTrans s a = ST ( s -> (s, Maybe a))
-- as it is and Nothing is returned as value
-- else execution continues
instance Functor (StateTrans s) where
fmap = liftM
instance Applicative (StateTrans s) where
pure = return
(<*>) = ap
instance Monad (StateTrans s) where
(ST p) >>= k
= ST (\s0 -> let
......
......@@ -5,6 +5,9 @@
-- one-argument newtype defined in the same module
module ShouldSucceed where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
-- library stuff
class Monad m => MonadState s m | m -> s where
......@@ -15,6 +18,13 @@ newtype State s a = State {
runState :: (s -> (a, s))
}
instance Functor (State s) where
fmap = liftM
instance Applicative (State s) where
pure = return
(<*>) = ap
instance Monad (State s) where
return a = State $ \s -> (a, s)
m >>= k = State $ \s -> let
......@@ -28,7 +38,7 @@ instance MonadState s (State s) where
-- test code
newtype Foo a = MkFoo (State Int a)
deriving (Monad, MonadState Int)
deriving (Functor, Applicative, Monad, MonadState Int)
f :: Foo Int
f = get
......@@ -6,8 +6,10 @@
module ShouldCompile where
import Control.Applicative (Applicative)
import Foreign.Ptr
newtype RenderM a = RenderM (IO a) deriving (Functor, Monad)
newtype RenderM a = RenderM (IO a) deriving (Functor, Applicative, Monad)
type RenderCallback = Int -> Int -> RenderM ()
......
......@@ -14,6 +14,9 @@
module Sample where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data Safe
data MayFail
......@@ -23,6 +26,13 @@ data Result s a where
newtype M s a = M { unM :: IO (Result s a) }
instance Functor (M s) where
fmap = liftM
instance Applicative (M s) where
pure = return
(<*>) = ap
instance Monad (M s) where
return x = M (return (Ok x))
......
......@@ -2,6 +2,9 @@
module Main where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
-- abstract syntax -------------------------------------------------------------
data Ty t where
Bool :: Ty Bool
......@@ -87,6 +90,13 @@ data Tree a = Val a | Choice (Tree a) (Tree a)
-- Val :: a -> Tree a Z
-- Choice :: Tree a n -> Tree a n -> Tree a (S n)
instance Functor Tree where
fmap = liftM
instance Applicative Tree where
pure = return
(<*>) = ap
instance Monad Tree where
return x = Val x
(Val a) >>= f = f a
......
......@@ -6,6 +6,9 @@ import System.IO
import System.IO.Unsafe
import Debug.Trace
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
-- parser produced by Happy Version 1.16
data HappyAbsSyn
......@@ -166,6 +169,13 @@ newtype HappyIdentity a = HappyIdentity a
happyIdentity = HappyIdentity
happyRunIdentity (HappyIdentity a) = a
instance Functor HappyIdentity where
fmap = liftM
instance Applicative HappyIdentity where
pure = return
(<*>) = ap
instance Monad HappyIdentity where
return = HappyIdentity
(HappyIdentity p) >>= q = q p
......
Breakpoint 0 activated at ../HappyTest.hs:(216,1)-(227,35)
Stopped at ../HappyTest.hs:(216,1)-(227,35)
Breakpoint 0 activated at ../HappyTest.hs:(226,1)-(237,35)
Stopped at ../HappyTest.hs:(226,1)-(237,35)
_result :: [Token] = _
*** Ignoring breakpoint
*** Ignoring breakpoint
......
......@@ -2,6 +2,8 @@
module ShouldCompile where
import Control.Applicative (Applicative)
data family S a
newtype instance S Int = S Int
......@@ -10,5 +12,5 @@ newtype instance S Int = S Int
data family S2 a b
newtype instance S2 Int b = S2 (IO b)
deriving Monad
deriving (Functor, Applicative, Monad)
......@@ -10,8 +10,18 @@ module Main (main) where
import Control.Monad.Fix
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data X a = X a deriving Show
instance Functor X where
fmap = liftM
instance Applicative X where
pure = return
(<*>) = ap
instance Monad X where
return = X
(X a) >>= f = f a
......
......@@ -7,8 +7,18 @@ module Foo where
import qualified Prelude
import Prelude hiding (Monad(..))
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
newtype Identity a = Identity { runIdentity :: a }
instance Prelude.Functor Identity where
fmap = liftM
instance Applicative Identity where
pure = Prelude.return
(<*>) = ap
instance Prelude.Monad Identity where
return a = Identity a
m >>= k = k (runIdentity m)
......
......@@ -2,5 +2,7 @@
{-# OPTIONS_GHC -Wall -Werror #-}
module Bug(P) where
newtype P a = P (IO a) deriving Monad
import Control.Applicative (Applicative)
newtype P a = P (IO a) deriving (Functor, Applicative, Monad)
{-# LANGUAGE CPP #-}
module T7145b ( A.Applicative(pure) ) where
import qualified Control.Applicative as A
......
T7145b.hs:6:1: Warning: Defined but not used: ‛pure’
T7145b.hs:8:1: Warning: Defined but not used: ‛pure’
......@@ -4,6 +4,7 @@
module Simpl009Help where
import Control.Applicative (Applicative(..), Alternative(empty, (<|>)))
import Control.Monad
newtype Parser s a
......@@ -14,6 +15,13 @@ data P s res
| Fail [String] [String]
| Result res (P s res)
instance Functor (Parser s) where
fmap = liftM
instance Applicative (Parser s) where
pure = return
(<*>) = ap
instance Monad (Parser s) where
return a = Parser (\fut -> fut a)
......@@ -23,6 +31,10 @@ instance Monad (Parser s) where
fail s =
Parser (\fut exp -> Fail exp [s])
instance Alternative (Parser s) where
empty = mzero
(<|>) = mplus
instance MonadPlus (Parser s) where
mplus = error "urk"
mzero = Parser (\fut exp -> Fail exp [])
......
......@@ -11,8 +11,18 @@ module EvalTest where
import GHC.Conc
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data Eval a = Done a
instance Functor Eval where
fmap = liftM
instance Applicative Eval where
pure = return
(<*>) = ap
instance Monad Eval where
return x = Done x
Done x >>= k = k x -- Note: pattern 'Done x' makes '>>=' strict
......
......@@ -6,6 +6,7 @@
module T3831(setAttributes) where
import Data.Monoid
import Control.Applicative (Applicative(..), Alternative(empty, (<|>)))
import Control.Monad
class (Monoid s, OutputCap s) => TermStr s
......@@ -17,13 +18,13 @@ class OutputCap f where
instance OutputCap [Char] where
instance (Enum p, OutputCap f) => OutputCap (p -> f) where
instance MonadPlus Capability where
mzero = Capability (const $ return Nothing)
Capability f `mplus` Capability g = Capability $ \t -> do
mx <- f t
case mx of
Nothing -> g t
_ -> return mx
instance Functor Capability where
fmap = liftM
instance Applicative Capability where
pure = return
(<*>) = ap
instance Monad Capability where
return = Capability . const . return . Just
......@@ -33,6 +34,18 @@ instance Monad Capability where
Nothing -> return Nothing
Just x -> let Capability g' = g x in g' t
instance Alternative Capability where
empty = mzero
(<|>) = mplus
instance MonadPlus Capability where
mzero = Capability (const $ return Nothing)
Capability f `mplus` Capability g = Capability $ \t -> do
mx <- f t
case mx of
Nothing -> g t
_ -> return mx
newtype Capability a = Capability (() -> IO (Maybe a))
tiGetOutput1 :: forall f . OutputCap f => String -> Capability f
......
......@@ -4,6 +4,8 @@
module T4203 where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
newtype NonNegative a = NonNegative a
deriving (Eq, Num, Show)
......@@ -26,6 +28,13 @@ instance Arbitrary EmptyStackSet where
newtype Gen a = Gen a
instance Functor Gen where
fmap = liftM
instance Applicative Gen where
pure = return
(<*>) = ap
instance Monad Gen where
return a = Gen a
Gen m >>= k = Gen (let Gen m' = k m in m')
......
......@@ -5,9 +5,19 @@
module T3955 where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
class (Monad m) => MonadReader r m
newtype Reader r a = Reader { runReader :: r -> a }
instance Functor (Reader r) where
fmap = liftM
instance Applicative (Reader r) where
pure = return
(<*>) = ap
instance Monad (Reader r) where
(>>=) = error "urk"
return = error "urk"
......@@ -15,7 +25,7 @@ instance Monad (Reader r) where
instance MonadReader r (Reader r)
newtype T a x = T (Reader a x)
deriving (Monad, MonadReader a)
deriving (Functor, Applicative, Monad, MonadReader a)
{-
[1 of 1] Compiling Main ( bug.hs, interpreted )
......
......@@ -6,6 +6,8 @@
module Storage.Hashed.Monad () where
import Control.Applicative (Applicative(..))
class Monad m => TreeRO m where
withDirectory :: (MonadError e m) => Int -> m a -> m a
expandTo :: (MonadError e m) => Int -> m Int
......@@ -18,6 +20,13 @@ instance (Monad m, MonadError e m) => TreeRO (M m) where
data M (m :: * -> *) a
instance Functor (M m) where
fmap = undefined
instance Applicative (M m) where
pure = undefined
(<*>) = undefined
instance Monad m => Monad (M m) where
(>>=) = undefined
return = undefined
......
module Tc239_Help ( WrapIO, WrapIO2 ) where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
newtype WrapIO e a = MkWrapIO { unwrap :: IO a }
type WrapIO2 a = WrapIO String a
instance Functor (WrapIO e) where
fmap = liftM
instance Applicative (WrapIO e) where
pure = return
(<*>) = ap
instance Monad (WrapIO e) where
return x = MkWrapIO (return x)
......
module ShouldSucceed where
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
data State c a = State (c -> (a,c))
unState :: State c a -> (c -> (a,c))
......@@ -13,6 +16,13 @@ bindState m k = State (\s0 -> let (a,s1) = (unState m) s0
(b,s2) = (unState (k a)) s1
in (b,s2))
instance Eq c => Functor (State c) where
fmap = liftM
instance Eq c => Applicative (State c) where
pure = return
(<*>) = ap
instance Eq c => Monad (State c) where
return = unitState
(>>=) = bindState
......
......@@ -12,4 +12,4 @@ class MyFunctor f where
class MyFunctor ap => MyApplicative ap where
type ApplicativeCtxt ap a :: Constraint
type ApplicativeCtxt ap a = FunctorCtxt ap a
(<*>) :: (ApplicativeCtxt ap a, ApplicativeCtxt ap b) => ap (a -> b) -> ap a -> ap b
(<***>) :: (ApplicativeCtxt ap a, ApplicativeCtxt ap b) => ap (a -> b) -> ap a -> ap b
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment