Skip to content

Instantly share code, notes, and snippets.

@JordanMartinez
Created September 8, 2020 01:58
Show Gist options
  • Save JordanMartinez/767e8bb8a86e8c90694fd72fab14f87d to your computer and use it in GitHub Desktop.
Save JordanMartinez/767e8bb8a86e8c90694fd72fab14f87d to your computer and use it in GitHub Desktop.
ArrayZipper's smallest Extend implementation
module Main where
import Prelude
import Control.Comonad (class Comonad)
import Control.Extend (class Extend)
import Control.Monad.Gen (chooseInt)
import Data.Array (length, mapWithIndex, slice, unsafeIndex)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Test.QuickCheck.Laws as Laws
import Test.QuickCheck.Laws.Control (checkComonad, checkExtend)
import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary, arbitrary, coarbitrary)
import Test.Spec (describe, it)
import Test.Spec.Reporter.Console (consoleReporter)
import Test.Spec.Runner (runSpec)
import Type.Proxy (Proxy(..), Proxy2(..))
main :: Effect Unit
main = launchAff_ do
runSpec [consoleReporter] do
describe "Laws" do
it "Extend" do
liftEffect $ checkExtend proxy2
it "Comonad" do
liftEffect $ checkComonad proxy2
where
proxy1 = Proxy :: Proxy (ArrayZipper Laws.A)
proxy2 = Proxy2 :: Proxy2 ArrayZipper
-- | An immutable Zipper for an Array.
-- | Modifications to the focused element are `O(n)` due to creating
-- | a new array rather than mutating the underlying array.
-- | Navigating to a new focus element is `O(1)` regardless of how far
-- | away from the current focus that element is. This
-- | is in contrast to a `List`-based zipper where modifications
-- | are `O(1)` and navigation is `O(n)`.
-- |
-- | In other words, this zipper works well in read-heavy code
-- | but might not work well in write-heavy code
-- |
-- | [0, 1, 2, 3, 4, 5] <-- underlying array
-- | ^ ^
-- | | |
-- | | -- maxIndex: 5
-- | -- focusIndex: 3
newtype ArrayZipper a =
ArrayZipper { array :: Array a, focusIndex :: Int, maxIndex :: Int }
derive instance eqArrayZipper :: Eq a => Eq (ArrayZipper a)
derive instance functorArrayZipper :: Functor ArrayZipper
instance extendArrayZipper :: Extend ArrayZipper where
extend
:: forall b a
. (ArrayZipper a -> b)
-> ArrayZipper a
-> ArrayZipper b
extend f (ArrayZipper rec) =
let
sliceArray idx _ =
f (ArrayZipper
{ array: slice idx (rec.maxIndex + 1) rec.array
, focusIndex: 0
, maxIndex: rec.maxIndex - idx
})
in ArrayZipper (rec { array = mapWithIndex sliceArray rec.array})
instance comonadArrayZipper :: Comonad ArrayZipper where
extract :: forall a. ArrayZipper a -> a
extract (ArrayZipper r) = unsafePartial (unsafeIndex r.array r.focusIndex)
instance arbitraryArrayZipper :: Arbitrary a => Arbitrary (ArrayZipper a) where
arbitrary = do
array <- arbitrary
let maxIndex = length array - 1
focusIndex <- chooseInt 0 maxIndex
pure $ ArrayZipper { array, focusIndex, maxIndex }
instance coarbitraryArrayZipper :: Coarbitrary a => Coarbitrary (ArrayZipper a) where
coarbitrary (ArrayZipper r) =
coarbitrary r.array >>>
coarbitrary r.maxIndex >>>
coarbitrary r.focusIndex
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment