orion/purescript-node-stream-pipes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix: more Pipes.Collect utils, stack-safety

Browse Source
This commit is contained in:
orion kindel
2024-05-11 18:01:34 -05:00
parent f2f18c3c13
commit 634e52fe39
14 changed files with 354 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
test/Test/Main.purs
View File

@@ -8,6 +8,7 @@ import Effect.Aff (launchAff_)
import Test.Pipes.Node.Stream as Test.Pipes.Node.Stream
import Test.Pipes.Node.Buffer as Test.Pipes.Node.Buffer
import Test.Pipes.Node.FS as Test.Pipes.Node.FS
import Test.Pipes.Collect as Test.Pipes.Collect
import Test.Spec.Reporter (specReporter)
import Test.Spec.Runner (defaultConfig, runSpec')
@@ -16,3 +17,4 @@ main = launchAff_ $ runSpec' (defaultConfig { failFast = true, timeout = Nothing
Test.Pipes.Node.Stream.spec
Test.Pipes.Node.Buffer.spec
Test.Pipes.Node.FS.spec
Test.Pipes.Collect.spec

111
test/Test/Pipes.Collect.purs Normal file
View File

@@ -0,0 +1,111 @@
module Test.Pipes.Collect where
import Prelude
import Control.Monad.Gen (chooseInt)
import Control.Monad.Rec.Class (Step(..), tailRecM)
import Control.Monad.ST as ST
import Control.Monad.ST.Ref as STRef
import Data.Array as Array
import Data.Bifunctor (lmap)
import Data.HashMap (HashMap)
import Data.HashMap as HashMap
import Data.List (List)
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse)
import Data.Tuple.Nested (type (/\), (/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Unsafe (unsafePerformEffect)
import Foreign.Object (Object)
import Foreign.Object as Object
import Pipes (yield)
import Pipes.Collect as Pipes.Collect
import Pipes.Core (Producer)
import Test.QuickCheck.Gen (randomSampleOne)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
testData
:: { array :: Array (Int /\ Int)
, list :: List (Int /\ Int)
, strarray :: Array (String /\ Int)
, object :: Object Int
, map :: Map Int Int
, hashMap :: HashMap Int Int
, stream :: Producer (Int /\ Int) Aff Unit
, streamStr :: Producer (String /\ Int) Aff Unit
}
testData =
unsafePerformEffect $ do
array <-
flip traverse (Array.range 0 99999) \k -> do
v <- liftEffect $ randomSampleOne $ chooseInt 0 99999
pure $ k /\ v
let
strarray = lmap show <$> array
object = Object.fromFoldable strarray
map' :: forall m. m -> (Int -> Int -> m -> m) -> m
map' empty insert = ST.run do
st <- STRef.new empty
ST.foreach array \(k /\ v) -> void $ STRef.modify (insert k v) st
STRef.read st
hashMap = map' HashMap.empty HashMap.insert
map = map' Map.empty Map.insert
pure
{ array
, strarray
, list: List.fromFoldable array
, object
, hashMap
, map
, stream: flip tailRecM 0 \ix -> case Array.index array ix of
Just a -> yield a $> Loop (ix + 1)
Nothing -> pure $ Done unit
, streamStr: flip tailRecM 0 \ix -> case Array.index strarray ix of
Just a -> yield a $> Loop (ix + 1)
Nothing -> pure $ Done unit
}
spec :: Spec Unit
spec =
describe "Test.Pipes.Collect" do
describe "toArray" do
it "collects an array" do
act <- Pipes.Collect.toArray testData.stream
act `shouldEqual` testData.array
it "empty ok" do
act :: Array Int <- Pipes.Collect.toArray (pure unit)
act `shouldEqual` []
describe "toObject" do
it "collects" do
act <- Pipes.Collect.toObject $ testData.streamStr
act `shouldEqual` testData.object
it "empty ok" do
act :: Object Int <- Pipes.Collect.toObject (pure unit)
act `shouldEqual` Object.empty
describe "toMap" do
it "collects" do
act <- Pipes.Collect.toMap testData.stream
act `shouldEqual` testData.map
it "empty ok" do
act :: Map String Int <- Pipes.Collect.toMap (pure unit)
act `shouldEqual` Map.empty
describe "toHashMap" do
it "collects" do
act <- Pipes.Collect.toHashMap testData.stream
act `shouldEqual` testData.hashMap
it "empty ok" do
act :: HashMap String Int <- Pipes.Collect.toHashMap (pure unit)
act `shouldEqual` HashMap.empty
describe "toList" do
it "collects" do
act <- Pipes.Collect.toList testData.stream
act `shouldEqual` testData.list
it "empty ok" do
act :: List (String /\ Int) <- Pipes.Collect.toList (pure unit)
act `shouldEqual` List.Nil

50
test/Test/Pipes.Node.Buffer.purs
View File

@@ -27,6 +27,7 @@ import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (fail, shouldEqual)
data BufferJunk = BufferJunk Buffer
instance Arbitrary BufferJunk where
arbitrary = sized \s -> do
ns <- vectorOf s (chooseInt 0 7)
@@ -36,6 +37,7 @@ instance Arbitrary BufferJunk where
pure $ BufferJunk buf
data BufferUTF8 = BufferUTF8 String Buffer
instance Arbitrary BufferUTF8 where
arbitrary = do
s <- genAsciiString
@@ -43,27 +45,27 @@ instance Arbitrary BufferUTF8 where
spec :: Spec Unit
spec = describe "Pipes.Node.Buffer" do
describe "toString" do
it "fails when encoding wrong" do
vals <- Pipes.each <$> (map \(BufferJunk b) -> b) <$> liftEffect (randomSample' 10 arbitrary)
let
uut = Pipes.runEffect $ vals >-> Pipes.Node.Buffer.toString UTF8 >-> Pipes.drain
ok = do
uut
fail "Should have thrown"
err _ = pure unit
catchError ok err
it "junk OK in hex" do
vals <- Pipes.each <$> (map \(BufferJunk b) -> b) <$> liftEffect (randomSample' 10 arbitrary)
Pipes.runEffect $ vals >-> Pipes.Node.Buffer.toString Hex >-> Pipes.drain
it "UTF8 ok" do
vals <- (map \(BufferUTF8 s b) -> s /\ b) <$> liftEffect (randomSample' 100 arbitrary)
let
bufs = Pipes.each $ snd <$> vals
strs = fst <$> vals
act <- Array.fromFoldable <$> Pipes.toListM (bufs >-> Pipes.Node.Buffer.toString UTF8)
act `shouldEqual` strs
describe "fromString" do
it "ok" do
vals <- Pipes.each <$> liftEffect (randomSample' 100 genAsciiString)
Pipes.runEffect $ vals >-> Pipes.Node.Buffer.fromString UTF8 >-> Pipes.drain
describe "toString" do
it "fails when encoding wrong" do
vals <- Pipes.each <$> (map \(BufferJunk b) -> b) <$> liftEffect (randomSample' 10 arbitrary)
let
uut = Pipes.runEffect $ vals >-> Pipes.Node.Buffer.toString UTF8 >-> Pipes.drain
ok = do
uut
fail "Should have thrown"
err _ = pure unit
catchError ok err
it "junk OK in hex" do
vals <- Pipes.each <$> (map \(BufferJunk b) -> b) <$> liftEffect (randomSample' 10 arbitrary)
Pipes.runEffect $ vals >-> Pipes.Node.Buffer.toString Hex >-> Pipes.drain
it "UTF8 ok" do
vals <- (map \(BufferUTF8 s b) -> s /\ b) <$> liftEffect (randomSample' 100 arbitrary)
let
bufs = Pipes.each $ snd <$> vals
strs = fst <$> vals
act <- Array.fromFoldable <$> Pipes.toListM (bufs >-> Pipes.Node.Buffer.toString UTF8)
act `shouldEqual` strs
describe "fromString" do
it "ok" do
vals <- Pipes.each <$> liftEffect (randomSample' 100 genAsciiString)
Pipes.runEffect $ vals >-> Pipes.Node.Buffer.fromString UTF8 >-> Pipes.drain

106
test/Test/Pipes.Node.FS.purs
View File

@@ -24,63 +24,63 @@ import Test.Spec.Assertions (fail, shouldEqual)
spec :: Spec Unit
spec = describe "Pipes.Node.FS" do
describe "read" do
around tmpFile $ it "fails if the file does not exist" \p -> do
flip catchError (const $ pure unit) do
Pipes.runEffect $ Pipes.Node.FS.read p >-> Pipes.drain
fail "should have thrown"
around tmpFile $ it "reads ok" \p -> do
liftEffect $ FS.writeTextFile UTF8 p "foo"
s <- fold <$> Pipes.toListM (Pipes.Node.FS.read p >-> unEOS >-> Pipes.Node.Buffer.toString UTF8)
s `shouldEqual` "foo"
around tmpFile $ it "fails if the file already exists" \p -> do
liftEffect $ FS.writeTextFile UTF8 "foo" p
flip catchError (const $ pure unit) do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.create p
fail "should have thrown"
describe "create" do
around tmpFile $ it "creates the file when not exists" \p -> do
describe "read" do
around tmpFile $ it "fails if the file does not exist" \p -> do
flip catchError (const $ pure unit) do
Pipes.runEffect $ Pipes.Node.FS.read p >-> Pipes.drain
fail "should have thrown"
around tmpFile $ it "reads ok" \p -> do
liftEffect $ FS.writeTextFile UTF8 p "foo"
s <- fold <$> Pipes.toListM (Pipes.Node.FS.read p >-> unEOS >-> Pipes.Node.Buffer.toString UTF8)
s `shouldEqual` "foo"
around tmpFile $ it "fails if the file already exists" \p -> do
liftEffect $ FS.writeTextFile UTF8 "foo" p
flip catchError (const $ pure unit) do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.create p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "fails if the file already exists" \p -> do
liftEffect $ FS.writeTextFile UTF8 "foo" p
flip catchError (const $ pure unit) do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.create p
fail "should have thrown"
describe "append" do
around tmpFile $ it "creates the file when not exists" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "appends" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
Pipes.runEffect $ withEOS (yield "\n" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
Pipes.runEffect $ withEOS (yield "bar" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo\nbar"
describe "truncate" do
around tmpFile $ it "creates the file when not exists" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "overwrites contents" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
Pipes.runEffect $ withEOS (yield "bar" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "bar"
around tmpFiles $ it "json lines >-> parse >-> _.foo >-> write" \(a /\ b) -> do
let
exp = [{foo: "a"}, {foo: "bar"}, {foo: "123"}]
liftEffect $ FS.writeTextFile UTF8 a $ intercalate "\n" $ writeJSON <$> exp
Pipes.runEffect $
Pipes.Node.FS.read a
fail "should have thrown"
describe "create" do
around tmpFile $ it "creates the file when not exists" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.create p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "fails if the file already exists" \p -> do
liftEffect $ FS.writeTextFile UTF8 "foo" p
flip catchError (const $ pure unit) do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.create p
fail "should have thrown"
describe "append" do
around tmpFile $ it "creates the file when not exists" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "appends" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
Pipes.runEffect $ withEOS (yield "\n" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
Pipes.runEffect $ withEOS (yield "bar" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.append p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo\nbar"
describe "truncate" do
around tmpFile $ it "creates the file when not exists" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "foo"
around tmpFile $ it "overwrites contents" \p -> do
Pipes.runEffect $ withEOS (yield "foo" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
Pipes.runEffect $ withEOS (yield "bar" >-> Pipes.Node.Buffer.fromString UTF8) >-> Pipes.Node.FS.truncate p
contents <- liftEffect $ FS.readTextFile UTF8 p
contents `shouldEqual` "bar"
around tmpFiles $ it "json lines >-> parse >-> _.foo >-> write" \(a /\ b) -> do
let
exp = [ { foo: "a" }, { foo: "bar" }, { foo: "123" } ]
liftEffect $ FS.writeTextFile UTF8 a $ intercalate "\n" $ writeJSON <$> exp
Pipes.runEffect $
Pipes.Node.FS.read a
>-> inEOS (Pipes.Node.Buffer.toString UTF8)
>-> Pipes.String.split (wrap "\n")
>-> inEOS (jsonParse @{foo :: String})
>-> inEOS (jsonParse @{ foo :: String })
>-> inEOS (Pipes.map _.foo)
>-> Pipes.Util.intersperse "\n"
>-> inEOS (Pipes.Node.Buffer.fromString UTF8)
>-> Pipes.Node.FS.create b
act <- liftEffect $ FS.readTextFile UTF8 b
act `shouldEqual` "a\nbar\n123"
act <- liftEffect $ FS.readTextFile UTF8 b
act `shouldEqual` "a\nbar\n123"

10
test/Test/Pipes.Node.Stream.purs
View File

@@ -96,7 +96,7 @@ spec =
str :: String <- genAlphaString
num :: Int <- arbitrary
stuff :: Array String <- arbitrary
pure {str, num, stuff}
pure { str, num, stuff }
objs <- liftEffect (randomSample' 1 obj)
let
exp = fold (writeJSON <$> objs)
@@ -108,14 +108,14 @@ spec =
describe "Transform" do
it "gzip" do
let
json = yield $ writeJSON {foo: "bar"}
json = yield $ writeJSON { foo: "bar" }
exp = "1f8b0800000000000003ab564acbcf57b2524a4a2c52aa0500eff52bfe0d000000"
gzip <- S.fromTransform <$> O.fromBufferTransform <$> liftEffect (Zlib.toDuplex <$> Zlib.createGzip)
outs :: List.List String <- Pipes.toListM (S.withEOS (json >-> Pipes.Buffer.fromString UTF8) >-> gzip >-> S.unEOS >-> Pipes.Buffer.toString Hex)
fold outs `shouldEqual` exp
around tmpFiles
$ it "file >-> gzip >-> file >-> gunzip" \(a /\ b) -> do
liftEffect $ FS.writeTextFile UTF8 a $ writeJSON [1, 2, 3, 4]
liftEffect $ FS.writeTextFile UTF8 a $ writeJSON [ 1, 2, 3, 4 ]
areader <- liftEffect $ reader a
bwritestream /\ bwriter <- liftEffect $ writer b
gzip <- S.fromTransform <$> O.fromBufferTransform <$> liftEffect (Zlib.toDuplex <$> Zlib.createGzip)
@@ -125,7 +125,7 @@ spec =
gunzip <- S.fromTransform <$> O.fromBufferTransform <$> liftEffect (Zlib.toDuplex <$> Zlib.createGunzip)
breader <- liftEffect $ reader b
nums <- Pipes.toListM (breader >-> gunzip >-> S.unEOS >-> Pipes.Buffer.toString UTF8 >-> jsonParse @(Array Int) >-> Pipes.mapFoldable identity)
Array.fromFoldable nums `shouldEqual` [1, 2, 3, 4]
Array.fromFoldable nums `shouldEqual` [ 1, 2, 3, 4 ]
around tmpFile $ it "file >-> discardTransform" \(p :: String) -> do
liftEffect $ FS.writeTextFile UTF8 p "foo"
r <- reader p
@@ -137,4 +137,4 @@ spec =
r <- reader p
chars' <- liftEffect charsTransform
out :: List.List String <- Pipes.toListM $ r >-> S.inEOS (Pipes.Buffer.toString UTF8) >-> S.fromTransform chars' >-> S.unEOS
out `shouldEqual` List.fromFoldable ["f", "o", "o", " ", "b", "a", "r"]
out `shouldEqual` List.fromFoldable [ "f", "o", "o", " ", "b", "a", "r" ]