fix: generalize to MonadAff

This commit is contained in:
bingus 2024-05-13 11:52:09 -05:00
parent b4b6dfdebd
commit e87d81cc1d
Signed by: orion
GPG Key ID: 6D4165AE4C928719
5 changed files with 72 additions and 54 deletions

View File

@ -9,7 +9,7 @@ workspace:
- datetime: ">=6.1.0 <7.0.0" - datetime: ">=6.1.0 <7.0.0"
- effect: ">=4.0.0 <5.0.0" - effect: ">=4.0.0 <5.0.0"
- exceptions: ">=6.0.0 <7.0.0" - exceptions: ">=6.0.0 <7.0.0"
- foldable-traversable - foldable-traversable: ">=6.0.0 <7.0.0"
- foreign: ">=7.0.0 <8.0.0" - foreign: ">=7.0.0 <8.0.0"
- foreign-object: ">=4.1.0 <5.0.0" - foreign-object: ">=4.1.0 <5.0.0"
- integers: ">=6.0.0 <7.0.0" - integers: ">=6.0.0 <7.0.0"
@ -18,7 +18,7 @@ workspace:
- newtype: ">=5.0.0 <6.0.0" - newtype: ">=5.0.0 <6.0.0"
- node-buffer: ">=9.0.0 <10.0.0" - node-buffer: ">=9.0.0 <10.0.0"
- node-event-emitter: ">=3.0.0 <4.0.0" - node-event-emitter: ">=3.0.0 <4.0.0"
- node-stream-pipes - node-stream-pipes: ">=1.2.3 <2.0.0"
- node-streams: ">=9.0.0 <10.0.0" - node-streams: ">=9.0.0 <10.0.0"
- nullable: ">=6.0.0 <7.0.0" - nullable: ">=6.0.0 <7.0.0"
- numbers: ">=9.0.1 <10.0.0" - numbers: ">=9.0.1 <10.0.0"
@ -28,11 +28,11 @@ workspace:
- prelude: ">=6.0.1 <7.0.0" - prelude: ">=6.0.1 <7.0.0"
- record: ">=4.0.0 <5.0.0" - record: ">=4.0.0 <5.0.0"
- record-extra: ">=5.0.1 <6.0.0" - record-extra: ">=5.0.1 <6.0.0"
- st - st: ">=6.2.0 <7.0.0"
- strings: ">=6.0.1 <7.0.0" - strings: ">=6.0.1 <7.0.0"
- tailrec: ">=6.1.0 <7.0.0" - tailrec: ">=6.1.0 <7.0.0"
- transformers: ">=6.0.0 <7.0.0" - transformers: ">=6.0.0 <7.0.0"
- tuples - tuples: ">=7.0.0 <8.0.0"
- typelevel-prelude: ">=7.0.0 <8.0.0" - typelevel-prelude: ">=7.0.0 <8.0.0"
- unsafe-coerce: ">=6.0.0 <7.0.0" - unsafe-coerce: ">=6.0.0 <7.0.0"
test_dependencies: test_dependencies:
@ -120,12 +120,10 @@ workspace:
- typelevel-prelude - typelevel-prelude
- unfoldable - unfoldable
- unicode - unicode
- unordered-collections
- unsafe-coerce - unsafe-coerce
- variant - variant
extra_packages: extra_packages: {}
node-stream-pipes:
git: https://git.orionkindel.com/orion/purescript-node-stream-pipes
ref: v1.0.5
packages: packages:
aff: aff:
type: registry type: registry
@ -608,9 +606,9 @@ packages:
dependencies: dependencies:
- effect - effect
node-stream-pipes: node-stream-pipes:
type: git type: registry
url: https://git.orionkindel.com/orion/purescript-node-stream-pipes version: 1.2.3
rev: f2f18c3c13ae2f0f5787ccfb3832fc8c653e83ad integrity: sha256-lXD3x6+p72uBrRHGHrob2jrrBDakhhZE9O9EYE4aFiE=
dependencies: dependencies:
- aff - aff
- arrays - arrays
@ -618,6 +616,8 @@ packages:
- either - either
- exceptions - exceptions
- foldable-traversable - foldable-traversable
- foreign-object
- lists
- maybe - maybe
- mmorph - mmorph
- newtype - newtype
@ -627,6 +627,7 @@ packages:
- node-path - node-path
- node-streams - node-streams
- node-zlib - node-zlib
- ordered-collections
- parallel - parallel
- pipes - pipes
- prelude - prelude
@ -634,6 +635,8 @@ packages:
- strings - strings
- tailrec - tailrec
- transformers - transformers
- tuples
- unordered-collections
- unsafe-coerce - unsafe-coerce
node-streams: node-streams:
type: registry type: registry
@ -1038,6 +1041,21 @@ packages:
- foldable-traversable - foldable-traversable
- maybe - maybe
- strings - strings
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: unsafe-coerce:
type: registry type: registry
version: 6.0.0 version: 6.0.0

