From bd49b84a762720f2865b1e99bb18ce091ad34094 Mon Sep 17 00:00:00 2001 From: Denis Buzdalov Date: Thu, 20 Jun 2024 00:00:57 +0300 Subject: [PATCH] [ new ] Add the implementation for the cozippable interface --- .github/linters/.ecrc | 5 + .github/linters/.jscpd.json | 4 + .github/linters/.markdown-lint.yml | 11 ++ .github/workflows/ci-package.yml | 82 +++++++++++ .github/workflows/ci-super-linter.yml | 41 ++++++ .gitignore | 4 + LICENSE | 202 ++++++++++++++++++++++++++ NOTICE | 2 + README.md | 105 +++++++++++++ cozippable.ipkg | 12 ++ pack.toml | 5 + src/Data/Cozippable.idr | 195 +++++++++++++++++++++++++ tests/Tests.idr | 8 + tests/docs/readme/README.md | 1 + tests/docs/readme/expected | 6 + tests/docs/readme/run | 13 ++ tests/docs/readme/test.ipkg | 3 + tests/tests.ipkg | 8 + 18 files changed, 707 insertions(+) create mode 100644 .github/linters/.ecrc create mode 100644 .github/linters/.jscpd.json create mode 100644 .github/linters/.markdown-lint.yml create mode 100644 .github/workflows/ci-package.yml create mode 100644 .github/workflows/ci-super-linter.yml create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 NOTICE create mode 100644 README.md create mode 100644 cozippable.ipkg create mode 100644 pack.toml create mode 100644 src/Data/Cozippable.idr create mode 100644 tests/Tests.idr create mode 120000 tests/docs/readme/README.md create mode 100644 tests/docs/readme/expected create mode 100755 tests/docs/readme/run create mode 100644 tests/docs/readme/test.ipkg create mode 100644 tests/tests.ipkg diff --git a/.github/linters/.ecrc b/.github/linters/.ecrc new file mode 100644 index 0000000..b682057 --- /dev/null +++ b/.github/linters/.ecrc @@ -0,0 +1,5 @@ +{ + "Disable": { + "IndentSize": true + } +} diff --git a/.github/linters/.jscpd.json b/.github/linters/.jscpd.json new file mode 100644 index 0000000..49a207d --- /dev/null +++ b/.github/linters/.jscpd.json @@ -0,0 +1,4 @@ +{ + "noSymlinks": "true", + "exitCode": 10 +} diff --git a/.github/linters/.markdown-lint.yml b/.github/linters/.markdown-lint.yml new file mode 100644 index 0000000..4eaf44f --- /dev/null +++ b/.github/linters/.markdown-lint.yml @@ -0,0 +1,11 @@ +--- +# https://github.com/DavidAnson/markdownlint/blob/main/doc/Rules.md +first-line-h1: false +blanks-around-fences: false +line-length: + line_length: 148 + code_block_line_length: 148 +no-inline-html: + allowed_elements: + - details + - summary diff --git a/.github/workflows/ci-package.yml b/.github/workflows/ci-package.yml new file mode 100644 index 0000000..b3cf815 --- /dev/null +++ b/.github/workflows/ci-package.yml @@ -0,0 +1,82 @@ +--- +name: Build and test + +on: + push: + branches: + - main + - master + tags: + - '**' + pull_request: + branches: + - main + - master + schedule: + - cron: '0 1 * * *' + +permissions: read-all + +concurrency: + group: ${{ github.workflow }}@${{ github.ref }} + cancel-in-progress: true + +defaults: + run: + shell: bash + +env: + PACK_DIR: /root/.pack + +jobs: + + get-upstream-matrix: + name: Acquire matrix of upstream modes + runs-on: ubuntu-latest + container: ghcr.io/stefan-hoeck/idris2-pack:latest + outputs: + upstream-matrix: "${{ steps.get-upstream-matrix.outputs.upstream-matrix }}" + steps: + - name: Install Git + run: apt-get update && apt-get install git + - name: Get upstream matrix + id: get-upstream-matrix + run: | + CURR="$(idris2 --version | sed 's/.*-//')" + MAIN="$(git ls-remote https://github.com/idris-lang/Idris2 main | head -c 9)" + echo "Current: $CURR, bleeding edge: $MAIN" + if [ "$CURR" == "$MAIN" ]; then + echo 'upstream-matrix=["latest-pack-collection"]' + else + echo 'upstream-matrix=["latest-pack-collection", "bleeding-edge-compiler"]' + fi >> "$GITHUB_OUTPUT" + + build-and-test: + name: Build and test `${{ github.repository }}` + needs: get-upstream-matrix + runs-on: ubuntu-latest + container: ghcr.io/stefan-hoeck/idris2-pack:latest + strategy: + fail-fast: false + matrix: + upstream-mode: ${{ fromJSON(needs.get-upstream-matrix.outputs.upstream-matrix) }} + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Update `pack-db` + run: pack update-db + - name: Switch to the latest compiler, if needed + if: ${{ matrix.upstream-mode == 'bleeding-edge-compiler' }} + run: | + { echo; echo "[idris2]"; echo 'commit = "latest:main"'; } >> pack.toml + pack fetch + - name: Switch to the latest collection + run: pack switch latest + - name: Compute the package name + run: | + echo "package_name=$(sed -e 's|.*/||' -e 's/idris2\?-//' \ + <<< ${{ github.repository }})" >> "$GITHUB_ENV" + - name: Build `${{ env.package_name }}` + run: pack build ${{ env.package_name }} + - name: Test `${{ env.package_name }}` + run: pack test ${{ env.package_name }} diff --git a/.github/workflows/ci-super-linter.yml b/.github/workflows/ci-super-linter.yml new file mode 100644 index 0000000..c478029 --- /dev/null +++ b/.github/workflows/ci-super-linter.yml @@ -0,0 +1,41 @@ +--- +name: Lint + +on: + push: + branches: + - main + - master + tags: + - '*' + pull_request: + branches: + - main + - master + +permissions: + statuses: write + +concurrency: + group: ${{ github.workflow }}@${{ github.ref }} + cancel-in-progress: true + +jobs: + build: + name: Lint Code Base + runs-on: ubuntu-latest + steps: + + - name: Checkout + uses: actions/checkout@v4 + with: + # Full git history is needed to get a proper + # list of changed files within `super-linter` + fetch-depth: 0 + + - name: Lint Code Base + uses: super-linter/super-linter/slim@v6.0.0 + env: + DEFAULT_BRANCH: master + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + IGNORE_GENERATED_FILES: true diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..96c35b8 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +build/ +.build/ +**/tests/failures +**/tests/**/output diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d645695 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/NOTICE b/NOTICE new file mode 100644 index 0000000..c2b640a --- /dev/null +++ b/NOTICE @@ -0,0 +1,2 @@ +Collection utils for Idris 2 +Copyright 2021-2024 Denis Buzdalov diff --git a/README.md b/README.md new file mode 100644 index 0000000..a45dbaa --- /dev/null +++ b/README.md @@ -0,0 +1,105 @@ + + +# Cozippable interface + +Well-known `Zippable` interface (due to its nature) works on a common subpart of collections being zipped. +Say, when you have + +```idris +oneList : List Nat +oneList = [0, 1, 2, 3, 4] + +anotherList : List Nat +anotherList = [10, 20, 30] +``` + +when you zip them + +```idris +ZippedLists : List Nat +ZippedLists = zipWith (+) oneList anotherList +``` + +the resulting list has the length of the shortest one: + +```idris +ZippedListsContents : ZippedLists = [10, 21, 32] +ZippedListsContents = Refl +``` + +But what if we would like to manage all the missing information too? +For that we have `cozip` from this library: + +```idris +CozippedLists : List Nat +CozippedLists = cozipWith (these' 100 200 (+)) oneList anotherList +``` + +In this situation the resulting list has the length of the longest given one, giving us the ability to handle missing values. +In this particular example, we manage missing data by adding `100` and `200` in case of missing stuff in the left and right list, correspondingly. + +Look at the results: + +```idris +CozippedListsContents : CozippedLists = [10, 21, 32, 203, 204] +CozippedListsContents = Refl +``` + +Using the same interface we can manage other data types too. +For example, imagine you have the following maps: + + + +```idris +names : SortedMap Id String +names = fromList [ (0, "John"), (1, "Denis"), (3, "Edwin") ] + +scores : SortedMap Id Nat +scores = fromList [ (1, 5), (3, 100), (15, 1) ] +``` + +Imagine that you want to have composite descriptions without losing any data. +Using `cozip` you can do the following: + +```idris +desc : SortedMap Id String +desc = cozipWith f names scores where + f : These String Nat -> String + f $ This name = name + f $ That score = "unnamed user with score \{score}" + f $ Both name score = "\{name} with score \{score}" +``` + +We can check the result: + +```idris +DescStr : String +DescStr = unlines $ map show $ SortedMap.toList $ desc + +Expected : String +Expected = """ + (0, "John") + (1, "Denis with score 5") + (3, "Edwin with score 100") + (15, "unnamed user with score 1") + + """ + +main_checkMap : IO () +main_checkMap = printLn $ DescStr == Expected +``` + +(Notice that we are using runtime comparison because string primitives do not work well at the compile time) diff --git a/cozippable.ipkg b/cozippable.ipkg new file mode 100644 index 0000000..38ed115 --- /dev/null +++ b/cozippable.ipkg @@ -0,0 +1,12 @@ +package cozippable + +authors = "Denis Buzdalov" + +brief = "Cozippable interface and implementations" + +license = "Apache-2.0" + +sourcedir = "src" +builddir = ".build" + +modules = Data.Cozippable diff --git a/pack.toml b/pack.toml new file mode 100644 index 0000000..1f5581a --- /dev/null +++ b/pack.toml @@ -0,0 +1,5 @@ +[custom.all.cozippable] +type = "local" +path = "." +ipkg = "cozippable.ipkg" +test = "tests/tests.ipkg" diff --git a/src/Data/Cozippable.idr b/src/Data/Cozippable.idr new file mode 100644 index 0000000..50046ef --- /dev/null +++ b/src/Data/Cozippable.idr @@ -0,0 +1,195 @@ +module Data.Cozippable + +import Data.Colist +import Data.Colist1 +import Data.List.Lazy +import Data.List1 +import public Data.These +import Data.SortedSet +import Data.SortedMap +import Data.Vect + +%default total + +||| The `Cozippable` interface describes how you can combine and split elements of a parameterised type, those elements may not contain equal amount of information. +||| +||| The easiest example is `List`. When you `zip` them using standard `Zippable` interface, only their prefixes of commit length are taken into account, +||| or else it is impossible to fulfill the interface. +||| Sometimes we may want to deal with such lack of information explicitly. +||| That's why zipping function of the `Cozippable` interface takes `These` data type, which is an inclusive "or", i.e. either one of elements, or both of them. +public export +interface Cozippable z where + + cozipWith : (These a b -> c) -> z a -> z b -> z c + + cozip : z a -> z b -> z (These a b) + cozip = cozipWith id + + uncozipWith : (a -> These b c) -> z a -> These (z b) (z c) + + uncozip : z (These a b) -> These (z a) (z b) + uncozip = uncozipWith id + +export infixr 6 `cozip` -- same as `zip` from `Data.Zippable` + +public export +cozipWith' : Cozippable z => Functor z => (These a b -> c) -> These (z a) (z b) -> z c +cozipWith' f (This x) = map (f . This) x +cozipWith' f (That x) = map (f . That) x +cozipWith' f (Both x y) = cozipWith f x y + +public export +cozip' : Cozippable z => Functor z => These (z a) (z b) -> z (These a b) +cozip' = cozipWith' id + +public export +[Compose] Cozippable f => Cozippable g => Functor g => Cozippable (f . g) where + cozipWith f = cozipWith $ cozipWith' f + uncozipWith f = uncozipWith $ uncozipWith f + +--- Particular implementations --- + +public export +Semigroup a => Cozippable (Pair a) where + cozipWith f (x, y) (x', y') = (x <+> x', f $ Both y y') + uncozipWith f (x, y) = bimap (x,) (x,) $ f y + +public export +Cozippable Maybe where + cozipWith _ Nothing Nothing = Nothing + cozipWith f Nothing (Just y) = Just $ f $ That y + cozipWith f (Just x) Nothing = Just $ f $ This x + cozipWith f (Just x) (Just y) = Just $ f $ Both x y + + uncozipWith f Nothing = Both Nothing Nothing + uncozipWith f (Just x) = bimap Just Just $ f x + +-- Prefers left `Left` when both are `Left`s, as default `Zippable` implementation +public export +Cozippable (Either a) where + cozipWith _ (Left x) (Left _) = Left x + cozipWith f (Left _) (Right y) = Right $ f $ That y + cozipWith f (Right x) (Left _) = Right $ f $ This x + cozipWith f (Right x) (Right y) = Right $ f $ Both x y + + uncozipWith f (Left x) = Both (Left x) (Left x) + uncozipWith f (Right x) = bimap Right Right $ f x + +-- Combines both `Left`s when there are both of them +public export +[CombineLeft] Semigroup a => Cozippable (Either a) where + cozipWith _ (Left x) (Left y) = Left $ x <+> y + cozipWith f (Left _) (Right y) = Right $ f $ That y + cozipWith f (Right x) (Left _) = Right $ f $ This x + cozipWith f (Right x) (Right y) = Right $ f $ Both x y + + uncozipWith f (Left x) = Both (Left x) (Left x) + uncozipWith f (Right x) = bimap Right Right $ f x + +public export +Semigroup a => Cozippable (These a) where + cozipWith f (This x) (This y) = This $ x <+> y + cozipWith f (This x) (That y) = That $ f $ That y + cozipWith f (This x) (Both y z) = Both (x <+> y) $ f $ That z + cozipWith f (That x) (This y) = Both y $ f $ This x + cozipWith f (That x) (That y) = That $ f $ Both x y + cozipWith f (That x) (Both y z) = Both y $ f $ Both x z + cozipWith f (Both x z) (This y) = Both (x <+> y) $ f $ This z + cozipWith f (Both x z) (That y) = Both x $ f $ Both z y + cozipWith f (Both x z) (Both y w) = Both (x <+> y) $ f $ Both z w + + uncozipWith f (This x) = Both (This x) (This x) + uncozipWith f (That x) = bimap That That $ f x + uncozipWith f (Both x y) = bimap (Both x) (Both x) $ f y + +public export +Cozippable List where + cozipWith f [] [] = [] + cozipWith f [] (y::ys) = f (That y) :: cozipWith f [] ys + cozipWith f (x::xs) [] = f (This x) :: cozipWith f xs [] + cozipWith f (x::xs) (y::ys) = f (Both x y) :: cozipWith f xs ys + + uncozipWith f [] = Both [] [] + uncozipWith f (x::xs) = do + let sub = uncozipWith f xs + case f x of + This y => mapFst (y::) sub + That y => mapSnd (y::) sub + Both y z => bimap (y::) (z::) sub + +public export +Cozippable SnocList where + cozipWith f [<] [<] = [<] + cozipWith f [<] (sy: mapFst (: mapSnd (: bimap (: This $ y:::zs + (This y , That []) => This $ singleton y + (This y , That $ z::zs) => Both (singleton y) (z:::zs) + (This y , Both zs []) => This $ y:::zs + (This y , Both zs (w::ws)) => Both (y:::zs) (w:::ws) + (That y , This []) => That $ singleton y + (That y , This (z::zs)) => Both (z:::zs) (singleton y) + (That y , That zs) => That $ y:::zs + (That y , Both [] ws) => That $ y:::ws + (That y , Both (z::zs) ws) => Both (z:::zs) (y:::ws) + (Both y w, This zs) => Both (y:::zs) (singleton w) + (Both y w, That zs) => Both (singleton y) (w:::zs) + (Both y w, Both zs vs) => Both (y:::zs) (w:::vs) + +public export +[VectMaybe] Cozippable (Vect n . Maybe) where + cozipWith f [] [] = [] + cozipWith f (x::xs) (y::ys) = cozipWith f x y :: cozipWith @{VectMaybe} f xs ys + + uncozipWith f [] = Both [] [] + uncozipWith f (x::xs) = do + let (l, r) = fromBoth Nothing Nothing $ uncozipWith f x + bimap (l::) (r::) $ uncozipWith @{VectMaybe} f xs + +public export +Cozippable LazyList where + cozipWith f [] [] = [] + cozipWith f [] (y::ys) = f (That y) :: cozipWith f [] ys + cozipWith f (x::xs) [] = f (This x) :: cozipWith f xs [] + cozipWith f (x::xs) (y::ys) = f (Both x y) :: cozipWith f xs ys + + uncozipWith f [] = Both [] [] + uncozipWith f (x::xs) = do + let left : Lazy (LazyList b) = fromMaybe [] $ fromThis $ uncozipWith f xs + let right : Lazy (LazyList c) = fromMaybe [] $ fromThat $ uncozipWith f xs + case f x of + This y => Both (y::left) right + That y => Both left (y::right) + Both y z => Both (y::left) (z::right) + +public export +Ord k => Cozippable (SortedMap k) where + cozipWith f mx my = SortedMap.fromList $ merge (SortedMap.toList mx) (SortedMap.toList my) where + merge : List (k, a) -> List (k, b) -> List (k, c) + merge [] [] = [] + merge [] ys = mapSnd (f . That) <$> ys + merge xs [] = mapSnd (f . This) <$> xs + merge xxs@((kx,x)::xs) yys@((ky,y)::ys) = + if kx < ky then (kx, f $ This x) :: merge xs yys + else if kx == ky then (kx, f $ Both x y) :: merge xs ys + else (ky, f $ That y) :: merge xxs ys + + uncozipWith f mx = do + let xs = mapSnd f <$> SortedMap.toList mx + let ls = flip mapMaybe xs $ \kbc => (Builtin.fst kbc,) <$> fromThis (Builtin.snd kbc) + let rs = flip mapMaybe xs $ \kbc => (Builtin.fst kbc,) <$> fromThat (Builtin.snd kbc) + Both (fromList ls) (fromList rs) diff --git a/tests/Tests.idr b/tests/Tests.idr new file mode 100644 index 0000000..bf581c0 --- /dev/null +++ b/tests/Tests.idr @@ -0,0 +1,8 @@ +module Tests + +import Test.Golden.RunnerHelper + +main : IO () +main = goldenRunner + [ "Documentation" `atDir` "docs" + ] diff --git a/tests/docs/readme/README.md b/tests/docs/readme/README.md new file mode 120000 index 0000000..8a33348 --- /dev/null +++ b/tests/docs/readme/README.md @@ -0,0 +1 @@ +../../../README.md \ No newline at end of file diff --git a/tests/docs/readme/expected b/tests/docs/readme/expected new file mode 100644 index 0000000..7767f94 --- /dev/null +++ b/tests/docs/readme/expected @@ -0,0 +1,6 @@ +1/1: Building README (README.md) + +--------------------------------- +Running check main_checkMap... +--------------------------------- +True diff --git a/tests/docs/readme/run b/tests/docs/readme/run new file mode 100755 index 0000000..fb029fb --- /dev/null +++ b/tests/docs/readme/run @@ -0,0 +1,13 @@ +rm -rf build + +flock "$1" pack -q install-deps test.ipkg && \ +idris2 --no-color --console-width 0 --no-banner --find-ipkg --check README.md && \ +for mn in `grep 'main.* : IO ()' README.md | sed 's/ : IO ()$//' | sed 's/^ *//'`; do + echo + echo "---------------------------------" + echo "Running check $mn..." + echo "---------------------------------" + idris2 --find-ipkg --exec "$mn" README.md +done + +rm -rf build diff --git a/tests/docs/readme/test.ipkg b/tests/docs/readme/test.ipkg new file mode 100644 index 0000000..6c66be2 --- /dev/null +++ b/tests/docs/readme/test.ipkg @@ -0,0 +1,3 @@ +package test + +depends = cozippable diff --git a/tests/tests.ipkg b/tests/tests.ipkg new file mode 100644 index 0000000..b41b2d1 --- /dev/null +++ b/tests/tests.ipkg @@ -0,0 +1,8 @@ +package coop-tests + +main = Tests +executable = runtests + +builddir = ".build" + +depends = golden-runner-helper