sized-grid 0.1.1.0 → 0.1.1.1

raw patch · 6 files changed

+105/−69 lines, 6 filesdep ~aesondep ~hedgehogdep ~tastyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, hedgehog, tasty, tasty-hedgehog

API changes (from Hackage documentation)

Files

• sized-grid.cabal +6/−6
• src/SizedGrid/Coord.hs +5/−0
• src/SizedGrid/Coord/Periodic.hs +4/−0
• src/SizedGrid/Grid/Class.hs +5/−0
• src/SizedGrid/Grid/Grid.hs +68/−63
• tests/Main.hs +17/−0

@@ -1,5 +1,5 @@ name: sized-grid-version: 0.1.1.0+version: 0.1.1.1 cabal-version: >=1.10 category: Data build-type: Simple@@ -42,7 +42,7 @@         random ==1.1.*,         mtl >=2.2.2 && <2.3,         constraints ==0.10.*,-        aeson >=1.2.4.0 && <1.3+        aeson >=1.2.4.0 && <1.5     default-language: Haskell2010     hs-source-dirs: src     other-modules:@@ -55,14 +55,14 @@     build-depends:         base >=4.9 && <4.12,         sized-grid -any,-        hedgehog >=0.5.3 && <0.6,-        tasty >=1.0.1.1 && <1.1,-        tasty-hedgehog >=0.1.0.2 && <0.2,+        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.3,+        aeson >=1.2.4.0 && <1.5,         HUnit >=1.6.0.0 && <1.7,         tasty-hunit >=0.10.0.1 && <0.11     default-language: Haskell2010

@@ -41,6 +41,7 @@ newtype Coord cs = Coord {unCoord :: NP I cs}   deriving (Generic) + _WrappedCoord :: Lens' (Coord cs) (NP I cs) _WrappedCoord f (Coord n) = Coord <$> f n @@ -257,3 +258,7 @@                      (\(I a) -> K (abs $ fromIntegral a)) $                  from (min (new .-. c) (c .-. new))) <= n     in filter helper $ moorePoints n c++-- | 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)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                        #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-}@@ -22,7 +23,10 @@ import           Data.AffineSpace import           Data.Maybe            (fromJust) import           Data.Proxy+#if MIN_VERSION_base(4,11,0)+#else import           Data.Semigroup+#endif import           GHC.TypeLits import           System.Random 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                    #-} {-# LANGUAGE FlexibleContexts       #-} {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}@@ -15,7 +16,11 @@  import           Control.Lens           hiding (index) import           Data.Functor.Rep+#if MIN_VERSION_base(4,11,0)+#else import           Data.Semigroup         hiding (All (..))+#endif+ import           Generics.SOP import qualified GHC.TypeLits           as GHC 

