primitive-extras 0.10.1.8 → 0.10.1.9
raw patch · 10 files changed
+117/−128 lines, 10 files
Files
- library/PrimitiveExtras/Bitmap.hs +1/−0
- library/PrimitiveExtras/By6Bits.hs +3/−2
- library/PrimitiveExtras/Prelude.hs +1/−20
- library/PrimitiveExtras/PrimArray.hs +1/−0
- library/PrimitiveExtras/PrimMultiArray.hs +1/−0
- library/PrimitiveExtras/SmallArray.hs +13/−13
- primitive-extras.cabal +8/−5
- test/Main.hs +85/−85
- test/Main/Gens.hs +3/−3
- test/Main/Transaction.hs +1/−0
library/PrimitiveExtras/Bitmap.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-}+ module PrimitiveExtras.Bitmap ( Bitmap (..), empty,
library/PrimitiveExtras/By6Bits.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-}+ module PrimitiveExtras.By6Bits ( By6Bits, empty,@@ -154,8 +155,8 @@ Focus.Set a -> Focus.Set (By6Bits (Bitmap.singleton index) (pure a)) Focus.Remove -> Focus.Leave revealSsa (By6Bits indices array) =- fmap (fmap aChangeToSsaChange) $- if Bitmap.isPopulated index indices+ fmap (fmap aChangeToSsaChange)+ $ if Bitmap.isPopulated index indices then do a <- indexSmallArrayM array (Bitmap.populatedIndex index indices) revealA a
library/PrimitiveExtras/Prelude.hs view
@@ -7,28 +7,15 @@ ) where --- base-------------------------- import Control.Applicative as Exports import Control.Arrow as Exports import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports--- profunctors------------------------------ deferred-folds------------------------------ foldl-------------------------- import Control.Foldl as Exports (Fold (..), FoldM (..)) import Control.Monad as Exports hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fix as Exports hiding (fix) import Control.Monad.IO.Class as Exports--- primitive--------------------------- import Control.Monad.Primitive as Exports import Control.Monad.ST as Exports import Data.Bits as Exports@@ -42,7 +29,7 @@ import Data.Fixed as Exports import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports+import Data.Functor as Exports hiding (unzip) import Data.Functor.Identity as Exports import Data.IORef as Exports import Data.Int as Exports@@ -52,8 +39,6 @@ import Data.Monoid as Exports hiding (First (..), Last (..)) import Data.Ord as Exports import Data.Primitive as Exports--- primitive-unlifted-------------------------- import Data.Primitive.Unlifted.Array as Exports import Data.Primitive.Unlifted.Class as Exports import Data.Profunctor.Choice as Exports@@ -71,8 +56,6 @@ import Debug.Trace as Exports import DeferredFolds.Unfoldl as Exports (Unfoldl (..)) import DeferredFolds.UnfoldlM as Exports (UnfoldlM (..))--- focus-------------------------- import Focus as Exports (Focus (..)) import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports@@ -82,8 +65,6 @@ import GHC.Exts as Exports (groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports--- list-t-------------------------- import ListT as Exports (ListT (..)) import Numeric as Exports import System.Environment as Exports
library/PrimitiveExtras/PrimArray.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-}+ module PrimitiveExtras.PrimArray where import qualified Data.ByteString.Short.Internal as ShortByteString
library/PrimitiveExtras/PrimMultiArray.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-}+ module PrimitiveExtras.PrimMultiArray ( PrimMultiArray, create,
library/PrimitiveExtras/SmallArray.hs view
@@ -100,19 +100,19 @@ orderedPair :: Int -> e -> Int -> e -> SmallArray e orderedPair i1 e1 i2 e2 = {-# SCC "orderedPair" #-}- runSmallArray $- if- | i1 < i2 -> do- a <- newSmallArray 2 e1- writeSmallArray a 1 e2- return a- | i1 > i2 -> do- a <- newSmallArray 2 e1- writeSmallArray a 0 e2- return a- | otherwise -> do- a <- newSmallArray 1 e2- return a+ runSmallArray+ $ if+ | i1 < i2 -> do+ a <- newSmallArray 2 e1+ writeSmallArray a 1 e2+ return a+ | i1 > i2 -> do+ a <- newSmallArray 2 e1+ writeSmallArray a 0 e2+ return a+ | otherwise -> do+ a <- newSmallArray 1 e2+ return a {-# INLINE findAndReplace #-} findAndReplace :: (a -> Maybe a) -> SmallArray a -> SmallArray a
primitive-extras.cabal view
@@ -1,12 +1,15 @@ cabal-version: 3.0 name: primitive-extras-version: 0.10.1.8-category: Primitive synopsis: Extras for the "primitive" library+description:+ Raw collection of extra utiltilies for the "primitive" library.++version: 0.10.1.9+category: Primitive homepage: https://github.com/metrix-ai/primitive-extras bug-reports: https://github.com/metrix-ai/primitive-extras/issues author: Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer: Metrix.AI Tech Team <tech@metrix.ai>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru> copyright: (c) 2018, Metrix.AI license: MIT license-file: LICENSE@@ -71,7 +74,7 @@ PrimitiveExtras.Types build-depends:- base >=4.7 && <5+ , base >=4.7 && <5 , bytestring >=0.10 && <0.12 , cereal >=0.5.5 && <0.6 , deferred-folds >=0.9 && <0.10@@ -131,7 +134,7 @@ Main.Transaction build-depends:- cereal+ , cereal , deferred-folds , focus , primitive
test/Main.hs view
@@ -18,95 +18,95 @@ main :: IO () main =- defaultMain $- testGroup "All" $- [ testGroup "SmallArray" $- [ testCase "set" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [1, 4, 3]- (SmallArray.toList (SmallArray.set 1 4 array)),- testCase "insert" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [1, 4, 2, 3]- (SmallArray.toList (SmallArray.insert 1 4 array)),- testCase "unset" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [1, 3]- (SmallArray.toList (SmallArray.unset 1 array)),- testCase "focus insert, when exists" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [1, 4, 3]- (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 2) (const False) array)))),- testCase "focus insert, when doesn't exist" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [4, 1, 2, 3]- (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 4) (const False) array)))),- testCase "focus delete" $- let array = SmallArray.list [1, 2, 3]- in assertEqual- ""- [1, 3]- (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement Focus.delete (== 2) (const False) array))))- ],- testGroup "By6Bits" $- [ testCase "empty" $ do- assertEqual- ""- (replicate (finiteBitSize (undefined :: Int)) Nothing)- (By6Bits.toMaybeList (By6Bits.empty :: By6Bits Int32)),- testProperty "toMaybeList, maybeList" $ forAll Gen.maybeList $ \maybeList ->- maybeList === By6Bits.toMaybeList (By6Bits.maybeList maybeList),- testCase "unset" $- assertEqual- ""- ([Just 1, Nothing, Nothing, Just 3] <> replicate (finiteBitSize (undefined :: Int) - 4) Nothing)- (By6Bits.toMaybeList (By6Bits.unset 1 (By6Bits.maybeList [Just 1, Just 2, Nothing, Just 3]))),- testTransactionProperty "set" Gen.setTransaction,- testTransactionProperty "unset" Gen.unsetTransaction,- testTransactionProperty "focusInsert" Gen.focusInsertTransaction,- testTransactionProperty "focusDelete" Gen.focusDeleteTransaction,- testTransactionProperty "unfoldl" Gen.unfoldlTransaction,- testTransactionProperty "lookup" Gen.lookupTransaction,- testTransactionProperty "composite" Gen.transaction- ],- testGroup "PrimArray" $- [ testProperty "Construction from primitive vector" $- let gen = do- offset <- choose (0, 2)- length <- choose (0, 100)- listSize <-- let minSize = offset + length- in choose (minSize, minSize + 100)- list :: [Int32] <- replicateM listSize arbitrary- return (list, offset, length)- in forAll gen $ \(inputList, offset, length) ->- let !inputVec = PrimitiveVector.fromList inputList- !sliceVec = PrimitiveVector.slice offset length inputVec- !sliceList = PrimitiveVector.toList sliceVec- in sliceList === primArrayToList (PrimArray.primitiveVector sliceVec),- testProperty "Serializes well with as in memory" $ forAll (Gen.primArray Gen.element) $ \primArray ->- Right primArray- === Serialize.runGet- (PrimArray.cerealGetAsInMemory Serialize.get)- (Serialize.runPut ((PrimArray.cerealPutAsInMemory Serialize.put) primArray))- ]+ defaultMain+ $ testGroup "All"+ $ [ testGroup "SmallArray"+ $ [ testCase "set"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [1, 4, 3]+ (SmallArray.toList (SmallArray.set 1 4 array)),+ testCase "insert"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [1, 4, 2, 3]+ (SmallArray.toList (SmallArray.insert 1 4 array)),+ testCase "unset"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [1, 3]+ (SmallArray.toList (SmallArray.unset 1 array)),+ testCase "focus insert, when exists"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [1, 4, 3]+ (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 2) (const False) array)))),+ testCase "focus insert, when doesn't exist"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [4, 1, 2, 3]+ (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement (Focus.insert 4) (== 4) (const False) array)))),+ testCase "focus delete"+ $ let array = SmallArray.list [1, 2, 3]+ in assertEqual+ ""+ [1, 3]+ (SmallArray.toList (snd (runIdentity (SmallArray.focusOnFoundElement Focus.delete (== 2) (const False) array))))+ ],+ testGroup "By6Bits"+ $ [ testCase "empty" $ do+ assertEqual+ ""+ (replicate (finiteBitSize (undefined :: Int)) Nothing)+ (By6Bits.toMaybeList (By6Bits.empty :: By6Bits Int32)),+ testProperty "toMaybeList, maybeList" $ forAll Gen.maybeList $ \maybeList ->+ maybeList === By6Bits.toMaybeList (By6Bits.maybeList maybeList),+ testCase "unset"+ $ assertEqual+ ""+ ([Just 1, Nothing, Nothing, Just 3] <> replicate (finiteBitSize (undefined :: Int) - 4) Nothing)+ (By6Bits.toMaybeList (By6Bits.unset 1 (By6Bits.maybeList [Just 1, Just 2, Nothing, Just 3]))),+ testTransactionProperty "set" Gen.setTransaction,+ testTransactionProperty "unset" Gen.unsetTransaction,+ testTransactionProperty "focusInsert" Gen.focusInsertTransaction,+ testTransactionProperty "focusDelete" Gen.focusDeleteTransaction,+ testTransactionProperty "unfoldl" Gen.unfoldlTransaction,+ testTransactionProperty "lookup" Gen.lookupTransaction,+ testTransactionProperty "composite" Gen.transaction+ ],+ testGroup "PrimArray"+ $ [ testProperty "Construction from primitive vector"+ $ let gen = do+ offset <- choose (0, 2)+ length <- choose (0, 100)+ listSize <-+ let minSize = offset + length+ in choose (minSize, minSize + 100)+ list :: [Int32] <- replicateM listSize arbitrary+ return (list, offset, length)+ in forAll gen $ \(inputList, offset, length) ->+ let !inputVec = PrimitiveVector.fromList inputList+ !sliceVec = PrimitiveVector.slice offset length inputVec+ !sliceList = PrimitiveVector.toList sliceVec+ in sliceList === primArrayToList (PrimArray.primitiveVector sliceVec),+ testProperty "Serializes well with as in memory" $ forAll (Gen.primArray Gen.element) $ \primArray ->+ Right primArray+ === Serialize.runGet+ (PrimArray.cerealGetAsInMemory Serialize.get)+ (Serialize.runPut ((PrimArray.cerealPutAsInMemory Serialize.put) primArray))+ ] ] - testTransactionProperty :: String -> Gen (Transaction.Transaction Int) -> TestTree testTransactionProperty name transactionGen =- testProperty (showString "Transaction: " name) $- forAll ((,) <$> Gen.maybeList <*> transactionGen) $ \(maybeList, transaction) ->+ testProperty (showString "Transaction: " name)+ $ forAll ((,) <$> Gen.maybeList <*> transactionGen)+ $ \(maybeList, transaction) -> case transaction of Transaction.Transaction name applyToMaybeList applyToBy6Bits -> let ssa = By6Bits.maybeList maybeList
test/Main/Gens.hs view
@@ -43,9 +43,9 @@ maybeList :: Gen [Maybe Int] maybeList =- replicateM (finiteBitSize (undefined :: Int)) $- frequency $- [ (4, fmap Just element),+ replicateM (finiteBitSize (undefined :: Int))+ $ frequency+ $ [ (4, fmap Just element), (1, pure Nothing) ]
test/Main/Transaction.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-}+ module Main.Transaction where import qualified Data.Text as Text