├── .gitignore ├── .gitmodules ├── LICENSE ├── Makefile ├── README.md ├── examples ├── Base64.idr ├── File.idr ├── LICENSE ├── Network.idr ├── README.md ├── examples.ipkg └── text.txt ├── install_libs ├── src ├── Data │ ├── AVL.idr │ ├── Functor │ │ ├── Compose.idr │ │ └── Of.idr │ ├── LazyList.idr │ └── Proxy.idr ├── Streaming.idr ├── Streaming │ ├── API.idr │ ├── Bytes.idr │ ├── Char.idr │ ├── Encoding │ │ ├── Base64.idr │ │ ├── Base64 │ │ │ └── Alphabet.idr │ │ └── UTF8.idr │ ├── Internal.idr │ ├── Network │ │ └── Curl.idr │ └── Streams.idr └── Util.idr └── streaming.ipkg /.gitignore: -------------------------------------------------------------------------------- 1 | .git/ 2 | build/ 3 | *.so 4 | *.o 5 | *.a 6 | *.tcc 7 | *.ttm 8 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "libs/managed"] 2 | path = libs/managed 3 | url = https://github.com/MarcelineVQ/idris2-managed 4 | 5 | [submodule "libs/curl"] 6 | path = libs/curl 7 | url = https://github.com/MarcelineVQ/idris2-curl 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Similar to Idris1/2 documentation, this software falls under the CC0 license. 2 | 3 | https://creativecommons.org/publicdomain/zero/1.0/ 4 | https://creativecommons.org/publicdomain/zero/1.0/legalcode 5 | https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt 6 | 7 | Reproduced below: 8 | 9 | Creative Commons Legal Code 10 | 11 | CC0 1.0 Universal 12 | 13 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 14 | LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 15 | ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 16 | INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 17 | REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 18 | PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 19 | THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 20 | HEREUNDER. 21 | 22 | Statement of Purpose 23 | 24 | The laws of most jurisdictions throughout the world automatically confer 25 | exclusive Copyright and Related Rights (defined below) upon the creator 26 | and subsequent owner(s) (each and all, an "owner") of an original work of 27 | authorship and/or a database (each, a "Work"). 28 | 29 | Certain owners wish to permanently relinquish those rights to a Work for 30 | the purpose of contributing to a commons of creative, cultural and 31 | scientific works ("Commons") that the public can reliably and without fear 32 | of later claims of infringement build upon, modify, incorporate in other 33 | works, reuse and redistribute as freely as possible in any form whatsoever 34 | and for any purposes, including without limitation commercial purposes. 35 | These owners may contribute to the Commons to promote the ideal of a free 36 | culture and the further production of creative, cultural and scientific 37 | works, or to gain reputation or greater distribution for their Work in 38 | part through the use and efforts of others. 39 | 40 | For these and/or other purposes and motivations, and without any 41 | expectation of additional consideration or compensation, the person 42 | associating CC0 with a Work (the "Affirmer"), to the extent that he or she 43 | is an owner of Copyright and Related Rights in the Work, voluntarily 44 | elects to apply CC0 to the Work and publicly distribute the Work under its 45 | terms, with knowledge of his or her Copyright and Related Rights in the 46 | Work and the meaning and intended legal effect of CC0 on those rights. 47 | 48 | 1. Copyright and Related Rights. A Work made available under CC0 may be 49 | protected by copyright and related or neighboring rights ("Copyright and 50 | Related Rights"). Copyright and Related Rights include, but are not 51 | limited to, the following: 52 | 53 | i. the right to reproduce, adapt, distribute, perform, display, 54 | communicate, and translate a Work; 55 | ii. moral rights retained by the original author(s) and/or performer(s); 56 | iii. publicity and privacy rights pertaining to a person's image or 57 | likeness depicted in a Work; 58 | iv. rights protecting against unfair competition in regards to a Work, 59 | subject to the limitations in paragraph 4(a), below; 60 | v. rights protecting the extraction, dissemination, use and reuse of data 61 | in a Work; 62 | vi. database rights (such as those arising under Directive 96/9/EC of the 63 | European Parliament and of the Council of 11 March 1996 on the legal 64 | protection of databases, and under any national implementation 65 | thereof, including any amended or successor version of such 66 | directive); and 67 | vii. other similar, equivalent or corresponding rights throughout the 68 | world based on applicable law or treaty, and any national 69 | implementations thereof. 70 | 71 | 2. Waiver. To the greatest extent permitted by, but not in contravention 72 | of, applicable law, Affirmer hereby overtly, fully, permanently, 73 | irrevocably and unconditionally waives, abandons, and surrenders all of 74 | Affirmer's Copyright and Related Rights and associated claims and causes 75 | of action, whether now known or unknown (including existing as well as 76 | future claims and causes of action), in the Work (i) in all territories 77 | worldwide, (ii) for the maximum duration provided by applicable law or 78 | treaty (including future time extensions), (iii) in any current or future 79 | medium and for any number of copies, and (iv) for any purpose whatsoever, 80 | including without limitation commercial, advertising or promotional 81 | purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 82 | member of the public at large and to the detriment of Affirmer's heirs and 83 | successors, fully intending that such Waiver shall not be subject to 84 | revocation, rescission, cancellation, termination, or any other legal or 85 | equitable action to disrupt the quiet enjoyment of the Work by the public 86 | as contemplated by Affirmer's express Statement of Purpose. 87 | 88 | 3. Public License Fallback. Should any part of the Waiver for any reason 89 | be judged legally invalid or ineffective under applicable law, then the 90 | Waiver shall be preserved to the maximum extent permitted taking into 91 | account Affirmer's express Statement of Purpose. In addition, to the 92 | extent the Waiver is so judged Affirmer hereby grants to each affected 93 | person a royalty-free, non transferable, non sublicensable, non exclusive, 94 | irrevocable and unconditional license to exercise Affirmer's Copyright and 95 | Related Rights in the Work (i) in all territories worldwide, (ii) for the 96 | maximum duration provided by applicable law or treaty (including future 97 | time extensions), (iii) in any current or future medium and for any number 98 | of copies, and (iv) for any purpose whatsoever, including without 99 | limitation commercial, advertising or promotional purposes (the 100 | "License"). The License shall be deemed effective as of the date CC0 was 101 | applied by Affirmer to the Work. Should any part of the License for any 102 | reason be judged legally invalid or ineffective under applicable law, such 103 | partial invalidity or ineffectiveness shall not invalidate the remainder 104 | of the License, and in such case Affirmer hereby affirms that he or she 105 | will not (i) exercise any of his or her remaining Copyright and Related 106 | Rights in the Work or (ii) assert any associated claims and causes of 107 | action with respect to the Work, in either case contrary to Affirmer's 108 | express Statement of Purpose. 109 | 110 | 4. Limitations and Disclaimers. 111 | 112 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 113 | surrendered, licensed or otherwise affected by this document. 114 | b. Affirmer offers the Work as-is and makes no representations or 115 | warranties of any kind concerning the Work, express, implied, 116 | statutory or otherwise, including without limitation warranties of 117 | title, merchantability, fitness for a particular purpose, non 118 | infringement, or the absence of latent or other defects, accuracy, or 119 | the present or absence of errors, whether or not discoverable, all to 120 | the greatest extent permissible under applicable law. 121 | c. Affirmer disclaims responsibility for clearing rights of other persons 122 | that may apply to the Work or any use thereof, including without 123 | limitation any person's Copyright and Related Rights in the Work. 124 | Further, Affirmer disclaims responsibility for obtaining any necessary 125 | consents, permissions or other rights required for any use of the 126 | Work. 127 | d. Affirmer understands and acknowledges that Creative Commons is not a 128 | party to this document and has no duty or obligation with respect to 129 | this CC0 or use of the Work. 130 | 131 | 132 | 133 | 134 | 135 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # literally just convenience 2 | 3 | PKGNAME = streaming 4 | 5 | .PHONY: build 6 | 7 | build: 8 | idris2 --build ${PKGNAME}.ipkg 9 | 10 | install: 11 | idris2 --install ${PKGNAME}.ipkg 12 | 13 | clean: 14 | @find . -type f -name '*.ttc' -exec rm -f {} \; 15 | @find . -type f -name '*.ttm' -exec rm -f {} \; 16 | @find . -type f -name '*.ibc' -exec rm -f {} \; 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Effectful Streaming For Idris 2 | ===== 3 | 4 | This package provides a central idea and tool for effectful streaming. Heavily based on the [Haskell library](https://hackage.haskell.org/package/streaming) of the same idea. 5 | 6 | This isn't a Total streaming library and doesn't make use of more advanced idris features. Totality would be great but unlikely since it could impose restrictions of the Functors/Monads we're able to make use of. That's a reasonable area of experimentation though. 7 | 8 | On top of general streaming, this package's intent is to provide a basis to stream bytes from sources like files or network. To that end there is a Streaming.Bytes module providing some basics. Future work is likely to come in the form of another package that depends on this one and possibly interacts with [bytes](https://github.com/MarcelineVQ/idris2-bytes) 9 | 10 | Examples are available as a package in the `examples` directory. 11 | 12 | Required libs are included as submodules for your convenience. You can type `./install_libs` to fetch and install them. 13 | 14 | TODO 15 | ---- 16 | Scrutinize uses of inlining to see if it matters at all when we don't have optimization anyway. Further, once we're far enough along: re-implement core forms as just ADTs instead of the Builder pattern and compare the performance. It would have been easier to start that way and tried Builder afterwards but oh well. 17 | 18 | Version 19 | ------- 20 | 21 | This package follows [Haskell PVP](https://pvp.haskell.org/) which is distinct from [SEMVER](https://semver.org/) in that when examining `1.2.3`, `1.2` is the Major Version rather than `1`. 22 | -------------------------------------------------------------------------------- /examples/Base64.idr: -------------------------------------------------------------------------------- 1 | module Base64 2 | 3 | -- Example of streaming from/to files. 4 | 5 | import Streaming 6 | import Streaming.Bytes as B 7 | import Streaming.Char as C 8 | import Streaming.Encoding.UTF8 9 | import Streaming.Encoding.Base64 10 | import Util -- withFile 11 | 12 | import Control.Monad.Trans 13 | import Control.Monad.Identity 14 | import Control.Monad.Either 15 | 16 | import System.File 17 | import Data.Strings 18 | 19 | import Data.List as L -- reverse 20 | 21 | import Control.Monad.Managed 22 | 23 | ------------------------------------------------- 24 | -- Streaming Base64 Encoding/Decoding Example 25 | 26 | {- Here we read in some test ascii data and see if it encodes and decodes into 27 | the same data. A further test is done by reading in from urandom to see if 28 | entirely arbitrary data roundtrips properly. 29 | 30 | This is written in a 'forward' style to follow along with the steps the 31 | stream takes. One could as easily use . and $ and write this in regular 32 | 'reverse' style Idris/Haskell composition. 33 | -} 34 | ------------------------------------------------- 35 | 36 | text : String 37 | text = "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure." 38 | 39 | text_enc : String 40 | text_enc = "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" 41 | 42 | -- rfc reference strings 43 | test_str1_ref : String 44 | test_str1_ref = "" 45 | test_str2_ref : String 46 | test_str2_ref = "f" 47 | test_str3_ref : String 48 | test_str3_ref = "fo" 49 | test_str4_ref : String 50 | test_str4_ref = "foo" 51 | test_str5_ref : String 52 | test_str5_ref = "foob" 53 | test_str6_ref : String 54 | test_str6_ref = "fooba" 55 | test_str7_ref : String 56 | test_str7_ref = "foobar" 57 | -- rfc reference encoded-strings 58 | test_str1_enc : String 59 | test_str1_enc = "" 60 | test_str2_enc : String 61 | test_str2_enc = "Zg==" 62 | test_str3_enc : String 63 | test_str3_enc = "Zm8=" 64 | test_str4_enc : String 65 | test_str4_enc = "Zm9v" 66 | test_str5_enc : String 67 | test_str5_enc = "Zm9vYg==" 68 | test_str6_enc : String 69 | test_str6_enc = "Zm9vYmE=" 70 | test_str7_enc : String 71 | test_str7_enc = "Zm9vYmFy" 72 | 73 | 74 | fromString' : Monad m => String -> Stream (Of Char) m () 75 | fromString' str = each''' (unpack str) 76 | 77 | toString' : Monad m => Stream (Of Char) m r -> m String 78 | toString' = S.foldr_ strCons "" 79 | 80 | -- Making it easy to change for testing 81 | alphabet : Alphabet 82 | alphabet = standardAlphabet 83 | 84 | -- The Strings used here are expected to be comprised of ascii data for this test 85 | roundtrip : String -> String 86 | roundtrip s = fromString' s 87 | &$ maps (cast . ord) 88 | |> encodeBase64 alphabet 89 | |> decodeBase64 alphabet 90 | |> maps (chr . cast) 91 | |> runIdentity . toString' 92 | 93 | roundtrip' : String -> String 94 | roundtrip' s = fromString' s &$ 95 | maps (cast . ord) |> 96 | encodeBase64 alphabet |> 97 | decodeBase64 alphabet |> 98 | maps (chr . cast) |> 99 | runIdentity . toString' 100 | 101 | -- encode and check against our specific rfc reference strings 102 | enc : String -> String -> Bool 103 | enc s1 s2 = fromString' s1 104 | &$ maps (cast . ord) -- turn to Bits8 105 | |> encodeBase64 alphabet 106 | |> maps (chr . cast) -- back to Char 107 | |> toString' 108 | |> (== s2) . runIdentity 109 | 110 | -- using Managed for fun, it's not really that useful for just one 'withFoo' 111 | randoStr : Stream (Of Bits8) Managed (Either FileError ()) 112 | randoStr = effect $ do 113 | Right rand <- use . managed $ withFile "/dev/urandom" Read 114 | | Left err => pure . pure $ Left err 115 | pure $ bits8FromFile {io=Managed} rand *> pure (Right ()) 116 | 117 | rando : Monad m => Stream (Of Bits8) m r -> m Bool 118 | rando str = str 119 | &$ take 3000 120 | |> copy 121 | |> encodeBase64 alphabet 122 | |> decodeBase64 alphabet 123 | |> S.toList -- encoded/decoded data 124 | |> S.toList -- original data 125 | |> map (\(enc :> orig) => zipWith (==) enc (fstOf orig)) -- compare them 126 | |> map (and . map delay) -- check they're all True 127 | -- This is surely slow since we're acting on the results of a ran Stream, 128 | -- ideally we'd want to stream the comparison and not convert to list. 129 | 130 | export 131 | main : IO () 132 | main = do 133 | putStrLn $ "text encodes: " ++ show (enc text text_enc) 134 | putStrLn $ "text roundtrips: " ++ show (roundtrip text == text) 135 | 136 | putStrLn $ "st1 encodes: " ++ show (enc test_str1_ref test_str1_enc) 137 | putStrLn $ "st2 encodes: " ++ show (enc test_str2_ref test_str2_enc) 138 | putStrLn $ "st3 encodes: " ++ show (enc test_str3_ref test_str3_enc) 139 | putStrLn $ "st4 encodes: " ++ show (enc test_str4_ref test_str4_enc) 140 | putStrLn $ "st5 encodes: " ++ show (enc test_str5_ref test_str5_enc) 141 | putStrLn $ "st6 encodes: " ++ show (enc test_str6_ref test_str6_enc) 142 | putStrLn $ "st7 encodes: " ++ show (enc test_str7_ref test_str7_enc) 143 | 144 | putStrLn $ "st1 roundtrips: " ++ show (roundtrip test_str1_ref == test_str1_ref) 145 | putStrLn $ "st2 roundtrips: " ++ show (roundtrip test_str2_ref == test_str2_ref) 146 | putStrLn $ "st3 roundtrips: " ++ show (roundtrip test_str3_ref == test_str3_ref) 147 | putStrLn $ "st4 roundtrips: " ++ show (roundtrip test_str4_ref == test_str4_ref) 148 | putStrLn $ "st5 roundtrips: " ++ show (roundtrip test_str5_ref == test_str5_ref) 149 | putStrLn $ "st6 roundtrips: " ++ show (roundtrip test_str6_ref == test_str6_ref) 150 | putStrLn $ "st7 roundtrips: " ++ show (roundtrip test_str7_ref == test_str7_ref) 151 | 152 | -- slowslowslow, but the encoder works and the memory use is consistent 153 | -- It'd be nice to track down which part is slow with this. 154 | runManaged $ do 155 | r <- rando randoStr 156 | putStrLn $ "/dev/urandom data roundtripped: " ++ show r 157 | pure () 158 | -------------------------------------------------------------------------------- /examples/File.idr: -------------------------------------------------------------------------------- 1 | module File 2 | 3 | -- Example of streaming from/to files. 4 | 5 | import Streaming 6 | import Streaming.Bytes as B 7 | import Streaming.Char as C 8 | import Streaming.Encoding.UTF8 9 | import Util -- withFile 10 | 11 | import System.File 12 | import Data.Strings 13 | 14 | import Data.List as L -- reverse 15 | 16 | ------------------------------------------------- 17 | -- Streaming File Read Example 18 | {- Here we read a file, split on newlines, split on words, reverse each word, 19 | unwords, unlines and spit it back out. 20 | This is written in a 'forward' style to follow along with the steps the 21 | stream takes. One could as easily use . and $ and write this in regular 22 | 'reverse' style Idris/Haskell composition. 23 | -} 24 | ------------------------------------------------- 25 | 26 | export 27 | main : IO () 28 | main = do 29 | let filename = "text.txt" 30 | Right res <- readFile filename 31 | | Left err => fileBad filename err 32 | putStrLn res 33 | B.bits8FromFile' filename 34 | &$ decodeUtf8 35 | |> encodeUtf8 -- encoding roundtripping test, temporary 36 | |> decodeUtf8 -- encoding roundtripping test, temporary 37 | |> C.lines 38 | |> S.mapf (C.words |> S.mapf S.rev |> C.unwords) 39 | |> C.unlines 40 | -- We collect the Chars into a String here instead of just piping them 41 | -- to stdout because the idris backend for printing has some issues 42 | -- right now with non-ascii Chars. Strings don't exhibit this issue. 43 | -- More directly single-Char printing uses putchar which on the c-side 44 | -- casts from int to char which is lossy. 45 | |> S.foldr strCons "" >>= putStrLn . fstOf 46 | pure () 47 | where 48 | fileBad : String -> FileError -> IO () 49 | fileBad fname err = printLn $ "File error: " ++ fname ++ ", " ++ show err 50 | -------------------------------------------------------------------------------- /examples/LICENSE: -------------------------------------------------------------------------------- 1 | Similar to Idris1/2 documentation, this software falls under the CC0 license. 2 | 3 | https://creativecommons.org/publicdomain/zero/1.0/ 4 | https://creativecommons.org/publicdomain/zero/1.0/legalcode 5 | https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt 6 | 7 | Reproduced below: 8 | 9 | Creative Commons Legal Code 10 | 11 | CC0 1.0 Universal 12 | 13 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 14 | LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 15 | ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 16 | INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 17 | REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 18 | PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 19 | THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 20 | HEREUNDER. 21 | 22 | Statement of Purpose 23 | 24 | The laws of most jurisdictions throughout the world automatically confer 25 | exclusive Copyright and Related Rights (defined below) upon the creator 26 | and subsequent owner(s) (each and all, an "owner") of an original work of 27 | authorship and/or a database (each, a "Work"). 28 | 29 | Certain owners wish to permanently relinquish those rights to a Work for 30 | the purpose of contributing to a commons of creative, cultural and 31 | scientific works ("Commons") that the public can reliably and without fear 32 | of later claims of infringement build upon, modify, incorporate in other 33 | works, reuse and redistribute as freely as possible in any form whatsoever 34 | and for any purposes, including without limitation commercial purposes. 35 | These owners may contribute to the Commons to promote the ideal of a free 36 | culture and the further production of creative, cultural and scientific 37 | works, or to gain reputation or greater distribution for their Work in 38 | part through the use and efforts of others. 39 | 40 | For these and/or other purposes and motivations, and without any 41 | expectation of additional consideration or compensation, the person 42 | associating CC0 with a Work (the "Affirmer"), to the extent that he or she 43 | is an owner of Copyright and Related Rights in the Work, voluntarily 44 | elects to apply CC0 to the Work and publicly distribute the Work under its 45 | terms, with knowledge of his or her Copyright and Related Rights in the 46 | Work and the meaning and intended legal effect of CC0 on those rights. 47 | 48 | 1. Copyright and Related Rights. A Work made available under CC0 may be 49 | protected by copyright and related or neighboring rights ("Copyright and 50 | Related Rights"). Copyright and Related Rights include, but are not 51 | limited to, the following: 52 | 53 | i. the right to reproduce, adapt, distribute, perform, display, 54 | communicate, and translate a Work; 55 | ii. moral rights retained by the original author(s) and/or performer(s); 56 | iii. publicity and privacy rights pertaining to a person's image or 57 | likeness depicted in a Work; 58 | iv. rights protecting against unfair competition in regards to a Work, 59 | subject to the limitations in paragraph 4(a), below; 60 | v. rights protecting the extraction, dissemination, use and reuse of data 61 | in a Work; 62 | vi. database rights (such as those arising under Directive 96/9/EC of the 63 | European Parliament and of the Council of 11 March 1996 on the legal 64 | protection of databases, and under any national implementation 65 | thereof, including any amended or successor version of such 66 | directive); and 67 | vii. other similar, equivalent or corresponding rights throughout the 68 | world based on applicable law or treaty, and any national 69 | implementations thereof. 70 | 71 | 2. Waiver. To the greatest extent permitted by, but not in contravention 72 | of, applicable law, Affirmer hereby overtly, fully, permanently, 73 | irrevocably and unconditionally waives, abandons, and surrenders all of 74 | Affirmer's Copyright and Related Rights and associated claims and causes 75 | of action, whether now known or unknown (including existing as well as 76 | future claims and causes of action), in the Work (i) in all territories 77 | worldwide, (ii) for the maximum duration provided by applicable law or 78 | treaty (including future time extensions), (iii) in any current or future 79 | medium and for any number of copies, and (iv) for any purpose whatsoever, 80 | including without limitation commercial, advertising or promotional 81 | purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 82 | member of the public at large and to the detriment of Affirmer's heirs and 83 | successors, fully intending that such Waiver shall not be subject to 84 | revocation, rescission, cancellation, termination, or any other legal or 85 | equitable action to disrupt the quiet enjoyment of the Work by the public 86 | as contemplated by Affirmer's express Statement of Purpose. 87 | 88 | 3. Public License Fallback. Should any part of the Waiver for any reason 89 | be judged legally invalid or ineffective under applicable law, then the 90 | Waiver shall be preserved to the maximum extent permitted taking into 91 | account Affirmer's express Statement of Purpose. In addition, to the 92 | extent the Waiver is so judged Affirmer hereby grants to each affected 93 | person a royalty-free, non transferable, non sublicensable, non exclusive, 94 | irrevocable and unconditional license to exercise Affirmer's Copyright and 95 | Related Rights in the Work (i) in all territories worldwide, (ii) for the 96 | maximum duration provided by applicable law or treaty (including future 97 | time extensions), (iii) in any current or future medium and for any number 98 | of copies, and (iv) for any purpose whatsoever, including without 99 | limitation commercial, advertising or promotional purposes (the 100 | "License"). The License shall be deemed effective as of the date CC0 was 101 | applied by Affirmer to the Work. Should any part of the License for any 102 | reason be judged legally invalid or ineffective under applicable law, such 103 | partial invalidity or ineffectiveness shall not invalidate the remainder 104 | of the License, and in such case Affirmer hereby affirms that he or she 105 | will not (i) exercise any of his or her remaining Copyright and Related 106 | Rights in the Work or (ii) assert any associated claims and causes of 107 | action with respect to the Work, in either case contrary to Affirmer's 108 | express Statement of Purpose. 109 | 110 | 4. Limitations and Disclaimers. 111 | 112 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 113 | surrendered, licensed or otherwise affected by this document. 114 | b. Affirmer offers the Work as-is and makes no representations or 115 | warranties of any kind concerning the Work, express, implied, 116 | statutory or otherwise, including without limitation warranties of 117 | title, merchantability, fitness for a particular purpose, non 118 | infringement, or the absence of latent or other defects, accuracy, or 119 | the present or absence of errors, whether or not discoverable, all to 120 | the greatest extent permissible under applicable law. 121 | c. Affirmer disclaims responsibility for clearing rights of other persons 122 | that may apply to the Work or any use thereof, including without 123 | limitation any person's Copyright and Related Rights in the Work. 124 | Further, Affirmer disclaims responsibility for obtaining any necessary 125 | consents, permissions or other rights required for any use of the 126 | Work. 127 | d. Affirmer understands and acknowledges that Creative Commons is not a 128 | party to this document and has no duty or obligation with respect to 129 | this CC0 or use of the Work. 130 | 131 | 132 | 133 | 134 | 135 | -------------------------------------------------------------------------------- /examples/Network.idr: -------------------------------------------------------------------------------- 1 | module Network 2 | 3 | import Streaming 4 | import Streaming.Bytes as BS 5 | 6 | import System.File 7 | import Network.Socket 8 | 9 | import Control.Monad.Trans 10 | 11 | import Control.Monad.Either 12 | import Control.Monad.Managed 13 | 14 | import Data.LazyList as LL 15 | import Util -- Either instances 16 | 17 | ------------------------------------------------- 18 | -- Streaming Network Example 19 | -- 20 | -- NB This file is a work in progress, I just wanted to get it put out before I 21 | -- forget to. Exercises task is subject to change. 22 | -- 23 | -- NB This example has not been tested to make sure it's running in constant 24 | -- space. 25 | {- Let's read the text from example.com! We're going to do some parsing here to 26 | find the text we're after but in real life you'd use a proper parsing lib. 27 | That could be a good next project, streaming to a parsing lib. 28 | This example is a little more involved to make use of some extra tooling to 29 | be expanded on later. 30 | In a real program you'd want to enforce that connecting has been done before 31 | sending or receiving, consider Control.Linear.Network for your own tests. 32 | 33 | I expect network primitives to eventually provide Bits8 rather than Char as 34 | they do now, in the mean time we cast to Bits8. This is currently correct to 35 | do as these are really a 'c char' which is 8 bits. 36 | -} 37 | ------------------------------------------------- 38 | 39 | %foreign "C:strerror,libc,string.h" 40 | strerror : Int -> String 41 | -- No reason to PrimIO, right? It's just a lookup. 42 | 43 | ||| A sum Error type for this example, for making EitherT use direct. 44 | data Error = SocketError Int 45 | | ConnectError Int 46 | | SendError Int 47 | | RecvError Int 48 | | FileError FileError 49 | 50 | showError : Error -> String 51 | showError (SocketError err) = "Socket error: " ++ strerror err 52 | showError (ConnectError err) = "Connect error: " ++ strerror err 53 | showError (SendError err) = "Send error: " ++ strerror err 54 | showError (RecvError err) = "Recv error: " ++ strerror err 55 | showError (FileError err) = "File error: " ++ show err 56 | 57 | -- While this is really Maybe Error, writing it as Either Error () plays nicer 58 | -- with the EitherT setup used here. 59 | streamnet : (Monad m, HasIO m) => Socket -> Stream (Of Bits8) m (Either Error ()) 60 | streamnet sock = Effect $ do 61 | let chunkLen = 1024 62 | Right (res,len) <- recv sock chunkLen 63 | | Left err => pure $ Return (Left (RecvError err)) 64 | pure $ if len == 0 65 | then Return (Right ()) 66 | else each (map (cast . cast {to=Int}) . LL.unpack $ res) *> 67 | if len < chunkLen 68 | then Return (Right ()) 69 | else streamnet sock 70 | 71 | withFile : HasIO io => String -> Mode 72 | -> (Either Error File -> io b) -> io b 73 | withFile file mode act = do 74 | f <- first FileError <$> openFile file mode 75 | res <- act f 76 | traverse closeFile f 77 | pure res 78 | 79 | withSocket : HasIO io => SocketFamily -> SocketType -> ProtocolNumber 80 | -> (Either Error Socket -> io b) -> io b 81 | withSocket fam ty proto act = do 82 | sock <- first SocketError <$> socket fam ty proto 83 | res <- act sock 84 | traverse close sock 85 | pure res 86 | 87 | main : IO () 88 | main = runManaged $ do 89 | let filename = "out.txt" 90 | addr = Hostname "www.example.com" 91 | msg = makeHeader ["GET / HTTP/1.0" 92 | ,"Host: www.example.com" 93 | ,"User-Agent: idris2-test"] 94 | res <- runEitherT $ do 95 | file <- MkEitherT . use . managed $ withFile "out.txt" WriteTruncate 96 | sock <- MkEitherT . use . managed $ withSocket AF_INET Stream 0 97 | 0 <- lift $ connect sock addr 80 98 | | err => throwE (ConnectError err) 99 | lift $ first SendError <$> send sock msg 100 | lift $ streamnet sock 101 | &$ maps charCast 102 | |> S.stdoutChrLn' 103 | pure () -- helps type inferrence 104 | either (putStrLn . showError) pure res 105 | where 106 | makeHeader : List String -> String 107 | makeHeader xs = concatMap (++ "\r\n") xs ++ "\r\n" 108 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | Examples of Effectful Streaming For Idris 2 | ===== 3 | 4 | The following examples assume that your first step was to enter the `examples` directory and type `idris2 --build examples.ipkg` 5 | 6 | * `File.idr` shows an example of stream processing on a file including running decoding. 7 | It is most directly ran by typing `idris2 -p streaming -p managed File.idr --exec main` 8 | Alternatively you can type `idris2 --repl examples.ipkg` and then `:module File` and finally `:exec main` 9 | 10 | * `Base64.idr` is a test of stream encoding/decoding on known and unknown data. 11 | It is most directly ran by typing `idris2 -p streaming -p managed Base64.idr --exec main` 12 | Alternatively you can type `idris2 --repl examples.ipkg` and then `:module Base64` and finally `:exec main` 13 | 14 | * `Network.idr` has an example of connecting to a website and streaming the results to stdout and a file at the same time. 15 | It is most directly ran by typing `idris2 -p network -p streaming -p managed Network.idr --exec main` 16 | Alternatively you can type `idris2 --repl examples.ipkg` and then `:module Network` and finally `:exec main` 17 | 18 | This currently installs `streaming` when built (for my own convenience) comment out the 'prebuild' line in examples.ipkg if you don't want this to happen. 19 | 20 | Version 21 | ------- 22 | 23 | This package follows [Haskell PVP](https://pvp.haskell.org/) which is distinct from [SEMVER](https://semver.org/) in that when examining `1.2.3`, `1.2` is the Major Version rather than `1`. 24 | -------------------------------------------------------------------------------- /examples/examples.ipkg: -------------------------------------------------------------------------------- 1 | package examples 2 | 3 | authors = "MarcelineVQ" 4 | version = "0.5.2.1" 5 | readme = "README.md" 6 | 7 | homepage = "https://github.com/MarcelineVQ/idris2-streaming" 8 | sourceloc = "https://github.com/MarcelineVQ/idris2-streaming.git" 9 | bugtracker = "https://github.com/MarcelineVQ/idris2-streaming/issues" 10 | 11 | license = "CC0 (refer to LICENSE file)" 12 | brief = "Examples of Effectful Streaming for Idris" 13 | 14 | modules = File 15 | , Network 16 | , Base64 17 | sourcedir = "" 18 | 19 | prebuild = "idris2 --clean examples.ipkg && cd .. && idris2 --clean streaming.ipkg && idris2 --install streaming.ipkg" 20 | 21 | -- main = Streaming 22 | 23 | depends = base, contrib, network, streaming, managed, curl 24 | -------------------------------------------------------------------------------- /examples/text.txt: -------------------------------------------------------------------------------- 1 | He just kept talking 2 | in one long 3 | incredibly unbroken sentence 4 | moving from topic to topic 5 | so that no-one had a chance to interrupt; 6 | it was really quite hypnotic. 7 | 😂 <- utf symbol crying laughter 8 | 🙂 <- utf symbol smile 9 | 🙃 <- utf symbol upside-down smile 10 | -------------------------------------------------------------------------------- /install_libs: -------------------------------------------------------------------------------- 1 | git submodule update --init 2 | cd libs 3 | 4 | cd managed 5 | idris2 --clean managed.ipkg && idris2 --install managed.ipkg 6 | cd .. 7 | 8 | cd curl 9 | idris2 --clean curl.ipkg && idris2 --install curl.ipkg 10 | cd .. 11 | -------------------------------------------------------------------------------- /src/Data/AVL.idr: -------------------------------------------------------------------------------- 1 | module Data.AVL 2 | 3 | import Data.List 4 | 5 | -- Boring basic AVL weight balanced BST 6 | -- ordered on keys to be more versatile 7 | 8 | Height : Type 9 | Height = Int 10 | 11 | export 12 | data Tree : Type -> Type -> Type where 13 | Leaf : Tree k a 14 | Node : (h : Int) -> (key : k) -> (v : a) -> (l : Tree k a) -> (r : Tree k a) -> Tree k a 15 | 16 | -- a a a 17 | -- \ / -> \ 18 | -- b -> b b b 19 | -- \ / \ 20 | -- c a c 21 | rotateL : Tree k a -> Tree k a 22 | rotateL (Node hA kA vA lA (Node hB kB vB lB c)) = Node hB kB vB (Node hA kA vA lA lB) c 23 | rotateL t = t 24 | 25 | roLtest1 : rotateL (Node 0 1 'a' Leaf (Node 0 2 'b' Leaf (Node 0 3 'c' Leaf Leaf))) = Node 0 2 'b' (Node 0 1 'a' Leaf Leaf) (Node 0 3 'c' Leaf Leaf) 26 | roLtest1 = Refl 27 | 28 | 29 | rotateR : Tree k a -> Tree k a 30 | rotateR (Node hA kA vA (Node hB kB vB c rB) rA) = Node hB kB vB c (Node hA kA vA rB rA) 31 | rotateR t = t 32 | 33 | roRtest1 : rotateR (Node 0 1 'a' (Node 0 2 'b' (Node 0 3 'c' Leaf Leaf) Leaf) Leaf) = Node 0 2 'b' (Node 0 3 'c' Leaf Leaf) (Node 0 1 'a' Leaf Leaf) 34 | roRtest1 = Refl 35 | 36 | 37 | -- c c 38 | -- / / 39 | -- a -> b -> b 40 | -- \ / / \ 41 | -- b a a c 42 | rotateRL : Tree k a -> Tree k a 43 | rotateRL Leaf = Leaf 44 | rotateRL (Node x k v l r) = rotateR (Node x k v (rotateL l) r) 45 | 46 | foobles2 : rotateRL (Node 0 3 'c' (Node 0 1 'a' Leaf (Node 0 2 'b' Leaf Leaf)) Leaf) = Node 0 2 'b' (Node 0 1 'a' Leaf Leaf) (Node 0 3 'c' Leaf Leaf) 47 | foobles2 = Refl 48 | 49 | rotateLR : Tree k a -> Tree k a 50 | rotateLR Leaf = Leaf 51 | rotateLR (Node x k v l r) = rotateL (Node x k v l (rotateR r)) 52 | 53 | foobles3 : rotateLR (Node 0 1 'a' Leaf (Node 0 3 'c' (Node 0 2 'b' Leaf Leaf) Leaf)) = Node 0 2 'b' (Node 0 1 'a' Leaf Leaf) (Node 0 3 'c' Leaf Leaf) 54 | foobles3 = Refl 55 | 56 | public export 57 | data NonEmpty : Tree k a -> Type where 58 | IsNonEmpty : NonEmpty (Node h k v l r) 59 | 60 | export 61 | height : Tree k a -> Int 62 | height Leaf = 0 63 | height (Node h k v l r) = h 64 | 65 | checkBalance : (t : Tree k a) -> Int 66 | checkBalance Leaf = 0 67 | checkBalance (Node x k v l r) = height r - height l 68 | 69 | data Balance = LeftHeavy | LeftLean | Neutral | RightLean | RightHeavy 70 | 71 | checkBalance' : Tree k a -> Balance 72 | checkBalance' Leaf = Neutral 73 | checkBalance' t = let i = checkBalance t 74 | in if i > 1 then RightHeavy 75 | else if i == 1 then RightLean 76 | else if i == -1 then LeftLean 77 | else if i < -1 then LeftHeavy 78 | else Neutral 79 | 80 | isLeftHeavy : Tree k a -> Bool 81 | isLeftHeavy t with (checkBalance' t) 82 | isLeftHeavy t | LeftHeavy = True 83 | isLeftHeavy t | _ = False 84 | 85 | isRightHeavy : Tree k a -> Bool 86 | isRightHeavy t with (checkBalance' t) 87 | isRightHeavy t | RightHeavy = True 88 | isRightHeavy t | _ = False 89 | 90 | balance : Tree k a -> Tree k a 91 | balance Leaf = Leaf 92 | balance n@(Node h k v l r) = case checkBalance' n of 93 | LeftHeavy => if isRightHeavy l then rotateRL n else rotateR n 94 | LeftLean => n 95 | Neutral => n 96 | RightLean => n 97 | RightHeavy => if isLeftHeavy r then rotateLR n else rotateL n 98 | 99 | export 100 | insert : Ord k => k -> a -> Tree k a -> Tree k a 101 | insert i x Leaf = Node 1 i x Leaf Leaf 102 | insert i x n@(Node h k v l r) = case compare i k of 103 | EQ => n 104 | LT => balance $ Node h k v (insert i x l) r 105 | GT => balance $ Node h k v l (insert i x r) 106 | 107 | export 108 | lookup : Ord k => k -> Tree k a -> Maybe a 109 | lookup i Leaf = Nothing 110 | lookup i n@(Node h k v l r) = case compare i k of 111 | EQ => Just v 112 | LT => lookup i l 113 | GT => lookup i r 114 | 115 | export 116 | fromList : Ord k => List (k,a) -> Tree k a 117 | fromList = foldr (uncurry insert) Leaf 118 | 119 | bt : Tree Int Char 120 | bt = Node 3 1 '1' Leaf (Node 2 2 '2' (Node 1 3 '3' Leaf Leaf) Leaf) 121 | 122 | bt2 : Tree Int Char 123 | bt2 = Node 3 1 '1' (Node 2 2 '2' (Node 1 3 '3' Leaf Leaf) Leaf) Leaf 124 | 125 | bt3 : Tree Int Char 126 | bt3 = fromList [(1,'1'),(2,'2'),(3,'3')] 127 | 128 | foobles4 : balance (Node 3 1 'a' Leaf (Node 2 3 'c' (Node 1 2 'b' Leaf Leaf) Leaf)) = Node 2 2 'b' (Node 1 1 'a' Leaf Leaf) (Node 1 3 'c' Leaf Leaf) 129 | foobles4 = ?dsfdfs 130 | 131 | 132 | 133 | 134 | -------------------------------------------------------------------------------- /src/Data/Functor/Compose.idr: -------------------------------------------------------------------------------- 1 | module Data.Functor.Compose 2 | 3 | public export 4 | data Compose : (f : Type -> Type) -> (g : Type -> Type) -> Type -> Type where 5 | MkCompose : f (g x) -> Compose f g x 6 | 7 | public export 8 | getCompose : Compose f g a -> f (g a) 9 | getCompose (MkCompose x) = x 10 | 11 | public export 12 | implementation (Functor f, Functor g) => Functor (Compose f g) where 13 | map f (MkCompose x) = MkCompose $ map (map f) x 14 | 15 | -------------------------------------------------------------------------------- /src/Data/Functor/Of.idr: -------------------------------------------------------------------------------- 1 | module Data.Functor.Of 2 | 3 | -- Of exists to allow stream functions to be polymorphic over the choice of 4 | -- stream value. This lets us reuse code for nested streams. 5 | -- Stream (Of a) m r vs Stream (Stream (Of a) m) m r 6 | -- It's being placed here just in case it ends up more useful than just for 7 | -- streams 8 | 9 | infixr 5 :> 10 | public export 11 | data Of : Type -> Type -> Type where 12 | ||| Streaming depends on the Lazyness of r currently 13 | (:>) : a -> Lazy r -> Of a r 14 | 15 | public export 16 | implementation Bifunctor Of where 17 | bimap f g (x :> y) = (f x :> g y) 18 | mapFst f (x :> y) = (f x :> y) 19 | mapSnd g (x :> y) = (x :> g y) 20 | 21 | -- public export 22 | -- Eq (Of a r) where 23 | -- Ord 24 | 25 | public export 26 | %inline 27 | Functor (Of a) where 28 | map f o = mapSnd f o 29 | 30 | -- Applicative 31 | -- Monad 32 | -- Foldable -- I'm not sure I want to provide these, they're quite strict 33 | -- Traversable -- I'm not sure I want to provide these, they're quite strict 34 | 35 | 36 | public export 37 | implementation (Semigroup a, Semigroup r) => Semigroup (Of a r) where 38 | (a :> c) <+> (b :> d) = (a <+> b) :> (c <+> d) 39 | 40 | public export 41 | implementation (Monoid a, Monoid r) => Monoid (Of a r) where 42 | neutral = neutral :> neutral 43 | 44 | public export 45 | implementation (Show a, Show r) => Show (Of a r) where 46 | showPrec d (x :> y) = showParens (d >= Backtick) (show x ++ " :> " ++ show y) 47 | 48 | %inline 49 | export 50 | fstOf : Of a b -> a 51 | fstOf (x :> y) = x 52 | 53 | %inline 54 | export 55 | sndOf : Of a b -> b 56 | sndOf (x :> y) = y 57 | -------------------------------------------------------------------------------- /src/Data/LazyList.idr: -------------------------------------------------------------------------------- 1 | module Data.LazyList 2 | 3 | public export 4 | data LazyList : Type -> Type where 5 | Nil : LazyList a 6 | (::) : a -> Lazy (LazyList a) -> LazyList a 7 | 8 | data NonEmpty : LazyList a -> Type where 9 | IsNonEmpty : NonEmpty (_ :: _) 10 | 11 | export 12 | Functor LazyList where 13 | map f [] = [] 14 | map f (x :: xs) = f x :: map f xs 15 | 16 | export 17 | Show a => Show (LazyList a) where 18 | show [] = "[]" 19 | show (x :: xs) = show x ++ " :: " ++ show xs 20 | 21 | public export 22 | Semigroup (LazyList a) where 23 | [] <+> ys = ys 24 | (x :: xs) <+> ys = x :: (xs <+> ys) 25 | 26 | public export 27 | Monoid (LazyList a) where 28 | neutral = [] 29 | 30 | export 31 | total 32 | head : LazyList a -> Maybe a 33 | head [] = Nothing 34 | head (x :: _) = Just x 35 | 36 | export 37 | total 38 | head' : (l : LazyList a) -> NonEmpty l => a 39 | head' (x :: _) = x 40 | 41 | export 42 | partial 43 | head'' : LazyList a -> a 44 | head'' [] = idris_crash "head: LazyList was empty" 45 | head'' (x :: _) = x 46 | 47 | export 48 | total 49 | tail : LazyList a -> Maybe (LazyList a) 50 | tail [] = Nothing 51 | tail (_ :: xs) = Just xs 52 | 53 | export 54 | total 55 | tail' : (l : LazyList a) -> NonEmpty l => LazyList a 56 | tail' (_ :: xs) = xs 57 | 58 | export 59 | partial 60 | tail'' : LazyList a -> LazyList a 61 | tail'' [] = idris_crash "tail: LazyList was empty" 62 | tail'' (_ :: xs) = xs 63 | 64 | export 65 | implementation Foldable LazyList where 66 | foldr f z [] = z 67 | foldr f z (x :: xs) = f x (foldr f z xs) 68 | 69 | 70 | export 71 | ||| Foldable's methods are strict due to needing (a -> b -> b). `map` and the 72 | ||| like can stay lazy probably because they have a constructors guarding their 73 | ||| recursion. We don't have that here and must instead be explicitly lazy in 74 | ||| our combining function. 75 | foldr' : (a -> Lazy b -> Lazy b) -> b -> LazyList a -> b 76 | foldr' f z [] = z 77 | foldr' f z (x :: xs) = f x (Delay (foldr' f z xs)) 78 | 79 | export 80 | toList : LazyList a -> List a 81 | toList = foldr' (\x,xs => x :: force xs) [] 82 | 83 | export -- Not lazy 84 | fromList : List a -> LazyList a 85 | fromList = foldr (\x,xs => x :: xs) [] 86 | 87 | -- It's weird but the S Z case is necessary otherwise a list like 88 | -- take 2 [1,2,idris_crash "foo"] will crash. I don't know why that should be, 89 | -- given that xs is Lazy. 90 | export 91 | take : Nat -> LazyList a -> LazyList a 92 | take Z _ = [] 93 | take _ [] = [] 94 | take (S Z) (x :: _) = x :: [] 95 | take (S k) (x :: xs) = x :: take k xs 96 | 97 | export 98 | take' : Nat -> Stream a -> LazyList a 99 | take' Z (x :: xs) = [] 100 | take' (S k) (x :: xs) = x :: take' k xs 101 | 102 | repeat : a -> LazyList a 103 | repeat x = x :: repeat x 104 | 105 | takeUntil : (a -> Bool) -> Stream a -> LazyList a 106 | takeUntil f (x :: xs) = if f x then [x] else x :: takeUntil f xs 107 | 108 | takeBefore : (a -> Bool) -> Stream a -> LazyList a 109 | takeBefore f (x :: xs) = if f x then [] else x :: takeBefore f xs 110 | 111 | export -- [2..7] = [2,3,4,5,6,7] 112 | rangeFromTo : (Range a, Ord a) => a -> a -> LazyList a 113 | rangeFromTo x y = if y > x then takeUntil (>= y) (rangeFrom x) 114 | else [] 115 | 116 | export 117 | ||| yanked from Prelude.Types 118 | unpack : String -> LazyList Char 119 | unpack str = unpack' (prim__cast_IntegerInt (natToInteger (length str)) - 1) str [] 120 | where 121 | unpack' : Int -> String -> LazyList Char -> LazyList Char 122 | unpack' pos str acc 123 | = if pos < 0 124 | then acc 125 | else assert_total $ unpack' (pos - 1) str (assert_total (prim__strIndex str pos)::acc) 126 | 127 | export 128 | zipWith : (a -> b -> c) -> LazyList a -> LazyList b -> LazyList c 129 | zipWith f (x :: xs) (y :: ys) = f x y :: zipWith f xs ys 130 | zipWith _ _ _ = [] 131 | 132 | export 133 | %inline 134 | zip : LazyList a -> LazyList b -> LazyList (a,b) 135 | zip = zipWith MkPair 136 | -------------------------------------------------------------------------------- /src/Data/Proxy.idr: -------------------------------------------------------------------------------- 1 | module Data.Proxy 2 | 3 | import Data.Stream 4 | 5 | data Proxy a = MkProxy 6 | 7 | %inline 8 | public export 9 | Functor Proxy where 10 | map f MkProxy = MkProxy 11 | 12 | %inline 13 | public export 14 | Applicative Proxy where 15 | pure _ = MkProxy 16 | _ <*> _ = MkProxy 17 | 18 | %inline 19 | public export 20 | Alternative Proxy where 21 | empty = MkProxy 22 | _ <|> _ = MkProxy 23 | 24 | %inline 25 | public export 26 | Monad Proxy where 27 | _ >>= _ = MkProxy 28 | join _ = MkProxy 29 | 30 | %inline 31 | public export 32 | Semigroup (Proxy a) where 33 | _ <+> _ = MkProxy 34 | 35 | %inline 36 | public export 37 | Monoid (Proxy a) where 38 | neutral = MkProxy 39 | 40 | %inline 41 | public export 42 | Eq (Proxy a) where 43 | _ == _ = True 44 | _ /= _ = False 45 | 46 | %inline 47 | public export 48 | Ord (Proxy a) where 49 | compare _ _ = EQ 50 | 51 | %inline 52 | public export 53 | Show (Proxy a) where 54 | show _ = "MkProxy" 55 | 56 | public export 57 | Range (Proxy a) where 58 | rangeFromTo _ _ = [MkProxy] 59 | rangeFromThenTo _ _ _ = [MkProxy] 60 | 61 | rangeFrom _ = repeat MkProxy 62 | rangeFromThen _ _ = repeat MkProxy 63 | 64 | -------------------------------------------------------------------------------- /src/Streaming.idr: -------------------------------------------------------------------------------- 1 | module Streaming 2 | 3 | import public Streaming.Streams as S 4 | import public Streaming.API as S 5 | -------------------------------------------------------------------------------- /src/Streaming/API.idr: -------------------------------------------------------------------------------- 1 | module Streaming.API 2 | 3 | import Prelude as P 4 | 5 | import public Streaming.Internal as S 6 | 7 | import Control.Monad.Trans -- lift 8 | 9 | import Data.LazyList 10 | 11 | -- import Util 12 | 13 | -- slightly more specific version of inspect 14 | export 15 | %inline 16 | next : Monad m => Stream (Of a) m r -> m (Either r (Of a (Stream (Of a) m r))) 17 | next = inspect 18 | 19 | export 20 | %inline 21 | cons : Monad m => a -> Stream (Of a) m r -> Stream (Of a) m r 22 | cons x str = wrap (x :> str) 23 | -- cons x str = Build (\r,eff,step => step (x :> streamFold r eff step str)) 24 | 25 | export 26 | copy : Monad m => Stream (Of a) m r -> Stream (Of a) (Stream (Of a) m) r 27 | copy str = case str of 28 | (Return x) => Effect . pure . Return $ x 29 | (Effect x) => Effect . pure . Effect $ copy <$> lift x -- tricky 30 | (Step (x :> y)) => Effect . pure . Effect $ (Step (x :> Return (Step (x :> copy y)))) 31 | (Build g) => copy (streamBuild g) 32 | 33 | export 34 | store : Monad m => (Stream (Of a) (Stream (Of a) m) r -> t) 35 | -> Stream (Of a) m r -> t 36 | store f str = f (copy str) 37 | 38 | ||| Appends two streams keeping the value of the latter, for a version that 39 | ||| keeps both results use <+> 40 | export 41 | append : Monad m => Stream (Of a) m r -> Stream (Of a) m r -> Stream (Of a) m r 42 | append s1 s2 = Build 43 | (\r,eff,step => streamFold (\_ => streamFold r eff step s2) eff step s1) 44 | 45 | export 46 | concats : (Functor f, Monad m) => Stream (Stream f m) m r -> Stream f m r 47 | concats str = Build 48 | (\r,eff,step => streamFold r eff (streamFold id eff step) str) 49 | 50 | export 51 | ||| strict (left) fold 52 | foldl : Monad m => (b -> a -> b) -> b -> Stream (Of a) m r -> m (Of b r) 53 | foldl f acc (Return r) = pure (acc :> r) 54 | foldl f acc (Effect m) = m >>= foldl f acc 55 | foldl f acc (Step (x :> str)) = foldl f (f acc x) str 56 | foldl f acc (Build g) = foldl f acc (streamBuild g) 57 | 58 | export 59 | foldr : Monad m => (a -> b -> b) -> b -> Stream (Of a) m r -> m (Of b r) 60 | foldr f acc = streamFold (\r => pure (acc :> r)) join 61 | (\(a :> rest) => mapFst (f a) <$> rest) 62 | 63 | export 64 | foldr_ : Monad m => (a -> b -> b) -> b -> Stream (Of a) m r -> m b 65 | foldr_ f acc = streamFold (\_ => pure acc) join (\(a :> rest) => f a <$> rest) 66 | 67 | foldl_ : Monad m => (b -> a -> b) -> b -> Stream (Of a) m r -> m b 68 | foldl_ f acc (Return r) = pure acc 69 | foldl_ f acc (Effect m) = m >>= foldl_ f acc 70 | foldl_ f acc (Step (x :> str)) = foldl_ f (f acc x) str 71 | foldl_ f acc (Build g) = foldl_ f acc (streamBuild g) 72 | 73 | export 74 | foldrM : Monad m => (a -> b -> m b) -> m b -> Stream (Of a) m r -> m (Of b r) 75 | foldrM f acc = streamFold (\r => (:> r) <$> acc) join 76 | (\(a :> rest) => do 77 | (b :> r) <- rest 78 | (:> r) <$> f a b) 79 | 80 | export -- our fold is foldl so we make a dlist 81 | toList : Monad m => Stream (Of a) m r -> m (Of (List a) r) 82 | toList str = mapFst ($ []) <$> foldl (\diff,a,ls => diff (a :: ls)) id str 83 | 84 | ||| Run an action on each element of a stream and reyield them, this is quite 85 | ||| useful for debug priting of stream values as you work on them. 86 | export 87 | chain : Monad m => (a -> m ()) -> Stream (Of a) m r -> Stream (Of a) m r 88 | chain f str = Build (\r,eff,step => streamFold r eff 89 | (\(x :> y) => eff $ f x *> pure (step (x :> y))) str) 90 | 91 | -- export 92 | -- toList_ : Monad m => Stream (Of a) m r -> m (List a) 93 | -- toList_ = fold_ (::) [] 94 | 95 | export 96 | length : Monad m => Stream (Of a) m r -> m (Of Int r) 97 | length = foldl (\n,_ => 1 + n) 0 98 | 99 | export 100 | length' : Monad m => Stream (Of a) m r -> m (Of Nat r) 101 | length' = foldl (\n,_ => S n) Z 102 | 103 | export 104 | length_ : Monad m => Stream (Of a) m r -> m Int 105 | length_ = foldl_ (\n,_ => 1 + n) 0 106 | 107 | export 108 | length'_ : Monad m => Stream (Of a) m r -> m Nat 109 | length'_ = foldl_ (\n,_ => S n) Z 110 | 111 | export 112 | sum : (Monad m, Num a) => Stream (Of a) m r -> m (Of a r) 113 | sum = foldl (+) 0 114 | 115 | export 116 | sum_ : (Monad m, Num a) => Stream (Of a) m r -> m a 117 | sum_ = foldl_ (+) 0 118 | 119 | ------------------------------------------------- 120 | -- Constructing Streams 121 | ------------------------------------------------- 122 | 123 | public export -- Might as well be public, it's just constructors. 124 | %inline 125 | ||| The empty stream, mostly for convenience. 126 | empty : Stream (Of a) m () 127 | empty = Return () 128 | 129 | export 130 | ||| aka 'single', a stream of one element. 131 | yield : Monad m => a -> Stream (Of a) m () 132 | yield x = cons x empty 133 | 134 | -- Stream (Of ) 135 | 136 | -- yields : f a -> Stream (Of a) m r 137 | 138 | -- 'each' of these could simply be Foldable if Foldable's foldr wasn't so strict 139 | 140 | export 141 | ||| Preferred method of providing List input to a Stream. 142 | each : Monad m => LazyList a -> Stream (Of a) m () 143 | each [] = empty 144 | each (x :: xs) = cons x (each xs) 145 | 146 | export 147 | ||| Turn a (list) stream into our Stream. 148 | each' : Monad m => Stream a -> Stream (Of a) m () 149 | each' (x :: xs) = cons x (each' xs) 150 | 151 | export 152 | ||| It's better to use LazyList. List will reside in memory all at once. 153 | each'' : Monad m => List a -> Stream (Of a) m () 154 | each'' = each . fromList 155 | 156 | export 157 | ||| You are best to avoid this, foldable's methods are strict, your source will 158 | ||| reside in memory all at once. And (for some reason) in a manner worse than 159 | ||| plain List. 160 | each''' : (Monad m, Foldable f) => f a -> Stream (Of a) m () 161 | each''' = foldr cons empty 162 | 163 | ------------------------------------------------- 164 | -- Splitting Streams 165 | ------------------------------------------------- 166 | 167 | -- idk how to 'Build' this. specifically to carry the Nat to the next 'step' 168 | export 169 | splitsAt : (Monad m, Functor f) => Int -> Stream f m r -> Stream f m (Stream f m r) 170 | splitsAt 0 str = Return str 171 | splitsAt n str = case str of 172 | (Return x) => Return (Return x) 173 | (Effect x) => Effect (splitsAt n <$> x) 174 | (Step x) => case n of 175 | 0 => Return (Step x) 176 | k => Step $ splitsAt (k-1) <$> x 177 | (Build g) => splitsAt n (streamBuild g) -- :( 178 | 179 | -- idk how to 'Build' this. specifically to carry the Nat to the next 'step' 180 | export 181 | splitsAt' : (Monad m, Functor f) => Nat -> Stream f m r -> Stream f m (Stream f m r) 182 | splitsAt' Z str = Return str 183 | splitsAt' n str = case str of 184 | (Return x) => Return (Return x) 185 | (Effect x) => Effect (splitsAt' n <$> x) 186 | (Step x) => case n of 187 | Z => Return (Step x) 188 | (S k) => Step $ splitsAt' k <$> x 189 | (Build g) => splitsAt' n (streamBuild g) -- :( 190 | 191 | -- idk how to 'Build' this 192 | export 193 | chunksOf : (Monad m, Functor f) => Int -> Stream f m r -> Stream (Stream f m) m r 194 | chunksOf n (Return x) = Return x 195 | chunksOf n (Effect x) = Effect (chunksOf n <$> x) 196 | chunksOf n (Step x) = Step (Step (map (map (chunksOf n) . splitsAt (n - 1)) x)) 197 | chunksOf n (Build g) = chunksOf n (streamBuild g) -- :( 198 | 199 | export 200 | chunksOf' : (Monad m, Functor f) => Nat -> Stream f m r -> Stream (Stream f m) m r 201 | chunksOf' n (Return x) = Return x 202 | chunksOf' n (Effect x) = Effect (chunksOf' n <$> x) 203 | chunksOf' n (Step x) = Step (Step (map (map (chunksOf' n) . splitsAt' (n`minus`1)) x)) 204 | chunksOf' n (Build g) = chunksOf' n (streamBuild g) -- :( 205 | 206 | 207 | -- I was able to 'Build' this because it doesn't need to carry state per 208 | -- invocation, it's a constant predicate. 209 | ||| `span` streams elements until one fails the condition, returning the remainder 210 | ||| span (<3) [1,2,3,4,5] => [3,4,5] 211 | export 212 | span : Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m (Stream (Of a) m r) 213 | span p str = Build (\r,eff,step => streamFold (r . Return) eff (spanIt p r eff step) str) 214 | where 215 | spanIt : (a -> Bool) -> (Stream (Of a) m r -> b) -> (m b -> b) -> (Of a b -> b) -> Of a b -> b 216 | spanIt pred r eff step v@(x :> y) = if pred x 217 | then step v 218 | else r $ Step (x :> str) 219 | 220 | export 221 | take : (Functor f, Monad m) => Int -> Stream f m r -> Stream f m () 222 | take 0 str = pure () 223 | take n str = case str of 224 | (Return x) => Return () 225 | (Effect x) => Effect (map (take n) x) 226 | (Step x) => Step (map (take (n - 1)) x) 227 | (Build g) => g (const (Return ())) (effect . map (take n)) (wrap . map (take (n - 1))) 228 | 229 | -- dunno how to 'Build' this 230 | export 231 | take' : (Functor f, Monad m) => Nat -> Stream f m r -> Stream f m () 232 | take' Z str = pure () 233 | take' n@(S k) str = case str of 234 | (Return x) => Return () 235 | (Effect x) => Effect (map (take' n) x) 236 | (Step x) => Step (map (take' k) x) 237 | (Build g) => g (const (Return ())) (effect . map (take' n)) (wrap . map (take' k)) 238 | 239 | export 240 | drop : (Functor f, Monad m) => Int -> Stream f m r -> Stream f m r 241 | drop 0 str = str 242 | drop n str = Build (\r,eff,step => streamFold r eff step (drop (n - 1) str)) 243 | 244 | export 245 | drop' : (Functor f, Monad m) => Nat -> Stream f m r -> Stream f m r 246 | drop' Z str = str 247 | drop' (S k) str = Build (\r,eff,step => streamFold r eff step (drop' k str)) 248 | 249 | export 250 | ||| `split` aka splitOn/splitBy 251 | ||| splits a stream into segments based on a predicate, consumes True results. 252 | split : Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Stream (Of a) m) m r 253 | split f (Return y) = Return y 254 | split f (Effect y) = Effect (map (split f) y) 255 | split f (Step (a :> rest)) = if not (f a) 256 | then Step (Prelude.map (split f) (yield a *> span (not . f) rest)) 257 | else split f rest 258 | split f (Build g) = split f (streamBuild g) 259 | 260 | export 261 | filter : Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r 262 | filter p str = Build (\r,eff,step => streamFold r eff (\(x :> y) => if p x then step (x :> y) else y) str) 263 | 264 | export 265 | all : Monad m => (a -> Bool) -> Stream (Of a) m r -> m (Of Bool r) 266 | all p str = foldl (\b,x => p x && b) True str 267 | 268 | export 269 | print : (HasIO io, Show a, Show r) => Stream (Of a) io r -> io r 270 | print x = streamFold (\r => printLn r *> pure r) join (\(x :> s) => print x *> s) x <* putStr "\n" 271 | 272 | -- infixl 9 `for` 273 | export 274 | -- | @for@ replaces each element of a stream with an associated stream. Note that the 275 | -- associated stream may layer any functor. 276 | for : (Monad m, Functor f) => Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r 277 | for str act = Build (\r,eff,step => streamFold r eff 278 | (\(a :> rest) => streamFold r eff step (act a *> for str act)) str) 279 | 280 | export 281 | concat : (Foldable f, Monad m) => Stream (Of (f a)) m r -> Stream (Of a) m r 282 | concat str = for str each''' 283 | 284 | -- Temporary, this seems like a common pattern somehow, I need to find what 285 | -- fundamental operation subsumes it. a variant of how concat is written perhaps 286 | export 287 | fromList : (Foldable f, Monad m) => m (Of (LazyList a) r) -> Stream (Of a) m r 288 | fromList xs = Effect $ do 289 | (x :> y) <- xs 290 | let g = each {m} x 291 | pure (Build (\r,eff,step => streamFold (\_ => r y) eff step g)) 292 | 293 | export 294 | fromList' : (Foldable f, Monad m) => m (Of (f a) r) -> Stream (Of a) m r 295 | fromList' xs = Effect $ do 296 | (x :> y) <- xs 297 | let g = each''' {m} x 298 | pure (Build (\r,eff,step => streamFold (\_ => r y) eff step g)) 299 | 300 | export 301 | zipWith : Monad m => (a -> b -> c) -> Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of c) m r 302 | zipWith f (Return r) str2 = Return r 303 | zipWith f (Effect m) str2 = Effect $ map (\str => zipWith f str str2) m 304 | zipWith f s@(Step (a :> y1)) str2 = case str2 of 305 | (Return r) => Return r 306 | (Effect m) => Effect $ map (zipWith f s) m 307 | (Step (b :> y2)) => Step $ f a b :> zipWith f y1 y2 308 | (Build g) => g Return Effect (\(b :> y2) => Step $ f a b :> y2) 309 | zipWith f (Build g) str2 = zipWith f (streamBuild g) str2 310 | 311 | export 312 | repeat : Monad m => a -> Stream (Of a) m r 313 | repeat x = effect (pure (wrap (x :> repeat x))) 314 | 315 | export 316 | replicate : Monad m => Int -> a -> Stream (Of a) m () 317 | replicate n x = take n (repeat {r=()} x) 318 | 319 | -- export 320 | -- replicateM : Monad m => Int -> m a -> Stream (Of a) m () 321 | -- replicateM n x = take n (repeat x) 322 | 323 | export 324 | %inline 325 | zip : Monad m => Stream (Of a) m r -> Stream (Of b) m r -> Stream (Of (a,b)) m r 326 | zip = zipWith MkPair 327 | 328 | export 329 | iterate : Monad m => (a -> a) -> a -> Stream (Of a) m r 330 | iterate f x = effect $ pure $ wrap $ x :> iterate f (f x) 331 | 332 | -- Helper, I seem to use it a lot but haskell 'streaming' doesn't have it, am I 333 | -- doing something wrong? 334 | -- Not quite sure about its execution complexity with the naive rev style 335 | export 336 | rev : Monad m => Stream (Of a) m r -> Stream (Of a) m r 337 | rev str0 = effect $ do 338 | Right (x :> str) <- inspect str0 339 | | Left l => pure . pure $ l 340 | pure $ rev str <* yield x 341 | 342 | ||| This is quite strict but it also that way in the haskell implementation 343 | ||| because Step is strict there and only lazy in the 2nd field of Of, which we 344 | ||| use immediately here, so it's fully strict. 345 | export 346 | effects : Monad m => Stream (Of a) m r -> m r 347 | effects = streamFold pure join sndOf 348 | -- effects (Return x) = pure x 349 | -- effects (Effect x) = x >>= effects 350 | -- effects (Step (x :> y)) = effects y -- too strict 351 | -- effects (Build f) = effects (streamBuild f) 352 | 353 | 354 | -- drained :: Monad m => Stream (Of a) m (Stream (Of b) m r) -> Stream (Of a) m r 355 | export 356 | drained : (Monad m, Monad (t m), Functor (t m), MonadTrans t) 357 | => t m (Stream (Of a) m r) -> t m r 358 | drained = join . map (lift . effects) 359 | 360 | ||| strictly take some of a stream and preserve the return type, it's barely 361 | ||| worth it given that it's strict on the whole stream 362 | export -- t is hard to deduce for the compiler so we help it along 363 | take'' : Monad m => Int -> Stream (Of a) m r -> Stream (Of a) m r 364 | take'' n = drained {t=Stream (Of a)} . splitsAt n 365 | -------------------------------------------------------------------------------- /src/Streaming/Bytes.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Bytes 2 | 3 | import Streaming 4 | -- import Streaming.Internal 5 | 6 | import System.File 7 | 8 | import Util 9 | 10 | import Control.Monad.Trans -- intercalates needs it 11 | 12 | {- This module provides ways of constructing streams of bytes (Bits8) and some 13 | basic manipulations of them. 14 | -} 15 | 16 | export 17 | lines : Monad m => Stream (Of Bits8) m a -> Stream (Stream (Of Bits8) m) m a 18 | lines = split (==10) 19 | 20 | export 21 | words : Monad m => Stream (Of Bits8) m a -> Stream (Stream (Of Bits8) m) m a 22 | words = split (==32) 23 | 24 | export 25 | unlines : Monad m => Stream (Stream (Of Bits8) m) m a -> Stream (Of Bits8) m a 26 | unlines str = intercalates (yield 10) str <* yield 10 27 | 28 | export 29 | unwords : Monad m => Stream (Stream (Of Bits8) m) m a -> Stream (Of Bits8) m a 30 | unwords = intercalates (yield 32) 31 | 32 | export 33 | charCast : Bits8 -> Char 34 | charCast r = cast (cast {to=Int} r) 35 | 36 | -- I expect file primitives to eventually provide Bits8 rather than Char as they 37 | -- do now, in the mean time we cast to Bits8. This is currently correct to do as 38 | -- these are really a 'c char' which is 8 bits. 39 | export 40 | ||| A stream of Bits8 as read from an open File from its current position, i.e. fgetc 41 | bits8FromFile : HasIO io => File -> Stream (Of Bits8) io () 42 | bits8FromFile handle = Build (\r,eff,step => bef handle r eff step) 43 | where 44 | bef : File -> (() -> b) -> (eff : io b -> b) -> (step : Of Bits8 b -> b) -> b 45 | bef file r eff step = eff $ do 46 | Right c <- fGetChar file 47 | | Left err => do Prelude.printLn "file read error" 48 | pure (r ()) 49 | -- We check here since fEOF doesn't seem to be set by next Step. 50 | False <- fEOF file 51 | | True => pure (r ()) 52 | pure $ step (cast (cast {to=Int} c) :> bef file r eff step) 53 | 54 | export 55 | ||| Open a file and read it as a stream of Bits8 56 | bits8FromFile' : HasIO io => String -> Stream (Of Bits8) io (Either FileError ()) 57 | bits8FromFile' file0 = effect $ do 58 | Right f <- openFile file0 Read 59 | | Left err => pure . pure $ Left err 60 | pure $ Build (\r,eff,step => bef f r eff step) 61 | where 62 | bef : File -> (Either FileError () -> b) -> (eff : io b -> b) 63 | -> (step : Of Bits8 b -> b) -> b 64 | bef file r eff step = eff $ do 65 | Right c <- fGetChar file 66 | | Left err => do Prelude.printLn "file read error" 67 | closeFile file 68 | pure (r (Left err)) 69 | -- We check here since fEOF doesn't seem to be set by next Step. 70 | False <- fEOF file 71 | | True => closeFile file *> pure (r (Right ())) 72 | pure $ step (cast (cast {to=Int} c) :> bef file r eff step) 73 | 74 | %foreign "C:fputc,libc" 75 | prim_fputc : Int -> FilePtr -> PrimIO Int 76 | 77 | fputc : HasIO io => File -> Bits8 -> io (Either FileError ()) 78 | fputc (FHandle ptr) b = do 79 | let c = cast b 80 | c' <- primIO $ prim_fputc c ptr 81 | pure $ if c' == c 82 | then Right () 83 | else Left FileWriteError 84 | 85 | export 86 | ||| A stream of Bits8 as read from a File from its current position, e.g. fgetc 87 | byteToFile : HasIO io => File -> Stream (Of Bits8) io r -> io (Either FileError r) 88 | byteToFile handle = streamFold (pure . Right) join (bef handle) 89 | where 90 | bef : File -> Of Bits8 (io (Either FileError r)) -> io (Either FileError r) 91 | bef file (b :> r) = do 92 | Right _ <- fputc file b 93 | | Left err => do Prelude.printLn "file read error" 94 | pure (Left err) 95 | -- We check here since fEOF doesn't seem to be set by next Step. 96 | False <- fEOF file 97 | | True => pure (Left FileWriteError) 98 | r 99 | -------------------------------------------------------------------------------- /src/Streaming/Char.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Char 2 | 3 | import Streaming 4 | -- import Streaming.Internal 5 | 6 | import Control.Monad.Trans 7 | 8 | {- This module eventually provides ways of constructing streams of Char and some 9 | basic manipulations of them. 10 | -} 11 | 12 | export 13 | lines : Monad m => Stream (Of Char) m a -> Stream (Stream (Of Char) m) m a 14 | lines = split (=='\n') 15 | 16 | export 17 | words : Monad m => Stream (Of Char) m a -> Stream (Stream (Of Char) m) m a 18 | words = split (==' ') 19 | 20 | export 21 | unlines : Monad m => Stream (Stream (Of Char) m) m a -> Stream (Of Char) m a 22 | unlines str = intercalates (yield '\n') str <* yield '\n' 23 | 24 | export 25 | unwords : Monad m => Stream (Stream (Of Char) m) m a -> Stream (Of Char) m a 26 | unwords = intercalates (yield ' ') 27 | -------------------------------------------------------------------------------- /src/Streaming/Encoding/Base64.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Encoding.Base64 2 | 3 | 4 | import Streaming.Internal as S 5 | import Streaming.API as S 6 | 7 | import Data.Functor.Of 8 | 9 | import Streaming.Bytes 10 | 11 | import System.File 12 | 13 | import Data.Strings 14 | 15 | -- import Data.LazyList 16 | import Data.List -- zip 17 | 18 | import Data.IOArray 19 | 20 | import Control.Monad.State 21 | 22 | import Util 23 | 24 | import Language.Reflection 25 | 26 | import public Streaming.Encoding.Base64.Alphabet 27 | 28 | 29 | -- base64 is an encoding _from_ binary data _to_ binary data matching a 30 | -- restricted alphabet of characters. 31 | -- https://tools.ietf.org/rfc/rfc4648#section-1 32 | 33 | export 34 | data EncodeError = CodepointOutOfRange 35 | | InvalidStartByte Bits8 36 | | CodepointEndedEarly 37 | 38 | export 39 | Show EncodeError where 40 | show CodepointOutOfRange = "CodepointOutOfRange" 41 | show (InvalidStartByte x) = "InvalidStartByte " ++ show x 42 | show CodepointEndedEarly = "CodepointEndedEarly" 43 | 44 | export 45 | data DecodeError = CharNotInAlphabet Char | DataEndedEarly | TooMuchPadding 46 | 47 | export 48 | Show DecodeError where 49 | show (CharNotInAlphabet x) = "CharNotInAlphabet: " ++ show x 50 | show DataEndedEarly = "Encoded data ended early" 51 | show TooMuchPadding = "TooMuchPadding" 52 | 53 | -- base64 can't have a decode error because it pads missing bits. 54 | export 55 | encodeBase64 : Monad m => Alphabet -> Stream (Of Bits8) m r 56 | -> Stream (Of Char) m r 57 | encodeBase64 alph str0 58 | = str0 &$ 59 | chunksOf 3 -- this foldl needs to account for folding over 3 instead of less 60 | |> mapf (store (\str => foldl (\acc,b => shiftL acc 8 .|. cast b) 0 61 | (take'' 3 $ str <* replicate 3 0)) -- pad to 3 62 | |> length -- <^ compute length and combine bits in one pass 63 | |> \res => effect $ do 64 | len :> b <- res 65 | pure $ case len of 66 | 1 => splitGroup 2 b <* yield 65 <* yield 65 -- pads 67 | 2 => splitGroup 3 b <* yield 65 68 | _ => splitGroup 4 b) 69 | -- ^ Combine up to three Bits8, note the number we got, split based on it 70 | |> concats 71 | |> encode alph 72 | where 73 | -- Split the Int into 4 six bit parts. Left as Int to skip a cast. 74 | -- Because we construct the pieces ourself we don't need to do checks later 75 | -- to be sure our Int fits into our alphabet. Their size means they must. 76 | splitGroup : forall r. Int -> Of Int r -> Stream (Of Int) m r 77 | splitGroup n (x :> r) = (iterate (`shiftR`6) x 78 | &$ take {r=()} 4 79 | |> maps (.&. 0x3F) 80 | |> rev -- the shifting makes the order backward 81 | |> take n) *> pure r 82 | -- e. = 101 46 83 | -- Z S 4 = 25 28 56 84 | -- A G U u = 0 6 20 46 85 | -- Take our six bit parts and convert them to chars. 86 | encode : forall r. Alphabet -> Stream (Of Int) m r -> Stream (Of Char) m r 87 | encode alph str0 = effect $ do 88 | Right (b :> str) <- inspect str0 89 | | Left r => pure . pure $ r 90 | pure $ if b == 65 -- pad 91 | then yield alph.pad *> encode alph str 92 | else yield (alph.toChar b) *> encode alph str 93 | 94 | -- What to do if encoded data ends early? 95 | -- Return what was decoded and the rest of the stream? 96 | ||| decode Char (from an Alphabet) to binary data 97 | export 98 | decodeBase64 : Monad m => Alphabet -> Stream (Of Char) m r 99 | -> Stream (Of Bits8) m (Either DecodeError r) 100 | decodeBase64 alph str0 = str0 101 | &$ S.filter (not . alph.whitespace) -- ignore whitespace 102 | |> validate alph 103 | |> chunksOf 4 104 | |> mapf (graft alph) 105 | |> concats 106 | where 107 | -- Ensure the encountered character is part of our alphabet 108 | validate : forall r. Alphabet -> Stream (Of Char) m r 109 | -> Stream (Of Char) m (Either DecodeError r) 110 | validate alph str0 = effect $ do 111 | Right (c :> str) <- inspect str0 112 | | Left l => pure . pure . Right $ l 113 | pure $ if c /= alph.pad 114 | then case alph.fromChar c of 115 | Nothing => pure . Left $ CharNotInAlphabet c 116 | Just _ => wrap (c :> validate alph str) 117 | else wrap (c :> validate alph str) 118 | 119 | -- Split the collected bytes into `n` eight bit parts. 120 | splitGroup : forall r. Int -> Of Int r -> Stream (Of Bits8) m r 121 | splitGroup n (x :> r) = (iterate (`shiftR`8) x 122 | &$ take {r=()} 3 123 | |> rev 124 | |> take n 125 | |> maps cast) -- the shifting makes the order backward 126 | *> Return r 127 | -- process 4 chars into 3 bytes 128 | -- store, check length gotten, unSplit, use what length demands pad otherwise 129 | graft : forall r. Alphabet -> Stream (Of Char) m r -> Stream (Of Bits8) m r 130 | graft alph str0 = str0 &$ store (maps (maybe 0 id . alph.fromChar) 131 | |> foldl (\acc,c => shiftL acc 6 .|. c) 0) -- merge chars) 132 | |> (length . S.filter (/= alph.pad)) 133 | |> \x => effect $ do 134 | len :> res <- x 135 | case len of 136 | -- 1 => pure . pure $ Left TooMuchPadding 137 | 2 => pure (splitGroup 1 res) 138 | 3 => pure (splitGroup 2 res) 139 | _ => pure (splitGroup len res) 140 | -- doesn't quite handle padding right yet 141 | -------------------------------------------------------------------------------- /src/Streaming/Encoding/Base64/Alphabet.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Encoding.Base64.Alphabet 2 | 3 | import Util -- Char instances 4 | 5 | import Data.List 6 | 7 | import Data.AVL 8 | 9 | import Data.AVL 10 | 11 | -- Alphabets MUST BE 64 characters, 0-63 not including pad, this is the base64. 12 | public export 13 | record Alphabet where 14 | constructor MkAlphabet 15 | toChar : Int -> Char -- to/from the 64 16 | fromChar : Char -> Maybe Int -- to/from the 64 17 | pad : Char -- not part of the 64 18 | whitespace : Char -> Bool -- not part of the 64 19 | 20 | -- An array lookup would be better for toChar 21 | -- ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['+','/'] 22 | export 23 | standardAlphabet : Alphabet 24 | standardAlphabet 25 | = let chars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['+','/'] 26 | arf1 = fromList (zip [0..63] chars) -- basic BST for log(n) lookup 27 | arf2 = fromList (zip chars [0..63]) -- basic BST for log(n) lookup 28 | in MkAlphabet 29 | (\i => maybe 'A' id (lookup i arf1)) 30 | -- (\c => fst <$> find ((== c) . snd) alph) 31 | (\c => lookup c arf2) 32 | '=' 33 | (`elem` ['\n','_']) 34 | -------------------------------------------------------------------------------- /src/Streaming/Encoding/UTF8.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Encoding.UTF8 2 | 3 | import Streaming.Internal as S 4 | import Streaming.API as S 5 | 6 | import Util 7 | 8 | export 9 | data DecodeError = CodepointOutOfRange 10 | | InvalidStartByte Bits8 11 | | CodepointEndedEarly 12 | 13 | export 14 | Show DecodeError where 15 | show CodepointOutOfRange = "CodepointOutOfRange" 16 | show (InvalidStartByte x) = "InvalidStartByte " ++ show x 17 | show CodepointEndedEarly = "CodepointEndedEarly" 18 | 19 | export 20 | data EncodeError = EncCodepointOutOfRange 21 | 22 | export 23 | Show EncodeError where 24 | show EncCodepointOutOfRange = "CodepointOutOfRange" 25 | 26 | -- check leading bit, use that to 'split off' the number of extra Bits8 needed. 27 | -- Check the split stream to make sure those all have follower bits and .|. them 28 | -- together into a larger type (int) after adjusting their position. If they 29 | -- don't all match then error out, if they do call it a Char. 30 | -- store, conceptually, acts on a copy of the substream we're splitting off 31 | -- so we can check validity and roll up the bits at the same time. 32 | -- messy messy coding, but working, I really need to learn bits better 33 | export 34 | decodeUtf8 : Monad m => Stream (Of Bits8) m r 35 | -> Stream (Of Char) m (Either DecodeError r) 36 | decodeUtf8 str0 = effect $ do 37 | Right (b :> str) <- inspect str0 38 | | Left l => pure . pure . pure $ l -- so pure 39 | case min 4 (leadingBits b) of 40 | 0 => pure $ wrap (bits8ToChar b :> decodeUtf8 str) -- need Delay? 41 | 1 => pure . pure . Left $ InvalidStartByte b 42 | x => let x' = x - 1 in 43 | str &$ splitsAt x' 44 | |> store ( maps cast -- Move to Int 45 | |> cons (maskMarker x' b) -- add lead bit to stream front 46 | |> S.foldl collect 0) -- combine stream's bits 47 | |> S.all ((1 ==) . leadingBits) -- requisit bits matched? 48 | |> \res => do 49 | True :> n :> s <- res 50 | | _ => pure . pure . Left $ CodepointEndedEarly 51 | pure $ if n < 0 || n > 0x10FFFF 52 | then pure . Left $ CodepointOutOfRange 53 | else wrap (cast n :> decodeUtf8 s) 54 | where -- 😀 = \128512 = 0x1F600 55 | maskMarker : (c : Int) -> Bits8 -> Int 56 | maskMarker c b = shiftL (shiftR 0xFF (c+3) .&. cast b) (6 * c+1) 57 | 58 | collect : Int -> Int -> Int 59 | collect acc x = shiftL acc 6 .|. (x .&. 0x3F) 60 | 61 | private 62 | %inline 63 | if' : Bool -> a -> a -> a 64 | if' x y z = if x then y else z 65 | 66 | -- determine our codepoint, split into requisite pieces, cast, mask, stream 67 | -- phew, how do I clean this up a bit? 68 | private 69 | encode : Monad m => Char -> Stream (Of Bits8) m (Either EncodeError ()) 70 | encode c = let ic = ord c 71 | in if' (ic <= 0x00007F) (map Right (enc 1 ic)) 72 | $ if' (ic <= 0x0007FF) (map Right (enc 2 ic)) 73 | $ if' (ic <= 0x00FFFF) (map Right (enc 3 ic)) 74 | $ if' (ic <= 0x10FFFF) (map Right (enc 4 ic)) 75 | $ pure (Left EncCodepointOutOfRange) 76 | where 77 | -- separate our codepoint into a stream of Bits8 then mask it off 78 | -- e.g. 32767 is 13 1-bits or 111111111111111 79 | -- our splitting here shifts the number 6 bits each iteration 80 | -- step1: 111111111111111 And masked: 10111111 81 | -- step2: 000000111111111 10111111 82 | -- step3: 000000000000111 10000111 83 | shiftedBytes : Int -> Stream (Of Bits8) m r 84 | shiftedBytes x 85 | = maps (\b => cast (0x80 .|. (b .&. 0x3F))) (iterate (`shiftR`6) x) 86 | -- Set up the starting byte that encodes what bytes follow: 87 | -- The count of leading 1's, terminated by a 0, says how many parts a 88 | -- codepoint has, e.g. codepoint 128512 is a 4 byte codepoint, it happens 89 | -- to start with the exact byte 11110000. Conceptually separated as 90 | -- 1111|0|000, 4 1's to show the count of bytes that make the codepoint, 91 | -- a terminator bit 0, and the first 3 bits of the codepoint. 92 | -- I suspect these teminator bits aren't really neccesary and are perhaps 93 | -- for utf16's use. 94 | encstart : (n : Int) -> (ic : Int) -> Bits8 95 | encstart 1 ic = cast ic 96 | encstart n ic = 97 | cast $ shiftL 0xFE (8 - (n+1)) -- starting bit mask 98 | .|. (shiftR 0xFF (n+1) .&. shiftR ic (8 * n)) -- mask and fill bits 99 | 100 | -- Combine our starting byte and the shifted follower bytes. 101 | enc : (n : Int) -> (ic : Int) -> Stream (Of Bits8) m () 102 | enc n ic = encstart n ic 103 | `cons` rev (take {r=()} (n - 1) (shiftedBytes ic)) 104 | 105 | export 106 | encodeUtf8 : Monad m => Stream (Of Char) m r 107 | -> Stream (Of Bits8) m (Either EncodeError r) 108 | encodeUtf8 str0 = effect $ do 109 | Right (c :> str) <- inspect str0 110 | | Left l => pure (pure (Right l)) 111 | pure $ encode c *> encodeUtf8 str 112 | -------------------------------------------------------------------------------- /src/Streaming/Internal.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Internal 2 | 3 | import Control.Monad.Trans 4 | import Control.Monad.Reader 5 | import Control.Monad.State 6 | 7 | import public Data.Functor.Of 8 | import public Data.Functor.Compose 9 | 10 | import Control.Monad.Managed 11 | 12 | -- Do I need builder-style stream fusion? If everything I do is a 'step' then 13 | -- what is there to fuse? Sure it should help for operations on the result type, 14 | -- but does it help for the stream state? 15 | 16 | ||| A neat bonus to the Build constructor is that we don't have to 'case' as 17 | ||| often when writing our functions because we can just farm out to Build which 18 | ||| streamFold will eventually case for us. 19 | ||| The Linearities are to satisfy HasIO, they might not stay. 20 | public export 21 | data Stream : (f : Type -> Type) -> (m : Type -> Type) -> Type -> Type where 22 | Return : (1 _ : r) -> Stream f m r 23 | ||| This is probably too strict right now, Step is strict in haskell but Effect is not 24 | Effect : (1 _ : m (Stream f m r)) -> Stream f m r 25 | Step : (1 _ : f (Stream f m r)) -> Stream f m r 26 | ||| Fusion constructor 27 | ||| We don't have a serious rewrite system in idris2 yet so this does the job 28 | ||| of fusing as long as we're careful about using streamFold and Build 29 | ||| whenever we can. 30 | Build : (1 _ : (forall b. (r -> b) -> (m b -> b) -> (f b -> b) -> b)) -> Stream f m r 31 | 32 | %name Streaming.Internal.Stream str,str2,str3 33 | 34 | export 35 | streamBuild : (forall b. (r -> b) -> (m b -> b) -> (f b -> b) -> b) 36 | -> Stream f m r 37 | streamBuild = \phi => phi Return Effect Step 38 | 39 | export 40 | streamFold : (Functor f, Monad m) 41 | => (r -> b) -> (m b -> b) -> (f b -> b) -> Stream f m r -> b 42 | streamFold done effect construct (Return x) = done x 43 | streamFold done effect construct (Effect x) 44 | = effect (streamFold done effect construct <$> x) 45 | streamFold done effect construct (Step x) 46 | = construct (streamFold done effect construct <$> x) 47 | streamFold done effect construct (Build g) = g done effect construct 48 | 49 | -- %transform "dsfsdf" streamFold return_ effect_ step_ (streamBuild psi) = psi return_ effect_ step_ 50 | 51 | export 52 | destroy : (Functor f, Monad m) 53 | => Stream f m r -> (f b -> b) -> (m b -> b) -> (r -> b) -> b 54 | destroy stream construct effect done = streamFold done effect construct stream 55 | 56 | mutual 57 | public export 58 | implementation 59 | (Functor f, Monad m) => Functor (Stream f m) where 60 | map f x = Build (\r,eff,step => streamFold (r . f) eff step x) 61 | 62 | public export 63 | implementation 64 | (Functor f, Monad m) => Applicative (Stream f m) where 65 | pure = Return 66 | x <*> y = do f <- x 67 | v <- y 68 | pure (f v) 69 | public export 70 | implementation 71 | (Functor f, Monad m) => Monad (Stream f m) where 72 | x >>= k = Build (\r,eff,step => streamFold (streamFold r eff step . k) eff step x) 73 | 74 | -- Alternative (Stream f m) where 75 | 76 | public export -- public, we're exporting Stream currently anyway 77 | %inline 78 | wrap : (Functor f, Monad m) => f (Stream f m a) -> Stream f m a 79 | -- wrap x = Build (\r,eff,step => step $ map (streamFold r eff step) x) 80 | wrap = Step 81 | 82 | 83 | public export -- public, we're exporting Stream currently anyway 84 | %inline 85 | effect : (Functor f, Monad m) => m (Stream f m r) -> Stream f m r 86 | effect = Effect 87 | 88 | export 89 | inspect : (Functor f, Monad m) 90 | => Stream f m r -> m (Either r (f (Stream f m r))) 91 | inspect str 92 | = streamFold 93 | (pure . Left) 94 | join 95 | -- We compress the guts and then reconstruct around it. 96 | (pure . (Right . map (Effect {f} {m} . map (either Return Step)))) 97 | str 98 | 99 | export 100 | unfold : (Functor f, Monad m) 101 | => (s -> m (Either r (f s))) -> s -> Stream f m r 102 | unfold step s = Effect $ do 103 | Right fs <- step s 104 | | Left r => pure (Return r) 105 | pure (Step (unfold step <$> fs)) 106 | 107 | -- unfold inspect = id 108 | baf : (Functor f, Monad m) => Stream f m r -> Stream f m r 109 | baf = unfold inspect 110 | 111 | infixr 2 |> -- flip . 112 | export 113 | ||| reversed . for forward combination of stream operations 114 | (|>) : (a -> b) -> (b -> c) -> a -> c 115 | f |> g = \x => g (f x) 116 | 117 | infixl 1 &$ -- flip $ 118 | export 119 | ||| reversed $ for forward combination of stream operations 120 | (&$) : a -> (a -> b) -> b 121 | x &$ f = f x 122 | 123 | ------------------------------------------------- 124 | -- Maps 125 | -- Mind that these don't share the same naming scheme as Haskell's 'streaming' 126 | ------------------------------------------------- 127 | 128 | export 129 | ||| map(f): Target the (f)unctor of `Stream f m r`. 130 | mapf : (Functor f, Monad m) 131 | => (forall x. f x -> g x) -> Stream f m r -> Stream g m r 132 | mapf f s = Build (\r,eff,step => streamFold r eff (step . f) s) 133 | 134 | export 135 | ||| map(s): Target (s)tream _values_ of `Stream (Of s) m r`. 136 | maps : Monad m 137 | => (a -> b) -> Stream (Of a) m r -> Stream (Of b) m r 138 | maps f s = mapf (mapFst f) s 139 | 140 | export 141 | ||| map(f)M: Effectfully target the (f)unctor of `Stream f M r`. 142 | mapfM : (Monad m, Functor f) 143 | => (forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r 144 | mapfM f s = Build (\r,eff,step => streamFold r eff (eff . map step . f) s) 145 | 146 | export 147 | ||| map(s)M: Effectfully target (s)tream _values_ of `Stream (Of s) M r`. 148 | mapsM : Monad m 149 | => (a -> m b) -> Stream (Of a) m r -> Stream (Of b) m r 150 | mapsM f s = mapfM (\(c :> g) => (:> g) <$> f c) s 151 | 152 | export 153 | ||| hoist: Target the (m)onad of a `Stream (Of s) m r` 154 | hoist : (Functor f, Monad m) 155 | => (forall x. m x -> n x) -> Stream f m r -> Stream f n r 156 | hoist f str = Build (\r,eff,step => streamFold r (eff . f) step str) 157 | 158 | export 159 | decompose : (Functor f, Monad m) 160 | => Stream (Compose m f) m r -> Stream f m r 161 | decompose g 162 | = Build (\r,eff,step => streamFold r eff (eff . map step . getCompose) g) 163 | 164 | export 165 | run : Monad m => Stream m m r -> m r 166 | run (Return x) = pure x 167 | run (Effect x) = x >>= run 168 | run (Step x) = x >>= run 169 | run (Build g) = run (streamBuild g) -- probably reasonable, we're running after all 170 | 171 | export 172 | mapsM_ : (Monad m, Functor f) => (forall x . f x -> m x) -> Stream f m r -> m r 173 | mapsM_ f = run . mapf f 174 | 175 | ||| This specializes to e.g. 176 | ||| intercalates :: (Monad m, Functor f) => Stream f m () 177 | ||| -> Stream (Stream f m) m r -> Stream f m r 178 | export 179 | intercalates : (Monad m, Monad (t m), MonadTrans t) 180 | => t m x -> Stream (t m) m r -> t m r 181 | intercalates sep (Return y) = pure y 182 | intercalates sep (Effect y) = lift y >>= intercalates sep 183 | intercalates sep (Step y) = do 184 | f' <- y 185 | steps sep f' 186 | where 187 | steps : t m x -> Stream (t m) m r -> t m r 188 | steps sep (Return y) = pure y 189 | steps sep (Effect y) = lift y >>= steps sep 190 | steps sep (Step y) = do 191 | sep 192 | f' <- y 193 | steps sep f' 194 | steps sep (Build g) = intercalates sep (streamBuild g) 195 | intercalates sep (Build g) = intercalates sep (streamBuild g) 196 | 197 | public export 198 | (Functor f, HasIO m) => HasIO (Stream f m) where 199 | liftIO act = Effect (liftIO $ io_bind act (pure . Return)) 200 | 201 | public export 202 | Functor f => MonadTrans (Stream f) where 203 | lift = Effect . map Return 204 | 205 | public export 206 | (Functor f, MonadManaged m) => MonadManaged (Stream f m) where 207 | use res = lift (use res) 208 | 209 | public export 210 | (Functor f, MonadReader r m) => MonadReader r (Stream f m) where 211 | ask = lift ask 212 | local f = hoist (local f) 213 | 214 | public export 215 | (Functor f, MonadState s m) => MonadState s (Stream f m) where 216 | get = lift get 217 | put s = lift (put s) 218 | 219 | ||| Run stream1 then stream2, <+> the results of each. 220 | public export 221 | (Semigroup r, Functor f, Monad m) => Semigroup (Stream f m r) where 222 | str <+> str2 = Build (\r,eff,step => streamFold (\v => streamFold (r . (v <+>)) 223 | eff step str2) eff step str) 224 | 225 | public export 226 | (Monoid r, Functor f, Monad m) => Monoid (Stream f m r) where 227 | neutral = pure neutral 228 | -------------------------------------------------------------------------------- /src/Streaming/Network/Curl.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Network.Curl 2 | 3 | import Streaming 4 | 5 | import Data.LazyList as L 6 | 7 | import Data.IORef 8 | 9 | import Data.Buffer 10 | 11 | import Control.Monad.Trans 12 | import Control.Monad.Managed 13 | import Network.Curl.Easy 14 | 15 | import Streaming.API as S 16 | import Streaming.Encoding.UTF8 17 | 18 | -- This is just an experiment right now, don't take it as the right way to go 19 | 20 | -- ioref seems good still 21 | streamCallback : IORef (LazyList String) -> (Buffer -> Int -> Int -> AnyPtr -> PrimIO Int) 22 | streamCallback ref str s len _ = toPrim $ do 23 | got <- rawSize str 24 | gr <- map (cast {to=Bits8}) <$> bufferData str 25 | xs :> Right _ <- S.toList $ decodeUtf8 (each'' gr) 26 | | _ => pure 0 27 | modifyIORef ref (pack xs ::) 28 | pure got 29 | 30 | mGlobalInit : Managed CurlECode 31 | mGlobalInit = managed $ \f => do 32 | ctx <- curlGlobalInit 33 | r <- f ctx 34 | curlGlobalCleanup 35 | pure r 36 | 37 | mEasyInit : Managed (Maybe (CurlHandle Easy)) 38 | mEasyInit = managed $ \f => do 39 | h <- curlEasyInit 40 | case h of 41 | Nothing => f h 42 | Just h' => do r <- f h 43 | curlEasyCleanup h' 44 | pure r 45 | 46 | -- I need to set my callback and then call perform 47 | export 48 | curl : String -> Stream (Of Bits8) Managed (Either String ()) 49 | curl url = effect $ do 50 | CURLE_OK <- mGlobalInit 51 | | r => pure (pure (Left $ "global init not ok: " ++ show r)) 52 | Just h <- mEasyInit 53 | | Nothing => pure (pure (Left $ "easy init not ok")) 54 | CURLE_OK <- curlEasySetopt h CURLOPT_URL url 55 | | r => pure (pure (Left $ "setopt not ok: " ++ show r)) 56 | CURLE_OK <- curlEasySetopt h CURLOPT_URL url 57 | | r => pure (pure (Left $ "setopt not ok: " ++ show r)) 58 | -- easy_to_bytes h 59 | ref <- newIORef {a=LazyList String} [] 60 | CURLE_OK <- curlEasySetopt h CURLOPT_WRITEFUNCTION (streamCallback ref) 61 | | r => pure (pure (Left $ "setopt not ok: " ++ show r)) 62 | CURLE_OK <- curlEasyPerform h 63 | | r => pure (pure (Left $ "perform not ok: " ++ show r)) 64 | dat <- readIORef ref 65 | pure $ the (Stream (Of Bits8) Managed (Either String ())) 66 | $ each dat 67 | &$ mapf (\(x :> r) => each {m=Managed} (unpack x) *> pure r) 68 | |> concats 69 | |> maps (cast . cast {to=Int}) 70 | |> (*> pure (Right ())) 71 | 72 | 73 | -------------------------------------------------------------------------------- /src/Streaming/Streams.idr: -------------------------------------------------------------------------------- 1 | module Streaming.Streams 2 | 3 | import Streaming.Internal as S 4 | import Streaming.API as S 5 | 6 | import Data.Functor.Of 7 | 8 | import System.File 9 | 10 | import Data.Strings 11 | 12 | import Util 13 | 14 | export 15 | data DecodeError = CodepointOutOfRange 16 | | InvalidStartByte Bits8 17 | | CodepointEndedEarly 18 | 19 | export 20 | Show DecodeError where 21 | show CodepointOutOfRange = "CodepointOutOfRange" 22 | show (InvalidStartByte x) = "InvalidStartByte " ++ show x 23 | show CodepointEndedEarly = "CodepointEndedEarly" 24 | 25 | export 26 | data EncodeError = EncCodepointOutOfRange 27 | -- data EncodeError = CodepointOutOfRange 28 | -- | InvalidStartByte Bits8 29 | -- | CodepointEndedEarly 30 | -- 31 | -- export 32 | export 33 | Show EncodeError where 34 | show EncCodepointOutOfRange = "CodepointOutOfRange" 35 | -- show (InvalidStartByte x) = "InvalidStartByte " ++ show x 36 | -- show CodepointEndedEarly = "CodepointEndedEarly" 37 | 38 | {- 39 | The intent of this module is to provide common stream sources, it's not very 40 | thought-through at the moment and is mostly used as a testbed for things that 41 | move elsewhere. 42 | -} 43 | 44 | export 45 | stdinLn : HasIO io => Stream (Of String) io () 46 | stdinLn = effect $ do 47 | False <- fEOF stdin 48 | | True => pure (Return ()) 49 | x <- getLine 50 | pure $ wrap (x :> stdinLn) 51 | 52 | -- readFile : HasIO io => 53 | 54 | -- stdinLn : HasIO io => Stream (Of String) io () 55 | -- stdinLn = ?sdff 56 | -- streamFold pure join (\(s :> act) => putStrLn s *> act) str 57 | -- fflush stdout 58 | 59 | export 60 | stdoutLn : HasIO io => Stream (Of String) io () -> io () 61 | stdoutLn str = do 62 | streamFold pure join (\(s :> act) => putStrLn s *> act) str 63 | fflush stdout 64 | 65 | export 66 | stdoutChr : HasIO io => Stream (Of Char) io () -> io () 67 | stdoutChr str = do 68 | streamFold pure join (\(s :> act) => putChar s *> act) str 69 | fflush stdout 70 | 71 | export 72 | stdoutChrLn : HasIO io => Stream (Of Char) io () -> io () 73 | stdoutChrLn str = do 74 | streamFold pure join (\(s :> act) => putChar s *> act) str 75 | putChar '\n' 76 | fflush stdout 77 | 78 | export 79 | stdoutChrLn' : HasIO io => Stream (Of Char) io r -> io r 80 | stdoutChrLn' str = do 81 | r <- streamFold pure join (\(s :> act) => putChar s *> act) str 82 | putChar '\n' 83 | fflush stdout 84 | pure r 85 | 86 | {- 87 | 88 | >>> S.sum $ S.take 3 (S.readLn :: Stream (Of Int) IO ()) 89 | 1 90 | 2 91 | 3 92 | 6 :> () 93 | 94 | >>> S.stdoutLn $ S.map (map toUpper) $ S.take 2 S.stdinLn 95 | hello 96 | HELLO 97 | world! 98 | WORLD! 99 | 100 | -} 101 | 102 | 103 | ofHandle : File -> Stream (Of Char) IO () 104 | ofHandle handle = Build (\r,eff,step => bef handle r eff step) 105 | where 106 | bef : File -> (() -> b) -> (eff : IO b -> b) -> (step : Of Char b -> b) -> b 107 | bef file r eff step = eff $ do 108 | False <- fEOF file 109 | | True => r <$> pclose file 110 | Right c <- fGetChar file 111 | | Left err => do Prelude.putStrLn "file read error" 112 | r <$> pclose file 113 | pure $ step (c :> bef file r eff step) 114 | 115 | foobaloo1 : IO () 116 | foobaloo1 = do 117 | z <- the (IO (Of Int ())) (sum $ maps cast $ take 3 stdinLn) 118 | printLn z 119 | 120 | 121 | foobaloo2 : IO () 122 | foobaloo2 = stdoutLn $ maps toUpper $ take 2 stdinLn 123 | 124 | foobaloo3 : IO () 125 | foobaloo3 = stdoutLn $ maps toUpper $ stdinLn 126 | -------------------------------------------------------------------------------- /src/Util.idr: -------------------------------------------------------------------------------- 1 | module Util 2 | 3 | -- NB things will need to be removed from here as Idris gains them in the 4 | -- Prelude. 5 | 6 | import System.File 7 | 8 | infixl 1 <&> 9 | export 10 | (<&>) : Functor f => f a -> (a -> b) -> f b 11 | x <&> f = f <$> x 12 | 13 | infixr 1 =<< 14 | export 15 | (=<<) : Monad m => (a -> m b) -> m a -> m b 16 | (=<<) = flip (>>=) 17 | 18 | -- For when Lazy is causing type problems and you want to avoid Force/Delay, or 19 | -- force/delay isn't working as I've noticed it sometimes doesn't. 20 | infixr 4 &&| 21 | export 22 | (&&|) : Bool -> Bool -> Bool 23 | (&&|) x y = x && y 24 | 25 | export 26 | catMaybes : List (Maybe a) -> List a 27 | catMaybes z = foldr (\m,f => maybe f (\x => (x ::) . f) m) id z [] 28 | 29 | export 30 | isJust : Maybe a -> Bool 31 | isJust (Just _ ) = True 32 | isJust _ = False 33 | 34 | export 35 | unzip : List (a,b) -> (List a, List b) 36 | unzip = foldr (\(x,y),(xs,ys) => (x :: xs, y :: ys)) ([],[]) 37 | 38 | -- This is hiiiiiideously slow! maybe it's because I'm using it at elab-time 39 | export 40 | unzip3 : List (a,b,c) -> (List a, List b, List c) 41 | unzip3 [] = ([],[],[]) 42 | unzip3 ((x, (y, z)) :: ls) = let (xs,ys,zs) = unzip3 ls 43 | in (x :: xs, y:: ys, z :: zs) 44 | 45 | export 46 | unless : Applicative f => Bool -> Lazy (f ()) -> f () 47 | unless b act = if b then pure () else act 48 | 49 | public export 50 | monus : Nat -> Nat -> Nat 51 | monus Z _ = Z 52 | monus k Z = k 53 | monus (S k) (S j) = k `monus`j 54 | 55 | export 56 | withFile : HasIO io => String -> Mode -> (Either FileError File -> io a) -> io a 57 | withFile file mode act = do res <- openFile file mode 58 | a <- act res 59 | either (\_ => pure a) 60 | (\f => pure a <* closeFile f) res 61 | 62 | export 63 | on : (b -> b -> c) -> (a -> b) -> a -> a -> c 64 | on f g x y = g x `f` g y 65 | 66 | infixl 9 ^ 67 | export 68 | %foreign "scheme:expt" 69 | (^) : Int -> Int -> Int 70 | 71 | infixl 7 .&. 72 | export 73 | %foreign "scheme:bitwise-and" 74 | (.&.) : Int -> Int -> Int 75 | 76 | infixl 8 .|. 77 | export 78 | %foreign "scheme:bitwise-ior" 79 | (.|.) : Int -> Int -> Int 80 | 81 | %foreign "scheme:bitwise-xor" 82 | export 83 | xor : Int -> Int -> Int 84 | 85 | %foreign "scheme:bitwise-not" 86 | export 87 | not : Int -> Int 88 | 89 | export 90 | leadingBits : Bits8 -> Int 91 | leadingBits b0 = count (cast b0) 7 92 | where 93 | count : Int -> Int -> Int 94 | count b p = if p >= 0 && b .&. shiftL 1 p > 0 95 | then 1 + count b (p - 1) 96 | else 0 97 | 98 | -- Bits8 is always a valid codepoint 99 | export 100 | bits8ToChar : Bits8 -> Char 101 | bits8ToChar = cast . cast {to=Int} 102 | 103 | export 104 | Range Char where 105 | rangeFromTo x y = cast <$> rangeFromTo {a=Int} (cast x) (cast y) 106 | rangeFromThenTo x y z 107 | = cast <$> rangeFromThenTo {a=Int} (cast x) (cast y) (cast z) 108 | rangeFrom x = cast <$> rangeFrom {a=Int} (cast x) 109 | rangeFromThen x y = cast <$> rangeFromThen {a=Int} (cast x) (cast y) 110 | -------------------------------------------------------------------------------- /streaming.ipkg: -------------------------------------------------------------------------------- 1 | package streaming 2 | 3 | authors = "MarcelineVQ" 4 | version = "0.7.4.1" 5 | readme = "README.md" 6 | 7 | homepage = "https://github.com/MarcelineVQ/idris2-streaming" 8 | sourceloc = "https://github.com/MarcelineVQ/idris2-streaming.git" 9 | bugtracker = "https://github.com/MarcelineVQ/idris2-streaming/issues" 10 | 11 | license = "CC0 (refer to LICENSE file)" 12 | brief = "Effectful Streaming for Idris" 13 | modules = 14 | -- Public 15 | Streaming 16 | , Streaming.Streams 17 | , Streaming.Bytes 18 | , Streaming.Char 19 | , Streaming.Encoding.UTF8 20 | , Streaming.Encoding.Base64 21 | , Streaming.Encoding.Base64.Alphabet 22 | 23 | , Streaming.Network.Curl 24 | 25 | , Data.Functor.Of 26 | , Data.Functor.Compose 27 | 28 | , Data.AVL 29 | 30 | , Data.Proxy 31 | , Data.LazyList 32 | 33 | -- Internal 34 | , Streaming.API 35 | , Streaming.Internal 36 | 37 | , Util -- Don't expect this one to always exist. 38 | 39 | sourcedir = "src" 40 | 41 | main = Streaming 42 | 43 | depends = base, contrib, network 44 | , managed, curl 45 | --------------------------------------------------------------------------------