diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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) + ] + ] ] - ] - ] ] diff --git a/library/PtrPoker/ByteString.hs b/library/PtrPoker/ByteString.hs --- a/library/PtrPoker/ByteString.hs +++ b/library/PtrPoker/ByteString.hs @@ -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) diff --git a/library/PtrPoker/Ffi.hs b/library/PtrPoker/Ffi.hs --- a/library/PtrPoker/Ffi.hs +++ b/library/PtrPoker/Ffi.hs @@ -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) diff --git a/library/PtrPoker/IO/ByteString.hs b/library/PtrPoker/IO/ByteString.hs --- a/library/PtrPoker/IO/ByteString.hs +++ b/library/PtrPoker/IO/ByteString.hs @@ -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) diff --git a/library/PtrPoker/IO/Prim.hs b/library/PtrPoker/IO/Prim.hs --- a/library/PtrPoker/IO/Prim.hs +++ b/library/PtrPoker/IO/Prim.hs @@ -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 #-} diff --git a/library/PtrPoker/Poke.hs b/library/PtrPoker/Poke.hs --- a/library/PtrPoker/Poke.hs +++ b/library/PtrPoker/Poke.hs @@ -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 diff --git a/library/PtrPoker/Prelude.hs b/library/PtrPoker/Prelude.hs --- a/library/PtrPoker/Prelude.hs +++ b/library/PtrPoker/Prelude.hs @@ -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 diff --git a/library/PtrPoker/Size.hs b/library/PtrPoker/Size.hs --- a/library/PtrPoker/Size.hs +++ b/library/PtrPoker/Size.hs @@ -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 diff --git a/library/PtrPoker/Text.hs b/library/PtrPoker/Text.hs new file mode 100644 --- /dev/null +++ b/library/PtrPoker/Text.hs @@ -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 diff --git a/library/PtrPoker/UncheckedShifting.hs b/library/PtrPoker/UncheckedShifting.hs --- a/library/PtrPoker/UncheckedShifting.hs +++ b/library/PtrPoker/UncheckedShifting.hs @@ -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 diff --git a/library/PtrPoker/Write.hs b/library/PtrPoker/Write.hs --- a/library/PtrPoker/Write.hs +++ b/library/PtrPoker/Write.hs @@ -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 diff --git a/ptr-poker.cabal b/ptr-poker.cabal --- a/ptr-poker.cabal +++ b/ptr-poker.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 =