----------------------------------------------------------------------
-- |
-- Module      : ErrM
-- Maintainer  : AR
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:22:00 $ 
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.5 $
--
-- hack for BNFC generated files. AR 21/9/2003
-----------------------------------------------------------------------------

{-# LANGUAGE CPP #-}
module GF.Data.ErrM where

import Control.Monad (MonadPlus(..),ap)
import Control.Applicative
import qualified Control.Monad.Fail as Fail

-- | Like 'Maybe' type with error msgs
data Err a = Ok a | Bad String
  deriving (ReadPrec [Err a]
ReadPrec (Err a)
Int -> ReadS (Err a)
ReadS [Err a]
(Int -> ReadS (Err a))
-> ReadS [Err a]
-> ReadPrec (Err a)
-> ReadPrec [Err a]
-> Read (Err a)
forall a. Read a => ReadPrec [Err a]
forall a. Read a => ReadPrec (Err a)
forall a. Read a => Int -> ReadS (Err a)
forall a. Read a => ReadS [Err a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Err a]
$creadListPrec :: forall a. Read a => ReadPrec [Err a]
readPrec :: ReadPrec (Err a)
$creadPrec :: forall a. Read a => ReadPrec (Err a)
readList :: ReadS [Err a]
$creadList :: forall a. Read a => ReadS [Err a]
readsPrec :: Int -> ReadS (Err a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Err a)
Read, Int -> Err a -> ShowS
[Err a] -> ShowS
Err a -> String
(Int -> Err a -> ShowS)
-> (Err a -> String) -> ([Err a] -> ShowS) -> Show (Err a)
forall a. Show a => Int -> Err a -> ShowS
forall a. Show a => [Err a] -> ShowS
forall a. Show a => Err a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err a] -> ShowS
$cshowList :: forall a. Show a => [Err a] -> ShowS
show :: Err a -> String
$cshow :: forall a. Show a => Err a -> String
showsPrec :: Int -> Err a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Err a -> ShowS
Show, Err a -> Err a -> Bool
(Err a -> Err a -> Bool) -> (Err a -> Err a -> Bool) -> Eq (Err a)
forall a. Eq a => Err a -> Err a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err a -> Err a -> Bool
$c/= :: forall a. Eq a => Err a -> Err a -> Bool
== :: Err a -> Err a -> Bool
$c== :: forall a. Eq a => Err a -> Err a -> Bool
Eq)

-- | Analogue of 'maybe'
err :: (String -> b) -> (a -> b) -> Err a -> b 
err :: (String -> b) -> (a -> b) -> Err a -> b
err String -> b
d a -> b
f Err a
e = case Err a
e of
  Ok a
a -> a -> b
f a
a
  Bad String
s -> String -> b
d String
s

-- | Analogue of 'fromMaybe'
fromErr :: a -> Err a -> a
fromErr :: a -> Err a -> a
fromErr a
a = (String -> a) -> (a -> a) -> Err a -> a
forall b a. (String -> b) -> (a -> b) -> Err a -> b
err (a -> String -> a
forall a b. a -> b -> a
const a
a) a -> a
forall a. a -> a
id

instance Monad Err where
  return :: a -> Err a
return      = a -> Err a
forall a. a -> Err a
Ok
  Ok a
a  >>= :: Err a -> (a -> Err b) -> Err b
>>= a -> Err b
f = a -> Err b
f a
a
  Bad String
s >>= a -> Err b
f = String -> Err b
forall a. String -> Err a
Bad String
s

#if !(MIN_VERSION_base(4,13,0))
  -- Monad(fail) will be removed in GHC 8.8+
  fail = Fail.fail
#endif

instance Fail.MonadFail Err where
  fail :: String -> Err a
fail        = String -> Err a
forall a. String -> Err a
Bad



-- | added 2\/10\/2003 by PEB
instance Functor Err where
  fmap :: (a -> b) -> Err a -> Err b
fmap a -> b
f (Ok a
a) = b -> Err b
forall a. a -> Err a
Ok (a -> b
f a
a)
  fmap a -> b
f (Bad String
s) = String -> Err b
forall a. String -> Err a
Bad String
s

instance Applicative Err where
  pure :: a -> Err a
pure = a -> Err a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: Err (a -> b) -> Err a -> Err b
(<*>) = Err (a -> b) -> Err a -> Err b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

-- | added by KJ
instance MonadPlus Err where
    mzero :: Err a
mzero = String -> Err a
forall a. String -> Err a
Bad String
"error (no reason given)"
    mplus :: Err a -> Err a -> Err a
mplus (Ok a
a)  Err a
_ = a -> Err a
forall a. a -> Err a
Ok a
a
    mplus (Bad String
s) Err a
b = Err a
b

instance Alternative Err where
    empty :: Err a
empty = Err a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: Err a -> Err a -> Err a
(<|>) = Err a -> Err a -> Err a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus