Skip to content

Fix 'fromIndex' internal helper #23

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.

Sign up for GitHub

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 5 commits into from
Nov 16, 2020
Merged

Fix 'fromIndex' internal helper #23

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
af4b7f0
Fix 'fromIndex' internal helper
garyb Jun 3, 2020
2eeb116
Bump build dependencies
garyb Jun 3, 2020
13a8dde
Add `Cons a Nil` case for `fromIndex`
garyb Jul 22, 2020
0366fa7
Merge remote-tracking branch 'origin/master' into fix-fromIndex
garyb Jul 22, 2020
5869905
Merge branch 'master' into fix-fromIndex
JordanMartinez Nov 15, 2020
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
27 changes: 10 additions & 17 deletions src/Control/Monad/Gen.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,11 +13,12 @@ import Prelude

import Control.Monad.Gen.Class (class MonadGen, Size, chooseBool, chooseFloat, chooseInt, resize, sized)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Data.Foldable (foldMap, length)
import Data.Foldable (foldMap, foldr, length)
import Data.Maybe (Maybe(..))
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (alaF)
import Data.Newtype (alaF, un)
import Data.Semigroup.Foldable (class Foldable1, foldMap1)
import Data.Semigroup.Last (Last(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Unfoldable (class Unfoldable, unfoldr)

Expand Down Expand Up @@ -118,22 +119,14 @@ filtered gen = tailRecM go unit
Nothing -> Loop unit
Just a' -> Done a'

-- | Internal: used by fromIndex
newtype AtIndex a = AtIndex (Int -> a)

instance semigroupAtIndex :: Semigroup (AtIndex a)
where
append (AtIndex f) (AtIndex g) =
AtIndex \i -> if i <= 0 then f i else g (i - 1)

atIndex :: forall a. a -> AtIndex a
atIndex = AtIndex <<< const

getAtIndex :: forall a. AtIndex a -> Int -> a
getAtIndex (AtIndex f) = f

-- | Internal: get the Foldable element at index i.
-- | If the index is <= 0, return the first element.
-- | If it's >= length, return the last.
fromIndex :: forall f a. Foldable1 f => Int -> f a -> a
fromIndex i xs = getAtIndex (foldMap1 atIndex xs) i
fromIndex i xs = go i (foldr Cons Nil xs)
where
go _ (Cons a Nil) = a
go j (Cons a _) | j <= 0 = a
go j (Cons _ as) = go (j - 1) as
-- next case is "impossible", but serves as proof of non-emptyness
go _ Nil = un Last (foldMap1 Last xs)
7 changes: 7 additions & 0 deletions test/Main.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,13 @@ main = do
log "`genNonEmpty` should not reduce the remainder size below zero"
one :: NonEmpty Array Int ← Gen.resize (const 0) $ GenC.genNonEmpty (Gen.sized pure)
liftEffect $ assertEqual { actual: one, expected: 0 :| [] }

log "Ensure that `elements` will produce all possible values (tests will hang if this fails)"
_ ← Gen.suchThat (Gen.elements ("A" :| ["B", "C", "D"])) (_ == "A")
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Couldn't we do something that will fail (rather than hang CI for who knows how long) like this?

test = do
  let testElems = "A" :| ["B", "C", "D"]
  elems <- randomSample' 100 (Gen.elements testElems)
  let generatedElems = foldl (\mymap e -> Map.insertWith (_ + 1) e 0 mymap) Map.empty elems
  keys generatedElems `shouldEqual` (toArray testElems)
  -- some other frequency test here, too.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Only if we don't mind there occasionally being random failures. There's no limited number of samples you can generate that won't result in a false negative from time to time.

I suppose that's still technically true with the current test, just the number of things it will generate is bound by the CI timeout or node crashing rather than there being an explicit limit.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Only if we don't mind there occasionally being random failures. There's no limited number of samples you can generate that won't result in a false negative from time to time.

True, but at least CI fails quicker. Also, if we increase the number of elements generated, wouldn't that decrease the possibility of a random failure occurring?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, the larger the number the less likely it will fail.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So.... 1,000, right? 😆

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'll merge this PR and then submit a PR that uses the above approach.

_ ← Gen.suchThat (Gen.elements ("A" :| ["B", "C", "D"])) (_ == "B")
_ ← Gen.suchThat (Gen.elements ("A" :| ["B", "C", "D"])) (_ == "C")
_ ← Gen.suchThat (Gen.elements ("A" :| ["B", "C", "D"])) (_ == "D")
pure unit

log "check frequency"
Frequency.check
Expand Down