packages feed

ptr 0.15.7 → 0.16

raw patch · 5 files changed

+86/−51 lines, 5 filesdep +QuickCheckdep ~tastydep ~tasty-quickcheck

Dependencies added: QuickCheck

Dependency ranges changed: tasty, tasty-quickcheck

Files

library/Ptr/Poke.hs view
@@ -54,3 +54,18 @@ pokeAndPeek :: B.PokeAndPeek input output -> Poke input pokeAndPeek (B.PokeAndPeek size io _) =   Poke size io++{-# INLINE asciiChar #-}+asciiChar :: Poke Char+asciiChar =+  contramap (fromIntegral . ord) word8++{-# INLINE asciiDigit #-}+asciiDigit :: Poke Word8+asciiDigit =+  contramap (+ 48) word8++{-# INLINE asciiHexDigit #-}+asciiHexDigit :: Poke Word8+asciiHexDigit =+  contramap (\ n -> if n < 10 then 48 + n else 55 + n) word8
+ library/Ptr/PokeIO.hs view
@@ -0,0 +1,27 @@+{-|+Sketches of new module, which implements the poking actions.+-}+module Ptr.PokeIO+where++import Ptr.Prelude+++type PokeIO =+  Ptr Word8 -> IO ()++{-# INLINE sequentially #-}+sequentially :: Int -> PokeIO -> PokeIO -> PokeIO+sequentially space1 action1 action2 ptr =+  action1 ptr *> action2 (plusPtr ptr space1)++{-# INLINE concurrently #-}+concurrently :: Int -> PokeIO -> PokeIO -> PokeIO+concurrently space1 action1 action2 ptr =+  do+    lock <- newEmptyMVar+    forkIO $ do+      action1 ptr+      putMVar lock ()+    action2 (plusPtr ptr space1)+    takeMVar lock
library/Ptr/Poking.hs view
@@ -5,6 +5,7 @@ import qualified Ptr.IO as A import qualified Ptr.Poke as C import qualified Ptr.PokeAndPeek as D+import qualified Ptr.PokeIO as E import qualified Data.ByteString.Internal as B  @@ -22,9 +23,18 @@   Poking !Int !(Ptr Word8 -> IO ())  instance Semigroup Poking where-  {-# INLINE (<>) #-}+  {-|+  When the pokings are both larger than 2048 bits,+  the serialization is performed concurrently.+  -}+  {-# INLINABLE (<>) #-}   (<>) (Poking space1 action1) (Poking space2 action2) =-    Poking (space1 + space2) (\ptr -> action1 ptr *> action2 (plusPtr ptr space1))+    Poking (space1 + space2) action+    where+      action =+        if space1 < 2048 || space2 < 2048+          then E.sequentially space1 action1 action2+          else E.concurrently space1 action1 action2  instance Monoid Poking where   {-# INLINE mempty #-}@@ -34,25 +44,6 @@   mappend =     (<>) -{-|-Same as 'mappend' and '<>',-but performs the serialization concurrently.-This comes at the cost of an overhead,-so it is only advised to use this function when the merged serializations are heavy.--}-prependConc :: Poking -> Poking -> Poking-prependConc (Poking space1 action1) (Poking space2 action2) =-  Poking (space1 + space2) action-  where-    action ptr =-      do-        lock <- newEmptyMVar-        forkIO $ do-          action1 ptr-          putMVar lock ()-        action2 (plusPtr ptr space1)-        takeMVar lock- {-# INLINE word8 #-} word8 :: Word8 -> Poking word8 x =@@ -103,37 +94,37 @@             (quot, rem) ->               loop (word8 (48 + fromIntegral rem) <> builder) quot -{-# INLINABLE paddedAndTrimmedAsciiIntegral #-}-paddedAndTrimmedAsciiIntegral :: Integral a => Int -> a -> Poking-paddedAndTrimmedAsciiIntegral !length !integral =+{-# INLINE asciiChar #-}+asciiChar :: Char -> Poking+asciiChar =+  word8 . fromIntegral . ord++{-# INLINABLE asciiPaddedAndTrimmedIntegral #-}+asciiPaddedAndTrimmedIntegral :: Integral a => Int -> a -> Poking+asciiPaddedAndTrimmedIntegral !length !integral =   if length > 0     then       if integral >= 0         then case quotRem integral 10 of           (quot, rem) ->-            paddedAndTrimmedAsciiIntegral (pred length) quot <>+            asciiPaddedAndTrimmedIntegral (pred length) quot <>             word8 (48 + fromIntegral rem)         else stimes length (word8 48)     else mempty -{-# INLINE asciiChar #-}-asciiChar :: Char -> Poking-asciiChar =-  word8 . fromIntegral . ord--{-# INLINABLE utcTimeInIso8601InAscii #-}+{-# INLINABLE asciiUtcTimeInIso8601 #-} {- 2017-02-01T05:03:58Z -}-utcTimeInIso8601InAscii :: UTCTime -> Poking-utcTimeInIso8601InAscii utcTime =-  paddedAndTrimmedAsciiIntegral 4 year <> word8 45 <> -  paddedAndTrimmedAsciiIntegral 2 month <> word8 45 <>-  paddedAndTrimmedAsciiIntegral 2 day <>+asciiUtcTimeInIso8601 :: UTCTime -> Poking+asciiUtcTimeInIso8601 utcTime =+  asciiPaddedAndTrimmedIntegral 4 year <> word8 45 <> +  asciiPaddedAndTrimmedIntegral 2 month <> word8 45 <>+  asciiPaddedAndTrimmedIntegral 2 day <>   word8 84 <>-  paddedAndTrimmedAsciiIntegral 2 hour <> word8 58 <>-  paddedAndTrimmedAsciiIntegral 2 minute <> word8 58 <>-  paddedAndTrimmedAsciiIntegral 2 (round second) <>+  asciiPaddedAndTrimmedIntegral 2 hour <> word8 58 <>+  asciiPaddedAndTrimmedIntegral 2 minute <> word8 58 <>+  asciiPaddedAndTrimmedIntegral 2 (round second) <>   word8 90   where     LocalTime date (TimeOfDay hour minute second) = utcToLocalTime utc utcTime
ptr.cabal view
@@ -1,7 +1,7 @@ name:   ptr version:-  0.15.7+  0.16 category:   Ptr, Data synopsis:@@ -50,6 +50,7 @@   other-modules:     Ptr.Receive.Core     Ptr.IO+    Ptr.PokeIO     Ptr.UncheckedShifting     Ptr.Prelude   build-depends:@@ -81,17 +82,18 @@     -threaded     "-with-rtsopts=-N"   default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010   build-depends:     --     ptr,     -- testing:-    tasty == 0.11.*,-    tasty-quickcheck == 0.8.*,-    tasty-hunit == 0.9.*,-    quickcheck-instances >= 0.3.11 && < 0.4,+    tasty >=0.12 && <0.13,+    tasty-quickcheck >=0.9 && <0.10,+    tasty-hunit >=0.9 && <0.10,+    quickcheck-instances >=0.3.11 && <0.4,+    QuickCheck >=2.8.1 && <3,     --     bug == 1.*,     rerebase == 1.*
tests/Main.hs view
@@ -31,13 +31,13 @@     ,     testGroup "Poking"     [-      testCase "paddedAndTrimmedAsciiIntegral" $ do-        assertEqual "" "001" (A.poking (F.paddedAndTrimmedAsciiIntegral 3 1))-        assertEqual "" "001" (A.poking (F.paddedAndTrimmedAsciiIntegral 3 2001))-        assertEqual "" "000" (A.poking (F.paddedAndTrimmedAsciiIntegral 3 (-1)))+      testCase "asciiPaddedAndTrimmedIntegral" $ do+        assertEqual "" "001" (A.poking (F.asciiPaddedAndTrimmedIntegral 3 1))+        assertEqual "" "001" (A.poking (F.asciiPaddedAndTrimmedIntegral 3 2001))+        assertEqual "" "000" (A.poking (F.asciiPaddedAndTrimmedIntegral 3 (-1)))       ,-      testCase "utcTimeInIso8601InAscii" $ do-        assertEqual "" "2017-02-01T05:03:58Z" (A.poking (F.utcTimeInIso8601InAscii (read "2017-02-01 05:03:58")))+      testCase "asciiUtcTimeInIso8601" $ do+        assertEqual "" "2017-02-01T05:03:58Z" (A.poking (F.asciiUtcTimeInIso8601 (read "2017-02-01 05:03:58")))     ]   ]