summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNikitaVolkov <>2018-08-09 18:12:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-08-09 18:12:00 (GMT)
commit12a2777e64ff15c8a6b27752a824c63a3c53f7d7 (patch)
tree1edc0ed1cfabaa4e74aecaaaabe0e4e4bcbaae7a
parentd5fa1342182fbd95ceb3a60ab3a486db57538123 (diff)
version 0.16.6HEAD0.16.6master
-rw-r--r--library/Ptr/Parse.hs6
-rw-r--r--library/Ptr/Poking.hs30
-rw-r--r--ptr.cabal2
-rw-r--r--tests/Main.hs23
4 files changed, 49 insertions, 12 deletions
diff --git a/library/Ptr/Parse.hs b/library/Ptr/Parse.hs
index bb00454..11c2a13 100644
--- a/library/Ptr/Parse.hs
+++ b/library/Ptr/Parse.hs
@@ -182,7 +182,9 @@ bytesWhile predicate =
else do
bytes <- B.packCStringLen (castPtr ptr, availableAmount - unconsumedAmount)
succeed bytes unconsumedAmount currentPtr
- else failWithEOI 0
+ else do
+ bytes <- B.packCStringLen (castPtr ptr, availableAmount - unconsumedAmount)
+ succeed bytes unconsumedAmount currentPtr
in iterate availableAmount availableAmount ptr
{-# INLINE skipWhile #-}
@@ -198,7 +200,7 @@ skipWhile predicate =
if predicate byte
then iterate availableAmount (pred unconsumedAmount) (plusPtr ptr 1)
else succeed () unconsumedAmount ptr
- else failWithEOI 0
+ else succeed () unconsumedAmount ptr
in iterate availableAmount availableAmount ptr
{-# INLINE foldWhile #-}
diff --git a/library/Ptr/Poking.hs b/library/Ptr/Poking.hs
index 2e52d74..473edad 100644
--- a/library/Ptr/Poking.hs
+++ b/library/Ptr/Poking.hs
@@ -8,6 +8,8 @@ import qualified Ptr.PokeAndPeek as D
import qualified Ptr.PokeIO as E
import qualified Data.ByteString.Internal as B
import qualified Data.Vector as F
+import qualified Data.Vector.Generic as GenericVector
+import qualified Data.List as List
{-|
@@ -45,6 +47,11 @@ instance Monoid Poking where
mappend =
(<>)
+instance IsString Poking where
+ fromString string = Poking (List.length string) io where
+ io ptr = foldM_ step ptr string where
+ step ptr char = A.pokeWord8 ptr (fromIntegral (ord char)) $> plusPtr ptr 1
+
{-# INLINE null #-}
null :: Poking -> Bool
null =
@@ -172,21 +179,38 @@ list element =
_ -> state <> word8 0
{-# INLINABLE vector #-}
-vector :: (element -> Poking) -> F.Vector element -> Poking
+vector :: GenericVector.Vector vector element => (element -> Poking) -> vector element -> Poking
vector element vectorValue =
Poking byteSize io
where
byteSize =
- foldl' step 0 vectorValue
+ GenericVector.foldl' step 0 vectorValue
where
step !byteSize elementValue =
case element elementValue of
Poking elementByteSize _ -> byteSize + elementByteSize
io ptr =
- F.foldM'_ step ptr vectorValue
+ GenericVector.foldM'_ step ptr vectorValue
where
step ptr elementValue =
case element elementValue of
Poking elementByteSize elementIO -> do
elementIO ptr
return (plusPtr ptr elementByteSize)
+
+{-# INLINABLE intercalateVector #-}
+intercalateVector :: GenericVector.Vector vector element => (element -> Poking) -> Poking -> vector element -> Poking
+intercalateVector element (Poking separatorLength separatorIo) vectorValue = Poking length io where
+ length = GenericVector.foldl' step 0 vectorValue + ((GenericVector.length vectorValue - 1) * separatorLength) where
+ step length elementValue = case element elementValue of
+ Poking elementLength _ -> length + elementLength
+ indexIsLast = let
+ lastIndex = pred (GenericVector.length vectorValue)
+ in (== lastIndex)
+ io ptr = GenericVector.ifoldM'_ step ptr vectorValue where
+ step ptr index elementValue = case element elementValue of
+ Poking elementLength elementIo -> if indexIsLast index
+ then elementIo ptr $> ptr
+ else let
+ ptrAfterElement = plusPtr ptr elementLength
+ in elementIo ptr *> separatorIo ptrAfterElement $> plusPtr ptrAfterElement separatorLength
diff --git a/ptr.cabal b/ptr.cabal
index 1c6a939..c99cef2 100644
--- a/ptr.cabal
+++ b/ptr.cabal
@@ -1,7 +1,7 @@
name:
ptr
version:
- 0.16.5
+ 0.16.6
category:
Ptr, Data
synopsis:
diff --git a/tests/Main.hs b/tests/Main.hs
index 0e84965..6bb7be4 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -14,6 +14,7 @@ import qualified Ptr.ByteString as A
import qualified Ptr.Poking as F
import qualified Ptr.Parse as G
import qualified Data.ByteString as D
+import qualified Data.Vector.Unboxed as UnboxedVector
main =
@@ -39,6 +40,12 @@ main =
,
testCase "asciiUtcTimeInIso8601" $ do
assertEqual "" "2017-02-01T05:03:58Z" (A.poking (F.asciiUtcTimeInIso8601 (read "2017-02-01 05:03:58")))
+ ,
+ testCase "fromString" $ do
+ assertEqual "" "123" (A.poking "123")
+ ,
+ testCase "intercalateVector" $ do
+ assertEqual "" "1,2,3,4" (A.poking (F.intercalateVector F.asciiIntegral "," (UnboxedVector.fromList [1 :: Word8, 2, 3, 4])))
]
,
parsing
@@ -46,12 +53,16 @@ main =
parsing :: TestTree
parsing =
- testGroup "Parsing" $
- [
- testCase "bytesWhile" $ assertEqual "" "123" (A.parse "123456" (G.bytesWhile (< 52)) undefined undefined)
- ,
- testCase "bytesWhile 2" $ assertEqual "" "123456" (A.parse "123456" (G.bytesWhile (< 59)) undefined undefined)
- ]
+ testGroup "Parsing" $ let
+ assertParsesTo expected input parser =
+ assertEqual "" (Right expected) (A.parse input (fmap Right parser) (Left . Left) (Left . Right))
+ in [
+ testCase "bytesWhile" $ assertParsesTo "123" "123456" $ G.bytesWhile (< 52)
+ ,
+ testCase "bytesWhile on full input" $ assertParsesTo "123456" "123456" $ G.bytesWhile (< 59)
+ ,
+ testCase "skipWhile on full input" $ assertParsesTo () "123456" $ G.skipWhile (< 59)
+ ]
pokeThenPeek :: B.Poke a -> C.Peek a -> Maybe (a -> a)
pokeThenPeek (B.Poke pokeSize pokeIO) (C.Peek peekSize peekIO) =