Commit 42f6cda7 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Cabal: define MonadFail instances

This silences `-Wnoncanonical-monadfail-instances` warnings in the Cabal
library
parent cadf0578
......@@ -188,6 +188,8 @@ library
Win32 >= 2.2 && < 2.4
ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs
if impl(ghc >= 8.0)
ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
exposed-modules:
Distribution.Compat.CreatePipe
......@@ -268,6 +270,7 @@ library
other-modules:
Distribution.Compat.CopyFile
Distribution.Compat.MonadFail
Distribution.Compat.Semigroup
Distribution.GetOpt
Distribution.Lex
......
{-# LANGUAGE CPP #-}
-- | Compatibility layer for "Control.Monad.Fail"
module Distribution.Compat.MonadFail ( MonadFail(fail) ) where
#if __GLASGOW_HASKELL__ >= 800
-- provided by base-4.9.0.0 and later
import Control.Monad.Fail (MonadFail(fail))
#else
-- the following code corresponds to
-- http://hackage.haskell.org/package/fail-4.9.0.0
import qualified Prelude as P
import Prelude hiding (fail)
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
class Monad m => MonadFail m where
fail :: String -> m a
-- instances provided by base-4.9
instance MonadFail Maybe where
fail _ = Nothing
instance MonadFail [] where
fail _ = []
instance MonadFail IO where
fail = P.fail
instance MonadFail ReadPrec where
fail = P.fail -- = P (\_ -> fail s)
instance MonadFail ReadP where
fail = P.fail
#endif
......@@ -69,6 +69,8 @@ module Distribution.Compat.ReadP
)
where
import qualified Distribution.Compat.MonadFail as Fail
import Control.Monad( MonadPlus(..), liftM, liftM2, replicateM, ap, (>=>) )
import Data.Char (isSpace)
import Control.Applicative as AP (Applicative(..), Alternative(empty, (<|>)))
......@@ -104,6 +106,9 @@ instance Monad (P s) where
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
fail = Fail.fail
instance Fail.MonadFail (P s) where
fail _ = Fail
instance Alternative (P s) where
......@@ -156,9 +161,12 @@ instance Applicative (Parser r s) where
instance Monad (Parser r s) where
return = AP.pure
fail _ = R (const Fail)
fail = Fail.fail
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
instance Fail.MonadFail (Parser r s) where
fail _ = R (const Fail)
--instance MonadPlus (Parser r s) where
-- mzero = pfail
-- mplus = (+++)
......
......@@ -44,6 +44,7 @@ import Distribution.License
import Distribution.Version
import Distribution.Package
import Distribution.ModuleName
import qualified Distribution.Compat.MonadFail as Fail
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.ReadE
import Distribution.Text
......@@ -100,6 +101,9 @@ instance Monad ParseResult where
ParseOk ws x >>= f = case f x of
ParseFailed err -> ParseFailed err
ParseOk ws' x' -> ParseOk (ws'++ws) x'
fail = Fail.fail
instance Fail.MonadFail ParseResult where
fail s = ParseFailed (FromString s Nothing)
catchParseError :: ParseResult a -> (PError -> ParseResult a)
......
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