{- |
Module      :  Data.MaybeLike.Instances
Copyright   :  (c) Eduard Sergeev 2013
License     :  BSD-style (see the file LICENSE)

Maintainer  :  eduard.sergeev@gmail.com
Stability   :  experimental
Portability :  non-portable (multi-param classes, functional dependencies)

Defines default instances of `MaybeLike` for most primitive "Unboxed" types

-}

{-# LANGUAGE NoImplicitPrelude, MultiParamTypeClasses,
  FlexibleContexts, FlexibleInstances #-}


module Data.MaybeLike.Instances
(

  module Data.MaybeLike

) where

import Data.Eq ((==))
import Prelude (Bounded(maxBound), (/), isNaN)
import Prelude (Float, Double)
import Data.Char
import Data.Int
import Data.Word
import qualified Data.Maybe as M

import Data.MaybeLike


instance MaybeLike (M.Maybe a) a where
    {-# INLINE nothing #-}
    nothing :: Maybe a
nothing = Maybe a
forall a. Maybe a
M.Nothing
    {-# INLINE isNothing #-}
    isNothing :: Maybe a -> Bool
isNothing = Maybe a -> Bool
forall a. Maybe a -> Bool
M.isNothing
    {-# INLINE just #-}
    just :: a -> Maybe a
just = a -> Maybe a
forall a. a -> Maybe a
M.Just
    {-# INLINE fromJust #-}
    fromJust :: Maybe a -> a
fromJust = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
M.fromJust

instance MaybeLike Char Char where
    {-# INLINE nothing #-}
    nothing :: Char
nothing = Char
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Char -> Bool
isNothing Char
v = Char
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Char -> Char
just Char
v = Char
v
    {-# INLINE fromJust #-}
    fromJust :: Char -> Char
fromJust Char
v = Char
v 

instance MaybeLike Int Int where
    {-# INLINE nothing #-}
    nothing :: Int
nothing = Int
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Int -> Bool
isNothing Int
v = Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Int -> Int
just Int
v = Int
v
    {-# INLINE fromJust #-}
    fromJust :: Int -> Int
fromJust Int
v = Int
v 

instance MaybeLike Int8 Int8 where
    {-# INLINE nothing #-}
    nothing :: Int8
nothing = Int8
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Int8 -> Bool
isNothing Int8
v = Int8
v Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Int8 -> Int8
just Int8
v = Int8
v
    {-# INLINE fromJust #-}
    fromJust :: Int8 -> Int8
fromJust Int8
v = Int8
v 

instance MaybeLike Int16 Int16 where
    {-# INLINE nothing #-}
    nothing :: Int16
nothing = Int16
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Int16 -> Bool
isNothing Int16
v = Int16
v Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Int16 -> Int16
just Int16
v = Int16
v
    {-# INLINE fromJust #-}
    fromJust :: Int16 -> Int16
fromJust Int16
v = Int16
v 

instance MaybeLike Int32 Int32 where
    {-# INLINE nothing #-}
    nothing :: Int32
nothing = Int32
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Int32 -> Bool
isNothing Int32
v = Int32
v Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Int32 -> Int32
just Int32
v = Int32
v
    {-# INLINE fromJust #-}
    fromJust :: Int32 -> Int32
fromJust Int32
v = Int32
v 

instance MaybeLike Int64 Int64 where
    {-# INLINE nothing #-}
    nothing :: Int64
nothing = Int64
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Int64 -> Bool
isNothing Int64
v = Int64
v Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Int64 -> Int64
just Int64
v = Int64
v
    {-# INLINE fromJust #-}
    fromJust :: Int64 -> Int64
fromJust Int64
v = Int64
v 


instance MaybeLike Word Word where
    {-# INLINE nothing #-}
    nothing :: Word
nothing = Word
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Word -> Bool
isNothing Word
v = Word
v Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Word -> Word
just Word
v = Word
v
    {-# INLINE fromJust #-}
    fromJust :: Word -> Word
fromJust Word
v = Word
v 

instance MaybeLike Word8 Word8 where
    {-# INLINE nothing #-}
    nothing :: Word8
nothing = Word8
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Word8 -> Bool
isNothing Word8
v = Word8
v Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Word8 -> Word8
just Word8
v = Word8
v
    {-# INLINE fromJust #-}
    fromJust :: Word8 -> Word8
fromJust Word8
v = Word8
v 

instance MaybeLike Word16 Word16 where
    {-# INLINE nothing #-}
    nothing :: Word16
nothing = Word16
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Word16 -> Bool
isNothing Word16
v = Word16
v Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Word16 -> Word16
just Word16
v = Word16
v
    {-# INLINE fromJust #-}
    fromJust :: Word16 -> Word16
fromJust Word16
v = Word16
v 

instance MaybeLike Word32 Word32 where
    {-# INLINE nothing #-}
    nothing :: Word32
nothing = Word32
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Word32 -> Bool
isNothing Word32
v = Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Word32 -> Word32
just Word32
v = Word32
v
    {-# INLINE fromJust #-}
    fromJust :: Word32 -> Word32
fromJust Word32
v = Word32
v 

instance MaybeLike Word64 Word64 where
    {-# INLINE nothing #-}
    nothing :: Word64
nothing = Word64
forall a. Bounded a => a
maxBound
    {-# INLINE isNothing #-}
    isNothing :: Word64 -> Bool
isNothing Word64
v = Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
forall a. Bounded a => a
maxBound
    {-# INLINE just #-}
    just :: Word64 -> Word64
just Word64
v = Word64
v
    {-# INLINE fromJust #-}
    fromJust :: Word64 -> Word64
fromJust Word64
v = Word64
v


instance MaybeLike Float Float where
    {-# INLINE nothing #-}
    nothing :: Float
nothing = Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
    {-# INLINE isNothing #-}
    isNothing :: Float -> Bool
isNothing = Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN
    {-# INLINE just #-}
    just :: Float -> Float
just Float
v = Float
v
    {-# INLINE fromJust #-}
    fromJust :: Float -> Float
fromJust Float
v = Float
v 

instance MaybeLike Double Double where
    {-# INLINE nothing #-}
    nothing :: Double
nothing = Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
    {-# INLINE isNothing #-}
    isNothing :: Double -> Bool
isNothing = Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN
    {-# INLINE just #-}
    just :: Double -> Double
just Double
v = Double
v
    {-# INLINE fromJust #-}
    fromJust :: Double -> Double
fromJust Double
v = Double
v