{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Hcompta.Expr.Maybe where

import Data.Maybe (Maybe(..))
import Control.Monad (Monad(..))
import Data.Function (($))

import Hcompta.Expr.Dup

-- * Class 'Expr_Maybe'

class Expr_Maybe repr where
	default may
	 :: Monad repr
	 => repr (Maybe a)
	 -> repr b
	 -> repr ((->) (repr a) (repr b))
	 -> repr b
	default nothing
	 :: Monad repr
	 => repr (Maybe a)
	default just
	 :: Monad repr
	 => repr a
	 -> repr (Maybe a)
	
	may
	 :: repr (Maybe a)
	 -> repr b
	 -> repr ((->) (repr a) (repr b))
	 -> repr b
	may r_m r_n r_j = do
		m <- r_m
		case m of
		 Nothing -> r_n
		 Just x -> do
			j <- r_j
			j (return x)
	nothing :: repr (Maybe a)
	nothing = return Nothing
	just :: repr a -> repr (Maybe a)
	just r_a = do
		a <- r_a
		return $ Just a

instance -- Expr_Maybe Dup
 ( Expr_Maybe r1
 , Expr_Maybe r2
 , Monad r1
 , Monad r2
 ) => Expr_Maybe (Dup r1 r2) where
	may (m1 `Dup` m2) (n1 `Dup` n2) (r1_j `Dup` r2_j) =
		may m1 n1 (return $ \r1_a -> do
			j <- r1_j
			a <- r1_a
			dup1 $ j $ r1_a `Dup` return a)
		`Dup`
		may m2 n2 (return $ \r2_a -> do
			j <- r2_j
			a <- r2_a
			dup2 $ j $ return a `Dup` r2_a)
	nothing = nothing `Dup` nothing
	just (a1 `Dup` a2) = just (a1 `Dup` a2)