diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright © 2016 Kyle McKean +Copyright © 2018chessai + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Kyle McKean nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Maybe/Unpacked.hs b/src/Data/Maybe/Unpacked.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked.hs @@ -0,0 +1,620 @@ +-------------------------------------------------------------------------------- + +-- Copyright © 2016 Kyle McKean +-- Copyright © 2018 Daniel Cartwright + +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- * Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above +-- copyright notice, this list of conditions and the following +-- disclaimer in the documentation and/or other materials provided +-- with the distribution. +-- +-- * Neither the name of Kyle McKean nor the names of other +-- contributors may be used to endorse or promote products derived +-- from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-------------------------------------------------------------------------------- + +{-# OPTIONS_GHC -Wall #-} + +-------------------------------------------------------------------------------- + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +-------------------------------------------------------------------------------- + +{-| This module is intended to be a drop-in replacement + for base's 'Data.Maybe'. To shave off pointer chasing, it + uses @'-XUnboxedSums'@ to represent the @'Maybe'@ type + as two machine words that are contiguous in memory, without + loss of expressiveness that base's 'Data.Maybe' provides. + + This library provides pattern synonyms @'Just'@ and @'Nothing'@ + that allow users to pattern match on an unpacked Maybe + in a familiar way. + + Functions are also provided for converting an unpacked Maybe + to the base library's Maybe, and vice versa. + + This library is in alpha, and the internals + are likely to change. +-} + +module Data.Maybe.Unpacked + ( Maybe(Maybe, Just, Nothing) + , nothing + , just + , maybe + , isJust + , isNothing + , fromJust + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + , fromBaseMaybe + , toBaseMaybe + ) where + +-------------------------------------------------------------------------------- + +import Prelude + () + +import Control.Applicative (Alternative(empty, (<|>)), Applicative(liftA2, pure, (<*>), (*>))) + +import Control.Monad (Monad(return, (>>=)), MonadPlus(mzero, mplus)) +import Control.Monad.Fail (MonadFail(fail)) +import Control.Monad.Fix (MonadFix(mfix)) +import Control.Monad.Zip (MonadZip(mzipWith)) + +import Data.Data + ( Constr + , Data(dataTypeOf, gunfold, toConstr) + , DataType + , Fixity(Prefix) + , mkConstr + , mkDataType + ) +import Data.Eq (Eq((==))) +import Data.Foldable + (Foldable(foldMap, foldr, foldl, length, null, product, sum)) + +import Data.Function (const, flip, id, (.), ($)) +import Data.Functor (Functor(fmap)) +import Data.Functor.Classes + ( Eq1(liftEq) + , Ord1(liftCompare) + , Read1(liftReadPrec, liftReadListPrec, liftReadList) + , Show1(liftShowsPrec) + , readData + , readUnaryWith + , liftReadListPrecDefault + , liftReadListDefault + , showsUnaryWith + ) + +import qualified Data.Maybe as BaseMaybe +import Data.Monoid (Monoid(mempty,mappend)) +import Data.Ord (Ord(compare, (>)), Ordering(EQ, GT, LT)) +import Data.Semigroup (Semigroup((<>))) +import Data.Traversable (Traversable(sequenceA, traverse)) + +import GHC.Base (Bool(False,True), Int, build) +import GHC.Err (error, errorWithoutStackTrace) +import GHC.Num ( (+) ) +import GHC.Read (Read(readPrec), expectP) +import GHC.Show (Show(showsPrec), showString, showParen) + +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +-------------------------------------------------------------------------------- + +-- | The 'Maybe' type encapsulates an optional value. A value of type +-- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@), +-- or it is empty (represented as @'Nothing'@). Using 'Maybe' is a good way to +-- deal with errors or exceptional cases without resorting to drastic +-- measures such as 'error'. +-- +-- The 'Maybe' type is also a monad. It is a simple kind of error +-- monad, where all errors are represented by @'Nothing'@. A richer +-- error monad can be built using the 'Data.Either.Either' type. +-- +data Maybe a = Maybe (# (# #) | a #) + +-- | The 'Just' pattern synonym mimics the functionality of the 'Data.Maybe.Just' constructor +-- from /Data.Maybe/. +-- +pattern Just :: a -> Maybe a +pattern Just a = Maybe (# | a #) + +-- | The 'Nothing' pattern synonym mimics the functionality of the 'Data.Maybe.Nothing' constructor +-- from /Data.Maybe/. +-- +pattern Nothing :: Maybe a +pattern Nothing = Maybe (# (# #) | #) + +{-# COMPLETE Just, Nothing #-} + +-- | This is the same as 'Nothing'. +nothing :: Maybe a +nothing = Maybe (# (# #) | #) +{-# INLINE nothing #-} + +-- | This is the same as 'Just'. +just :: a -> Maybe a +just x = Maybe (# | x #) +{-# INLINE just #-} + +-- | The 'maybe' function takes a default value, a function, and a 'Maybe' +-- value. If the 'Maybe' value is 'Nothing', the function returns the +-- default value. Otherwise, it applies the function to the value inside +-- the 'Just' and returns the result. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> maybe False odd (just 3) +-- True +-- +-- >>> maybe False odd nothing +-- False +-- +-- Read an integer from a string using 'readMaybe'. If we succeed, +-- return twice the integer; that is, apply @(*2)@ to it. If instead +-- we fail to parse an integer, return @0@ by default: +-- +-- >>> maybe 0 (*2) (fromBaseMaybe $ readMaybe "5") +-- 10 +-- >>> maybe 0 (*2) (fromBaseMaybe $ readMaybe "") +-- 0 +-- +-- Apply 'show' to a @Maybe Int@. If we have @'just' n@, we want to show +-- the underlying 'Int' @n@. But if we have 'nothing', we return the +-- empty string instead of (for example) \"Nothing\": +-- +-- >>> maybe "" show (just 5) +-- "5" +-- >>> maybe "" show nothing +-- "" +-- +maybe :: b -> (a -> b) -> Maybe a -> b +maybe def f (Maybe x) = case x of + (# (# #) | #) -> def + (# | a #) -> f a +{-# INLINE maybe #-} + +-- | The 'isJust' function returns 'True' if its argument is of the +-- form @Just _@. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> isJust (just 3) +-- True +-- +-- >>> isJust (just ()) +-- True +-- +-- >>> isJust nothing +-- False +-- +-- Only the outer constructor is taken into consideration: +-- +-- >>> isJust (just nothing) +-- True +-- +isJust :: Maybe a -> Bool +isJust = maybe False (const True) +{-# INLINE isJust #-} + +-- | The 'isNothing' function returns 'True' if its argument is 'nothing'. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> isNothing (just 3) +-- False +-- +-- >>> isNothing (just ()) +-- False +-- +-- >>> isNothing nothing +-- True +-- +-- Only the outer constructor is taken into consideration: +-- +-- >>> isNothing (just nothing) +-- False +isNothing :: Maybe a -> Bool +isNothing = maybe True (const False) +{-# INLINE isNothing #-} + +-- | The 'fromJust' function extracts the element out of a 'just' and +-- throws an error if its argument is 'nothing'. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> fromJust (just 1) +-- 1 +-- +-- >>> 2 * (fromJust (just 10)) +-- 20 +-- +-- >>> 2 * (fromJust nothing) +-- *** Exception: Data.Maybe.Unpacked.fromJust: Nothing +-- +fromJust :: Maybe a -> a +fromJust = fromMaybe (error "Data.Maybe.Unpacked.fromJust: Nothing") +{-# 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'. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> fromMaybe "" (just "Hello, World!") +-- "Hello, World!" +-- +-- >>> fromMaybe "" nothing +-- "" +-- +-- Read an integer from a string using 'readMaybe'. If we fail to +-- parse an integer, we want to return @0@ by default: +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> fromMaybe 0 (parse "5") +-- 5 +-- >>> fromMaybe 0 (parse "") +-- 0 +-- +fromMaybe :: a -> Maybe a -> a +fromMaybe def = maybe def id +{-# INLINE fromMaybe #-} + +-- | The 'maybeToList' function returns an empty list when given +-- 'nothing' or a singleton list when not given 'nothing'. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> maybeToList (just 7) +-- [7] +-- +-- >>> maybeToList nothing +-- [] +-- +-- One can use 'maybeToList' to avoid pattern matching when combined +-- with a function that (safely) works on lists: +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> sum $ maybeToList (parse "3") +-- 3 +-- >>> sum $ maybeToList (parse "") +-- 0 +-- +-- This being said 'Maybe' is an instance of the 'Foldable' typeclass +-- so the example above could also be written as: +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> sum $ parse "3" +-- 3 +-- >>> sum $ parse "" +-- 0 +-- +maybeToList :: 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. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> listToMaybe [] +-- Nothing +-- +-- >>> listToMaybe [9] +-- Just 9 +-- +-- >>> listToMaybe [1,2,3] +-- Just 1 +-- +-- Composing 'maybeToList' with 'listToMaybe' should be the identity +-- on singleton/empty lists: +-- +-- >>> maybeToList $ listToMaybe [5] +-- [5] +-- >>> maybeToList $ listToMaybe [] +-- [] +-- +-- But not on lists with more than one element: +-- +-- >>> maybeToList $ listToMaybe [1,2,3] +-- [1] +-- +listToMaybe :: [a] -> Maybe a +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +-- | The 'catMaybes' function takes a list of 'Maybe's and returns +-- a list of all the 'just' values. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> catMaybes [just 1, nothing, just 3] +-- [1,3] +-- +-- When constructing a list of 'Maybe' values, 'catMaybes' can be used +-- to return all of the \"success\" results (if the list is the result +-- of a 'map', then 'mapMaybe' would be more appropriate): +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> [ parse x | x <- ["1", "Foo", "3"] ] +-- [Just 1,Nothing,Just 3] +-- >>> catMaybes $ [ parse x | x <- ["1", "Foo", "3"] ] +-- [1,3] +-- +catMaybes :: [Maybe a] -> [a] +catMaybes = mapMaybe id +{-# INLINE catMaybes #-} + +-- | 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 is @'Just' b@, then @b@ is +-- included in the result list. +-- +-- ==== __Examples__ +-- +-- Using @'mapMaybe' f x@ is a shortcut for @'catMaybes' $ 'map' f x@ +-- in most cases: +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> mapMaybe parse ["1", "Foo", "3"] +-- [1,3] +-- >>> catMaybes $ map parse ["1", "Foo", "3"] +-- [1,3] +-- +-- If we map the 'just' function, the entire list should be returned: +-- +-- >>> mapMaybe just [1,2,3] +-- [1,2,3] +-- +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe _ [] = [] +mapMaybe f !(a:as) = let bs = mapMaybe f as in maybe bs (: bs) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +-- | The 'fromBaseMaybe' function converts base's 'Data.Maybe.Maybe' to a +-- 'Data.Maybe.Unpacked.Maybe'. This function is good for using existing +-- functions that return 'Data.Maybe' maybes. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> import Text.Read ( readMaybe ) +-- >>> let parse = fromBaseMaybe . readMaybe :: String -> Maybe Int +-- >>> parse "3" +-- Just 3 +-- >>> parse "" +-- Nothing +-- +fromBaseMaybe :: BaseMaybe.Maybe a -> Maybe a +fromBaseMaybe (BaseMaybe.Just x) = just x +fromBaseMaybe _ = nothing +{-# INLINE fromBaseMaybe #-} + +-- | The 'toBaseMaybe' function converts a 'Maybe' value to a +-- value of base's 'Data.Maybe.Maybe' type. +-- +-- This function is provided for testing and convenience +-- but it is not an idiomatic use of this library. It ruins the speed and space gains from +-- unpacking the 'Maybe'. I implore you to destruct the 'Maybe' with 'maybe' instead. +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> import Data.List (unfoldr) +-- >>> let ana n = if n == 5 then nothing else just (n+1,n+1) +-- >>> unfoldr (toBaseMaybe . ana) 0 +-- [1,2,3,4,5] +-- +toBaseMaybe :: Maybe a -> BaseMaybe.Maybe a +toBaseMaybe = maybe BaseMaybe.Nothing BaseMaybe.Just +{-# INLINE toBaseMaybe #-} + +-------------------------------------------------------------------------------- + +-- Below here lie only instances, and helpers for instances + +maybeDataType :: DataType +maybeDataType = mkDataType "Data.Maybe.Unpacked.Maybe" [nothingConstr, justConstr] + +nothingConstr :: Constr +nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix + +justConstr :: Constr +justConstr = mkConstr maybeDataType "Just" [] Prefix + +instance Data a => Data (Maybe a) where + toConstr = maybe nothingConstr (const justConstr) + gunfold _ _ = errorWithoutStackTrace "Data.Data.gunfold(Data.Maybe.Unpacked.Maybe)" + dataTypeOf _ = maybeDataType + +instance Functor Maybe where + fmap f = maybe nothing (just . f) + {-# INLINE fmap #-} + +instance Applicative Maybe where + pure = just + {-# INLINE pure #-} + mf <*> mx = maybe nothing (\f -> fmap f mx) mf + {-# INLINE (<*>) #-} + +instance Monad Maybe where + return = just + {-# INLINE return #-} + mx >>= f = maybe nothing f mx + {-# INLINE (>>=) #-} + +instance MonadFail Maybe where + fail _ = nothing + {-# INLINE fail #-} + +instance MonadFix Maybe where + mfix f = let a = f (fromJust a) in a + {-# INLINE mfix #-} + +instance MonadZip Maybe where + mzipWith = liftA2 + {-# INLINE mzipWith #-} + +instance Alternative Maybe where + empty = nothing + {-# INLINE empty #-} + mx <|> my = maybe my just mx + {-# INLINE (<|>) #-} + +instance MonadPlus Maybe where + mzero = nothing + {-# INLINE mzero #-} + mplus mx my = maybe my just mx + {-# INLINE mplus #-} + +instance Foldable Maybe where + foldMap f ma = maybe mempty f ma + {-# INLINE foldMap #-} + foldr f z ma = maybe z ((flip f) z) ma + {-# INLINE foldr #-} + foldl f z ma = maybe z (f z) ma + {-# INLINE foldl #-} + length = maybe 0 (const 1) + {-# INLINE length #-} + null = isNothing + {-# INLINE null #-} + product = maybe 0 id + {-# INLINE product #-} + sum = maybe 0 id + {-# INLINE sum #-} + +instance Traversable Maybe where + sequenceA ma = maybe (pure nothing) (fmap just) ma + {-# INLINE sequenceA #-} + traverse f ma = maybe (pure nothing) (fmap just . f) ma + {-# INLINE traverse #-} + +instance Semigroup a => Semigroup (Maybe a) where + ma <> mb = maybe mb (\a -> maybe ma (\b -> just (a <> b)) mb) ma + {-# INLINE (<>) #-} + +instance Semigroup a => Monoid (Maybe a) where + mempty = nothing + {-# INLINE mempty #-} + mappend = (<>) + {-# INLINE mappend #-} + +instance Eq a => Eq (Maybe a) where + ma == mb = maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + {-# INLINE (==) #-} + +instance Ord a => Ord (Maybe a) where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + {-# INLINE compare #-} + +appPrec :: Int +appPrec = 10 +{-# INLINE appPrec #-} + +instance Show a => Show (Maybe a) where + showsPrec p ma = maybe (showString "Nothing") + (\a -> showParen (p > appPrec) (showString "Just " . (showsPrec (appPrec + 1) a))) ma + +instance Read a => Read (Maybe a) where + readPrec = parens $ nothingP +++ justP + where nothingP = prec appPrec $ do + Ident "Nothing" <- lexP + return nothing + justP = prec appPrec $ do + Ident "Just" <- lexP + a <- step readPrec + return (just a) + +instance Eq1 Maybe where + liftEq _ Nothing Nothing = True + liftEq _ Nothing (Just _) = False + liftEq _ (Just _) Nothing = False + liftEq eq (Just x) (Just y) = eq x y + +instance Ord1 Maybe where + liftCompare _ Nothing Nothing = EQ + liftCompare _ Nothing (Just _) = LT + liftCompare _ (Just _) Nothing = GT + liftCompare comp (Just x) (Just y) = comp x y + +instance Read1 Maybe where + liftReadPrec rp _ = + parens (expectP (Ident "Nothing") *> pure nothing) + <|> + readData (readUnaryWith rp "Just" just) + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault + +instance Show1 Maybe where + liftShowsPrec _ _ _ Nothing = showString "Nothing" + liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE KindSignatures #-} + +module Main (main) where + +import Prelude hiding (Maybe(..), maybe) + +import Control.Applicative +import Control.Monad (liftM, MonadPlus) +import Control.Monad.Zip (MonadZip) +import Data.Functor.Classes +import Data.Maybe.Unpacked (Maybe(Just, Nothing), nothing, just) +import Data.Monoid (Monoid(mempty,mappend)) +import Data.Proxy (Proxy(..)) +import Data.Semigroup (Semigroup((<>))) +import Test.QuickCheck.Classes +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Gen + +main :: IO () +main = lawsCheckMany myClassTests + +myClassTests :: [(String, [Laws])] +myClassTests = + [ ("Ground types", myLaws maybeInt) + , ("Higher-kinded types", myLaws1 maybeProxy) + ] + +myLaws + :: (Arbitrary a, Monoid a, Eq a, Ord a, Semigroup a, Show a, Read a) + => Proxy a -> [Laws] +myLaws p = + [ commutativeMonoidLaws p + , eqLaws p + , ordLaws p + , semigroupLaws p + , showReadLaws p + ] + +myLaws1 + :: (Arbitrary1 a, Alternative a, Applicative a, Foldable a, Functor a, Monad a, MonadPlus a, MonadZip a, Traversable a, Eq1 a, Show1 a) + => Proxy a -> [Laws] +myLaws1 p = + [ alternativeLaws p + , applicativeLaws p + , foldableLaws p + , functorLaws p + , monadLaws p + , monadPlusLaws p + , monadZipLaws p + , traversableLaws p + ] + +maybeProxy :: Proxy Maybe +maybeProxy = Proxy + +maybeInt :: Proxy (Maybe Int) +maybeInt = Proxy + +instance Semigroup Int where + (<>) = (+) + +instance Monoid Int where + mempty = 0 + mappend = (+) + +instance Arbitrary a => Arbitrary (Maybe a) where + arbitrary = arbitrary1 + shrink = shrink1 + +instance Arbitrary1 Maybe where + liftArbitrary arb = frequency [(1, return nothing), (3, liftM just arb)] + + liftShrink shr (Just x) = nothing : [ just x' | x' <- shr x ] + liftShrink _ Nothing = [] diff --git a/unpacked-maybe.cabal b/unpacked-maybe.cabal new file mode 100644 --- /dev/null +++ b/unpacked-maybe.cabal @@ -0,0 +1,54 @@ +-------------------------------------------------------------------------------- + +name: unpacked-maybe +version: 0.1.0.0 +synopsis: An unpacked maybe data type +description: + This module is intended to be a drop-in replacement for the Maybe type provided by base. To shave off pointer chasing, it uses '-XUnboxedSums' to represent the Maybe type as two machine words that are contiguous in memory, without loss of expressiveness that Maybe provides. + . + This library provides pattern synonyms Just and Nothing that allow users to pattern match on an Unpacked Maybe in the familiar way. + . + Functions are also provided for converting an Unpacked Maybe to the base library's Maybe, and vice versa. + . + This library is in alpha, and the internals are likely to change. +homepage: https://github.com/mckeankylej/unpacked-maybe#readme +license: BSD3 +license-file: LICENSE +author: Kyle McKean, chessai +maintainer: mckean.kylej@gmail.com +copyright: + Copyright © 2018 Kyle McKean + Copyright © 2018chessai +category: Development +build-type: Simple +cabal-version: >=1.10 + +-------------------------------------------------------------------------------- + +library + hs-source-dirs: src + exposed-modules: Data.Maybe.Unpacked + build-depends: base >= 4.10 && < 5 + , ghc-prim + default-language: Haskell2010 + +------------------------------------------------------------------------------- + +test-suite unpacked-maybe-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base + , unpacked-maybe + , QuickCheck + , quickcheck-classes + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 + default-language: Haskell2010 + +------------------------------------------------------------------------------- + +source-repository head + type: git + location: https://github.com/mckeankylej/unpacked-maybe + +--------------------------------------------------------------------------------