ptr-poker 0.1.2 → 0.1.2.1
raw patch · 13 files changed
+634/−668 lines, 13 filesdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: text
API changes (from Hackage documentation)
Files
- bench/Main.hs +60/−57
- library/PtrPoker/ByteString.hs +19/−28
- library/PtrPoker/Ffi.hs +3/−4
- library/PtrPoker/IO/ByteString.hs +3/−4
- library/PtrPoker/IO/Prim.hs +5/−6
- library/PtrPoker/Poke.hs +114/−152
- library/PtrPoker/Prelude.hs +19/−31
- library/PtrPoker/Size.hs +192/−148
- library/PtrPoker/Text.hs +15/−0
- library/PtrPoker/UncheckedShifting.hs +17/−21
- library/PtrPoker/Write.hs +115/−139
- ptr-poker.cabal +3/−2
- test/Main.hs +69/−76
bench/Main.hs view
@@ -1,65 +1,68 @@ module Main where -import Prelude+import qualified Data.Text.Encoding as Text import Gauge.Main import qualified PtrPoker.Write as Write-import qualified Data.Text.Encoding as Text-+import Prelude main =- defaultMain [- bgroup "bWord32" [- bench "4"- $ nf- (\(a,b,c,d) -> Write.writeToByteString $- Write.bWord32 a <> Write.bWord32 b <> Write.bWord32 c <> Write.bWord32 d)- (1,2,3,4)- ]- ,- bgroup "textUtf8" $ let- latinSampleBySize size =- enumFromTo 'a' 'z' &- replicate size &- concat &- fromString- greekSampleBySize size =- enumFromTo 'Α' 'Ω' &- replicate size &- concat &- fromString- !latinSample1 = latinSampleBySize 1- !latinSample10 = latinSampleBySize 10- !latinSample100 = latinSampleBySize 100- !greekSample1 = greekSampleBySize 1- !greekSample10 = greekSampleBySize 10- !greekSample100 = greekSampleBySize 100- in [- bgroup "ptr-poker" [- bgroup "latin" [- bench "1" (nf (Write.writeToByteString . Write.textUtf8) latinSample1),- bench "10" (nf (Write.writeToByteString . Write.textUtf8) latinSample10),- bench "100" (nf (Write.writeToByteString . Write.textUtf8) latinSample100)- ]- ,- bgroup "greek" [- bench "1" (nf (Write.writeToByteString . Write.textUtf8) greekSample1),- bench "10" (nf (Write.writeToByteString . Write.textUtf8) greekSample10),- bench "100" (nf (Write.writeToByteString . Write.textUtf8) greekSample100)- ]- ]- ,- bgroup "text" [- bgroup "latin" [- bench "1" (nf Text.encodeUtf8 latinSample1),- bench "10" (nf Text.encodeUtf8 latinSample10),- bench "100" (nf Text.encodeUtf8 latinSample100)- ]- ,- bgroup "greek" [- bench "1" (nf Text.encodeUtf8 greekSample1),- bench "10" (nf Text.encodeUtf8 greekSample10),- bench "100" (nf Text.encodeUtf8 greekSample100)+ defaultMain+ [ bgroup+ "bWord32"+ [ bench "4" $+ nf+ ( \(a, b, c, d) ->+ Write.writeToByteString $+ Write.bWord32 a <> Write.bWord32 b <> Write.bWord32 c <> Write.bWord32 d+ )+ (1, 2, 3, 4)+ ],+ bgroup "textUtf8" $+ let latinSampleBySize size =+ enumFromTo 'a' 'z'+ & replicate size+ & concat+ & fromString+ greekSampleBySize size =+ enumFromTo 'Α' 'Ω'+ & replicate size+ & concat+ & fromString+ !latinSample1 = latinSampleBySize 1+ !latinSample10 = latinSampleBySize 10+ !latinSample100 = latinSampleBySize 100+ !greekSample1 = greekSampleBySize 1+ !greekSample10 = greekSampleBySize 10+ !greekSample100 = greekSampleBySize 100+ in [ bgroup+ "ptr-poker"+ [ bgroup+ "latin"+ [ bench "1" (nf (Write.writeToByteString . Write.textUtf8) latinSample1),+ bench "10" (nf (Write.writeToByteString . Write.textUtf8) latinSample10),+ bench "100" (nf (Write.writeToByteString . Write.textUtf8) latinSample100)+ ],+ bgroup+ "greek"+ [ bench "1" (nf (Write.writeToByteString . Write.textUtf8) greekSample1),+ bench "10" (nf (Write.writeToByteString . Write.textUtf8) greekSample10),+ bench "100" (nf (Write.writeToByteString . Write.textUtf8) greekSample100)+ ]+ ],+ bgroup+ "text"+ [ bgroup+ "latin"+ [ bench "1" (nf Text.encodeUtf8 latinSample1),+ bench "10" (nf Text.encodeUtf8 latinSample10),+ bench "100" (nf Text.encodeUtf8 latinSample100)+ ],+ bgroup+ "greek"+ [ bench "1" (nf Text.encodeUtf8 greekSample1),+ bench "10" (nf Text.encodeUtf8 greekSample10),+ bench "100" (nf Text.encodeUtf8 greekSample100)+ ]+ ] ]- ]- ] ]
library/PtrPoker/ByteString.hs view
@@ -1,21 +1,15 @@-{-# LANGUAGE CPP #-}-module PtrPoker.ByteString-where+module PtrPoker.ByteString where -import PtrPoker.Prelude hiding (empty) import Data.ByteString-import Data.ByteString.Internal-import Data.ByteString.Builder.Prim-import qualified Data.Text as Text-import qualified Data.Text.Array as TextArray-import qualified Data.Text.Internal as TextInternal-import qualified Data.Text.Encoding as TextEncoding-import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Builder.Extra as Builder+import Data.ByteString.Builder.Prim import qualified Data.ByteString.Builder.Scientific as ScientificBuilder+import Data.ByteString.Internal+import qualified Data.ByteString.Lazy as Lazy import qualified PtrPoker.Ffi as Ffi-+import PtrPoker.Prelude hiding (empty)+import qualified PtrPoker.Text as Text builderWithStrategy strategy builder = builder@@ -30,28 +24,25 @@ double :: Double -> ByteString double dbl =- unsafeCreateUptoN 25 (\ ptr ->- Ffi.pokeDouble dbl ptr- & fmap fromIntegral)+ unsafeCreateUptoN+ 25+ ( \ptr ->+ Ffi.pokeDouble dbl ptr+ & fmap fromIntegral+ ) unsafeCreateDownToN :: Int -> (Ptr Word8 -> IO Int) -> ByteString unsafeCreateDownToN allocSize populate = unsafeDupablePerformIO $ do fp <- mallocByteString allocSize- actualSize <- withForeignPtr fp (\ p -> populate (plusPtr p (pred allocSize)))+ actualSize <- withForeignPtr fp (\p -> populate (plusPtr p (pred allocSize))) return $! PS fp (allocSize - actualSize) actualSize -{-# INLINABLE textUtf8 #-}+{-# INLINEABLE textUtf8 #-} textUtf8 :: Text -> ByteString-#if MIN_VERSION_text(2,0,0)-textUtf8 (TextInternal.Text (TextArray.ByteArray arr) off len) =-#else-textUtf8 (TextInternal.Text (TextArray.aBA -> arr) off len) =-#endif+textUtf8 = Text.destruct $ \arr off len -> if len == 0- then- empty- else- unsafeCreateUptoN (len * 3) $ \ ptr -> do- postPtr <- inline Ffi.encodeText ptr arr (fromIntegral off) (fromIntegral len)- return (minusPtr postPtr ptr)+ then empty+ else unsafeCreateUptoN (len * 3) $ \ptr -> do+ postPtr <- inline Ffi.encodeText ptr arr (fromIntegral off) (fromIntegral len)+ return (minusPtr postPtr ptr)
library/PtrPoker/Ffi.hs view
@@ -1,11 +1,10 @@ {-# LANGUAGE UnliftedFFITypes #-}-module PtrPoker.Ffi-where -import PtrPoker.Prelude+module PtrPoker.Ffi where+ import Foreign.C import GHC.Base (ByteArray#, MutableByteArray#)-+import PtrPoker.Prelude foreign import ccall unsafe "static int_dec" pokeIntInDec :: CInt -> Ptr Word8 -> IO (Ptr Word8)
library/PtrPoker/IO/ByteString.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE CPP #-}-module PtrPoker.IO.ByteString-where -import PtrPoker.Prelude-import Data.ByteString.Internal+module PtrPoker.IO.ByteString where +import Data.ByteString.Internal+import PtrPoker.Prelude #if MIN_VERSION_bytestring(0,11,0)
library/PtrPoker/IO/Prim.hs view
@@ -1,27 +1,26 @@ {-# LANGUAGE CPP #-}-module PtrPoker.IO.Prim-where +module PtrPoker.IO.Prim where+ import PtrPoker.Prelude import qualified PtrPoker.UncheckedShifting as UncheckedShifting - {-# INLINE pokeStorable #-} pokeStorable :: Storable a => Ptr Word8 -> a -> IO () pokeStorable ptr value =- {-# SCC "pokeStorable" #-} + {-# SCC "pokeStorable" #-} poke (castPtr ptr) value {-# INLINE pokeWord8 #-} pokeWord8 :: Ptr Word8 -> Word8 -> IO () pokeWord8 ptr value =- {-# SCC "pokeWord8" #-} + {-# SCC "pokeWord8" #-} poke ptr value {-# INLINE pokeWord8Off #-} pokeWord8Off :: Ptr Word8 -> Int -> Word8 -> IO () pokeWord8Off ptr off value =- {-# SCC "pokeWord8Off" #-} + {-# SCC "pokeWord8Off" #-} pokeByteOff ptr off value {-# INLINE pokeBEWord16 #-}
library/PtrPoker/Poke.hs view
@@ -1,285 +1,247 @@-{-# LANGUAGE CPP #-}-module PtrPoker.Poke-where+module PtrPoker.Poke where -import PtrPoker.Prelude hiding (concat)+import qualified PtrPoker.Ffi as Ffi import qualified PtrPoker.IO.ByteString as ByteStringIO import qualified PtrPoker.IO.Prim as PrimIO-import qualified PtrPoker.Ffi as Ffi-import qualified Data.Text.Internal as Text-import qualified Data.Text.Array as TextArray-+import PtrPoker.Prelude hiding (concat)+import qualified PtrPoker.Text as Text {-# RULES- "foldMap" forall f foldable. foldMap f foldable =- Poke $ \ p -> foldM (\ p (Poke poker) -> poker p) p foldable+"foldMap" forall f foldable.+ foldMap f foldable =+ Poke $ \p -> foldM (\p (Poke poker) -> poker p) p foldable #-} -{-|-Abstraction over an IO action,-which takes a pointer, populates it and-produces a pointer right after the populated data.--}-newtype Poke =- Poke { pokePtr :: Ptr Word8 -> IO (Ptr Word8) }+-- |+-- Abstraction over an IO action,+-- which takes a pointer, populates it and+-- produces a pointer right after the populated data.+newtype Poke = Poke {pokePtr :: Ptr Word8 -> IO (Ptr Word8)} instance Semigroup Poke where- {-# INLINE[1] (<>) #-}+ {-# INLINE [1] (<>) #-} Poke lIO <> Poke rIO = Poke (lIO >=> rIO) sconcat = concat instance Monoid Poke where- {-# INLINE[1] mempty #-}+ {-# INLINE [1] mempty #-} mempty = Poke return mconcat = concat -{-|-Reuses the IsString instance of 'ByteString'.--}+-- |+-- Reuses the IsString instance of 'ByteString'. instance IsString Poke where fromString = byteString . fromString -{-|-Concatenate a foldable of pokes.--}-{-# INLINE[1] concat #-}+-- |+-- Concatenate a foldable of pokes.+{-# INLINE [1] concat #-} concat :: Foldable f => f Poke -> Poke concat pokers =- Poke (\ p -> foldM (\ p (Poke io) -> io p) p pokers)+ Poke (\p -> foldM (\p (Poke io) -> io p) p pokers) -{-|-Efficiently copy the contents of ByteString using @memcpy@.--}+-- |+-- Efficiently copy the contents of ByteString using @memcpy@. {-# INLINE byteString #-} byteString :: ByteString -> Poke byteString bs =- Poke $ \ ptr -> inline ByteStringIO.pokeByteString ptr bs+ Poke $ \ptr -> inline ByteStringIO.pokeByteString ptr bs -{-|-Encode Word8 as byte, incrementing the pointer by 1.--}-{-# INLINE[1] word8 #-}+-- |+-- Encode Word8 as byte, incrementing the pointer by 1.+{-# INLINE [1] word8 #-} word8 :: Word8 -> Poke word8 a =- Poke (\ p -> PrimIO.pokeWord8 p a $> plusPtr p 1)+ Poke (\p -> PrimIO.pokeWord8 p a $> plusPtr p 1) -{-|-Encode Word16 in Little-endian.--}-{-# INLINE[1] lWord16 #-}+-- |+-- Encode Word16 in Little-endian.+{-# INLINE [1] lWord16 #-} lWord16 :: Word16 -> Poke lWord16 a =- Poke (\ p -> PrimIO.pokeLEWord16 p a $> plusPtr p 2)+ Poke (\p -> PrimIO.pokeLEWord16 p a $> plusPtr p 2) -{-|-Encode Word16 in Big-endian.--}-{-# INLINE[1] bWord16 #-}+-- |+-- Encode Word16 in Big-endian.+{-# INLINE [1] bWord16 #-} bWord16 :: Word16 -> Poke bWord16 a =- Poke (\ p -> PrimIO.pokeBEWord16 p a $> plusPtr p 2)+ Poke (\p -> PrimIO.pokeBEWord16 p a $> plusPtr p 2) -{-|-Encode Word32 in Little-endian.--}-{-# INLINE[1] lWord32 #-}+-- |+-- Encode Word32 in Little-endian.+{-# INLINE [1] lWord32 #-} lWord32 :: Word32 -> Poke lWord32 a =- Poke (\ p -> PrimIO.pokeLEWord32 p a $> plusPtr p 4)+ Poke (\p -> PrimIO.pokeLEWord32 p a $> plusPtr p 4) -{-|-Encode Word32 in Big-endian.--}-{-# INLINE[1] bWord32 #-}+-- |+-- Encode Word32 in Big-endian.+{-# INLINE [1] bWord32 #-} bWord32 :: Word32 -> Poke bWord32 a =- Poke (\ p -> PrimIO.pokeBEWord32 p a $> plusPtr p 4)+ Poke (\p -> PrimIO.pokeBEWord32 p a $> plusPtr p 4) -{-|-Encode Word64 in Little-endian.--}-{-# INLINE[1] lWord64 #-}+-- |+-- Encode Word64 in Little-endian.+{-# INLINE [1] lWord64 #-} lWord64 :: Word64 -> Poke lWord64 a =- Poke (\ p -> PrimIO.pokeLEWord64 p a $> plusPtr p 8)+ Poke (\p -> PrimIO.pokeLEWord64 p a $> plusPtr p 8) -{-|-Encode Word64 in Big-endian.--}-{-# INLINE[1] bWord64 #-}+-- |+-- Encode Word64 in Big-endian.+{-# INLINE [1] bWord64 #-} bWord64 :: Word64 -> Poke bWord64 a =- Poke (\ p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8)+ Poke (\p -> PrimIO.pokeBEWord64 p a $> plusPtr p 8) -{-|-Encode Int16 in Little-endian.--}+-- |+-- Encode Int16 in Little-endian. {-# INLINE lInt16 #-} lInt16 :: Int16 -> Poke lInt16 = lWord16 . fromIntegral -{-|-Encode Int16 in Big-endian.--}+-- |+-- Encode Int16 in Big-endian. {-# INLINE bInt16 #-} bInt16 :: Int16 -> Poke bInt16 = bWord16 . fromIntegral -{-|-Encode Int32 in Little-endian.--}+-- |+-- Encode Int32 in Little-endian. {-# INLINE lInt32 #-} lInt32 :: Int32 -> Poke lInt32 = lWord32 . fromIntegral -{-|-Encode Int32 in Big-endian.--}+-- |+-- Encode Int32 in Big-endian. {-# INLINE bInt32 #-} bInt32 :: Int32 -> Poke bInt32 = bWord32 . fromIntegral -{-|-Encode Int64 in Little-endian.--}+-- |+-- Encode Int64 in Little-endian. {-# INLINE lInt64 #-} lInt64 :: Int64 -> Poke lInt64 = lWord64 . fromIntegral -{-|-Encode Int64 in Big-endian.--}+-- |+-- Encode Int64 in Big-endian. {-# INLINE bInt64 #-} bInt64 :: Int64 -> Poke bInt64 = bWord64 . fromIntegral -{-|-Encode Text in UTF8.--}+-- |+-- Encode Text in UTF8. {-# INLINE textUtf8 #-} textUtf8 :: Text -> Poke-#if MIN_VERSION_text(2,0,0)-textUtf8 (Text.Text (TextArray.ByteArray arr) off len) =-#else-textUtf8 (Text.Text (TextArray.aBA -> arr) off len) =-#endif- Poke (\ p -> Ffi.encodeText p arr (fromIntegral off) (fromIntegral len))+textUtf8 = Text.destruct $ \arr off len ->+ Poke (\p -> Ffi.encodeText p arr (fromIntegral off) (fromIntegral len)) -- * ASCII integers+ ------------------------- -{-|-Encode Int8 as a signed ASCII decimal.--}-{-# INLINE[1] int8AsciiDec #-}+-- |+-- Encode Int8 as a signed ASCII decimal.+{-# INLINE [1] int8AsciiDec #-} int8AsciiDec :: Int8 -> Poke int8AsciiDec a = Poke (Ffi.pokeIntInDec (fromIntegral a)) -{-|-Encode Int16 as a signed ASCII decimal.--}-{-# INLINE[1] int16AsciiDec #-}+-- |+-- Encode Int16 as a signed ASCII decimal.+{-# INLINE [1] int16AsciiDec #-} int16AsciiDec :: Int16 -> Poke int16AsciiDec a = Poke (Ffi.pokeIntInDec (fromIntegral a)) -{-|-Encode Int32 as a signed ASCII decimal.--}-{-# INLINE[1] int32AsciiDec #-}+-- |+-- Encode Int32 as a signed ASCII decimal.+{-# INLINE [1] int32AsciiDec #-} int32AsciiDec :: Int32 -> Poke int32AsciiDec a = Poke (Ffi.pokeIntInDec (fromIntegral a)) -{-|-Encode Int64 as a signed ASCII decimal.--}-{-# INLINE[1] int64AsciiDec #-}+-- |+-- Encode Int64 as a signed ASCII decimal.+{-# INLINE [1] int64AsciiDec #-} int64AsciiDec :: Int64 -> Poke int64AsciiDec a = Poke (Ffi.pokeLongLongIntInDec (fromIntegral a)) -{-|-Encode Int as a signed ASCII decimal.--}-{-# INLINE[1] intAsciiDec #-}+-- |+-- Encode Int as a signed ASCII decimal.+{-# INLINE [1] intAsciiDec #-} intAsciiDec :: Int -> Poke intAsciiDec a = Poke (Ffi.pokeLongLongIntInDec (fromIntegral a)) -{-|-Encode Word8 as an unsigned ASCII decimal.--}-{-# INLINE[1] word8AsciiDec #-}+-- |+-- Encode Word8 as an unsigned ASCII decimal.+{-# INLINE [1] word8AsciiDec #-} word8AsciiDec :: Word8 -> Poke word8AsciiDec a = Poke (Ffi.pokeUIntInDec (fromIntegral a)) -{-|-Encode Word16 as an unsigned ASCII decimal.--}-{-# INLINE[1] word16AsciiDec #-}+-- |+-- Encode Word16 as an unsigned ASCII decimal.+{-# INLINE [1] word16AsciiDec #-} word16AsciiDec :: Word16 -> Poke word16AsciiDec a = Poke (Ffi.pokeUIntInDec (fromIntegral a)) -{-|-Encode Word32 as an unsigned ASCII decimal.--}-{-# INLINE[1] word32AsciiDec #-}+-- |+-- Encode Word32 as an unsigned ASCII decimal.+{-# INLINE [1] word32AsciiDec #-} word32AsciiDec :: Word32 -> Poke word32AsciiDec a = Poke (Ffi.pokeUIntInDec (fromIntegral a)) -{-|-Encode Word64 as an unsigned ASCII decimal.--}-{-# INLINE[1] word64AsciiDec #-}+-- |+-- Encode Word64 as an unsigned ASCII decimal.+{-# INLINE [1] word64AsciiDec #-} word64AsciiDec :: Word64 -> Poke word64AsciiDec a = Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a)) -{-|-Encode Word as an unsigned ASCII decimal.--}-{-# INLINE[1] wordAsciiDec #-}+-- |+-- Encode Word as an unsigned ASCII decimal.+{-# INLINE [1] wordAsciiDec #-} wordAsciiDec :: Word -> Poke wordAsciiDec a = Poke (Ffi.pokeLongLongUIntInDec (fromIntegral a)) -{-|-Encode Double as a signed ASCII decimal.--}+-- |+-- Encode Double as a signed ASCII decimal. {-# INLINE doubleAsciiDec #-} doubleAsciiDec :: Double -> Poke doubleAsciiDec a =- Poke $ \ ptr ->+ Poke $ \ptr -> Ffi.pokeDouble a ptr & fmap (plusPtr ptr . fromIntegral) - -- * Low level+ ------------------------- -{-|-Having the amount of bytes to be written precomputed,-executes an action,-which fills the pointer going downward,-starting from the pointer that follows the chunk.-I.e., you have to decrement the pointer-before writing the first byte,-decrement it again before writing the second byte and so on.--}+-- |+-- Having the amount of bytes to be written precomputed,+-- executes an action,+-- which fills the pointer going downward,+-- starting from the pointer that follows the chunk.+-- I.e., you have to decrement the pointer+-- before writing the first byte,+-- decrement it again before writing the second byte and so on. {-# INLINE sizedReverse #-} sizedReverse :: Int -> (Ptr Word8 -> IO a) -> Poke sizedReverse size action =- Poke $ \ ptr ->- let- afterPtr =- plusPtr ptr size- in action afterPtr $> afterPtr+ Poke $ \ptr ->+ let afterPtr =+ plusPtr ptr size+ in action afterPtr $> afterPtr
library/PtrPoker/Prelude.hs view
@@ -1,25 +1,23 @@ module PtrPoker.Prelude-( - module Exports,- showAsText,-)+ ( module Exports,+ showAsText,+ ) where --- base---------------------------import Control.Applicative as Exports hiding (WrappedArrow(..))+import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports+import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports@@ -31,19 +29,21 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Compose as Exports-import Data.Int as Exports import Data.IORef as Exports+import Data.Int as Exports import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.List.NonEmpty as Exports (NonEmpty(..))+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt, (<>)) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports-import Data.Semigroup as Exports hiding (First(..), Last(..)) import Data.STRef as Exports+import Data.Scientific as Exports (Scientific)+import Data.Semigroup as Exports hiding (First (..), Last (..)) import Data.String as Exports+import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports@@ -55,13 +55,12 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports-import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith)+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (ByteArray#, IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose)@@ -71,22 +70,11 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports---- text---------------------------import Data.Text as Exports (Text)---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- scientific---------------------------import Data.Scientific as Exports (Scientific)+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) showAsText :: Show a => a -> Text showAsText = show >>> fromString
library/PtrPoker/Size.hs view
@@ -1,166 +1,210 @@-{-# LANGUAGE CPP #-}-{-|-Functions that compute the required allocation size by value.--}-module PtrPoker.Size-where+-- |+-- Functions that compute the required allocation size by value.+module PtrPoker.Size where -import PtrPoker.Prelude-import qualified Data.Text.Internal as Text-import qualified Data.Text.Array as TextArray import qualified PtrPoker.Ffi as Ffi---{-|-Efficiently count the amount of bytes required to encode Word64-as a decimal number in ASCII.+import PtrPoker.Prelude+import qualified PtrPoker.Text as Text -Implemented as a balanced tree of \"ifs\"-centered around the middle of the range.-This is much faster than anything based on logarithms.--}+-- |+-- Efficiently count the amount of bytes required to encode Word64+-- as a decimal number in ASCII.+--+-- Implemented as a balanced tree of \"ifs\"+-- centered around the middle of the range.+-- This is much faster than anything based on logarithms. {-# INLINE word64AsciiDec #-} word64AsciiDec :: Word64 -> Int word64AsciiDec x = if x > 9999999999- then if x > 99999999999999- then if x > 9999999999999999- then if x > 99999999999999999- then if x > 999999999999999999- then if x > 9999999999999999999- then 20- else 19- else 18- else 17- else if x > 999999999999999- then 16- else 15- else if x > 999999999999- then if x > 9999999999999- then 14- else 13- else if x > 99999999999- then 12- else 11- else if x > 99999- then if x > 9999999- then if x > 99999999- then if x > 999999999- then 10- else 9- else 8- else if x > 999999- then 7- else 6- else if x > 99- then if x > 999- then if x > 9999- then 5- else 4- else 3- else if x > 9- then 2- else 1--{-|-Efficiently count the amount of bytes required to encode Int64-as a signed decimal number in ASCII.+ then+ if x > 99999999999999+ then+ if x > 9999999999999999+ then+ if x > 99999999999999999+ then+ if x > 999999999999999999+ then+ if x > 9999999999999999999+ then 20+ else 19+ else 18+ else 17+ else+ if x > 999999999999999+ then 16+ else 15+ else+ if x > 999999999999+ then+ if x > 9999999999999+ then 14+ else 13+ else+ if x > 99999999999+ then 12+ else 11+ else+ if x > 99999+ then+ if x > 9999999+ then+ if x > 99999999+ then+ if x > 999999999+ then 10+ else 9+ else 8+ else+ if x > 999999+ then 7+ else 6+ else+ if x > 99+ then+ if x > 999+ then+ if x > 9999+ then 5+ else 4+ else 3+ else+ if x > 9+ then 2+ else 1 -Implemented as a balanced tree of \"ifs\"-centered around the middle of the range.-This is much faster than anything based on logarithms.--}+-- |+-- Efficiently count the amount of bytes required to encode Int64+-- as a signed decimal number in ASCII.+--+-- Implemented as a balanced tree of \"ifs\"+-- centered around the middle of the range.+-- This is much faster than anything based on logarithms. {-# INLINE int64AsciiDec #-} int64AsciiDec :: Int64 -> Int int64AsciiDec x = if x < 0- then if x < -9999999999- then if x < -99999999999999- then if x < -9999999999999999- then if x < -99999999999999999- then if x < -999999999999999999- then 20- else 19- else 18- else if x < -999999999999999- then 17- else 16- else if x < -999999999999- then if x < -9999999999999- then 15- else 14- else if x < -99999999999- then 13- else 12- else if x < -99999- then if x < -9999999- then if x < -99999999- then if x < -999999999- then 11- else 10- else 9- else if x < -999999- then 8- else 7- else if x < -99- then if x < -999- then if x < -9999- then 6- else 5- else 4- else if x < -9- then 3- else 2- else if x > 9999999999- then if x > 99999999999999- then if x > 9999999999999999- then if x > 99999999999999999- then if x > 999999999999999999- then 19- else 18- else 17- else if x > 999999999999999- then 16- else 15- else if x > 999999999999- then if x > 9999999999999- then 14- else 13- else if x > 99999999999- then 12- else 11- else if x > 99999- then if x > 9999999- then if x > 99999999- then if x > 999999999- then 10- else 9- else 8- else if x > 999999- then 7- else 6- else if x > 99- then if x > 999- then if x > 9999- then 5- else 4- else 3- else if x > 9- then 2- else 1+ then+ if x < -9999999999+ then+ if x < -99999999999999+ then+ if x < -9999999999999999+ then+ if x < -99999999999999999+ then+ if x < -999999999999999999+ then 20+ else 19+ else 18+ else+ if x < -999999999999999+ then 17+ else 16+ else+ if x < -999999999999+ then+ if x < -9999999999999+ then 15+ else 14+ else+ if x < -99999999999+ then 13+ else 12+ else+ if x < -99999+ then+ if x < -9999999+ then+ if x < -99999999+ then+ if x < -999999999+ then 11+ else 10+ else 9+ else+ if x < -999999+ then 8+ else 7+ else+ if x < -99+ then+ if x < -999+ then+ if x < -9999+ then 6+ else 5+ else 4+ else+ if x < -9+ then 3+ else 2+ else+ if x > 9999999999+ then+ if x > 99999999999999+ then+ if x > 9999999999999999+ then+ if x > 99999999999999999+ then+ if x > 999999999999999999+ then 19+ else 18+ else 17+ else+ if x > 999999999999999+ then 16+ else 15+ else+ if x > 999999999999+ then+ if x > 9999999999999+ then 14+ else 13+ else+ if x > 99999999999+ then 12+ else 11+ else+ if x > 99999+ then+ if x > 9999999+ then+ if x > 99999999+ then+ if x > 999999999+ then 10+ else 9+ else 8+ else+ if x > 999999+ then 7+ else 6+ else+ if x > 99+ then+ if x > 999+ then+ if x > 9999+ then 5+ else 4+ else 3+ else+ if x > 9+ then 2+ else 1 -{-|-Efficiently count the amount of bytes required to encode Text-in UTF8.--}+-- |+-- Efficiently count the amount of bytes required to encode Text+-- in UTF8. {-# INLINE textUtf8 #-} textUtf8 :: Text -> Int-#if MIN_VERSION_text(2,0,0)-textUtf8 (Text.Text (TextArray.ByteArray arr) off len) =-#else-textUtf8 (Text.Text (TextArray.aBA -> arr) off len) =-#endif+textUtf8 = Text.destruct $ \arr off len -> Ffi.countTextAllocationSize- arr (fromIntegral off) (fromIntegral len)+ arr+ (fromIntegral off)+ (fromIntegral len) & unsafeDupablePerformIO & fromIntegral
+ library/PtrPoker/Text.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module PtrPoker.Text where++import qualified Data.Text.Array as TextArray+import qualified Data.Text.Internal as Text+import PtrPoker.Prelude++{-# INLINE destruct #-}+destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x+#if MIN_VERSION_text(2,0,0)+destruct k (Text.Text (TextArray.ByteArray arr) off len) = k arr off len+#else+destruct k (Text.Text (TextArray.aBA -> arr) off len) = k arr off len+#endif
library/PtrPoker/UncheckedShifting.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+ -- | -- Copyright : (c) 2010 Simon Meier --@@ -11,16 +12,14 @@ -- -- These functions are undefined when the amount being shifted by is -- greater than the size in bits of a machine Int#.-----module PtrPoker.UncheckedShifting (- shiftr_w16- , shiftr_w32- , shiftr_w64- , shiftr_w-- , caseWordSize_32_64- ) where-+module PtrPoker.UncheckedShifting+ ( shiftr_w16,+ shiftr_w32,+ shiftr_w64,+ shiftr_w,+ caseWordSize_32_64,+ )+where #if !defined(__HADDOCK__) import GHC.Base@@ -33,9 +32,8 @@ import Data.Word #endif -import Prelude import Foreign-+import Prelude ------------------------------------------------------------------------ -- Unchecked shifts@@ -77,20 +75,18 @@ shiftr_w64 = shiftR #endif - -- | Select an implementation depending on the bit-size of 'Word's. -- Currently, it produces a runtime failure if the bitsize is different. -- This is detected by the testsuite. {-# INLINE caseWordSize_32_64 #-}-caseWordSize_32_64 :: a -- Value to use for 32-bit 'Word's- -> a -- Value to use for 64-bit 'Word's- -> a+caseWordSize_32_64 ::+ -- | Value to use for 32-bit 'Word's+ a ->+ -- | Value to use for 64-bit 'Word's+ a ->+ a caseWordSize_32_64 f32 f64 =-#if MIN_VERSION_base(4,7,0) case finiteBitSize (undefined :: Word) of-#else- case bitSize (undefined :: Word) of-#endif 32 -> f32 64 -> f64- s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s+ s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s
library/PtrPoker/Write.hs view
@@ -1,35 +1,30 @@-module PtrPoker.Write-where+module PtrPoker.Write where -import PtrPoker.Prelude hiding (concat)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Internal as ByteString+import qualified PtrPoker.ByteString as ByteString+import qualified PtrPoker.Ffi as Ffi import qualified PtrPoker.IO.ByteString as ByteStringIO import qualified PtrPoker.IO.Prim as PrimIO import qualified PtrPoker.Poke as Poke+import PtrPoker.Prelude hiding (concat) import qualified PtrPoker.Size as Size-import qualified PtrPoker.Ffi as Ffi-import qualified PtrPoker.ByteString as ByteString-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Internal as ByteString --{-|-Execute Write, producing strict ByteString.--}-{-# INLINABLE writeToByteString #-}+-- |+-- Execute Write, producing strict ByteString.+{-# INLINEABLE writeToByteString #-} writeToByteString :: Write -> ByteString-writeToByteString Write{..} =+writeToByteString Write {..} = ByteString.unsafeCreate writeSize (void . Poke.pokePtr writePoke) -{-|-Specification of how many bytes to allocate and how to populate them.--Useful for creating strict bytestrings and tasks like that.--}-data Write =- Write {- writeSize :: Int,+-- |+-- Specification of how many bytes to allocate and how to populate them.+--+-- Useful for creating strict bytestrings and tasks like that.+data Write = Write+ { writeSize :: Int, writePoke :: Poke.Poke- }+ } instance Semigroup Write where {-# INLINE (<>) #-}@@ -47,131 +42,115 @@ mconcat = concat -{-|-Reuses the IsString instance of 'ByteString'.--}+-- |+-- Reuses the IsString instance of 'ByteString'. instance IsString Write where {-# INLINE fromString #-} fromString = byteString . fromString -{-|-Concatenate a foldable of writes.--}+-- |+-- Concatenate a foldable of writes. {-# INLINE concat #-} concat :: Foldable f => f Write -> Write concat f = Write- (foldl' (\ a b -> a + writeSize b) 0 f)- (Poke.Poke (\ p -> foldM (\ p write -> Poke.pokePtr (writePoke write) p) p f))+ (foldl' (\a b -> a + writeSize b) 0 f)+ (Poke.Poke (\p -> foldM (\p write -> Poke.pokePtr (writePoke write) p) p f)) -{-|-Render Word8 as byte.--}+-- |+-- Render Word8 as byte. {-# INLINE word8 #-} word8 :: Word8 -> Write word8 a = Write 1 (Poke.word8 a) -{-|-Render Word16 in Little-endian.--}+-- |+-- Render Word16 in Little-endian. {-# INLINE lWord16 #-} lWord16 :: Word16 -> Write lWord16 a = Write 2 (Poke.lWord16 a) -{-|-Render Word16 in Big-endian.--}+-- |+-- Render Word16 in Big-endian. {-# INLINE bWord16 #-} bWord16 :: Word16 -> Write bWord16 a = Write 2 (Poke.bWord16 a) -{-|-Render Word32 in Little-endian.--}+-- |+-- Render Word32 in Little-endian. {-# INLINE lWord32 #-} lWord32 :: Word32 -> Write lWord32 a = Write 4 (Poke.lWord32 a) -{-|-Render Word32 in Big-endian.--}+-- |+-- Render Word32 in Big-endian. {-# INLINE bWord32 #-} bWord32 :: Word32 -> Write bWord32 a = Write 4 (Poke.bWord32 a) -{-|-Render Word64 in Little-endian.--}+-- |+-- Render Word64 in Little-endian. {-# INLINE lWord64 #-} lWord64 :: Word64 -> Write lWord64 a = Write 8 (Poke.lWord64 a) -{-|-Render Word64 in Big-endian.--}+-- |+-- Render Word64 in Big-endian. {-# INLINE bWord64 #-} bWord64 :: Word64 -> Write bWord64 a = Write 8 (Poke.bWord64 a) -{-|-Render Int16 in Little-endian.--}+-- |+-- Render Int16 in Little-endian. {-# INLINE lInt16 #-} lInt16 :: Int16 -> Write lInt16 a = Write 2 (Poke.lInt16 a) -{-|-Render Int16 in Big-endian.--}+-- |+-- Render Int16 in Big-endian. {-# INLINE bInt16 #-} bInt16 :: Int16 -> Write bInt16 a = Write 2 (Poke.bInt16 a) -{-|-Render Int32 in Little-endian.--}+-- |+-- Render Int32 in Little-endian. {-# INLINE lInt32 #-} lInt32 :: Int32 -> Write lInt32 a = Write 4 (Poke.lInt32 a) -{-|-Render Int32 in Big-endian.--}+-- |+-- Render Int32 in Big-endian. {-# INLINE bInt32 #-} bInt32 :: Int32 -> Write bInt32 a = Write 4 (Poke.bInt32 a) -{-|-Render Int64 in Little-endian.--}+-- |+-- Render Int64 in Little-endian. {-# INLINE lInt64 #-} lInt64 :: Int64 -> Write lInt64 a = Write 8 (Poke.lInt64 a) -{-|-Render Int64 in Big-endian.--}+-- |+-- Render Int64 in Big-endian. {-# INLINE bInt64 #-} bInt64 :: Int64 -> Write bInt64 a = Write 8 (Poke.bInt64 a) -{-|-Render Word64 in ASCII decimal.--}+-- |+-- Render Word64 in ASCII decimal. {-# INLINE word64AsciiDec #-} word64AsciiDec :: Word64 -> Write word64AsciiDec a =@@ -182,17 +161,15 @@ poke = Poke.sizedReverse size (Ffi.revPokeUInt64 (fromIntegral a)) -{-|-Render Word in ASCII decimal.--}+-- |+-- Render Word in ASCII decimal. {-# INLINE wordAsciiDec #-} wordAsciiDec :: Word -> Write wordAsciiDec = word64AsciiDec . fromIntegral -{-|-Render Int64 in ASCII decimal.--}+-- |+-- Render Int64 in ASCII decimal. {-# INLINE int64AsciiDec #-} int64AsciiDec :: Int64 -> Write int64AsciiDec a =@@ -203,94 +180,93 @@ poke = Poke.sizedReverse size (Ffi.revPokeInt64 (fromIntegral a)) -{-|-Render Int in ASCII decimal.--}+-- |+-- Render Int in ASCII decimal. {-# INLINE intAsciiDec #-} intAsciiDec :: Int -> Write intAsciiDec = int64AsciiDec . fromIntegral -{-|-Render double interpreting non-real values,-such as @NaN@, @Infinity@, @-Infinity@,-as is.--}+-- |+-- Render double interpreting non-real values,+-- such as @NaN@, @Infinity@, @-Infinity@,+-- as is. {-# INLINE doubleAsciiDec #-} doubleAsciiDec :: Double -> Write doubleAsciiDec a = if a == 0 then word8 48- else if isNaN a- then "NaN"- else if isInfinite a- then if a < 0- then "-Infinity"- else "Infinity"- else if a < 0- then word8 45 <> byteString (ByteString.double (negate a))- else byteString (ByteString.double a)+ else+ if isNaN a+ then "NaN"+ else+ if isInfinite a+ then+ if a < 0+ then "-Infinity"+ else "Infinity"+ else+ if a < 0+ then word8 45 <> byteString (ByteString.double (negate a))+ else byteString (ByteString.double a) -{-|-Render double interpreting non real values,-such as @NaN@, @Infinity@, @-Infinity@,-as zero.--}+-- |+-- Render double interpreting non real values,+-- such as @NaN@, @Infinity@, @-Infinity@,+-- as zero. {-# INLINE zeroNonRealDoubleAsciiDec #-} zeroNonRealDoubleAsciiDec :: Double -> Write zeroNonRealDoubleAsciiDec a = if a == 0 || isNaN a || isInfinite a then word8 48- else if a < 0- then word8 45 <> byteString (ByteString.double (negate a))- else byteString (ByteString.double a)+ else+ if a < 0+ then word8 45 <> byteString (ByteString.double (negate a))+ else byteString (ByteString.double a) -{-|-Render Scientific in ASCII decimal.--}+-- |+-- Render Scientific in ASCII decimal. {-# INLINE scientificAsciiDec #-} scientificAsciiDec :: Scientific -> Write scientificAsciiDec = byteString . ByteString.scientific -{-|-Efficiently copy the contents of ByteString using @memcpy@.--}+-- |+-- Efficiently copy the contents of ByteString using @memcpy@. {-# INLINE byteString #-} byteString :: ByteString -> Write byteString a = Write (ByteString.length a) (inline Poke.byteString a) -{-|-Render Text in UTF8.--Does pretty much the same as 'Data.Text.Encoding.encodeUtf8',-both implementation and performance-wise,-while allowing you to avoid redundant @memcpy@-compared to @('byteString' . 'Data.Text.Encoding.encodeUtf8')@.--Following are the benchmark results comparing the performance of-@('writeToByteString' . 'textUtf8')@ with-@Data.Text.Encoding.'Data.Text.Encoding.encodeUtf8'@-on inputs in Latin and Greek (requiring different number of surrogate bytes).-The results show that they are quite similar.--=== __Benchmark results__--> textUtf8/ptr-poker/latin/1 mean 51.54 ns ( +- 3.083 ns )-> textUtf8/ptr-poker/latin/10 mean 132.8 ns ( +- 14.75 ns )-> textUtf8/ptr-poker/latin/100 mean 860.6 ns ( +- 66.61 ns )-> textUtf8/ptr-poker/greek/1 mean 106.4 ns ( +- 19.28 ns )-> textUtf8/ptr-poker/greek/10 mean 498.4 ns ( +- 8.022 ns )-> textUtf8/ptr-poker/greek/100 mean 4.462 μs ( +- 31.58 ns )-> textUtf8/text/latin/1 mean 52.77 ns ( +- 3.311 ns )-> textUtf8/text/latin/10 mean 206.1 ns ( +- 26.78 ns )-> textUtf8/text/latin/100 mean 1.337 μs ( +- 43.34 ns )-> textUtf8/text/greek/1 mean 88.22 ns ( +- 1.119 ns )-> textUtf8/text/greek/10 mean 475.2 ns ( +- 21.15 ns )-> textUtf8/text/greek/100 mean 4.252 μs ( +- 64.33 ns )--}-{-# INLINABLE textUtf8 #-}+-- |+-- Render Text in UTF8.+--+-- Does pretty much the same as 'Data.Text.Encoding.encodeUtf8',+-- both implementation and performance-wise,+-- while allowing you to avoid redundant @memcpy@+-- compared to @('byteString' . 'Data.Text.Encoding.encodeUtf8')@.+--+-- Following are the benchmark results comparing the performance of+-- @('writeToByteString' . 'textUtf8')@ with+-- @Data.Text.Encoding.'Data.Text.Encoding.encodeUtf8'@+-- on inputs in Latin and Greek (requiring different number of surrogate bytes).+-- The results show that they are quite similar.+--+-- === __Benchmark results__+--+-- > textUtf8/ptr-poker/latin/1 mean 51.54 ns ( +- 3.083 ns )+-- > textUtf8/ptr-poker/latin/10 mean 132.8 ns ( +- 14.75 ns )+-- > textUtf8/ptr-poker/latin/100 mean 860.6 ns ( +- 66.61 ns )+-- > textUtf8/ptr-poker/greek/1 mean 106.4 ns ( +- 19.28 ns )+-- > textUtf8/ptr-poker/greek/10 mean 498.4 ns ( +- 8.022 ns )+-- > textUtf8/ptr-poker/greek/100 mean 4.462 μs ( +- 31.58 ns )+-- > textUtf8/text/latin/1 mean 52.77 ns ( +- 3.311 ns )+-- > textUtf8/text/latin/10 mean 206.1 ns ( +- 26.78 ns )+-- > textUtf8/text/latin/100 mean 1.337 μs ( +- 43.34 ns )+-- > textUtf8/text/greek/1 mean 88.22 ns ( +- 1.119 ns )+-- > textUtf8/text/greek/10 mean 475.2 ns ( +- 21.15 ns )+-- > textUtf8/text/greek/100 mean 4.252 μs ( +- 64.33 ns )+{-# INLINEABLE textUtf8 #-} textUtf8 :: Text -> Write textUtf8 = byteString . ByteString.textUtf8
ptr-poker.cabal view
@@ -1,5 +1,5 @@ name: ptr-poker-version: 0.1.2+version: 0.1.2.1 synopsis: Pointer poking action construction and composition toolkit homepage: https://github.com/nikita-volkov/ptr-poker bug-reports: https://github.com/nikita-volkov/ptr-poker/issues@@ -29,6 +29,7 @@ PtrPoker.IO.ByteString PtrPoker.IO.Prim PtrPoker.Prelude+ PtrPoker.Text PtrPoker.UncheckedShifting c-sources: cbits/dtoa.c@@ -39,7 +40,7 @@ base >=4.11 && <5, bytestring >=0.10 && <0.12, scientific >=0.3.6.2 && <0.4,- text >=1 && <3+ text >=1 && <2 test-suite test type: exitcode-stdio-1.0
test/Main.hs view
@@ -1,132 +1,125 @@ module Main where -import Prelude+import qualified Data.ByteString.Char8 as Char8ByteString+import qualified Data.Text.Encoding as Text import Hedgehog-import Hedgehog.Main import qualified Hedgehog.Gen as Gen+import Hedgehog.Main import qualified Hedgehog.Range as Range-import qualified Data.ByteString.Char8 as Char8ByteString-import qualified Data.Text.Encoding as Text-import qualified PtrPoker.Write as Write-import qualified PtrPoker.Size as Size import qualified Numeric.Limits as NumericLimits-+import qualified PtrPoker.Size as Size+import qualified PtrPoker.Write as Write+import Prelude main = defaultMain $ pure $ checkParallel $ $$(discover) prop_word64Size = withTests 999 $- property $ do- a <- forAll (Gen.word64 (Range.exponential minBound maxBound))- Size.word64AsciiDec a- === length (show a)+ property $ do+ a <- forAll (Gen.word64 (Range.exponential minBound maxBound))+ Size.word64AsciiDec a+ === length (show a) prop_int64Size = withTests 999 $- property $ do- a <- forAll (Gen.int64 (Range.exponential minBound maxBound))- Size.int64AsciiDec a- === length (show a)+ property $ do+ a <- forAll (Gen.int64 (Range.exponential minBound maxBound))+ Size.int64AsciiDec a+ === length (show a) prop_wordAsciiDec = withTests 999 $- property $ do- a <- forAll (Gen.word (Range.exponential minBound maxBound))- let- string =- Char8ByteString.unpack (Write.writeToByteString (Write.wordAsciiDec a))- annotate string- read string === a+ property $ do+ a <- forAll (Gen.word (Range.exponential minBound maxBound))+ let string =+ Char8ByteString.unpack (Write.writeToByteString (Write.wordAsciiDec a))+ annotate string+ read string === a prop_intAsciiDec = withTests 999 $- property $ do- a <- forAll (Gen.int (Range.exponential minBound maxBound))- let- string =- Char8ByteString.unpack (Write.writeToByteString (Write.intAsciiDec a))- annotate string- read string === a+ property $ do+ a <- forAll (Gen.int (Range.exponential minBound maxBound))+ let string =+ Char8ByteString.unpack (Write.writeToByteString (Write.intAsciiDec a))+ annotate string+ read string === a prop_doubleAsciiDec = withTests 999 $- property $ do- a <- forAll realFloatGen- let- string =- Char8ByteString.unpack (Write.writeToByteString (Write.doubleAsciiDec a))- annotate string- if isNaN a- then string === "NaN"- else read string === a+ property $ do+ a <- forAll realFloatGen+ let string =+ Char8ByteString.unpack (Write.writeToByteString (Write.doubleAsciiDec a))+ annotate string+ if isNaN a+ then string === "NaN"+ else read string === a prop_realZeroNonRealDoubleAsciiDec = withTests 999 $- property $ do- a <- forAll realRealFloatGen- let- string =- Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))- annotate string- read string === a+ property $ do+ a <- forAll realRealFloatGen+ let string =+ Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))+ annotate string+ read string === a prop_nonRealZeroNonRealDoubleAsciiDec = withTests 99 $- property $ do- a <- forAll nonRealRealFloatGen- let- string =- Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))- annotate string- read string === 0+ property $ do+ a <- forAll nonRealRealFloatGen+ let string =+ Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a))+ annotate string+ read string === 0 prop_sizeOfTextUtf8 = withTests 999 $- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))- Size.textUtf8 a- === Char8ByteString.length (Text.encodeUtf8 a)+ property $ do+ a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))+ Size.textUtf8 a+ === Char8ByteString.length (Text.encodeUtf8 a) prop_sizeOfTextASCII = withTests 999 $- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)- Size.textUtf8 a- === Char8ByteString.length (Text.encodeUtf8 a)+ property $ do+ a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)+ Size.textUtf8 a+ === Char8ByteString.length (Text.encodeUtf8 a) prop_textASCII = withTests 999 $- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)- Write.writeToByteString (Write.textUtf8 a)- === Text.encodeUtf8 a+ property $ do+ a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii)+ Write.writeToByteString (Write.textUtf8 a)+ === Text.encodeUtf8 a prop_textUtf8 = withTests 999 $- property $ do- a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))- Write.writeToByteString (Write.textUtf8 a)- === Text.encodeUtf8 a+ property $ do+ a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode]))+ Write.writeToByteString (Write.textUtf8 a)+ === Text.encodeUtf8 a -- * Gens+ ------------------------- realFloatGen =- Gen.frequency [- (99, realRealFloatGen)- ,- (1, nonRealRealFloatGen)+ Gen.frequency+ [ (99, realRealFloatGen),+ (1, nonRealRealFloatGen) ] nonRealRealFloatGen = Gen.element [0 / 0, 1 / 0, (-1) / 0, -0] realRealFloatGen =- Gen.frequency [- (50, fullRangeExponentialRealFloatGen)- ,- (50, simpleZeroToOneRealFloatGen)+ Gen.frequency+ [ (50, fullRangeExponentialRealFloatGen),+ (50, simpleZeroToOneRealFloatGen) ] fullRangeExponentialRealFloatGen =