module Data.Option where
import Data.Fail
import Data.StrictList.Types
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.Trans
import Data.Aeson
import Data.Data
import Data.Hashable
import GHC.Generics (Generic)
import Safe.Plus
import Test.QuickCheck
import qualified Control.Monad.Fail as Fail
data Option a
= None
| Some !a
deriving (Show, Read, Eq, Generic, Typeable, Data, Functor, Foldable, Traversable)
instance Applicative Option where
pure = Some
f <*> x =
case f of
Some g -> fmap g x
None -> None
instance Monad Option where
(Some x) >>= k = k x
None >>= _ = None
(>>) = (*>)
fail _ = None
instance Monoid a => Monoid (Option a) where
mempty = None
None `mappend` m = m
m `mappend` None = m
Some m1 `mappend` Some m2 = Some (m1 `mappend` m2)
instance Alternative Option where
empty = None
None <|> r = r
l <|> _ = l
instance MonadPlus Option
instance ToJSON a => ToJSON (Option a) where
toJSON = toJSON . optionToMaybe
instance FromJSON a => FromJSON (Option a) where
parseJSON x = maybeToOption <$> parseJSON x
newtype OptionT m a
= OptionT
{ runOptionT :: m (Option a)
}
runOptionTDef :: Functor m => a -> OptionT m a -> m a
runOptionTDef x = fmap (fromOption x) . runOptionT
class ToOptionT t where
optionT :: Monad m => m (t a) -> OptionT m a
instance ToOptionT Maybe where
optionT = OptionT . fmap maybeToOption
instance ToOptionT Option where
optionT = OptionT
instance Functor m => Functor (OptionT m) where
fmap f = OptionT . fmap (fmap f) . runOptionT
instance (Functor m, Monad m) => Applicative (OptionT m) where
pure = return
(<*>) = ap
instance Monad m => Fail.MonadFail (OptionT m) where
fail _ = OptionT (return None)
instance Monad m => Monad (OptionT m) where
fail = safeFail
return = lift . return
x >>= f = OptionT (runOptionT x >>= option (return None) (runOptionT . f))
instance Ord a => Ord (Option a) where
compare x y =
case x of
Some a ->
case y of
Some b -> compare a b
None -> GT
None ->
case y of
None -> EQ
Some _ -> LT
instance NFData a => NFData (Option a) where
rnf None = ()
rnf (Some b) = rnf b
instance MonadTrans OptionT where
lift x = OptionT (Some <$> x)
instance (MonadIO m) => MonadIO (OptionT m) where
liftIO = lift . liftIO
instance Fail.MonadFail Option where
fail _ = None
instance Arbitrary a => Arbitrary (Option a) where
arbitrary = frequency [(1, return None), (3, Some <$> arbitrary)]
shrink (Some x) = None : [ Some x' | x' <- shrink x ]
shrink _ = []
noneIf :: (a -> Bool) -> a -> Option a
noneIf p x
| p x = None
| otherwise = Some x
fromOption :: a -> Option a -> a
fromOption def opt =
case opt of
Some x -> x
None -> def
isSome :: Option a -> Bool
isSome (Some _) = True
isSome _ = False
isNone :: Option a -> Bool
isNone None = True
isNone _ = False
optionToMaybe :: Option a -> Maybe a
optionToMaybe (Some a) = Just a
optionToMaybe None = Nothing
maybeToOption :: Maybe a -> Option a
maybeToOption (Just a) = Some a
maybeToOption Nothing = None
optionToList :: Option a -> [a]
optionToList (Some a) = [a]
optionToList None = []
optionToSL :: Option a -> StrictList a
optionToSL (Some a) = a :! Nil
optionToSL None = Nil
listToOption :: [a] -> Option a
listToOption [] = None
listToOption (x:_) = Some x
getSomeNote :: Monad m => String -> Option a -> m a
getSomeNote str = option (safeFail str) return
option :: b -> (a -> b) -> Option a -> b
option def f opt =
case opt of
Some a -> f $! a
None -> def
catOptions :: [Option a] -> [a]
catOptions ls = [x | Some x <- ls]
mapOption :: (a -> Option b) -> [a] -> [b]
mapOption _ [] = []
mapOption f (x:xs) =
let rs = mapOption f xs in
case f x of
None -> rs
Some r -> r : rs
instance Hashable a => Hashable (Option a)
forOptionM :: Monad m => [a] -> (a -> OptionT m b) -> m [b]
forOptionM xs f = catOptions <$> forM xs (runOptionT . f)
mapOptionM :: Monad m => (a -> OptionT m b) -> [a] -> m [b]
mapOptionM = flip forOptionM
safeFromSome :: Option a -> a
safeFromSome = fromOption (safeError "fromSome is None!")
failToOption :: Fail a -> Option a
failToOption (Ok x) = Some x
failToOption _ = None
optionToFail :: String -> Option a -> Fail a
optionToFail _ (Some x) = Ok x
optionToFail err None = Fail err
optionToFailT :: Monad m => String -> Option a -> FailT m a
optionToFailT _ (Some x) = return x
optionToFailT err None = safeFail err