View File

@ -10,16 +10,13 @@ package:
strict: true strict: true
pedanticPackages: true pedanticPackages: true
dependencies: dependencies:
- foldable-traversable
- node-stream-pipes
- st
- tuples
- aff: ">=7.1.0 <8.0.0" - aff: ">=7.1.0 <8.0.0"
- arrays: ">=7.3.0 <8.0.0" - arrays: ">=7.3.0 <8.0.0"
- bifunctors: ">=6.0.0 <7.0.0" - bifunctors: ">=6.0.0 <7.0.0"
- datetime: ">=6.1.0 <7.0.0" - datetime: ">=6.1.0 <7.0.0"
- effect: ">=4.0.0 <5.0.0" - effect: ">=4.0.0 <5.0.0"
- exceptions: ">=6.0.0 <7.0.0" - exceptions: ">=6.0.0 <7.0.0"
- foldable-traversable: ">=6.0.0 <7.0.0"
- foreign: ">=7.0.0 <8.0.0" - foreign: ">=7.0.0 <8.0.0"
- foreign-object: ">=4.1.0 <5.0.0" - foreign-object: ">=4.1.0 <5.0.0"
- integers: ">=6.0.0 <7.0.0" - integers: ">=6.0.0 <7.0.0"
@ -28,6 +25,7 @@ package:
- newtype: ">=5.0.0 <6.0.0" - newtype: ">=5.0.0 <6.0.0"
- node-buffer: ">=9.0.0 <10.0.0" - node-buffer: ">=9.0.0 <10.0.0"
- node-event-emitter: ">=3.0.0 <4.0.0" - node-event-emitter: ">=3.0.0 <4.0.0"
- node-stream-pipes: ">=1.2.3 <2.0.0"
- node-streams: ">=9.0.0 <10.0.0" - node-streams: ">=9.0.0 <10.0.0"
- nullable: ">=6.0.0 <7.0.0" - nullable: ">=6.0.0 <7.0.0"
- numbers: ">=9.0.1 <10.0.0" - numbers: ">=9.0.1 <10.0.0"
@ -37,9 +35,11 @@ package:
- prelude: ">=6.0.1 <7.0.0" - prelude: ">=6.0.1 <7.0.0"
- record: ">=4.0.0 <5.0.0" - record: ">=4.0.0 <5.0.0"
- record-extra: ">=5.0.1 <6.0.0" - record-extra: ">=5.0.1 <6.0.0"
- st: ">=6.2.0 <7.0.0"
- strings: ">=6.0.1 <7.0.0" - strings: ">=6.0.1 <7.0.0"
- tailrec: ">=6.1.0 <7.0.0" - tailrec: ">=6.1.0 <7.0.0"
- transformers: ">=6.0.0 <7.0.0" - transformers: ">=6.0.0 <7.0.0"
- tuples: ">=7.0.0 <8.0.0"
- typelevel-prelude: ">=7.0.0 <8.0.0" - typelevel-prelude: ">=7.0.0 <8.0.0"
- unsafe-coerce: ">=6.0.0 <7.0.0" - unsafe-coerce: ">=6.0.0 <7.0.0"
test: test:
@ -53,7 +53,4 @@ package:
- simple-json - simple-json
- spec - spec
workspace: workspace:
extraPackages: extraPackages: {}
node-stream-pipes:
git: 'https://git.orionkindel.com/orion/purescript-node-stream-pipes'
ref: 'v1.0.5'

View File

@ -54,15 +54,15 @@ recordToForeign = unsafeCoerce
-- | Requires an ordered array of column names. -- | Requires an ordered array of column names.
make make
:: forall @config @missing @extra :: forall @config @missing @extra
. Union config missing (Config extra) . Union config missing (Config extra)
=> Array String => Array String
-> { | config } -> { | config }
-> Effect (CSVStringifier ()) -> Effect (CSVStringifier ())
make columns = make columns =
makeImpl makeImpl
<<< unsafeToForeign <<< unsafeToForeign
<<< Object.union (recordToForeign { columns, header: true }) <<< Object.union (recordToForeign { columns, header: true })
<<< recordToForeign <<< recordToForeign
-- | Convert the raw stream to a typed ObjectStream -- | Convert the raw stream to a typed ObjectStream
toObjectStream :: CSVStringifier () -> Object.Transform (Array String) String toObjectStream :: CSVStringifier () -> Object.Transform (Array String) String

View File

