Commit e70bbe03 authored by byorgey's avatar byorgey
Browse files

Merge pull request #1385 from bennofs/patch-1

Functor and Applicative instances
parents cd935e2e 4761562f
......@@ -69,8 +69,9 @@ module Distribution.Compat.ReadP
)
where
import Control.Monad( MonadPlus(..), liftM2 )
import Control.Monad( MonadPlus(..), liftM2, ap )
import Data.Char (isSpace)
import Control.Applicative (Applicative(..))
infixr 5 +++, <++
......@@ -87,6 +88,13 @@ data P s a
-- Monad, MonadPlus
instance Functor (P s) where
fmap f x = x >>= return . f
instance Applicative (P s) where
pure = return
(<*>) = ap
instance Monad (P s) where
return x = Result x Fail
......@@ -138,6 +146,10 @@ type ReadP r a = Parser r Char a
instance Functor (Parser r s) where
fmap h (R f) = R (\k -> f (k . h))
instance Applicative (Parser r s) where
pure = return
(<*>) = ap
instance Monad (Parser r s) where
return x = R (\k -> k x)
fail _ = R (\_ -> Fail)
......
......@@ -72,7 +72,9 @@ import Data.Char (isSpace)
import Data.Maybe (listToMaybe, isJust)
import Data.Monoid ( Monoid(..) )
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 Control.Arrow (first)
import System.Directory (doesFileExist)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
......@@ -602,6 +604,13 @@ buildInfoNames = map fieldName binfoFieldDescrs
-- on the 'mtl' package.
newtype StT s m a = StT { runStT :: s -> m (a,s) }
instance Functor f => Functor (StT s f) where
fmap g (StT f) = StT $ fmap (first g) . f
instance (Monad m, Functor m) => Applicative (StT s m) where
pure = return
(<*>) = ap
instance Monad m => Monad (StT s m) where
return a = StT (\s -> return (a,s))
StT f >>= g = StT $ \s -> do
......
......@@ -87,7 +87,8 @@ import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map
import Control.Monad (foldM)
import Control.Monad (foldM, ap)
import Control.Applicative (Applicative(..))
import System.FilePath (normalise)
import Data.List (sortBy)
......@@ -115,6 +116,15 @@ showPWarning fpath (UTFWarning line fname) =
data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
deriving Show
instance Functor ParseResult where
fmap _ (ParseFailed err) = ParseFailed err
fmap f (ParseOk ws x) = ParseOk ws $ f x
instance Applicative ParseResult where
pure = return
(<*>) = ap
instance Monad ParseResult where
return = ParseOk []
ParseFailed err >>= _ = ParseFailed err
......
......@@ -55,6 +55,7 @@ import Data.Either
( partitionEithers )
import qualified Data.Map as Map
import Control.Monad
import Control.Applicative (Applicative(..))
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP
( (+++), (<++) )
......@@ -769,6 +770,10 @@ instance Functor Match where
fmap f (ExactMatch d xs) = ExactMatch 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
return a = ExactMatch 0 [a]
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