From 634e52fe39c674cf3f3dfb9376acbe84fed2d428 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Sat, 11 May 2024 18:01:34 -0500 Subject: [PATCH] fix: more Pipes.Collect utils, stack-safety --- package.json | 3 +- spago.lock | 21 ++++++ spago.yaml | 5 ++ src/Node.Stream.Object.js | 34 +++++----- src/Node.Stream.Object.purs | 17 +++-- src/Pipes.Collect.purs | 78 ++++++++++++++++++++-- src/Pipes.Node.FS.purs | 12 ++-- src/Pipes.Node.Stream.purs | 39 ++++++----- src/Pipes.String.purs | 2 +- test/Test/Main.purs | 2 + test/Test/Pipes.Collect.purs | 111 +++++++++++++++++++++++++++++++ test/Test/Pipes.Node.Buffer.purs | 50 +++++++------- test/Test/Pipes.Node.FS.purs | 106 ++++++++++++++--------------- test/Test/Pipes.Node.Stream.purs | 10 +-- 14 files changed, 354 insertions(+), 136 deletions(-) create mode 100644 test/Test/Pipes.Collect.purs diff --git a/package.json b/package.json index 922cd8a..78ef127 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,7 @@ { - "name": "purescript-csv-stream", + "name": "purescript-node-stream-pipes", "version": "v1.0.5", + "type": "module", "dependencies": { "csv-parse": "^5.5.5", "csv-stringify": "^6.4.6" diff --git a/spago.lock b/spago.lock index 8fc8228..693f747 100644 --- a/spago.lock +++ b/spago.lock @@ -9,6 +9,8 @@ workspace: - either: ">=6.1.0 <7.0.0" - exceptions: ">=6.0.0 <7.0.0" - foldable-traversable: ">=6.0.0 <7.0.0" + - foreign-object + - lists - maybe: ">=6.0.0 <7.0.0" - mmorph: ">=7.0.0 <8.0.0" - newtype: ">=5.0.0 <6.0.0" @@ -18,6 +20,7 @@ workspace: - node-path: ">=5.0.0 <6.0.0" - node-streams: ">=9.0.0 <10.0.0" - node-zlib: ">=0.4.0 <0.5.0" + - ordered-collections - parallel: ">=6.0.0 <7.0.0" - pipes: ">=8.0.0 <9.0.0" - prelude: ">=6.0.1 <7.0.0" @@ -25,6 +28,8 @@ workspace: - strings: ">=6.0.1 <7.0.0" - tailrec: ">=6.1.0 <7.0.0" - transformers: ">=6.0.0 <7.0.0" + - tuples + - unordered-collections - unsafe-coerce: ">=6.0.0 <7.0.0" test_dependencies: - console @@ -105,6 +110,7 @@ workspace: - type-equality - typelevel-prelude - unfoldable + - unordered-collections - unsafe-coerce - variant extra_packages: {} @@ -903,6 +909,21 @@ packages: - partial - prelude - tuples + unordered-collections: + type: registry + version: 3.1.0 + integrity: sha256-H2eQR+ylI+cljz4XzWfEbdF7ee+pnw2IZCeq69AuJ+Q= + dependencies: + - arrays + - enums + - functions + - integers + - lists + - prelude + - record + - tuples + - typelevel-prelude + - unfoldable unsafe-coerce: type: registry version: 6.0.0 diff --git a/spago.yaml b/spago.yaml index da7051b..76b1a72 100644 --- a/spago.yaml +++ b/spago.yaml @@ -10,6 +10,11 @@ package: strict: true pedanticPackages: true dependencies: + - foreign-object + - lists + - ordered-collections + - tuples + - unordered-collections - aff: ">=7.1.0 <8.0.0" - arrays: ">=7.3.0 <8.0.0" - effect: ">=4.0.0 <5.0.0" diff --git a/src/Node.Stream.Object.js b/src/Node.Stream.Object.js index c3b6a63..5f85aa1 100644 --- a/src/Node.Stream.Object.js +++ b/src/Node.Stream.Object.js @@ -1,35 +1,39 @@ import Stream from "stream"; /** @type {(s: Stream.Readable | Stream.Transform) => () => boolean} */ -export const isReadableImpl = s => () => s.readable +export const isReadableImpl = (s) => () => s.readable; /** @type {(s: Stream.Writable | Stream.Readable) => () => boolean} */ -export const isClosedImpl = s => () => s.closed +export const isClosedImpl = (s) => () => s.closed; /** @type {(s: Stream.Writable | Stream.Transform) => () => boolean} */ -export const isWritableImpl = s => () => s.writable +export const isWritableImpl = (s) => () => s.writable; /** @type {(s: Stream.Readable | Stream.Transform) => () => boolean} */ -export const isReadableEndedImpl = s => () => s.readableEnded +export const isReadableEndedImpl = (s) => () => s.readableEnded; /** @type {(s: Stream.Writable | Stream.Transform) => () => boolean} */ -export const isWritableEndedImpl = s => () => s.writableEnded +export const isWritableEndedImpl = (s) => () => s.writableEnded; /** @type {(s: Stream.Writable | Stream.Transform) => () => void} */ export const endImpl = (s) => () => s.end(); /** @type {(o: {ok: WriteResult, wouldBlock: WriteResult, closed: WriteResult}) => (s: Stream.Writable | Stream.Transform) => (a: unknown) => () => WriteResult} */ -export const writeImpl = ({ok, wouldBlock, closed}) => (s) => (a) => () => { - if (s.closed || s.writableEnded) { - return closed - } +export const writeImpl = + ({ ok, wouldBlock, closed }) => + (s) => + (a) => + () => { + if (s.closed || s.writableEnded) { + return closed; + } - if (s.write(a)) { - return ok - } else { - return wouldBlock - } -} + if (s.write(a)) { + return ok; + } else { + return wouldBlock; + } + }; /** @type {(o: {just: (_a: unknown) => ReadResult, wouldBlock: ReadResult, closed: ReadResult}) => (s: Stream.Readable | Stream.Transform) => () => ReadResult} */ export const readImpl = diff --git a/src/Node.Stream.Object.purs b/src/Node.Stream.Object.purs index c575320..5d57aea 100644 --- a/src/Node.Stream.Object.purs +++ b/src/Node.Stream.Object.purs @@ -28,6 +28,7 @@ data ReadResult a = ReadWouldBlock | ReadClosed | ReadJust a + derive instance Generic (ReadResult a) _ derive instance Functor ReadResult derive instance Eq a => Eq (ReadResult a) @@ -38,9 +39,11 @@ data WriteResult = WriteWouldBlock | WriteClosed | WriteOk + derive instance Generic WriteResult _ derive instance Eq WriteResult -instance Show WriteResult where show = genericShow +instance Show WriteResult where + show = genericShow type ReadResultFFI a = { closed :: ReadResult a, wouldBlock :: ReadResult a, just :: a -> ReadResult a } type WriteResultFFI = { closed :: WriteResult, wouldBlock :: WriteResult, ok :: WriteResult } @@ -59,10 +62,10 @@ foreign import isWritableEndedImpl :: forall s. s -> Effect Boolean foreign import isClosedImpl :: forall s. s -> Effect Boolean readResultFFI :: forall a. ReadResultFFI a -readResultFFI = {closed: ReadClosed, wouldBlock: ReadWouldBlock, just: ReadJust} +readResultFFI = { closed: ReadClosed, wouldBlock: ReadWouldBlock, just: ReadJust } writeResultFFI :: WriteResultFFI -writeResultFFI = {closed: WriteClosed, wouldBlock: WriteWouldBlock, ok: WriteOk} +writeResultFFI = { closed: WriteClosed, wouldBlock: WriteWouldBlock, ok: WriteOk } class Stream :: Type -> Constraint class Stream s where @@ -117,11 +120,11 @@ else instance (Write s a) => Write s a where write s a = write s a end s = end s -withErrorST :: forall s. Stream s => s -> Effect {cancel :: Effect Unit, error :: STRef Global (Maybe Error)} +withErrorST :: forall s. Stream s => s -> Effect { cancel :: Effect Unit, error :: STRef Global (Maybe Error) } withErrorST s = do error <- liftST $ STRef.new Nothing cancel <- flip (Event.once errorH) s \e -> void $ liftST $ STRef.write (Just e) error - pure {error, cancel} + pure { error, cancel } fromBufferReadable :: forall r. Stream.Readable r -> Readable Buffer fromBufferReadable = unsafeCoerce @@ -147,7 +150,7 @@ awaitReadableOrClosed s = do ended <- liftEffect $ isReadableEnded s readable <- liftEffect $ isReadable s when (not ended && not closed && not readable) - $ liftEither =<< parOneOf [onceAff0 readableH s $> Right unit, onceAff0 closeH s $> Right unit, Left <$> onceAff1 errorH s] + $ liftEither =<< parOneOf [ onceAff0 readableH s $> Right unit, onceAff0 closeH s $> Right unit, Left <$> onceAff1 errorH s ] awaitWritableOrClosed :: forall s a. Write s a => s -> Aff Unit awaitWritableOrClosed s = do @@ -155,7 +158,7 @@ awaitWritableOrClosed s = do ended <- liftEffect $ isWritableEnded s writable <- liftEffect $ isWritable s when (not ended && not closed && not writable) - $ liftEither =<< parOneOf [onceAff0 drainH s $> Right unit, onceAff0 closeH s $> Right unit, Left <$> onceAff1 errorH s] + $ liftEither =<< parOneOf [ onceAff0 drainH s $> Right unit, onceAff0 closeH s $> Right unit, Left <$> onceAff1 errorH s ] onceAff0 :: forall e. EventHandle0 e -> e -> Aff Unit onceAff0 h emitter = makeAff \res -> do diff --git a/src/Pipes.Collect.purs b/src/Pipes.Collect.purs index 9bbd964..b2d72c8 100644 --- a/src/Pipes.Collect.purs +++ b/src/Pipes.Collect.purs @@ -2,17 +2,81 @@ module Pipes.Collect where import Prelude -import Control.Monad.Rec.Class (class MonadRec) +import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT) +import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) import Control.Monad.ST.Class (liftST) +import Control.Monad.Trans.Class (lift) import Data.Array.ST as Array.ST +import Data.Either (hush) +import Data.HashMap (HashMap) +import Data.HashMap as HashMap +import Data.Hashable (class Hashable) +import Data.List (List) +import Data.List as List +import Data.Map (Map) +import Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.Tuple.Nested (type (/\), (/\)) import Effect.Class (class MonadEffect, liftEffect) -import Pipes (for) as Pipes +import Foreign.Object (Object) +import Foreign.Object.ST as Object.ST +import Foreign.Object.ST.Unsafe as Object.ST.Unsafe +import Pipes (next) as Pipes import Pipes.Core (Producer) -import Pipes.Core (runEffect) as Pipes --- | Traverse a pipe, collecting into a mutable array with constant stack usage -collectArray :: forall a m. MonadRec m => MonadEffect m => Producer a m Unit -> m (Array a) -collectArray p = do +-- | Fold every value produced +-- | +-- | Uses `MonadRec`, supporting producers of arbitrary length. +fold :: forall a b m. MonadRec m => (b -> a -> b) -> b -> Producer a m Unit -> m b +fold f b p = + let + insertNext b' p' = runMaybeT do + a /\ p'' <- MaybeT $ hush <$> Pipes.next p' + pure $ Loop $ f b' a /\ p'' + in + flip tailRecM (b /\ p) \(b' /\ p') -> fromMaybe (Done b') <$> insertNext b' p' + +-- | Fold every value produced with a monadic action +-- | +-- | Uses `MonadRec`, supporting producers of arbitrary length. +traverse :: forall a b m. MonadRec m => (b -> a -> m b) -> b -> Producer a m Unit -> m b +traverse f b p = + let + insertNext b' p' = runMaybeT do + a /\ p'' <- MaybeT $ hush <$> Pipes.next p' + b'' <- lift $ f b' a + pure $ Loop $ b'' /\ p'' + in + flip tailRecM (b /\ p) \(b' /\ p') -> fromMaybe (Done b') <$> insertNext b' p' + +-- | Execute a monadic action on every item in a producer. +-- | +-- | Uses `MonadRec`, supporting producers of arbitrary length. +foreach :: forall a m. MonadRec m => (a -> m Unit) -> Producer a m Unit -> m Unit +foreach f = traverse (const f) unit + +-- | Collect all values from a `Producer` into an array. +toArray :: forall a m. MonadRec m => MonadEffect m => Producer a m Unit -> m (Array a) +toArray p = do st <- liftEffect $ liftST $ Array.ST.new - Pipes.runEffect $ Pipes.for p \a -> void $ liftEffect $ liftST $ Array.ST.push a st + foreach (void <<< liftEffect <<< liftST <<< flip Array.ST.push st) p liftEffect $ liftST $ Array.ST.unsafeFreeze st + +-- | Collect all values from a `Producer` into a list. +toList :: forall a m. MonadRec m => MonadEffect m => Producer a m Unit -> m (List a) +toList = map List.reverse <<< fold (flip List.Cons) List.Nil + +-- | Collect all values from a `Producer` into a Javascript Object. +toObject :: forall a m. MonadRec m => MonadEffect m => Producer (String /\ a) m Unit -> m (Object a) +toObject p = do + st <- liftEffect $ liftST $ Object.ST.new + foreach (\(k /\ v) -> void $ liftEffect $ liftST $ Object.ST.poke k v st) p + liftEffect $ liftST $ Object.ST.Unsafe.unsafeFreeze st + +-- | Collect all values from a `Producer` into a `HashMap` +toHashMap :: forall k v m. Hashable k => MonadRec m => Producer (k /\ v) m Unit -> m (HashMap k v) +toHashMap = fold (\map (k /\ v) -> HashMap.insert k v map) HashMap.empty + +-- | Collect all values from a `Producer` into a `Map` +toMap :: forall k v m. Ord k => MonadRec m => Producer (k /\ v) m Unit -> m (Map k v) +toMap = fold (\map (k /\ v) -> Map.insert k v map) Map.empty diff --git a/src/Pipes.Node.FS.purs b/src/Pipes.Node.FS.purs index a73616c..f2b1281 100644 --- a/src/Pipes.Node.FS.purs +++ b/src/Pipes.Node.FS.purs @@ -23,8 +23,10 @@ import Prim.Row (class Union) -- | into `Producer (Maybe a)`, emitting `Nothing` before exiting. write :: forall r trash - . Union r trash WriteStreamOptions - => Record r -> FilePath -> Consumer (Maybe Buffer) Aff Unit + . Union r trash WriteStreamOptions + => Record r + -> FilePath + -> Consumer (Maybe Buffer) Aff Unit write o p = do w <- liftEffect $ FS.Stream.createWriteStream' p o fromWritable $ O.fromBufferWritable w @@ -33,19 +35,19 @@ write o p = do -- | -- | `write {flags: "wx"}` create :: FilePath -> Consumer (Maybe Buffer) Aff Unit -create = write {flags: "wx"} +create = write { flags: "wx" } -- | Open a file in write mode, truncating it if the file already exists. -- | -- | `write {flags: "w"}` truncate :: FilePath -> Consumer (Maybe Buffer) Aff Unit -truncate = write {flags: "w"} +truncate = write { flags: "w" } -- | Open a file in write mode, appending written contents if the file already exists. -- | -- | `write {flags: "a"}` append :: FilePath -> Consumer (Maybe Buffer) Aff Unit -append = write {flags: "a"} +append = write { flags: "a" } -- | Creates a `fs.Readable` stream for the file at the given path. -- | diff --git a/src/Pipes.Node.Stream.purs b/src/Pipes.Node.Stream.purs index d07dbc9..7c27a9f 100644 --- a/src/Pipes.Node.Stream.purs +++ b/src/Pipes.Node.Stream.purs @@ -30,19 +30,20 @@ fromReadable r = liftEffect rmErrorListener pure $ Done unit - go {error, cancel} = do + go { error, cancel } = do liftAff $ delay $ wrap 0.0 err <- liftEffect $ liftST $ STRef.read error for_ err throwError res <- liftEffect $ O.read r case res of - O.ReadJust a -> yield (Just a) $> Loop {error, cancel} - O.ReadWouldBlock -> lift (O.awaitReadableOrClosed r) $> Loop {error, cancel} + O.ReadJust a -> yield (Just a) $> Loop { error, cancel } + O.ReadWouldBlock -> lift (O.awaitReadableOrClosed r) $> Loop { error, cancel } O.ReadClosed -> yield Nothing *> cleanup cancel - in do - e <- liftEffect $ O.withErrorST r - tailRecM go e + in + do + e <- liftEffect $ O.withErrorST r + tailRecM go e -- | Convert a `Writable` stream to a `Pipe`. -- | @@ -56,7 +57,7 @@ fromWritable w = liftEffect $ O.end w pure $ Done unit - go {error, cancel} = do + go { error, cancel } = do liftAff $ delay $ wrap 0.0 err <- liftEffect $ liftST $ STRef.read error for_ err throwError @@ -67,14 +68,15 @@ fromWritable w = Just a -> do res <- liftEffect $ O.write w a case res of - O.WriteOk -> pure $ Loop {error, cancel} + O.WriteOk -> pure $ Loop { error, cancel } O.WriteWouldBlock -> do liftAff (O.awaitWritableOrClosed w) - pure $ Loop {error, cancel} + pure $ Loop { error, cancel } O.WriteClosed -> cleanup cancel - in do - r <- liftEffect $ O.withErrorST w - tailRecM go r + in + do + r <- liftEffect $ O.withErrorST w + tailRecM go r -- | Convert a `Transform` stream to a `Pipe`. -- | @@ -94,7 +96,7 @@ fromTransform t = O.ReadJust a -> yield (Just a) O.ReadWouldBlock -> pure unit O.ReadClosed -> yield Nothing *> pure unit - go {error, cancel} = do + go { error, cancel } = do liftAff $ delay $ wrap 0.0 err <- liftEffect $ liftST $ STRef.read error for_ err throwError @@ -107,13 +109,14 @@ fromTransform t = yieldFromReadableHalf case res of O.WriteClosed -> cleanup cancel - O.WriteOk -> pure $ Loop {error, cancel} + O.WriteOk -> pure $ Loop { error, cancel } O.WriteWouldBlock -> do lift (O.awaitWritableOrClosed t) - pure $ Loop {error, cancel} - in do - r <- liftEffect $ O.withErrorST t - tailRecM go r + pure $ Loop { error, cancel } + in + do + r <- liftEffect $ O.withErrorST t + tailRecM go r -- | Given a `Producer` of values, wrap them in `Just`. -- | diff --git a/src/Pipes.String.purs b/src/Pipes.String.purs index 592fb6f..d955ce1 100644 --- a/src/Pipes.String.purs +++ b/src/Pipes.String.purs @@ -33,7 +33,7 @@ split pat = do Nothing -> void $ liftEffect $ liftST $ Array.ST.push chunk buf Just ix -> do let - {before, after} = String.splitAt ix chunk + { before, after } = String.splitAt ix chunk len <- liftEffect $ liftST $ Array.ST.length buf buf' <- liftEffect $ liftST $ Array.ST.splice 0 len [] buf lift $ yield $ Just $ (fold buf') <> before diff --git a/test/Test/Main.purs b/test/Test/Main.purs index fab2200..0315a5a 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -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 diff --git a/test/Test/Pipes.Collect.purs b/test/Test/Pipes.Collect.purs new file mode 100644 index 0000000..efbe8b8 --- /dev/null +++ b/test/Test/Pipes.Collect.purs @@ -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 diff --git a/test/Test/Pipes.Node.Buffer.purs b/test/Test/Pipes.Node.Buffer.purs index 3f94a9c..5cea4c9 100644 --- a/test/Test/Pipes.Node.Buffer.purs +++ b/test/Test/Pipes.Node.Buffer.purs @@ -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 diff --git a/test/Test/Pipes.Node.FS.purs b/test/Test/Pipes.Node.FS.purs index 5f95b86..6196e0e 100644 --- a/test/Test/Pipes.Node.FS.purs +++ b/test/Test/Pipes.Node.FS.purs @@ -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" diff --git a/test/Test/Pipes.Node.Stream.purs b/test/Test/Pipes.Node.Stream.purs index 8e0c1ab..cd8f1b2 100644 --- a/test/Test/Pipes.Node.Stream.purs +++ b/test/Test/Pipes.Node.Stream.purs @@ -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" ]