{-# LANGUAGE DeriveDataTypeable #-}
module Data.Option (Option(..), fromMaybe, toMaybe) where
import Data.Data
import Control.Applicative
import Control.Monad

data Option a = Some !a
              | None
  deriving (Eq, Ord, Read, Show, Data, Typeable)

instance Monad Option where
  return = Some
  (Some v) >>= f = f v
  None     >>= f = None

instance MonadPlus Option where
  mzero = None
  None `mplus` v = v
  v    `mplus` _ = v

instance Functor Option where
  fmap f v = return . f =<< v

instance Applicative Option where
  pure  = return
  (<*>) = ap 

instance Alternative Option where
  empty = mzero
  (<|>) = mplus

fromMaybe (Just x) = Some x
fromMaybe Nothing  = None

toMaybe (Some x) = Just x
toMaybe None     = Nothing