@@ -27,41 +27,38 @@  -- | A multi dimensional sized grid newtype Grid (cs :: [*]) a = Grid-    { unGrid :: V.Vector a-    } deriving (Eq, Show, Functor, Foldable, Traversable, Eq1, Show1)+  { unGrid :: V.Vector a+  } deriving (Eq, Show, Functor, Foldable, Traversable, Eq1, Show1)  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+  pure =+    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) => Monad (Grid cs) where+instance (GHC.KnownNat (MaxCoordSize 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) =>          Distributive (Grid cs) where-    distribute = distributeRep+  distribute = distributeRep  instance (All IsCoord cs, GHC.KnownNat (MaxCoordSize cs)) =>          Representable (Grid cs) where-    type Rep (Grid cs) = Coord cs-    tabulate func = Grid $ V.fromList $ map func $ allCoord-    index (Grid v) c = v V.! coordPosition c+  type Rep (Grid cs) = Coord cs+  tabulate func = Grid $ V.fromList $ map func $ allCoord+  index (Grid v) c = v V.! coordPosition c -instance (All IsCoord cs) =>-         FunctorWithIndex (Coord cs) (Grid cs) where-    imap func (Grid v) = Grid $ V.zipWith func (V.fromList allCoord) v+instance (All IsCoord cs) => FunctorWithIndex (Coord cs) (Grid cs) where+  imap func (Grid v) = Grid $ V.zipWith func (V.fromList allCoord) v -instance (All IsCoord cs) =>-         FoldableWithIndex (Coord cs) (Grid cs) where-    ifoldMap func (Grid v) = foldMap id $ V.zipWith func (V.fromList allCoord) v+instance (All IsCoord cs) => FoldableWithIndex (Coord cs) (Grid cs) where+  ifoldMap func (Grid v) = foldMap id $ V.zipWith func (V.fromList allCoord) v -instance (All IsCoord cs) =>-         TraversableWithIndex (Coord cs) (Grid cs) where-    itraverse func (Grid v) =-        Grid <$> sequenceA (V.zipWith func (V.fromList allCoord) v)+instance (All IsCoord cs) => TraversableWithIndex (Coord cs) (Grid cs) where+  itraverse func (Grid v) =+    Grid <$> sequenceA (V.zipWith func (V.fromList allCoord) v)  -- | The first element of a type level list type family Head xs where@@ -78,10 +75,10 @@  -- | A Constraint that all grid sizes are instances of `KnownNat` type family AllGridSizeKnown cs :: Constraint where-    AllGridSizeKnown '[] = ()-    AllGridSizeKnown cs = ( GHC.KnownNat (CoordSized (Head cs))-                          , GHC.KnownNat (MaxCoordSize (Tail cs))-                          , AllGridSizeKnown (Tail cs))+  AllGridSizeKnown '[] = ()+  AllGridSizeKnown cs = ( GHC.KnownNat (CoordSized (Head cs))+                        , GHC.KnownNat (MaxCoordSize (Tail cs))+                        , AllGridSizeKnown (Tail cs))  -- | Convert a vector into a list of `Vector`s, where all the elements of the list have the given size. splitVectorBySize :: Int -> V.Vector a -> [V.Vector a]@@ -92,49 +89,57 @@  -- | Convert a grid to a series of nested lists. This removes type level information, but it is sometimes easier to work with lists collapseGrid ::-       forall cs a.-       ( SListI cs-       , AllGridSizeKnown cs-       )-    => Grid cs a-    -> CollapseGrid cs a+     forall cs a. (SListI cs, AllGridSizeKnown cs)+  => Grid cs a+  -> CollapseGrid cs a collapseGrid (Grid v) =-    case (shape :: Shape cs) of-        ShapeNil -> v V.! 0-        ShapeCons _ ->-            map (collapseGrid . Grid @(Tail cs)) $-            splitVectorBySize-                (fromIntegral $ GHC.natVal (Proxy @(MaxCoordSize (Tail cs))))-                v+  case (shape :: Shape cs) of+    ShapeNil -> v V.! 0+    ShapeCons _ ->+      map (collapseGrid . Grid @(Tail cs)) $+      splitVectorBySize+        (fromIntegral $ GHC.natVal (Proxy @(MaxCoordSize (Tail cs))))+        v  -- | Convert a series of nested lists to a grid. If the size of the grid does not match the size of lists this will be `Nothing` gridFromList ::-       forall cs a. (SListI cs, AllGridSizeKnown cs)-    => CollapseGrid cs a-    -> Maybe (Grid cs a)+     forall cs a. (SListI cs, AllGridSizeKnown cs)+  => CollapseGrid cs a+  -> Maybe (Grid cs a) gridFromList cg =-    case (shape :: Shape cs) of-        ShapeNil -> Just $ Grid $ V.singleton $ cg-        ShapeCons _ ->-            if length cg == fromIntegral (GHC.natVal (Proxy @(CoordSized (Head cs))))-                then Grid . mconcat <$>-                     traverse (fmap unGrid . gridFromList @(Tail cs)) cg-                else Nothing+  case (shape :: Shape cs) of+    ShapeNil -> Just $ Grid $ V.singleton $ cg+    ShapeCons _ ->+      if length cg == fromIntegral (GHC.natVal (Proxy @(CoordSized (Head cs))))+        then Grid . mconcat <$>+             traverse (fmap unGrid . gridFromList @(Tail cs)) cg+        else Nothing  instance (AllGridSizeKnown cs, ToJSON a, SListI cs) => ToJSON (Grid cs a) where-    toJSON (Grid v) =-        case (shape :: Shape cs) of-            ShapeNil -> toJSON (v V.! 0)-            ShapeCons _ ->-                toJSON $-                map (toJSON . Grid @(Tail cs)) $-                splitVectorBySize-                    (fromIntegral $ GHC.natVal (Proxy @(MaxCoordSize (Tail cs))))-                    v+  toJSON (Grid v) =+    case (shape :: Shape cs) of+      ShapeNil -> toJSON (v V.! 0)+      ShapeCons _ ->+        toJSON $+        map (toJSON . Grid @(Tail cs)) $+        splitVectorBySize+          (fromIntegral $ GHC.natVal (Proxy @(MaxCoordSize (Tail cs))))+          v  instance (All IsCoord cs, FromJSON a) => FromJSON (Grid cs a) where-  parseJSON v = case (shape :: Shape cs) of-    ShapeNil -> Grid . V.singleton <$> parseJSON v-    ShapeCons _ -> do-      a :: [Grid (Tail cs) a] <- parseJSON v-      return $ Grid $ foldMap unGrid a+  parseJSON v =+    case (shape :: Shape cs) of+      ShapeNil -> Grid . V.singleton <$> parseJSON v+      ShapeCons _ -> do+        a :: [Grid (Tail cs) a] <- parseJSON v+        return $ Grid $ foldMap unGrid a++transposeGrid ::+     ( IsCoord h+     , IsCoord w+     , GHC.KnownNat (MaxCoordSize '[ w, h])+     , GHC.KnownNat (MaxCoordSize '[ h, w])+     )+  => Grid '[ w, h] a+  -> Grid '[ h, w] a+transposeGrid g = tabulate $ \i -> index g $ tranposeCoord i

@@ -56,6 +56,7 @@        , Eq a        , AllGridSizeKnown cs        , cs ~ '[x,y]+       , GHC.KnownNat (MaxCoordSize '[y,x])        )     => Gen (Coord cs)     -> Gen a@@ -75,11 +76,22 @@                     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        ] +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)+  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))@@ -158,6 +170,11 @@        , 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            "Coord creation"            (coordCreationTests