Commit 016d1335 authored by Benno Fünfstück's avatar Benno Fünfstück
Browse files

More instances and use ap as default for (<*>)

parent 8558340b
...@@ -69,7 +69,7 @@ module Distribution.Compat.ReadP ...@@ -69,7 +69,7 @@ module Distribution.Compat.ReadP
) )
where where
import Control.Monad( MonadPlus(..), liftM2 ) import Control.Monad( MonadPlus(..), liftM2, ap )
import Data.Char (isSpace) import Data.Char (isSpace)
import Control.Applicative (Applicative(..)) import Control.Applicative (Applicative(..))
...@@ -93,8 +93,7 @@ instance Functor (P s) where ...@@ -93,8 +93,7 @@ instance Functor (P s) where
instance Applicative (P s) where instance Applicative (P s) where
pure = return pure = return
(<*>) = ap
f <*> a = f >>= \f' -> fmap f' a
instance Monad (P s) where instance Monad (P s) where
return x = Result x Fail return x = Result x Fail
...@@ -149,7 +148,7 @@ instance Functor (Parser r s) where ...@@ -149,7 +148,7 @@ instance Functor (Parser r s) where
instance Applicative (Parser r s) where instance Applicative (Parser r s) where
pure = return pure = return
f <*> a = f >>= \f' -> fmap f' a (<*>) = ap
instance Monad (Parser r s) where instance Monad (Parser r s) where
return x = R (\k -> k x) return x = R (\k -> k x)
......
...@@ -72,7 +72,8 @@ import Data.Char (isSpace) ...@@ -72,7 +72,8 @@ import Data.Char (isSpace)
import Data.Maybe (listToMaybe, isJust) import Data.Maybe (listToMaybe, isJust)
import Data.Monoid ( Monoid(..) ) import Data.Monoid ( Monoid(..) )
import Data.List (nub, unfoldr, partition, (\\)) import Data.List (nub, unfoldr, partition, (\\))
import Control.Monad (liftM, foldM, when, unless) import Control.Monad (liftM, foldM, when, unless, ap)
import Control.Applicative (Applicative(..))
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
...@@ -602,6 +603,13 @@ buildInfoNames = map fieldName binfoFieldDescrs ...@@ -602,6 +603,13 @@ buildInfoNames = map fieldName binfoFieldDescrs
-- on the 'mtl' package. -- on the 'mtl' package.
newtype StT s m a = StT { runStT :: s -> m (a,s) } newtype StT s m a = StT { runStT :: s -> m (a,s) }
instance Functor f => Functor (StT s f) where
fmap g (StT f) = StT $ \s -> fmap (\(a,s') -> (g a,s')) $ f s
instance (Monad m, Functor m) => Applicative (StT s m) where
pure = return
(<*>) = ap
instance Monad m => Monad (StT s m) where instance Monad m => Monad (StT s m) where
return a = StT (\s -> return (a,s)) return a = StT (\s -> return (a,s))
StT f >>= g = StT $ \s -> do StT f >>= g = StT $ \s -> do
......
...@@ -87,7 +87,7 @@ import Data.Char (isSpace, toLower, isAlphaNum, isDigit) ...@@ -87,7 +87,7 @@ import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten) import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Monad (foldM) import Control.Monad (foldM, ap)
import Control.Applicative (Applicative(..)) import Control.Applicative (Applicative(..))
import System.FilePath (normalise) import System.FilePath (normalise)
import Data.List (sortBy) import Data.List (sortBy)
...@@ -122,7 +122,8 @@ instance Functor ParseResult where ...@@ -122,7 +122,8 @@ instance Functor ParseResult where
instance Applicative ParseResult where instance Applicative ParseResult where
pure = ParseOk [] pure = ParseOk []
f <*> a = f >>= \f' -> fmap f' a (<*>) = ap
instance Monad ParseResult where instance Monad ParseResult where
return = ParseOk [] return = ParseOk []
......
...@@ -55,6 +55,7 @@ import Data.Either ...@@ -55,6 +55,7 @@ import Data.Either
( partitionEithers ) ( partitionEithers )
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Monad import Control.Monad
import Control.Applicative (Applicative(..))
import qualified Distribution.Compat.ReadP as Parse import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP import Distribution.Compat.ReadP
( (+++), (<++) ) ( (+++), (<++) )
...@@ -769,6 +770,10 @@ instance Functor Match where ...@@ -769,6 +770,10 @@ instance Functor Match where
fmap f (ExactMatch d xs) = ExactMatch d (fmap f xs) fmap f (ExactMatch d xs) = ExactMatch d (fmap f xs)
fmap f (InexactMatch d xs) = InexactMatch d (fmap f xs) fmap f (InexactMatch d xs) = InexactMatch d (fmap f xs)
instance Applicative Match where
pure = return
(<*>) = ap
instance Monad Match where instance Monad Match where
return a = ExactMatch 0 [a] return a = ExactMatch 0 [a]
NoMatch d ms >>= _ = NoMatch d ms NoMatch d ms >>= _ = NoMatch d ms
......
Supports Markdown
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