{-# LANGUAGE TypeFamilies          #-}

-- |
-- Module      : Data.Adaptive.Maybe
-- Copyright   : (c) Don Stewart 2009
-- License     : BSD-style
-- Maintainer  : dons@galois.com
-- Stability   : experimental
-- 
-- Self optimzing sum types.
--
-- This library statically adapts the polymorphic container
-- representation of Maybe to specific, more efficient representations,
-- when instantiated with particular monomorphic types. It does this via
-- an associated more efficient data type for each pair of elements you
-- wish to store in your container.
--
-- That is, instead of representing 'Maybe Int' as:
--
-- >           Just
-- >             | 
-- >           I# 3#
--
-- A self-optimizing pair will unpack the constructors, yielding this
-- data representation:
--
-- >       JustInt 3#
--
-- Saving an indirection. The resulting structure should be both more
-- time and space efficient than the generic polymorphic container it is
-- derived from.
--
-- Self adaptive polymorphic containers are able to unpack their
-- components, something not possible with, for example, strict
-- polymorphic containers.
--

module Data.Adaptive.Maybe where

import Prelude hiding (Maybe(..), maybe)
import Data.Word
import Data.Int

class AdaptMaybe a where

    data Maybe a

    -- construction
    just    :: a -> Maybe a
    {-# INLINE just #-}

    nothing :: Maybe a
    {-# INLINE nothing #-}

    -- | The 'isJust' function returns 'True' iff its argument is of the
    -- form @Just _@.
    isJust  :: Maybe a -> Bool
    {-# INLINE isJust #-}

    -- elimination
    maybe   :: b -> (a -> b) -> Maybe a -> b
    {-# INLINE maybe #-}

------------------------------------------------------------------------

-- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.
isNothing :: AdaptMaybe a => Maybe a -> Bool
isNothing = not . isJust
{-# INLINE isNothing #-}

-- | The 'fromJust' function extracts the element out of a 'Just' and
-- throws an error if its argument is 'Nothing'.
fromJust :: AdaptMaybe a => Maybe a -> a
fromJust = maybe (error "Data.Adaptive.Maybe.fromJust: Nothing") id
{-# INLINE fromJust #-}

-- | The 'fromMaybe' function takes a default value and and 'Maybe'
-- value.  If the 'Maybe' is 'Nothing', it returns the default values;
-- otherwise, it returns the value contained in the 'Maybe'.
fromMaybe :: AdaptMaybe a => a -> Maybe a -> a
fromMaybe d = maybe d id
{-# INLINE fromMaybe #-}

-- | The 'maybeToList' function returns an empty list when given
-- 'Nothing' or a singleton list when not given 'Nothing'.
maybeToList :: AdaptMaybe a => Maybe a -> [a]
maybeToList = maybe [] (:[])
{-# INLINE maybeToList #-}

-- | The 'listToMaybe' function returns 'Nothing' on an empty list
-- or @'Just' a@ where @a@ is the first element of the list.
listToMaybe :: AdaptMaybe a => [a] -> Maybe a
listToMaybe []        =  nothing
listToMaybe (a:_)     =  just a
{-# INLINE listToMaybe #-}

-- | The 'catMaybes' function takes a list of 'Maybe's and returns
-- a list of all the 'Just' values. 
catMaybes :: AdaptMaybe a => [Maybe a] -> [a]
catMaybes ls = [ fromJust x | x <- ls, isJust x ]

-- | The 'mapMaybe' function is a version of 'map' which can throw
-- out elements.  In particular, the functional argument returns
-- something of type @'Maybe' b@.  If this is 'Nothing', no element
-- is added on to the result list.  If it just @'Just' b@, then @b@ is
-- included in the result list.
mapMaybe :: AdaptMaybe b => (a -> Maybe b) -> [a] -> [b]
mapMaybe _ []     = []
mapMaybe f (x:xs) = maybe rs (:rs) (f x)
 where
    rs = mapMaybe f xs

------------------------------------------------------------------------
-- Generated by scripts/derive-maybe.hs
-- Instances
--

instance AdaptMaybe Int where
    data Maybe Int = NothingInt | JustInt {-# UNPACK #-}!Int
    just = JustInt
    nothing = NothingInt
    isJust (JustInt _) = True
    isJust _ = False
    maybe n _ NothingInt = n
    maybe _ f (JustInt x) = f x

instance AdaptMaybe Integer where
    data Maybe Integer = NothingInteger | JustInteger {-# UNPACK #-}!Integer
    just = JustInteger
    nothing = NothingInteger
    isJust (JustInteger _) = True
    isJust _ = False
    maybe n _ NothingInteger = n
    maybe _ f (JustInteger x) = f x

instance AdaptMaybe Int8 where
    data Maybe Int8 = NothingInt8 | JustInt8 {-# UNPACK #-}!Int8
    just = JustInt8
    nothing = NothingInt8
    isJust (JustInt8 _) = True
    isJust _ = False
    maybe n _ NothingInt8 = n
    maybe _ f (JustInt8 x) = f x

instance AdaptMaybe Int16 where
    data Maybe Int16 = NothingInt16 | JustInt16 {-# UNPACK #-}!Int16
    just = JustInt16
    nothing = NothingInt16
    isJust (JustInt16 _) = True
    isJust _ = False
    maybe n _ NothingInt16 = n
    maybe _ f (JustInt16 x) = f x

instance AdaptMaybe Int32 where
    data Maybe Int32 = NothingInt32 | JustInt32 {-# UNPACK #-}!Int32
    just = JustInt32
    nothing = NothingInt32
    isJust (JustInt32 _) = True
    isJust _ = False
    maybe n _ NothingInt32 = n
    maybe _ f (JustInt32 x) = f x

instance AdaptMaybe Int64 where
    data Maybe Int64 = NothingInt64 | JustInt64 {-# UNPACK #-}!Int64
    just = JustInt64
    nothing = NothingInt64
    isJust (JustInt64 _) = True
    isJust _ = False
    maybe n _ NothingInt64 = n
    maybe _ f (JustInt64 x) = f x

instance AdaptMaybe Word where
    data Maybe Word = NothingWord | JustWord {-# UNPACK #-}!Word
    just = JustWord
    nothing = NothingWord
    isJust (JustWord _) = True
    isJust _ = False
    maybe n _ NothingWord = n
    maybe _ f (JustWord x) = f x

instance AdaptMaybe Word8 where
    data Maybe Word8 = NothingWord8 | JustWord8 {-# UNPACK #-}!Word8
    just = JustWord8
    nothing = NothingWord8
    isJust (JustWord8 _) = True
    isJust _ = False
    maybe n _ NothingWord8 = n
    maybe _ f (JustWord8 x) = f x

instance AdaptMaybe Word16 where
    data Maybe Word16 = NothingWord16 | JustWord16 {-# UNPACK #-}!Word16
    just = JustWord16
    nothing = NothingWord16
    isJust (JustWord16 _) = True
    isJust _ = False
    maybe n _ NothingWord16 = n
    maybe _ f (JustWord16 x) = f x

instance AdaptMaybe Word32 where
    data Maybe Word32 = NothingWord32 | JustWord32 {-# UNPACK #-}!Word32
    just = JustWord32
    nothing = NothingWord32
    isJust (JustWord32 _) = True
    isJust _ = False
    maybe n _ NothingWord32 = n
    maybe _ f (JustWord32 x) = f x

instance AdaptMaybe Word64 where
    data Maybe Word64 = NothingWord64 | JustWord64 {-# UNPACK #-}!Word64
    just = JustWord64
    nothing = NothingWord64
    isJust (JustWord64 _) = True
    isJust _ = False
    maybe n _ NothingWord64 = n
    maybe _ f (JustWord64 x) = f x

instance AdaptMaybe Double where
    data Maybe Double = NothingDouble | JustDouble {-# UNPACK #-}!Double
    just = JustDouble
    nothing = NothingDouble
    isJust (JustDouble _) = True
    isJust _ = False
    maybe n _ NothingDouble = n
    maybe _ f (JustDouble x) = f x

instance AdaptMaybe Float where
    data Maybe Float = NothingFloat | JustFloat {-# UNPACK #-}!Float
    just = JustFloat
    nothing = NothingFloat
    isJust (JustFloat _) = True
    isJust _ = False
    maybe n _ NothingFloat = n
    maybe _ f (JustFloat x) = f x

instance AdaptMaybe Char where
    data Maybe Char = NothingChar | JustChar {-# UNPACK #-}!Char
    just = JustChar
    nothing = NothingChar
    isJust (JustChar _) = True
    isJust _ = False
    maybe n _ NothingChar = n
    maybe _ f (JustChar x) = f x