module ErrType where {
  data Err a = Success a | Failure String
               deriving Show;
               
  showErr :: Err Value -> String;
  showErr (Success a)   = showValue a;
  showErr (Failure str) = "Error: "++str;

  unitErr :: a -> Err a;
  unitErr a = Success a ;

  bindErr :: Err a -> (a -> Err b) -> Err b;
  (Success a)   `bindErr` k = k a;
  (Failure str) `bindErr` _ = Failure str;

  type M a = Err a;

  unitM :: a -> M a;
  unitM a = unitErr a;

  bindM :: M a -> (a -> M b) -> M b;
  m `bindM` k = m `bindErr` k;

  failM :: String -> M a;
  failM message = Failure message;

  --     by Daniel P. Friedman and Amr Sabry
  mfixU :: ((a -> M b) -> M (a -> M b)) -> M (a -> M b);
  mfixU f = f (\ a -> mfixU f `bindM` \ v -> v a);

  tryM :: M a -> M a -> M a;
  tryM (Success v) m2 = Success v;
  tryM (Failure _) m2 = m2; 

  data Value = Num Double | Bool Bool | Str String | Char Char 
             | Fun (Value -> M Value) | Pair Value Value | Unit;

  -- Value値を表示するために必要
  instance Show Value where {
    showsPrec p (Num d)  = showParen (p>8) (showString "Num " . shows d);
    showsPrec p (Bool b) = showParen (p>8) (showString "Bool " . shows b);
    showsPrec p (Str d)  = showParen (p>8)
                           (showString "Str " . showChar '"' . showString d. showChar '"');
    showsPrec p (Char c) = showParen (p>8) (showChar '\'' . showChar c . showChar '\'');
    showsPrec p (Fun f)  = showParen (p>8) (showString "Fun <function>");
    showsPrec p (Pair v1 v2) = showParen (p>8) (showChar '(' . showsPrec 0 v1 .
                                                showString ", " . showsPrec 0 v2 .
                                                showChar ')');
    showsPrec p Unit     = showString "Unit"
  };

  showValue (Num d)   = show d;
  showValue (Bool b)  = show b;
  showValue (Str str) = str;
  showValue (Char c)  = [c];
  showValue (Fun _)   = "<function>";
  showValue (Pair v1 v2) = "("++show v1++", "++show v2++")";
  showValue Unit      = "";

  -- Exprの抽象構文
  type Decl = (String, Expr);
  data Expr = Const Value | Var String | If Expr Expr Expr
            | Let Decl Expr | Letrec Decl Expr
            | Lambda String Expr | App Expr Expr
            | Try Expr Expr | Fail Expr
	      deriving Show;
}