tuples (empty) → 0.1.0.0
raw patch · 6 files changed
+442/−0 lines, 6 filesdep +QuickCheckdep +basedep +primitivesetup-changed
Dependencies added: QuickCheck, base, primitive, quickcheck-classes, tasty, tasty-quickcheck, tuples
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Data/Tuple/Types.hs +309/−0
- test/Main.hs +55/−0
- tuples.cabal +41/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for tuples++## 0.1.0.0 -- 2019-08-29++* First version. Includes pairs and triples for `Int`, `Word`, `Double`, and `ByteArray`
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++All rights reserved.++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 Andrew Martin 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Tuple/Types.hs view
@@ -0,0 +1,309 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language DerivingStrategies #-}++module Data.Tuple.Types+ ( -- * Pairs+ DoublePair(..)+ , IntPair(..)+ , WordPair(..)+ , ByteArrayPair(..)+ -- * Triples+ , DoubleTriple(..)+ , IntTriple(..)+ , WordTriple(..)+ , ByteArrayTriple(..)+ ) where++import Data.Primitive (ByteArray)+import Data.Primitive.Types (Prim)+import GHC.Exts ((+#),(*#))++import qualified Data.Primitive.Types as P++data DoublePair = DoublePair+ {-# UNPACK #-} !Double+ {-# UNPACK #-} !Double+ deriving stock (Eq,Ord,Show)+data DoubleTriple = DoubleTriple+ {-# UNPACK #-} !Double+ {-# UNPACK #-} !Double+ {-# UNPACK #-} !Double+ deriving stock (Eq,Ord,Show)++data IntPair = IntPair+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ deriving stock (Eq,Ord,Show)+data IntTriple = IntTriple+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ deriving stock (Eq,Ord,Show)++data WordPair = WordPair+ {-# UNPACK #-} !Word+ {-# UNPACK #-} !Word+ deriving stock (Eq,Ord,Show)+data WordTriple = WordTriple+ {-# UNPACK #-} !Word+ {-# UNPACK #-} !Word+ {-# UNPACK #-} !Word+ deriving stock (Eq,Ord,Show)++data ByteArrayPair = ByteArrayPair+ {-# UNPACK #-} !ByteArray+ {-# UNPACK #-} !ByteArray+ deriving stock (Eq,Ord,Show)+data ByteArrayTriple = ByteArrayTriple+ {-# UNPACK #-} !ByteArray+ {-# UNPACK #-} !ByteArray+ {-# UNPACK #-} !ByteArray+ deriving stock (Eq,Ord,Show)++instance Prim IntTriple where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 3# *# P.sizeOf# (undefined :: Int)+ alignment# _ = P.alignment# (undefined :: Int)+ indexByteArray# arr# i# = IntTriple+ (P.indexByteArray# arr# (3# *# i#))+ (P.indexByteArray# arr# ((3# *# i#) +# 1#))+ (P.indexByteArray# arr# ((3# *# i#) +# 2#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readByteArray# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, IntTriple i0 i1 i2 #)+ writeByteArray# arr# i# (IntTriple a b c) =+ \s0 -> case P.writeByteArray# arr# (3# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeByteArray# arr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = IntTriple+ (P.indexOffAddr# arr# (3# *# i#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 1#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 2#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, IntTriple i0 i1 i2 #)+ writeOffAddr# addr# i# (IntTriple a b c) =+ \s0 -> case P.writeOffAddr# addr# (3# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeOffAddr# addr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setOffAddr# = P.defaultSetOffAddr#++instance Prim WordTriple where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 3# *# P.sizeOf# (undefined :: Word)+ alignment# _ = P.alignment# (undefined :: Word)+ indexByteArray# arr# i# = WordTriple+ (P.indexByteArray# arr# (3# *# i#))+ (P.indexByteArray# arr# ((3# *# i#) +# 1#))+ (P.indexByteArray# arr# ((3# *# i#) +# 2#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readByteArray# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, WordTriple i0 i1 i2 #)+ writeByteArray# arr# i# (WordTriple a b c) =+ \s0 -> case P.writeByteArray# arr# (3# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeByteArray# arr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = WordTriple+ (P.indexOffAddr# arr# (3# *# i#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 1#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 2#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, WordTriple i0 i1 i2 #)+ writeOffAddr# addr# i# (WordTriple a b c) =+ \s0 -> case P.writeOffAddr# addr# (3# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeOffAddr# addr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setOffAddr# = P.defaultSetOffAddr#++instance Prim DoubleTriple where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 3# *# P.sizeOf# (undefined :: Double)+ alignment# _ = P.alignment# (undefined :: Double)+ indexByteArray# arr# i# = DoubleTriple+ (P.indexByteArray# arr# (3# *# i#))+ (P.indexByteArray# arr# ((3# *# i#) +# 1#))+ (P.indexByteArray# arr# ((3# *# i#) +# 2#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readByteArray# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, DoubleTriple i0 i1 i2 #)+ writeByteArray# arr# i# (DoubleTriple a b c) =+ \s0 -> case P.writeByteArray# arr# (3# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeByteArray# arr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = DoubleTriple+ (P.indexOffAddr# arr# (3# *# i#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 1#))+ (P.indexOffAddr# arr# ((3# *# i#) +# 2#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (3# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> case P.readOffAddr# arr# ((3# *# i#) +# 2#) s2 of+ (# s3, i2 #) -> (# s3, DoubleTriple i0 i1 i2 #)+ writeOffAddr# addr# i# (DoubleTriple a b c) =+ \s0 -> case P.writeOffAddr# addr# (3# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((3# *# i#) +# 1#) b s1 of+ s2 -> case P.writeOffAddr# addr# ((3# *# i#) +# 2# ) c s2 of+ s3 -> s3+ setOffAddr# = P.defaultSetOffAddr#++instance Prim DoublePair where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 2# *# P.sizeOf# (undefined :: Double)+ alignment# _ = P.alignment# (undefined :: Double)+ indexByteArray# arr# i# = DoublePair+ (P.indexByteArray# arr# (2# *# i#))+ (P.indexByteArray# arr# ((2# *# i#) +# 1#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, DoublePair i0 i1 #)+ writeByteArray# arr# i# (DoublePair a b) =+ \s0 -> case P.writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = DoublePair+ (P.indexOffAddr# arr# (2# *# i#))+ (P.indexOffAddr# arr# ((2# *# i#) +# 1#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, DoublePair i0 i1 #)+ writeOffAddr# addr# i# (DoublePair a b) =+ \s0 -> case P.writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = P.defaultSetOffAddr#++instance Prim IntPair where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 2# *# P.sizeOf# (undefined :: Int)+ alignment# _ = P.alignment# (undefined :: Int)+ indexByteArray# arr# i# = IntPair+ (P.indexByteArray# arr# (2# *# i#))+ (P.indexByteArray# arr# ((2# *# i#) +# 1#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, IntPair i0 i1 #)+ writeByteArray# arr# i# (IntPair a b) =+ \s0 -> case P.writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = IntPair+ (P.indexOffAddr# arr# (2# *# i#))+ (P.indexOffAddr# arr# ((2# *# i#) +# 1#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, IntPair i0 i1 #)+ writeOffAddr# addr# i# (IntPair a b) =+ \s0 -> case P.writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = P.defaultSetOffAddr#++instance Prim WordPair where+ {-# inline sizeOf# #-}+ {-# inline alignment# #-}+ {-# inline indexByteArray# #-}+ {-# inline readByteArray# #-}+ {-# inline writeByteArray# #-}+ {-# inline setByteArray# #-}+ {-# inline indexOffAddr# #-}+ {-# inline readOffAddr# #-}+ {-# inline writeOffAddr# #-}+ {-# inline setOffAddr# #-}+ sizeOf# _ = 2# *# P.sizeOf# (undefined :: Int)+ alignment# _ = P.alignment# (undefined :: Int)+ indexByteArray# arr# i# = WordPair+ (P.indexByteArray# arr# (2# *# i#))+ (P.indexByteArray# arr# ((2# *# i#) +# 1#))+ readByteArray# arr# i# =+ \s0 -> case P.readByteArray# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readByteArray# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, WordPair i0 i1 #)+ writeByteArray# arr# i# (WordPair a b) =+ \s0 -> case P.writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case P.writeByteArray# arr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setByteArray# = P.defaultSetByteArray#+ indexOffAddr# arr# i# = WordPair+ (P.indexOffAddr# arr# (2# *# i#))+ (P.indexOffAddr# arr# ((2# *# i#) +# 1#))+ readOffAddr# arr# i# =+ \s0 -> case P.readOffAddr# arr# (2# *# i#) s0 of+ (# s1, i0 #) -> case P.readOffAddr# arr# ((2# *# i#) +# 1#) s1 of+ (# s2, i1 #) -> (# s2, WordPair i0 i1 #)+ writeOffAddr# addr# i# (WordPair a b) =+ \s0 -> case P.writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case P.writeOffAddr# addr# ((2# *# i#) +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = P.defaultSetOffAddr#
+ test/Main.hs view
@@ -0,0 +1,55 @@+{-# language DerivingStrategies #-}+{-# language DerivingVia #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language LambdaCase #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++import Data.Tuple.Types (IntPair(..),WordPair(..))+import Data.Tuple.Types (IntTriple(..),WordTriple(..))+import Data.Tuple.Types (DoubleTriple(..),DoublePair(..))++import Control.Applicative (liftA2,liftA3)+import Data.Proxy (Proxy(..))+import Data.Typeable (Typeable,typeRep)+import Test.QuickCheck (Arbitrary,arbitrary)+import Test.QuickCheck.Classes (primLaws)+import Test.Tasty (TestTree,defaultMain,testGroup)++import qualified Test.QuickCheck.Classes as QCC+import qualified Test.Tasty.QuickCheck as TQC++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tuples"+ [ laws @IntTriple [primLaws]+ , laws @WordTriple [primLaws]+ , laws @DoubleTriple [primLaws]+ , laws @IntPair [primLaws]+ , laws @WordPair [primLaws]+ , laws @DoublePair [primLaws]+ ]++laws :: forall a. Typeable a => [Proxy a -> QCC.Laws] -> TestTree+laws = testGroup (show (typeRep (Proxy :: Proxy a))) . map+ ( \f -> let QCC.Laws name pairs = f (Proxy :: Proxy a) in+ testGroup name (map (uncurry TQC.testProperty) pairs)+ )++instance Arbitrary IntTriple where+ arbitrary = liftA3 IntTriple arbitrary arbitrary arbitrary+instance Arbitrary WordTriple where+ arbitrary = liftA3 WordTriple arbitrary arbitrary arbitrary+instance Arbitrary DoubleTriple where+ arbitrary = liftA3 DoubleTriple arbitrary arbitrary arbitrary+instance Arbitrary DoublePair where+ arbitrary = liftA2 DoublePair arbitrary arbitrary+instance Arbitrary IntPair where+ arbitrary = liftA2 IntPair arbitrary arbitrary+instance Arbitrary WordPair where+ arbitrary = liftA2 WordPair arbitrary arbitrary+
+ tuples.cabal view
@@ -0,0 +1,41 @@+cabal-version: 2.2+name: tuples+version: 0.1.0.0+synopsis: Small monomorphic tuples+description:+ This library provides small tuples where all the elements+ are the same type. The elements always unpack into the+ data constructor. This can be helpful when the tuple type+ is itself nested inside of another data constructor.+homepage: https://github.com/andrewthad/tuples+bug-reports: https://github.com/andrewthad/tuples/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++library+ exposed-modules: Data.Tuple.Types+ build-depends:+ , base >=4.11 && <5+ , primitive >=0.6.4 && <0.8+ hs-source-dirs: src+ ghc-options: -Wall -O2+ default-language: Haskell2010+test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ , base+ , tuples+ , primitive+ , quickcheck-classes+ , QuickCheck+ , tasty+ , tasty-quickcheck+ ghc-options: -Wall -O2+ default-language: Haskell2010