sized-grid 0.1.1.1 → 0.1.1.4
raw patch · 15 files changed
+678/−277 lines, 15 filesdep +QuickCheckdep +tasty-quickcheckdep −hedgehogdep −tasty-hedgehogdep ~adjunctionsdep ~aesondep ~base
Dependencies added: QuickCheck, tasty-quickcheck
Dependencies removed: hedgehog, tasty-hedgehog
Dependency ranges changed: adjunctions, aeson, base, comonad, constraints, distributive, generics-sop, lens, tasty, tasty-hunit, vector, vector-space
Files
- ChangeLog.md +8/−0
- README.lhs +1/−1
- README.md +1/−1
- sized-grid.cabal +37/−30
- src/SizedGrid/Coord.hs +70/−0
- src/SizedGrid/Coord/Class.hs +40/−1
- src/SizedGrid/Coord/HardWrap.hs +1/−0
- src/SizedGrid/Coord/Periodic.hs +1/−0
- src/SizedGrid/Grid/Class.hs +4/−12
- src/SizedGrid/Grid/Focused.hs +2/−3
- src/SizedGrid/Grid/Grid.hs +123/−10
- src/SizedGrid/Ordinal.hs +11/−0
- tests/Main.hs +187/−128
- tests/Test/Shrink.hs +24/−0
- tests/Test/Utils.hs +168/−91
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for sized-grid +## 0.1.1.4 -- 2018-11-20++* Changed test suite to use QuickCheck++## 0.1.1.3 -- 2018-11-14++* Version bumps+ ## 0.1.1.0 -- 2018-05-10 * Added Field instances for coord
README.lhs view
@@ -101,7 +101,7 @@ , All AffineSpace cs , All Eq cs , AllDiffSame Integer cs- , KnownNat (MaxCoordSize cs)+ , AllSizedKnown cs , IsGrid cs (grid cs) ) => Rule
README.md view
@@ -101,7 +101,7 @@ , All AffineSpace cs , All Eq cs , AllDiffSame Integer cs- , KnownNat (MaxCoordSize cs)+ , AllSizedKnown cs , IsGrid cs (grid cs) ) => Rule
sized-grid.cabal view
@@ -1,5 +1,5 @@ name: sized-grid-version: 0.1.1.1+version: 0.1.1.4 cabal-version: >=1.10 category: Data build-type: Simple@@ -19,6 +19,10 @@ README.lhs README.md +source-repository head+ type: git+ location: https://github.com/edwardwas/sized-grid+ library exposed-modules: SizedGrid.Ordinal@@ -31,18 +35,18 @@ SizedGrid.Grid.Focused SizedGrid build-depends:- base >=4.9 && <4.12,- lens >=4.16.1 && <4.17,- vector >=0.12.0.1 && <0.13,- vector-space ==0.13.*,- generics-sop >=0.3.2.0 && <0.4,- distributive >=0.5.3 && <0.6,- adjunctions ==4.4.*,- comonad >=5.0.3 && <5.1,- random ==1.1.*,+ base >=4.9 && <4.13,+ adjunctions >= 4.3 && < 4.5,+ aeson >=1.2 && <1.5,+ comonad >=5.0 && <5.1,+ constraints >= 0.9 && < 0.11,+ distributive >=0.5 && <0.6,+ generics-sop >=0.3 && <0.4,+ lens >=4.15 && <4.17, mtl >=2.2.2 && <2.3,- constraints ==0.10.*,- aeson >=1.2.4.0 && <1.5+ random ==1.1.*,+ vector >=0.12 && <0.13,+ vector-space >=0.10 && < 0.14 default-language: Haskell2010 hs-source-dirs: src other-modules:@@ -53,34 +57,37 @@ type: exitcode-stdio-1.0 main-is: Main.hs build-depends:- base >=4.9 && <4.12,- sized-grid -any,- hedgehog >=0.5.3 && <0.7,- tasty >=1.0.1.1 && <1.2,- tasty-hedgehog >=0.1.0.2 && <0.3,- vector-space ==0.13.*,- generics-sop >=0.3.2.0 && <0.4,- lens >=4.16.1 && <4.17,- adjunctions ==4.4.*,- aeson >=1.2.4.0 && <1.5,+ base >=4.9 && <4.13, HUnit >=1.6.0.0 && <1.7,- tasty-hunit >=0.10.0.1 && <0.11+ aeson >=1.2 && <1.5,+ adjunctions >= 4.3 && < 4.5,+ generics-sop >=0.3 && <0.4,+ lens >=4.15 && <4.17,+ sized-grid -any,+ tasty >=1.0 && <1.2,+ tasty-hunit >=0.10 && <0.11,+ vector >=0.12 && <0.13,+ vector-space >=0.10 && < 0.14,+ QuickCheck >= 2.10 && < 3.0,+ tasty-quickcheck >= 0.9 && < 1 default-language: Haskell2010 hs-source-dirs: tests other-modules: Test.Utils+ Test.Shrink+ test-suite readme type: exitcode-stdio-1.0 main-is: README.lhs build-depends:- base >=4.9 && <4.12,+ base >=4.9 && <4.13,+ ansi-terminal >=0.8.0.2 && <0.9,+ adjunctions >= 4.3 && < 4.5,+ comonad >=5.0 && <5.1,+ distributive >=0.5 && <0.6,+ lens >=4.15 && <4.17, markdown-unlit >=0.5.0 && <0.6, sized-grid -any,- distributive >=0.5.3 && <0.6,- adjunctions ==4.4.*,- vector-space ==0.13.*,- comonad >=5.0.3 && <5.1,- lens >=4.16.1 && <4.17,- ansi-terminal >=0.8.0.2 && <0.9+ vector-space >=0.10 && < 0.14 default-language: Haskell2010 ghc-options: -pgmL markdown-unlit
src/SizedGrid/Coord.hs view
@@ -1,14 +1,19 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-} module SizedGrid.Coord where @@ -22,6 +27,8 @@ import Data.AdditiveGroup import Data.Aeson import Data.AffineSpace+import Data.Constraint+import Data.Constraint.Nat import Data.List (intercalate) import Data.Semigroup (Semigroup (..)) import qualified Data.Vector as V@@ -29,6 +36,7 @@ import qualified Generics.SOP as SOP import GHC.Exts (Constraint) import GHC.Generics (Generic)+import GHC.TypeLits import qualified GHC.TypeLits as GHC import System.Random (Random (..)) @@ -41,7 +49,18 @@ newtype Coord cs = Coord {unCoord :: NP I cs} deriving (Generic) +coordSplit:: Coord (c ': cs) -> (c, Coord cs)+coordSplit (Coord (I x :* xs)) = (x, Coord xs) +pattern (:|) :: c -> Coord cs -> Coord (c ': cs)+pattern (:|) a as <- (coordSplit -> (a,as))+ where (:|) a (Coord as) = Coord (I a :* as)++pattern EmptyCoord :: Coord '[]+pattern EmptyCoord = Coord Nil++infixr 5 :|+ _WrappedCoord :: Lens' (Coord cs) (NP I cs) _WrappedCoord f (Coord n) = Coord <$> f n @@ -262,3 +281,54 @@ -- | Swap x and y for a coord in 2D space tranposeCoord :: Coord '[a,b] -> Coord '[b,a] tranposeCoord (Coord (a :* b :* Nil)) = Coord (b :* a :* Nil)++-- | The zero position for a coord+zeroCoord :: All IsCoord cs => Coord cs+zeroCoord = Coord $ hcpure (Proxy :: Proxy IsCoord) (I $ zeroPosition)++class AllSizedKnown (cs :: [*]) where+ sizeProof :: Dict (KnownNat (MaxCoordSize cs))++instance AllSizedKnown '[] where+ sizeProof = Dict++instance (KnownNat (CoordSized a), AllSizedKnown as) =>+ AllSizedKnown (a ': as) where+ sizeProof =+ withDict+ (sizeProof @as)+ (Dict \\ (timesNat @(CoordSized a) @(MaxCoordSize as)))++class WeakenCoord as bs where+ weakenCoord :: Coord as -> Maybe (Coord bs)++instance WeakenCoord '[] '[] where+ weakenCoord c = Just c++instance ( b ~ CoordFromNat a n+ , WeakenCoord as bs+ , IsCoord a+ , IsCoord (CoordFromNat a n)+ ) =>+ WeakenCoord (a ': as) (b ': bs) where+ weakenCoord (a :| as) = do+ bs <- weakenCoord as+ b <- weakenIsCoord a+ return (b :| bs)+ weakenCoord _ = error "Unreachable pattern in weakenCoord"++class StrengthenCoord as bs where+ strengthenCoord :: Coord as -> Coord bs++instance StrengthenCoord '[] '[] where+ strengthenCoord c = c++instance ( StrengthenCoord as bs+ , IsCoord (CoordFromNat a n)+ , IsCoord a+ , b ~ CoordFromNat a n+ , CoordSized a <= CoordSized (CoordFromNat a n)+ ) =>+ StrengthenCoord (a ': as) (b ': bs) where+ strengthenCoord (a :| as) = strengthenIsCoord a :| strengthenCoord as+ strengthenCoord _ = error "Unreachable pattern in strengthenCoord"
src/SizedGrid/Coord/Class.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}@@ -14,15 +15,31 @@ import SizedGrid.Ordinal import Control.Lens+import Data.Constraint+import Data.Maybe (fromJust) import Data.Proxy import GHC.TypeLits+import Unsafe.Coerce (unsafeCoerce) +-- | Proof an idiom about how `CoordFromNat` works. This relies on 'CoordFromNat a (CoordSized a ~ a'+coordFromNatCollapse ::+ forall a x y. Dict (CoordFromNat (CoordFromNat a x) y ~ CoordFromNat a y)+coordFromNatCollapse = unsafeCoerce (Dict :: Dict (z ~ z))++coordFromNatSame ::+ (CoordFromNat a ~ CoordFromNat b) :- (a ~ CoordFromNat b (CoordSized a))+coordFromNatSame = Sub (unsafeCoerce (Dict :: Dict (a ~ a)))++coordSizedCollapse :: forall c n . Dict (CoordSized (CoordFromNat c n) ~ n)+coordSizedCollapse = unsafeCoerce (Dict :: Dict (a ~ a))+ -- | Everything that can be uses as a Coordinate. The only required function is `asOrdinal` and the type instance of `CoordSized`: the rest can be derived automatically. -- -- This is kind * -> Constraint for ease of use later. There is some argument that it should be of kind (Nat -> *) -> Constraint and we could remove `CoordSized`, but that has other complications-class (1 <= CoordSized c, KnownNat (CoordSized c)) => IsCoord c where+class (1 <= CoordSized c, KnownNat (CoordSized c)) => IsCoord c where -- | The maximum number of values that a Coord can take type CoordSized c :: Nat+ type CoordFromNat c :: (Nat -> *) -- | As each coord represents a finite number of states, it must be isomorphic to an Ordinal asOrdinal :: Iso' c (Ordinal (CoordSized c)) -- | The origin. If c is an instance of `Monoid`, this should be mempty@@ -36,10 +53,32 @@ maxCoordSize :: proxy c -> Integer maxCoordSize p = natVal (sCoordSized p) - 1 + maxCoord :: c+ maxCoord = view (re asOrdinal) maxCoord++ asSizeProxy ::+ c+ -> (forall n. (KnownNat n, n + 1 <= (CoordSized c)) =>+ Proxy n -> x)+ -> x+ asSizeProxy c = asSizeProxy (view asOrdinal c)++ weakenIsCoord :: IsCoord (CoordFromNat c n) => c -> Maybe (CoordFromNat c n)+ weakenIsCoord = fmap (review asOrdinal) . weakenOrdinal . view asOrdinal++ strengthenIsCoord ::+ (IsCoord (CoordFromNat c n), CoordSized c <= CoordSized (CoordFromNat c n))+ => c+ -> CoordFromNat c n+ strengthenIsCoord = review asOrdinal . strengthenOrdinal . view asOrdinal+ instance (1 <= n, KnownNat n) => IsCoord (Ordinal n) where type CoordSized (Ordinal n) = n+ type CoordFromNat (Ordinal n) = Ordinal asOrdinal = id zeroPosition = Ordinal (Proxy @0)+ asSizeProxy (Ordinal p) func = func p+ maxCoord = fromJust $ numToOrdinal (maxCoordSize (Proxy :: Proxy (Ordinal n))) -- | Enumerate all possible values of a coord, in order allCoordLike :: IsCoord c => [c]
src/SizedGrid/Coord/HardWrap.hs view
@@ -38,6 +38,7 @@ instance (1 <= n, KnownNat n) => IsCoord (HardWrap n) where type CoordSized (HardWrap n) = n+ type CoordFromNat (HardWrap n) = HardWrap asOrdinal = iso unHardWrap HardWrap instance (1 <= n, KnownNat n) => Semigroup (HardWrap n) where
src/SizedGrid/Coord/Periodic.hs view
@@ -52,6 +52,7 @@ instance (1 <= n, KnownNat n) => IsCoord (Periodic n) where type CoordSized (Periodic n) = n+ type CoordFromNat (Periodic n) = Periodic asOrdinal = iso unPeriodic Periodic instance (1 <= n, KnownNat n) => Semigroup (Periodic n) where
src/SizedGrid/Grid/Class.hs view
@@ -22,7 +22,6 @@ #endif import Generics.SOP-import qualified GHC.TypeLits as GHC -- | Conversion between `Grid` and `FocusedGrid` and access grids at a `Coord` class IsGrid cs grid | grid -> cs where@@ -33,24 +32,17 @@ -- | Convert to, or run a function over, a `FocusedGrid` asFocusedGrid :: Lens' (grid a) (FocusedGrid cs a) -instance ( GHC.KnownNat (MaxCoordSize cs)- , All Semigroup cs- , All Monoid cs- , All IsCoord cs- ) =>+instance (AllSizedKnown cs, All IsCoord cs) => IsGrid cs (Grid cs) where gridIndex coord = lens (\g -> index g coord) (\(Grid v) a -> Grid (v & ix (coordPosition coord) .~ a)) asGrid = id- asFocusedGrid = lens (\g -> FocusedGrid g mempty) (\_ fg -> focusedGrid fg)+ asFocusedGrid =+ lens (\g -> FocusedGrid g zeroCoord) (\_ fg -> focusedGrid fg) -instance ( GHC.KnownNat (MaxCoordSize cs)- , All IsCoord cs- , All Monoid cs- , All Semigroup cs- ) =>+instance (AllSizedKnown cs, All IsCoord cs) => IsGrid cs (FocusedGrid cs) where gridIndex c = (\f (FocusedGrid g p) -> (\g' -> FocusedGrid g' p) <$> f g) .
src/SizedGrid/Grid/Focused.hs view
@@ -17,7 +17,6 @@ import Data.Functor.Rep import Data.Semigroup (Semigroup (..)) import Generics.SOP-import qualified GHC.TypeLits as GHC -- | Similar to `Grid`, but this has a focus on a certain square. Becuase of this we loose some instances, such as `Applicative`, but we gain a `Comonad` and `ComonadStore` instance. We can convert between a focused and unfocused list using facilites in `IsGrid` data FocusedGrid cs a = FocusedGrid@@ -25,7 +24,7 @@ , focusedGridPosition :: Coord cs } deriving (Functor,Foldable,Traversable) -instance ( GHC.KnownNat (MaxCoordSize cs)+instance ( AllSizedKnown cs , All IsCoord cs , All Monoid cs , All Semigroup cs@@ -35,7 +34,7 @@ extract (FocusedGrid g p) = index g p duplicate (FocusedGrid g p) = FocusedGrid (tabulate (FocusedGrid g)) p -instance ( GHC.KnownNat (MaxCoordSize cs)+instance ( AllSizedKnown cs , All IsCoord cs , All Monoid cs , All Semigroup cs
src/SizedGrid/Grid/Grid.hs view
@@ -1,9 +1,18 @@+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -16,35 +25,41 @@ import Control.Lens hiding (index) import Data.Aeson+import Data.Constraint import Data.Distributive import Data.Functor.Classes import Data.Functor.Rep import Data.Proxy (Proxy (..))+import Data.Semigroup ((<>)) import qualified Data.Vector as V import Generics.SOP-import GHC.Exts+import qualified GHC.Generics as GHC+import GHC.TypeLits import qualified GHC.TypeLits as GHC -- | A multi dimensional sized grid newtype Grid (cs :: [*]) a = Grid { unGrid :: V.Vector a- } deriving (Eq, Show, Functor, Foldable, Traversable, Eq1, Show1)+ } deriving (Eq, Show, Functor, Foldable, Traversable, Eq1, Show1, GHC.Generic) -instance GHC.KnownNat (MaxCoordSize cs) => Applicative (Grid cs) where- pure =- Grid .- V.replicate (fromIntegral $ GHC.natVal (Proxy :: Proxy (MaxCoordSize cs)))- Grid fs <*> Grid as = Grid $ V.zipWith ($) fs as+instance AllSizedKnown cs => Applicative (Grid cs) where+ pure =+ withDict+ (sizeProof @cs)+ (Grid .+ V.replicate+ (fromIntegral $ GHC.natVal (Proxy :: Proxy (MaxCoordSize cs))))+ Grid fs <*> Grid as = Grid $ V.zipWith ($) fs as -instance (GHC.KnownNat (MaxCoordSize cs), All IsCoord cs) =>+instance (AllSizedKnown cs, All IsCoord cs) => Monad (Grid cs) where g >>= f = imap (\p a -> f a `index` p) g -instance (GHC.KnownNat (MaxCoordSize cs), All IsCoord cs) =>+instance (AllSizedKnown cs, All IsCoord cs) => Distributive (Grid cs) where distribute = distributeRep -instance (All IsCoord cs, GHC.KnownNat (MaxCoordSize cs)) =>+instance (All IsCoord cs, AllSizedKnown cs) => Representable (Grid cs) where type Rep (Grid cs) = Coord cs tabulate func = Grid $ V.fromList $ map func $ allCoord@@ -143,3 +158,101 @@ => Grid '[ w, h] a -> Grid '[ h, w] a transposeGrid g = tabulate $ \i -> index g $ tranposeCoord i++splitGrid ::+ forall c cs a. (AllSizedKnown cs)+ => Grid (c ': cs) a+ -> Grid '[ c] (Grid cs a)+splitGrid (Grid v) =+ withDict+ (sizeProof @cs)+ (Grid $+ V.fromList $+ map+ Grid+ (splitVectorBySize+ (fromIntegral $ GHC.natVal (Proxy :: Proxy (MaxCoordSize cs)))+ v))++combineGrid :: Grid '[c] (Grid cs a) -> Grid (c ': cs) a+combineGrid (Grid v) = Grid (v >>= unGrid)++combineHigherDim ::+ ( CoordFromNat a ~ CoordFromNat b+ , c ~ CoordFromNat a ((GHC.+) (CoordSized a) (CoordSized b)))+ => Grid (a ': as) x+ -> Grid (b ': as) x+ -> Grid (c ': as) x+combineHigherDim (Grid v1) (Grid v2) = Grid (v1 <> v2)++dropGrid ::+ KnownNat n+ => Proxy n+ -> Grid '[ c] x+ -> Grid '[ CoordFromNat c (CoordSized c - n)] x+dropGrid p (Grid v) = Grid $ V.drop (fromIntegral $ natVal p) v++takeGrid :: KnownNat n => Proxy n -> Grid '[c] x -> Grid '[CoordFromNat c n] x+takeGrid p (Grid v) = Grid $ V.take (fromIntegral $ natVal p) v+++splitHigherDim ::+ forall a b c as x.+ ( KnownNat (CoordSized b)+ , c ~ CoordFromNat a (CoordSized a - CoordSized b)+ , CoordSized b <= CoordSized a+ , AllSizedKnown as+ )+ => Grid (a ': as) x+ -> (Grid (b ': as) x, Grid (c ': as) x)+splitHigherDim (Grid v) =+ let (a, b) =+ withDict+ (sizeProof @as)+ (V.splitAt+ (fromIntegral $+ GHC.natVal (Proxy @(CoordSized b)) *+ GHC.natVal (Proxy @(MaxCoordSize as)))+ v)+ in (Grid a, Grid b)++mapLowerDim ::+ forall as bs x y c f. (AllSizedKnown as, Applicative f)+ => (Grid as x -> f (Grid bs y))+ -> Grid (c ': as) x+ -> f (Grid (c ': bs) y)+mapLowerDim f (Grid v) =+ withDict+ (sizeProof @as)+ (fmap (Grid . V.concat) $+ traverse (fmap unGrid . f . Grid) $+ splitVectorBySize+ (fromIntegral (GHC.natVal (Proxy @(MaxCoordSize as))))+ v)++class ShrinkableGrid (cs :: [*]) (as :: [*]) (bs :: [*]) where+ shrinkGrid :: Coord cs -> Grid as x -> Grid bs x++instance ShrinkableGrid '[] '[] '[] where+ shrinkGrid _ (Grid v) = Grid v++instance ( KnownNat (CoordSized b)+ , AllSizedKnown as+ , IsCoord c+ , ShrinkableGrid cs as bs+ , CoordFromNat b ~ CoordFromNat a+ , CoordSized b <= (CoordSized a - CoordSized c + 1)+ ) =>+ ShrinkableGrid (c ': cs) (a ': as) (b ': bs) where+ shrinkGrid (c :| cs) =+ combineGrid . fmap (shrinkGrid cs) . helper . splitGrid+ where+ helper :: Grid '[ a] x -> Grid '[ b] x+ helper g =+ asSizeProxy c $ \(pTake :: Proxy n) ->+ withDict+ (coordFromNatCollapse @a @(CoordSized a - n) @(CoordSized b))+ (takeGrid (Proxy :: Proxy (CoordSized b)) (dropGrid pTake g) \\+ coordFromNatSame @b @a)+ shrinkGrid _ = error "Impossible pattern in shrinkGrid"+
src/SizedGrid/Ordinal.hs view
@@ -17,6 +17,7 @@ import SizedGrid.Internal.Type +import Control.Lens (Prism', prism') import Control.Monad (guard) import Data.Aeson import Data.Constraint@@ -63,6 +64,16 @@ -- | Transform an ordinal to a given number ordinalToNum :: Num a => Ordinal m -> a ordinalToNum (Ordinal p) = fromIntegral $ natVal p++strengthenOrdinal :: forall n m . (KnownNat m, n <= m) => Ordinal n -> Ordinal m+strengthenOrdinal (Ordinal (p :: Proxy x)) = (Ordinal p) \\ leTrans @(x + 1) @n @m++weakenOrdinal :: KnownNat m => Ordinal n -> Maybe (Ordinal m)+weakenOrdinal = numToOrdinal . ordinalToNum @Integer++-- | Convert between an ordinal and a usual number. This is a `Prism` as it may fail as `Oridnals` can only exist in a certain range.+_Ordinal :: (KnownNat n, Integral a) => Prism' a (Ordinal n)+_Ordinal = prism' ordinalToNum numToOrdinal instance (1 <= m, KnownNat m) => Bounded (Ordinal m) where minBound = Ordinal (Proxy @0)
tests/Main.hs view
@@ -6,32 +6,51 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} module Main where import SizedGrid +import Test.Shrink import Test.Utils -import Control.Lens hiding (index)-import Control.Monad (replicateM)+import Control.Lens hiding (index)+import Control.Monad (replicateM) import Data.Functor.Rep import Data.Proxy-import Generics.SOP hiding (S, Z)+import qualified Data.Vector as V+import Generics.SOP hiding (S, Z)+import qualified GHC.Generics as GHC import GHC.TypeLits-import qualified GHC.TypeLits as GHC-import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range+import qualified GHC.TypeLits as GHC+import Test.QuickCheck (Arbitrary (..), Arbitrary1 (..),+ Property, oneof, property, (.&&.),+ (===)) import Test.Tasty-import Test.Tasty.Hedgehog import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty) +instance (1 <= n, KnownNat n) => Arbitrary (Periodic n) where+ arbitrary = Periodic <$> oneof (map pure [minBound .. maxBound])++instance (1 <= n, KnownNat n) => Arbitrary (HardWrap n) where+ arbitrary = HardWrap <$> oneof (map pure [minBound .. maxBound])++instance (All Arbitrary cs, SListI cs) => Arbitrary (Coord cs) where+ arbitrary = Coord <$> hsequence (hcpure (Proxy @Arbitrary) arbitrary)++instance AllSizedKnown cs => Arbitrary1 (Grid cs) where+ liftArbitrary g = sequenceA (pure g)++instance (AllSizedKnown cs, Arbitrary a) => Arbitrary (Grid cs a) where+ arbitrary = liftArbitrary arbitrary+ assertOrderd :: Ord a => [a] -> Assertion assertOrderd = let helper [] = True helper (x:xs) = all (x <=) xs && helper xs- in assertBool "Ordered" . helper+ in assertBool "Ordered" . helper testAllCoordOrdered :: forall cs proxy. (All Eq cs, All Ord cs, All IsCoord cs)@@ -40,128 +59,174 @@ testAllCoordOrdered _ = testCase "allCoord is ordered" $ assertOrderd (allCoord @cs) -genPeriodic :: (1 <= n, GHC.KnownNat n) => Gen (Periodic n)-genPeriodic = Periodic <$> Gen.enumBounded--genCoord :: SListI cs => NP Gen cs -> Gen (Coord cs)-genCoord start = Coord <$> hsequence start- gridTests :: forall cs a x y. ( Show (Coord cs) , Eq (Coord cs) , All IsCoord cs- , GHC.KnownNat (MaxCoordSize cs)+ , AllSizedKnown cs , Show a , Eq a- , AllGridSizeKnown cs- , cs ~ '[x,y]- , GHC.KnownNat (MaxCoordSize '[y,x])+ , cs ~ '[ x, y]+ , KnownNat (CoordSized y * CoordSized x)+ , KnownNat (CoordSized x * CoordSized y)+ , Arbitrary a+ , Arbitrary x+ , Arbitrary y )- => Gen (Coord cs)- -> Gen a+ => Proxy (Coord cs)+ -> Proxy a -> [TestTree] gridTests genC genA =- let tabulateIndex =- property $ do- c <- forAll genC- c === index (tabulate id :: Grid cs (Coord cs)) c- collapseUnCollapse =- property $ do- g :: Grid cs a <- forAll (sequenceA $ pure genA)- Just g === gridFromList (collapseGrid g)- uncollapseCollapse =- property $ do- cg :: [[a]] <-- replicateM (fromIntegral $ natVal (Proxy @(CoordSized x))) $- replicateM (fromIntegral $ natVal (Proxy @(CoordSized y))) $ forAll genA- Just cg === (collapseGrid <$> gridFromList @cs cg)- doubleTranspose = property $ do- g :: Grid cs a <- forAll (sequenceA $ pure genA)- g === transposeGrid (transposeGrid g)- in [ testProperty "Tabulate index" tabulateIndex- , testProperty "Collapse UnCollapse" collapseUnCollapse- , testProperty "UnCollapse and Collapse" uncollapseCollapse- , testProperty "Transpose twice is id" doubleTranspose- ]+ let tabulateIndex :: Coord cs -> Property+ tabulateIndex c = c === index (tabulate id :: Grid cs (Coord cs)) c+ collapseUnCollapse :: Property+ collapseUnCollapse =+ property $ do+ g :: Grid cs a <- sequenceA $ pure arbitrary+ return (Just g === gridFromList (collapseGrid g))+ uncollapseCollapse =+ property $ do+ cg :: [[a]] <-+ replicateM (fromIntegral $ natVal (Proxy @(CoordSized x))) $+ replicateM (fromIntegral $ natVal (Proxy @(CoordSized y))) $+ arbitrary+ return (Just cg === (collapseGrid <$> gridFromList @cs cg))+ doubleTranspose =+ property $ do+ g :: Grid cs a <- sequenceA $ pure arbitrary+ return (g === transposeGrid (transposeGrid g))+ in [ testProperty "Tabulate index" tabulateIndex+ , testProperty "Collapse UnCollapse" collapseUnCollapse+ , testProperty "UnCollapse and Collapse" uncollapseCollapse+ , testProperty "Transpose twice is id" doubleTranspose+ ] -twoDimensionalCoordTests :: (cs ~ '[x,y], All Show cs, All Eq cs) => Gen (Coord cs) -> [TestTree]-twoDimensionalCoordTests genC =- let doubleTranspose = property $ do- c <- forAll genC- c === tranposeCoord (tranposeCoord c)+splitTests ::+ forall c cs a.+ ( Show a+ , Eq a+ , Num a+ , All IsCoord (c ': cs)+ , KnownNat (CoordSized c * MaxCoordSize cs)+ , KnownNat (MaxCoordSize cs)+ , KnownNat (5 * MaxCoordSize cs)+ , KnownNat (3 * MaxCoordSize cs)+ , KnownNat (2 * MaxCoordSize cs)+ , KnownNat (CoordSized (CoordFromNat c 2) * MaxCoordSize cs)+ , KnownNat (CoordSized (CoordFromNat c 2))+ , AllSizedKnown cs+ , Arbitrary a+ )+ => Proxy (c ': cs)+ -> Proxy a+ -> [TestTree]+splitTests _ _ =+ let splitAndCombine =+ property $ do+ g :: Grid (c ': cs) a <- sequenceA $ pure arbitrary+ return (g === combineGrid (splitGrid g))+ combineAndSplit =+ property $ do+ g :: Grid '[ c] (Grid cs a) <-+ sequenceA $ pure (sequenceA $ pure arbitrary)+ return (g === splitGrid (combineGrid g))+ higherSplitAndCombine =+ property $ do+ g :: Grid (Ordinal 5 ': cs) a <- sequenceA $ pure arbitrary+ let (a :: Grid (Ordinal 3 ': cs) a, b) = splitHigherDim g+ return (g === combineHigherDim a b)+ higherCombineAndSplit =+ property $ do+ g1 :: Grid (Ordinal 3 ': cs) a <- sequenceA $ pure arbitrary+ g2 :: Grid (Ordinal 2 ': cs) a <- sequenceA $ pure arbitrary+ let g = combineHigherDim g1 g2+ return ((g1, g2) === splitHigherDim g)+ in [ testProperty "Split and Combine" splitAndCombine+ , testProperty "Combine and split" combineAndSplit+ , testProperty "Split and Combine Higher dim" higherSplitAndCombine+ , testProperty "Combine and Split Higher dim" higherCombineAndSplit+ ]++twoDimensionalCoordTests ::+ forall cs x y . (cs ~ '[ x, y], All Show cs, All Eq cs, All Arbitrary cs)+ => Proxy (Coord cs)+ -> [TestTree]+twoDimensionalCoordTests _ =+ let doubleTranspose :: Coord cs -> Property+ doubleTranspose c = c === tranposeCoord (tranposeCoord c) in [testProperty "Transpose twice is id" doubleTranspose] coordCreationTests ::- (All Show cs, All Eq cs, Eq a, Show a, Show c, Eq c)- => Gen (Coord (c ': cs))- -> Gen a+ forall cs a c.+ ( All Show cs+ , All Eq cs+ , Eq a+ , Show a+ , Show c+ , Eq c+ , Arbitrary a+ , All Arbitrary cs+ , Arbitrary c+ )+ => Proxy (Coord (c ': cs))+ -> Proxy a -> [TestTree] coordCreationTests genC gen = [ testProperty "Create single coord" $- property $ forAll gen >>= \g -> g === (singleCoord g ^. _1)- , testProperty "Create double coord" $ property $ do- a <- forAll gen- b <- forAll gen- let coord = appendCoord b $ singleCoord a- a === coord ^. _2- b === coord ^. _1- , testProperty "Create triple coord" $ property $ do- a <- forAll gen- b <- forAll gen- c <- forAll gen- let coord = appendCoord c $ appendCoord b $ singleCoord a- a === coord ^. _3- b === coord ^. _2- c === coord ^. _1- , testProperty "Head and append" $ property $ do- coord <- forAll genC- a <- forAll gen- let newCoord = appendCoord a coord- a === newCoord ^. coordHead- coord === newCoord ^. coordTail- , testProperty "Tail destruction" $ property $ do- coord <- forAll genC- appendCoord (coord ^. coordHead) (coord ^. coordTail) === coord+ property $ \(g :: a) -> g === (singleCoord g ^. _1)+ , testProperty "Create double coord" $+ property $ \(a :: a) (b :: a) ->+ let coord = b :| singleCoord a+ in (a === coord ^. _2) .&&. (b === coord ^. _1)+ , testProperty "Create triple coord" $+ property $ \(a :: a) (b :: a) (c :: a) ->+ let coord = c :| (b :| singleCoord a)+ in (a === coord ^. _3) .&&. (b === coord ^. _2) .&&. (c === coord ^. _1)+ , testProperty "Head and append" $+ property $ \(coord :: Coord (c ': cs)) (a :: a) ->+ let newCoord = appendCoord a coord+ in (a === newCoord ^. coordHead) .&&. (coord === newCoord ^. coordTail)+ , testProperty "Tail destruction" $+ property $ \(coord :: Coord (c ': cs)) ->+ appendCoord (coord ^. coordHead) (coord ^. coordTail) === coord ] main :: IO () main = let periodic =- let g :: Gen (Periodic 10) = genPeriodic- in [ semigroupLaws g- , monoidLaws g- , additiveGroupLaws g- , affineSpaceLaws g- , aesonLaws g+ let p = Proxy @(Periodic 10)+ in [ semigroupLaws p+ , monoidLaws p+ , additiveGroupLaws p+ , affineSpaceLaws p+ , aesonLaws p+ , isCoordLaws p ] hardWrap =- let g :: Gen (HardWrap 10) = HardWrap <$> Gen.enumBounded- in [semigroupLaws g, monoidLaws g, affineSpaceLaws g, aesonLaws g]+ let p = Proxy @(HardWrap 10)+ in [ semigroupLaws p+ , monoidLaws p+ , affineSpaceLaws p+ , aesonLaws p+ , isCoordLaws p+ ] coord =- let g :: Gen (Coord '[ HardWrap 10, Periodic 20]) =- genCoord- ((HardWrap <$> Gen.enumBounded) :*- (Periodic <$> Gen.enumBounded) :*- Nil)- in [ semigroupLaws g- , monoidLaws g- , affineSpaceLaws g- , aesonLaws g- , testAllCoordOrdered g+ let p = Proxy @(Coord '[ HardWrap 10, Periodic 20])+ in [ semigroupLaws p+ , monoidLaws p+ , affineSpaceLaws p+ , aesonLaws p+ , testAllCoordOrdered p ] coord2 =- let g :: Gen (Coord '[ Periodic 10, Periodic 20]) =- genCoord- ((Periodic <$> Gen.enumBounded) :*- (Periodic <$> Gen.enumBounded) :*- Nil)- in [ semigroupLaws g- , monoidLaws g- , affineSpaceLaws g- , additiveGroupLaws g- , aesonLaws g- , testAllCoordOrdered g+ let p = Proxy @(Coord '[ Periodic 10, Periodic 20])+ in [ semigroupLaws p+ , monoidLaws p+ , affineSpaceLaws p+ , additiveGroupLaws p+ , aesonLaws p+ , testAllCoordOrdered p ] in defaultMain $ testGroup@@ -170,34 +235,28 @@ , testGroup "HardWrap 20" hardWrap , testGroup "Coord [HardWrap 10, Periodic 20]" coord , testGroup "Coord [Periodic 10, Periodic 20]" coord2- , testGroup "2D Coords" $ twoDimensionalCoordTests- (genCoord- ((HardWrap <$> Gen.enumBounded) :*- (Periodic <$> Gen.enumBounded) :*- Nil) :: Gen (Coord '[ HardWrap 10, Periodic 10]))+ , testGroup "2D Coords" $+ twoDimensionalCoordTests (Proxy @(Coord '[ HardWrap 10, Periodic 10])) , testGroup "Coord creation" (coordCreationTests- (genCoord- ((HardWrap <$> Gen.enumBounded) :*- (Periodic <$> Gen.enumBounded) :*- Nil) :: Gen (Coord '[ HardWrap 10, Periodic 10]))- (Gen.enumBounded :: Gen Int))+ (Proxy @(Coord '[ HardWrap 10, Periodic 10]))+ (Proxy @Int)) , testGroup "Grid" ((gridTests- @'[ Periodic 10, Periodic 11]- (genCoord $- (Periodic <$> Gen.enumBounded) :* (Periodic <$> Gen.enumBounded) :*- Nil))- (Gen.int $ Range.linear 0 100) ++- [ applicativeLaws- (Proxy @(Grid '[ Periodic 10, Periodic 11]))- (Gen.int $ Range.linear 0 100)- , aesonLaws- (sequenceA $- pure @(Grid '[ Periodic 10, Periodic 11]) $- Gen.int $ Range.linear 0 100)- , eq1Laws (Proxy @(Grid '[ Periodic 10, Periodic 20]))- ])+ (Proxy @(Coord ('[ Periodic 10, Periodic 11])))+ (Proxy @Int) +++ [ applicativeLaws+ (Proxy @(Grid '[ Periodic 10, Periodic 11]))+ (Proxy @Int)+ , aesonLaws (Proxy @(Grid '[ Periodic 10, Periodic 11] Int))+ , eq1Laws (Proxy @(Grid '[ Periodic 10, Periodic 20]))+ ]))+ , testGroup+ "Splitting"+ (splitTests+ (Proxy @('[ HardWrap 8, HardWrap 3, HardWrap 5]))+ (Proxy @Int))+ , shrinkTests ]
+ tests/Test/Shrink.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Shrink where++import Data.Maybe (fromJust)+import SizedGrid+import Test.Tasty+import Test.Tasty.HUnit++exampleGrid :: Grid '[Ordinal 3, Ordinal 3] Int+exampleGrid = fromJust $ gridFromList [[1,2,3],[4,5,6],[7,8,9]]++focusCenter :: Grid '[ Ordinal 1, Ordinal 1] Int+focusCenter =+ let c :: Coord '[Ordinal 3, Ordinal 3] =+ fromJust $+ (\x y -> x :| y :| EmptyCoord) <$> numToOrdinal (1 :: Int) <*>+ numToOrdinal (1 :: Int)+ in shrinkGrid c exampleGrid++shrinkTests :: TestTree+shrinkTests = testCase "Focusing" $ do+ assertEqual "Focus Center" focusCenter $ fromJust (gridFromList [[5]])
tests/Test/Utils.hs view
@@ -1,22 +1,30 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Utils where +import SizedGrid.Coord.Class+import SizedGrid.Ordinal++#if MIN_VERSION_base(4,11,0)+#else+import Data.Semigroup+#endif+import Control.Lens import Data.AdditiveGroup import Data.Aeson import Data.AffineSpace import Data.Functor.Classes+import Data.Functor.Compose import Data.Proxy-import Data.Semigroup-import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range+import GHC.TypeLits import Test.Tasty-import Test.Tasty.Hedgehog import Test.Tasty.HUnit+import Test.Tasty.QuickCheck eq1Laws :: forall f. (Eq1 f, Applicative f)@@ -27,39 +35,35 @@ assertEqual "Nil equal" True $ liftEq (==) (pure ()) (pure @f ()) in testGroup "Eq1 Laws" [testCase "Nil Eq" nilEq] -aesonLaws :: (Show a, Eq a, ToJSON a, FromJSON a) => Gen a -> TestTree-aesonLaws gen =- let encodeDecode = property $ do- a <- forAll gen- Just a === decode (encode a)- in testGroup "Aeson Laws" [testProperty "Encode decode" encodeDecode]+aesonLaws ::+ forall a proxy. (Show a, Eq a, ToJSON a, FromJSON a, Arbitrary a)+ => proxy a+ -> TestTree+aesonLaws _ =+ let encodeDecode :: a -> Property+ encodeDecode a = Just a === decode (encode a)+ in testGroup "Aeson Laws" [testProperty "Encode decode" encodeDecode] -semigroupLaws :: (Show a, Eq a, Semigroup a) => Gen a -> TestTree-semigroupLaws gen =- let assoc = property $ do- a <- forAll gen- b <- forAll gen- c <- forAll gen- a <> (b <> c) === (a <> b) <> c+semigroupLaws ::+ forall a proxy. (Show a, Eq a, Semigroup a, Arbitrary a)+ => proxy a+ -> TestTree+semigroupLaws _ =+ let assoc :: a -> a -> a -> Property+ assoc a b c = a <> (b <> c) === (a <> b) <> c in testGroup "Semigroup Laws" [testProperty "Associative" assoc] -monoidLaws :: (Show a, Eq a, Monoid a) => Gen a -> TestTree-monoidLaws gen =- let assoc =- property $ do- a <- forAll gen- b <- forAll gen- c <- forAll gen- mappend a (mappend b c) === mappend (mappend a b) c- memptyId =- property $ do- a <- forAll gen- a === mappend mempty a- a === mappend a mempty- concatIsFold =- property $ do- as <- forAll $ Gen.list (Range.linear 0 100) gen- mconcat as === foldr mappend mempty as+monoidLaws ::+ forall a proxy. (Show a, Eq a, Monoid a, Arbitrary a)+ => proxy a+ -> TestTree+monoidLaws _ =+ let assoc :: a -> a -> a -> Property+ assoc a b c = mappend a (mappend b c) === mappend (mappend a b) c+ memptyId :: a -> Property+ memptyId a = (a === (mappend mempty a)) .&&. ((a === mappend a mempty))+ concatIsFold :: [a] -> Property+ concatIsFold as = mconcat as === foldr mappend mempty as in testGroup "Monoid laws" [ testProperty "Associative" assoc@@ -67,26 +71,19 @@ , testProperty "Concat is Fold" concatIsFold ] -additiveGroupLaws :: (Show a, Eq a, AdditiveGroup a) => Gen a -> TestTree-additiveGroupLaws gen =- let assoc =- property $ do- a <- forAll gen- b <- forAll gen- c <- forAll gen- a ^+^ (b ^+^ c) === (a ^+^ b) ^+^ c- zeroId =- property $ do- a <- forAll gen- a === zeroV ^+^ a- a === a ^+^ zeroV- inverseId = property $ do- a <- forAll gen- a ^-^ a === zeroV- takeLeaves = property $ do- a <- forAll gen- b <- forAll gen- a ^-^ (a ^-^ b) === b+additiveGroupLaws ::+ forall a proxy. (Show a, Eq a, AdditiveGroup a, Arbitrary a)+ => proxy a+ -> TestTree+additiveGroupLaws _ =+ let assoc :: a -> a -> a -> Property+ assoc a b c = a ^+^ (b ^+^ c) === (a ^+^ b) ^+^ c+ zeroId :: a -> Property+ zeroId a = (a === zeroV ^+^ a) .&&. (a === a ^+^ zeroV)+ inverseId :: a -> Property+ inverseId a = a ^-^ a === zeroV+ takeLeaves :: a -> a -> Property+ takeLeaves a b = a ^-^ (a ^-^ b) === b in testGroup "AdditiveGroup laws" [ testProperty "Associative" assoc@@ -96,41 +93,121 @@ ] affineSpaceLaws ::- (Show a, Eq a, AffineSpace a, Eq (Diff a), Show (Diff a))- => Gen a- -> TestTree-affineSpaceLaws gen =- let addZero =- property $ do- a <- forAll gen- a === a .+^ zeroV- takeSelf =- property $ do- a <- forAll gen- a .-. a === zeroV- in testGroup- "AffineSpace Laws"- [testProperty "Add Zero" addZero, testProperty "Take self" takeSelf]+ forall a proxy.+ (Arbitrary a, Show a, Eq a, AffineSpace a, Eq (Diff a), Show (Diff a))+ => proxy a+ -> TestTree+affineSpaceLaws _ =+ let addZero :: a -> Property+ addZero a = a === a .+^ zeroV+ takeSelf :: a -> Property+ takeSelf a = a .-. a === zeroV+ in testGroup+ "AffineSpace Laws"+ [testProperty "Add Zero" addZero, testProperty "Take self" takeSelf] applicativeLaws ::- forall f a.- (Applicative f, Traversable f, Show (f a), Eq (f a), Num a, Show a)- => Proxy f- -> Gen a- -> TestTree-applicativeLaws _ gen =- let genF :: Gen (f a) = sequence $ pure gen- identiy =- property $ do- v <- forAll genF- v === (pure id <*> v)- homomorphism =- property $ do- x <- forAll gen- f <- (+) <$> forAll gen- (pure f <*> pure x) === pure @f (f x)- in testGroup- "Applicative Laws"- [ testProperty "Identity" identiy- , testProperty "Homomorphism" homomorphism- ]+ forall f a.+ ( Applicative f+ , Traversable f+ , Show (f a)+ , Eq (f a)+ , Show a+ , Arbitrary a+ , Arbitrary1 f+ , Function a+ , CoArbitrary a+ )+ => Proxy f+ -> Proxy a+ -> TestTree+applicativeLaws _ _ =+ let identiy :: Gen Property+ identiy = do+ v :: f a <- liftArbitrary arbitrary+ return (v === (pure id <*> v))+ homomorphism = do+ x :: a <- arbitrary+ f :: (a -> a) <- applyFun <$> arbitrary+ return ((pure f <*> pure x) === pure @f (f x))+ interchange :: Gen Property+ interchange = do+ u :: f (a -> a) <- liftArbitrary (applyFun <$> arbitrary)+ y :: a <- arbitrary+ let lhs :: f a = u <*> pure y+ rhs :: f a = pure ($ y) <*> u+ return (lhs === rhs)+ fmapLaw = do+ f :: (a -> a) <- applyFun <$> arbitrary+ x :: f a <- liftArbitrary arbitrary+ return ((f <$> x) === (pure f <*> x))+ composition = do+ u :: f (a -> a) <- liftArbitrary (applyFun <$> arbitrary)+ v :: f (a -> a) <- liftArbitrary (applyFun <$> arbitrary)+ w :: f a <- liftArbitrary arbitrary+ let lhs = u <*> (v <*> w)+ rhs = pure (.) <*> u <*> v <*> w+ return (lhs === rhs)+ in testGroup+ "Applicative Laws"+ [ testProperty "Identity" (property identiy)+ , testProperty "Homomorphism" (property homomorphism)+ , testProperty "Interchange" (property interchange)+ , testProperty "Fmap Law" (property fmapLaw)+ , testProperty "Composiiton" (property composition)+ ]++traversalLaws ::+ forall a f b.+ ( Eq a+ , Show a+ , Functor f+ , Arbitrary a+ , Function b+ , CoArbitrary b+ , Arbitrary b+ )+ => Traversal' a (f b)+ -> TestTree+traversalLaws t =+ let pureId =+ property $ do+ a :: a <- arbitrary+ return (pure @[] a === t pure a)+ compose =+ property $ do+ a :: a <- arbitrary+ fFunc :: b -> b <- applyFun <$> arbitrary+ gFunc :: b -> b <- applyFun <$> arbitrary+ let raiseFunc f x = Just (f <$> x)+ return+ (fmap (t (raiseFunc fFunc)) (t (raiseFunc gFunc) a) ===+ getCompose+ (t (Compose . fmap (raiseFunc fFunc) . (raiseFunc gFunc)) a))+ in testGroup+ "Traveral Laws"+ [testProperty "Pure Id" pureId, testProperty "Compose" compose]++isCoordLaws ::+ forall a. (IsCoord a)+ => Proxy a+ -> TestTree+isCoordLaws p =+ testCase "IsCoord Laws" $ do+ assertEqual+ "Max coord size is sCoordSized"+ (maxCoordSize p)+ (natVal (sCoordSized p) - 1)+ assertEqual+ "zeroPosition is Zero"+ (0 :: Int)+ (ordinalToNum $ view asOrdinal (zeroPosition @a))+ assertEqual+ "Size Proxy Zero"+ (0 :: Integer)+ (asSizeProxy (zeroPosition @a) natVal)+ assertEqual+ "Max size equality"+ (ordinalToNum $ view asOrdinal (maxCoord @a))+ (maxCoordSize p)+