module Pandora.Paradigm.Basis.Conclusion (Conclusion (..), conclusion, fail) where

import Pandora.Core.Functor (Variant (Co))
import Pandora.Core.Morphism ((.))
import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, unwrap))
import Pandora.Paradigm.Controlflow.Joint.Transformer (Transformer (Schema, lay, wrap))
import Pandora.Paradigm.Controlflow.Joint.Schemes.UT (UT (UT))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Divariant (($))
import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (False))
import Pandora.Pattern.Object.Chain (Chain ((<=>)), Ordering (Less, Greater))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))

data Conclusion e a = Failure e | Success a

instance Covariant (Conclusion e) where
        f <$> Success x = Success $ f x
        _ <$> Failure y = Failure y

instance Pointable (Conclusion e) where
        point = Success

instance Applicative (Conclusion e) where
        Success f <*> x = f <$> x
        Failure y <*> _ = Failure y

instance Alternative (Conclusion e) where
        Failure _ <+> x = x
        Success x <+> _ = Success x

instance Traversable (Conclusion e) where
        Failure y ->> _ = point $ Failure y
        Success x ->> f = Success <$> f x

instance Bindable (Conclusion e) where
        Success x >>= f = f x
        Failure y >>= _ = Failure y

instance Monad (Conclusion e) where

instance Interpreted (Conclusion e) where
        type Primary (Conclusion e) a = Conclusion e a
        unwrap x = x

instance Transformer (Conclusion e) where
        type Schema (Conclusion e) u = UT 'Co 'Co (Conclusion e) u
        lay x = UT $ Success <$> x
        wrap x = UT . point $ x

instance Covariant u => Covariant (UT 'Co 'Co (Conclusion e) u) where
        f <$> UT x = UT $ f <$$> x

instance Applicative u => Applicative (UT 'Co 'Co (Conclusion e) u) where
        UT f <*> UT x = UT $ apply <$> f <*> x

instance Pointable u => Pointable (UT 'Co 'Co (Conclusion e) u) where
        point = UT . point . point

instance (Pointable u, Bindable u) => Bindable (UT 'Co 'Co (Conclusion e) u) where
        UT x >>= f = UT $ x >>= conclusion (point . Failure) (unwrap . f)

instance Monad u => Monad (UT 'Co 'Co (Conclusion e) u) where

instance (Setoid e, Setoid a) => Setoid (Conclusion e a) where
        Success x == Success y = x == y
        Failure x == Failure y = x == y
        _ == _ = False

instance (Chain e, Chain a) => Chain (Conclusion e a) where
        Success x <=> Success y = x <=> y
        Failure x <=> Failure y = x <=> y
        Failure _ <=> Success _ = Less
        Success _ <=> Failure _ = Greater

instance (Semigroup e, Semigroup a) => Semigroup (Conclusion e a) where
        Success x + Success y = Success $ x + y
        Failure x + Failure y = Failure $ x + y
        Failure _ + Success y = Success y
        Success x + Failure _ = Success x

conclusion :: (e -> r) -> (a -> r) -> Conclusion e a -> r
conclusion f _ (Failure x) = f x
conclusion _ s (Success x) = s x

fail :: (e -> r) -> Conclusion e a -> Conclusion r a
fail f (Failure x) = Failure $ f x
fail _ (Success y) = Success y