@ -2,9 +2,9 @@ module Pipes.CSV where
import Prelude import Prelude
import Control.Monad.Error.Class (liftEither) import Control.Monad.Error.Class (class MonadThrow, liftEither)
import Control.Monad.Except (runExcept) import Control.Monad.Except (runExcept)
import Control.Monad.Rec.Class (forever) import Control.Monad.Rec.Class (class MonadRec, forever)
import Control.Monad.ST.Global as ST import Control.Monad.ST.Global as ST
import Control.Monad.ST.Ref as STRef import Control.Monad.ST.Ref as STRef
import Data.Array as Array import Data.Array as Array
@ -14,9 +14,9 @@ import Data.FunctorWithIndex (mapWithIndex)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff.Class (class MonadAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (Error, error)
import Node.Buffer (Buffer) import Node.Buffer (Buffer)
import Node.Stream.CSV.Parse as CSV.Parse import Node.Stream.CSV.Parse as CSV.Parse
import Node.Stream.CSV.Stringify as CSV.Stringify import Node.Stream.CSV.Stringify as CSV.Stringify
@ -47,10 +47,13 @@ import Type.Prelude (Proxy(..))
-- | rows `shouldEqual` [{id: 1, foo: "hi", is_deleted: false}, {id: 2, foo: "bye", is_deleted: true}] -- | rows `shouldEqual` [{id: 1, foo: "hi", is_deleted: false}, {id: 2, foo: "bye", is_deleted: true}]
-- | ``` -- | ```
parse parse
:: forall @r rl :: forall @r rl m
. RowToList r rl . MonadAff m
=> MonadThrow Error m
=> MonadRec m
=> RowToList r rl
=> ReadCSVRecord r rl => ReadCSVRecord r rl
=> Pipe (Maybe Buffer) (Maybe { | r }) Aff Unit => Pipe (Maybe Buffer) (Maybe { | r }) m Unit
parse = do parse = do
raw <- liftEffect $ CSV.Parse.make {} raw <- liftEffect $ CSV.Parse.make {}
colsST <- liftEffect $ ST.toEffect $ STRef.new Nothing colsST <- liftEffect $ ST.toEffect $ STRef.new Nothing
@ -74,14 +77,14 @@ parse = do
-- | Transforms buffer chunks of a CSV file to parsed -- | Transforms buffer chunks of a CSV file to parsed
-- | arrays of CSV values. -- | arrays of CSV values.
parseRaw :: Pipe (Maybe Buffer) (Maybe (Array String)) Aff Unit parseRaw :: forall m. MonadAff m => MonadThrow Error m => Pipe (Maybe Buffer) (Maybe (Array String)) m Unit
parseRaw = do parseRaw = do
s <- liftEffect $ CSV.Parse.toObjectStream <$> CSV.Parse.make {} s <- liftEffect $ CSV.Parse.toObjectStream <$> CSV.Parse.make {}
Pipes.Stream.fromTransform s Pipes.Stream.fromTransform s
-- | Transforms CSV rows into stringified CSV records -- | Transforms CSV rows into stringified CSV records
-- | using the given ordered array of column names. -- | using the given ordered array of column names.
stringifyRaw :: Array String -> Pipe (Maybe (Array String)) (Maybe String) Aff Unit stringifyRaw :: forall m. MonadAff m => MonadThrow Error m => Array String -> Pipe (Maybe (Array String)) (Maybe String) m Unit
stringifyRaw columns = do stringifyRaw columns = do
s <- liftEffect $ CSV.Stringify.toObjectStream <$> CSV.Stringify.make columns {} s <- liftEffect $ CSV.Stringify.toObjectStream <$> CSV.Stringify.make columns {}
Pipes.Stream.fromTransform s Pipes.Stream.fromTransform s
@ -89,7 +92,7 @@ stringifyRaw columns = do
-- | Transforms purescript records into stringified CSV records. -- | Transforms purescript records into stringified CSV records.
-- | -- |
-- | Columns are inferred from the record's keys, ordered alphabetically. -- | Columns are inferred from the record's keys, ordered alphabetically.
stringify :: forall r rl. WriteCSVRecord r rl => RowToList r rl => Keys rl => Pipe (Maybe { | r }) (Maybe String) Aff Unit stringify :: forall m r rl. MonadRec m => MonadAff m => MonadThrow Error m => WriteCSVRecord r rl => RowToList r rl => Keys rl => Pipe (Maybe { | r }) (Maybe String) m Unit
stringify = do stringify = do
raw <- liftEffect $ CSV.Stringify.make (Array.fromFoldable $ keys $ Proxy @r) {} raw <- liftEffect $ CSV.Stringify.make (Array.fromFoldable $ keys $ Proxy @r) {}
let let

View File

@ -14,7 +14,6 @@ import Effect.Class (liftEffect)
import Node.Encoding (Encoding(..)) import Node.Encoding (Encoding(..))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Pipes (yield, (>->)) import Pipes (yield, (>->))
import Pipes (each) as Pipes
import Pipes.CSV as Pipes.CSV import Pipes.CSV as Pipes.CSV
import Pipes.Collect as Pipes.Collect import Pipes.Collect as Pipes.Collect
import Pipes.Node.Buffer as Pipes.Buffer import Pipes.Node.Buffer as Pipes.Buffer
@ -26,7 +25,8 @@ import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) import Test.Spec.Assertions (shouldEqual)
csv :: String csv :: String
csv = """created,flag,foo,id csv =
"""created,flag,foo,id
2020-01-01T00:00:00.0Z,true,a,1 2020-01-01T00:00:00.0Z,true,a,1
2024-02-02T08:00:00.0Z,false,apple,2 2024-02-02T08:00:00.0Z,false,apple,2
1970-01-01T00:00:00.0Z,true,hello,3 1970-01-01T00:00:00.0Z,true,hello,3
@ -41,31 +41,31 @@ spec =
it "stringify" do it "stringify" do
let let
objs = objs =
[ {id: 1, foo: "a", flag: true, created: dt "2020-01-01T00:00:00Z"} [ { id: 1, foo: "a", flag: true, created: dt "2020-01-01T00:00:00Z" }
, {id: 2, foo: "apple", flag: false, created: dt "2024-02-02T08:00:00Z"} , { id: 2, foo: "apple", flag: false, created: dt "2024-02-02T08:00:00Z" }
, {id: 3, foo: "hello", flag: true, created: dt "1970-01-01T00:00:00Z"} , { id: 3, foo: "hello", flag: true, created: dt "1970-01-01T00:00:00Z" }
] ]
csv' <- map fold $ Pipes.Collect.collectArray $ Pipes.Stream.withEOS (Pipes.each objs) >-> Pipes.CSV.stringify >-> Pipes.Stream.unEOS csv' <- map fold $ Pipes.Collect.toArray $ Pipes.Stream.withEOS (Pipes.Construct.eachArray objs) >-> Pipes.CSV.stringify >-> Pipes.Stream.unEOS
csv' `shouldEqual` csv csv' `shouldEqual` csv
describe "parse" do describe "parse" do
it "parses csv" do it "parses csv" do
rows <- map Array.fromFoldable rows <- map Array.fromFoldable
$ Pipes.toListM $ Pipes.toListM
$ Pipes.Stream.withEOS (yield csv) $ Pipes.Stream.withEOS (yield csv)
>-> Pipes.Stream.inEOS (Pipes.Buffer.fromString UTF8) >-> Pipes.Stream.inEOS (Pipes.Buffer.fromString UTF8)
>-> Pipes.CSV.parse >-> Pipes.CSV.parse
>-> Pipes.Stream.unEOS >-> Pipes.Stream.unEOS
rows `shouldEqual` rows `shouldEqual`
[ {id: 1, foo: "a", flag: true, created: dt "2020-01-01T00:00:00Z"} [ { id: 1, foo: "a", flag: true, created: dt "2020-01-01T00:00:00Z" }
, {id: 2, foo: "apple", flag: false, created: dt "2024-02-02T08:00:00Z"} , { id: 2, foo: "apple", flag: false, created: dt "2024-02-02T08:00:00Z" }
, {id: 3, foo: "hello", flag: true, created: dt "1970-01-01T00:00:00Z"} , { id: 3, foo: "hello", flag: true, created: dt "1970-01-01T00:00:00Z" }
] ]
it "parses large csv" do it "parses large csv" do
nums <- liftEffect $ randomSample' 100000 (chooseInt 0 9) nums <- liftEffect $ randomSample' 100000 (chooseInt 0 9)
let let
csvRows = ["id\n"] <> ((_ <> "\n") <$> show <$> nums) csvRows = [ "id\n" ] <> ((_ <> "\n") <$> show <$> nums)
csv' = csv' =
let let
go ix go ix
@ -75,14 +75,14 @@ spec =
tailRecM go 0 tailRecM go 0
in16kbChunks = in16kbChunks =
Pipes.Util.chunked 16000 Pipes.Util.chunked 16000
>-> Pipes.Stream.inEOS (Pipes.map fold) >-> Pipes.Stream.inEOS (Pipes.map fold)
>-> Pipes.Stream.inEOS (Pipes.Buffer.fromString UTF8) >-> Pipes.Stream.inEOS (Pipes.Buffer.fromString UTF8)
rows <- rows <-
Pipes.Collect.collectArray Pipes.Collect.toArray
$ Pipes.Stream.withEOS csv' $ Pipes.Stream.withEOS csv'
>-> in16kbChunks >-> in16kbChunks
>-> Pipes.CSV.parse >-> Pipes.CSV.parse
>-> Pipes.Stream.unEOS >-> Pipes.Stream.unEOS
rows `shouldEqual` ((\id -> {id}) <$> nums) rows `shouldEqual` ((\id -> { id }) <$> nums)