Skip to content

do not drop extra elements in Data.List.Linear drop and take #486

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Apr 1, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions .github/workflows/ci.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,12 @@ jobs:
ghc-version: [96, 98, 910]
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: actions/checkout@v4
- uses: cachix/install-nix-action@v15
with:
nix_path: "${{ env.nixpkgs-url }}"
- name: Cache Cabal dependencies
uses: actions/cache@v2
uses: actions/cache@v4
with:
path: |
~/.cabal/packages
Expand All @@ -45,7 +45,7 @@ jobs:
- name: Run benchmarks
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal bench 2>&1 | tee benchmark_ghc${{ matrix.ghc-version }}.txt"
- name: Upload benchmark results
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: linear-base_benchmarks_ghc${{ matrix.ghc-version }}
path: |
Expand All @@ -56,12 +56,12 @@ jobs:
name: check formatting with ormolu
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: actions/checkout@v4
- uses: cachix/install-nix-action@v15
with:
nix_path: "${{ env.nixpkgs-url }}"
- name: Cache Stack dependencies
uses: actions/cache@v2
uses: actions/cache@v4
with:
path: ~/.stack
key: stack-deps-ormolu-${{ runner.os }}-${{ hashFiles('nix/sources.json') }}-v${{ env.cache-invalidation-key }}-${{ hashFiles('stack.yaml.lock') }}-${{ github.sha }}
Expand All @@ -75,12 +75,12 @@ jobs:
name: stack build
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: actions/checkout@v4
- uses: cachix/install-nix-action@v15
with:
nix_path: "${{ env.nixpkgs-url }}"
- name: Cache Stack dependencies
uses: actions/cache@v2
uses: actions/cache@v4
with:
path: ~/.stack
key: stack-deps-${{ runner.os }}-${{ hashFiles('nix/sources.json') }}-v${{ env.cache-invalidation-key }}-${{ hashFiles('stack.yaml.lock', 'linear-base.cabal') }}-${{ github.sha }}
Expand Down
7 changes: 4 additions & 3 deletions linear-base.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -170,14 +170,15 @@ test-suite test
hs-source-dirs: test
other-modules:
Test.Data.Destination
Test.Data.Functor.Linear
Test.Data.List
Test.Data.Mutable.Array
Test.Data.Mutable.Vector
Test.Data.Mutable.HashMap
Test.Data.Mutable.Set
Test.Data.Mutable.Vector
Test.Data.Polarized
Test.Data.Functor.Linear
Test.Data.V
Test.Data.Replicator
Test.Data.V
default-language: Haskell2010
build-depends:
inspection-testing,
Expand Down
4 changes: 2 additions & 2 deletions src/Data/List/Linear.hs
Original file line number Diff line number Diff line change
Expand Up @@ -191,13 +191,13 @@ dropWhile p (x : xs) =
take :: (Consumable a) => Int -> [a] %1 -> [a]
take _ [] = []
take i (x : xs)
| i Prelude.< 0 = (x, xs) `lseq` []
| i Prelude.<= 0 = (x, xs) `lseq` []
| otherwise = x : take (i - 1) xs

drop :: (Consumable a) => Int -> [a] %1 -> [a]
drop _ [] = []
drop i (x : xs)
| i Prelude.< 0 = x : xs
| i Prelude.<= 0 = x : xs
| otherwise = x `lseq` drop (i - 1) xs

-- | The intersperse function takes an element and a list and
Expand Down
2 changes: 2 additions & 0 deletions test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ module Main where

import Test.Data.Destination (destArrayTests)
import Test.Data.Functor.Linear (genericTests)
import Test.Data.List (listTests)
import Test.Data.Mutable.Array (mutArrTests)
import Test.Data.Mutable.HashMap (mutHMTests)
import Test.Data.Mutable.Set (mutSetTests)
Expand All @@ -29,6 +30,7 @@ allTests =
mutSetTests,
destArrayTests,
polarizedArrayTests,
listTests,
genericTests
],
testGroup
Expand Down
43 changes: 43 additions & 0 deletions test/Test/Data/List.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,43 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Data.List (listTests) where

import qualified Data.List.Linear as List
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Prelude.Linear
import Test.Tasty
import Test.Tasty.Hedgehog (testPropertyNamed)
import qualified Prelude

listTests :: TestTree
listTests =
testGroup
"List tests"
[ testPropertyNamed "take n ++ drop n = id" "take_drop" take_drop,
testPropertyNamed "length . take n = const n" "take_length" take_length
]

take_drop :: Property
take_drop = property $ do
n <- forAll $ Gen.int (Range.linear 0 50)
classify "0" $ n == 0
xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 40))
classify "length > n" $ Prelude.length xs > n
List.take n xs ++ List.drop n xs === xs

take_length :: Property
take_length = property $ do
n <- forAll $ Gen.int (Range.linear 0 50)
classify "0" $ n == 0
xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 40))
classify "length > n" $ Prelude.length xs > n
case Prelude.length xs > n of
True -> do
annotate "Prelude.length xs > n"
Prelude.length (List.take n xs) === n
False -> do
annotate "Prelude.length xs < n"
Prelude.length (List.take n xs) === Prelude.length xs