sized-grid 0.1.0.0 → 0.1.1.0

raw patch · 8 files changed

+173/−78 lines, 8 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.lhs +4/−0
• README.md +4/−0
• sized-grid.cabal +4/−4
• src/SizedGrid.hs +1/−0
• src/SizedGrid/Coord.hs +36/−3
• src/SizedGrid/Coord/Class.hs +11/−9
• tests/Main.hs +108/−62

@@ -1,5 +1,10 @@ # Revision history for sized-grid +## 0.1.1.0 -- 2018-05-10++* Added Field instances for coord+* Added ways of manipulating coords+ ## 0.1.0.0  -- 2018-04-18  * First version. 

@@ -1,5 +1,7 @@ [![Build Status](https://travis-ci.org/edwardwas/sized-grid.svg?branch=master)](https://travis-ci.org/edwardwas/sized-grid) +![Hackage](https://img.shields.io/hackage/v/sized-grid)+ sized-grid =========== @@ -21,6 +23,8 @@ The last type value of `Grid` is the type of each element.   The other main type is `Coord cs`, where `cs` is, again, a type level list of coordinate types. For example, `Coord '[Periodic 3, HardWrap 4]` is a coordinate in a 3 by 4 2D space. The different types (`Periodic` and `HardWrap`) tell how to handle combining theses different numbers. `Coord cs` is an instance of `Semigroup`, `Monoid` and `AdditiveGroup` as long as each of the coordinates is also an instance of that typeclass. `Coord` is also an instance of of `AffineSpace`, where `Diff` is a n-tuple, meaning we can pattern match and do all sorts of nice things.++For working directly with `Coord`s, one can construct them with `singleCoord` and `appendCoord` and consume and update them with `coordHead` and `coordTail`. They are also instances of `FieldN` from lens, allowing one to directly update or get a certain dimension.  There is a deliberately small number of functions that work over `Grid`: we instead opt for using typeclasses to create the required functionality. `Grid` is an instance of the following types (with some required constraints): 

@@ -1,5 +1,7 @@ [![Build Status](https://travis-ci.org/edwardwas/sized-grid.svg?branch=master)](https://travis-ci.org/edwardwas/sized-grid) +![Hackage](https://img.shields.io/hackage/v/sized-grid)+ sized-grid =========== @@ -21,6 +23,8 @@ The last type value of `Grid` is the type of each element.   The other main type is `Coord cs`, where `cs` is, again, a type level list of coordinate types. For example, `Coord '[Periodic 3, HardWrap 4]` is a coordinate in a 3 by 4 2D space. The different types (`Periodic` and `HardWrap`) tell how to handle combining theses different numbers. `Coord cs` is an instance of `Semigroup`, `Monoid` and `AdditiveGroup` as long as each of the coordinates is also an instance of that typeclass. `Coord` is also an instance of of `AffineSpace`, where `Diff` is a n-tuple, meaning we can pattern match and do all sorts of nice things.++For working directly with `Coord`s, one can construct them with `singleCoord` and `appendCoord` and consume and update them with `coordHead` and `coordTail`. They are also instances of `FieldN` from lens, allowing one to directly update or get a certain dimension.  There is a deliberately small number of functions that work over `Grid`: we instead opt for using typeclasses to create the required functionality. `Grid` is an instance of the following types (with some required constraints): 

@@ -1,5 +1,5 @@ name: sized-grid-version: 0.1.0.0+version: 0.1.1.0 cabal-version: >=1.10 category: Data build-type: Simple@@ -31,7 +31,7 @@         SizedGrid.Grid.Focused         SizedGrid     build-depends:-        base >=4.8 && <4.12,+        base >=4.9 && <4.12,         lens >=4.16.1 && <4.17,         vector >=0.12.0.1 && <0.13,         vector-space ==0.13.*,@@ -53,7 +53,7 @@     type: exitcode-stdio-1.0     main-is: Main.hs     build-depends:-        base >=4.8 && <4.12,+        base >=4.9 && <4.12,         sized-grid -any,         hedgehog >=0.5.3 && <0.6,         tasty >=1.0.1.1 && <1.1,@@ -73,7 +73,7 @@     type: exitcode-stdio-1.0     main-is: README.lhs     build-depends:-        base >=4.10.1.0 && <4.11,+        base >=4.9 && <4.12,         markdown-unlit >=0.5.0 && <0.6,         sized-grid -any,         distributive >=0.5.3 && <0.6,

@@ -2,6 +2,7 @@  module SizedGrid     (+      -- This reexports all of SizedGrid. Import this and you're godo to go       module X       -- * Rexported for generics-sop     , All

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds             #-} {-# LANGUAGE ScopedTypeVariables   #-}@@ -16,12 +17,11 @@  import           Control.Applicative   (liftA2) import           Control.Applicative   (empty)-import           Control.Lens          ((^.))+import           Control.Lens          hiding (from, to) import           Control.Monad.State import           Data.AdditiveGroup import           Data.Aeson import           Data.AffineSpace-import           Data.Functor.Identity import           Data.List             (intercalate) import           Data.Semigroup        (Semigroup (..)) import qualified Data.Vector           as V@@ -41,6 +41,9 @@ newtype Coord cs = Coord {unCoord :: NP I cs}   deriving (Generic) +_WrappedCoord :: Lens' (Coord cs) (NP I cs)+_WrappedCoord f (Coord n) = Coord <$> f n+ instance All Eq cs => Eq (Coord cs) where     Coord a == Coord b =         and $@@ -76,7 +79,6 @@                         (hcmap (Proxy @FromJSON) (\(K x) -> parseJSON x) a)                 Nothing -> empty - instance All Semigroup cs => Semigroup (Coord cs) where   Coord a <> Coord b = Coord $ hcliftA2 (Proxy :: Proxy Semigroup) (liftA2 (<>)) a b @@ -111,6 +113,37 @@                          ma)                     g         in (Coord c, g')++-- | Get the first element of a coord. Thanks to type level information, we can write this as a total `Lens`+coordHead :: Lens (Coord (a ': as)) (Coord (a' ': as)) a a'+coordHead f (Coord (I a :* as)) = (\a' -> Coord (I a' :* as)) <$> f a++-- | A `Lens` into the the tail of `Coord`+coordTail :: Lens (Coord (a ': as)) (Coord (a ': as')) (Coord as) (Coord as')+coordTail f (Coord (a :* as)) = (\(Coord as') -> Coord (a :* as')) <$> f (Coord as)++-- | Turn a single element into a one dimensional `Coord`+singleCoord :: a -> Coord '[a]+singleCoord a = Coord (I a :* Nil)++-- | Add a new element to a `Coord`. This increases the dimensionality+appendCoord :: a -> Coord as -> Coord (a ': as)+appendCoord a (Coord as) = Coord (I a :* as)++instance Field1 (Coord (a ': cs)) (Coord (a' ': cs)) a a' where+  _1 = coordHead++instance Field2 (Coord (a ': b ': cs)) (Coord (a ': b' ': cs)) b b' where+  _2 = coordTail . _1++instance Field3 (Coord (a ': b ': c ': cs)) (Coord (a ': b ': c' ': cs)) c c' where+  _3 = coordTail . _2++instance Field4 (Coord (a ': b ': c ': d ': cs)) (Coord (a ': b ': c ': d' ': cs)) d d' where+  _4 = coordTail . _3++instance Field5 (Coord (a ': b ': c ': d ': e ': cs)) (Coord (a ': b ': c ': d ': e' ': cs)) e e' where+  _5 = coordTail . _4  -- | The type of difference between two coords. A n-dimensional coord should have a `Diff` of an n-tuple of `Integers`. We use `Identity` and our 1-tuple. Unfortuantly, each instance is manual at the moment. type family CoordDiff (cs :: [k]) :: *

@@ -1,11 +1,13 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE PolyKinds         #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE TypeFamilies      #-}-{-# LANGUAGE TypeOperators     #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE DefaultSignatures   #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeOperators       #-}  module SizedGrid.Coord.Class where @@ -17,7 +19,7 @@  -- | 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 can remove `CoordSized`+-- 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   -- | The maximum number of values that a Coord can take   type CoordSized c :: Nat

@@ -9,23 +9,20 @@  module Main where -import           SizedGrid.Coord-import           SizedGrid.Coord.Class-import           SizedGrid.Coord.HardWrap-import           SizedGrid.Coord.Periodic-import           SizedGrid.Grid.Grid+import           SizedGrid  import           Test.Utils -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           Generics.SOP        hiding (S, Z) import           GHC.TypeLits-import qualified GHC.TypeLits             as GHC+import qualified GHC.TypeLits        as GHC import           Hedgehog-import qualified Hedgehog.Gen             as Gen-import qualified Hedgehog.Range           as Range+import qualified Hedgehog.Gen        as Gen+import qualified Hedgehog.Range      as Range import           Test.Tasty import           Test.Tasty.Hedgehog import           Test.Tasty.HUnit@@ -83,58 +80,107 @@        , testProperty "UnCollapse and Collapse" uncollapseCollapse        ] +coordCreationTests ::+     (All Show cs, All Eq cs, Eq a, Show a, Show c, Eq c)+  => Gen (Coord (c ': cs))+  -> Gen 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+  ]+ main :: IO () main =-    let periodic =-            let g :: Gen (Periodic 10) = genPeriodic-            in [ semigroupLaws g-               , monoidLaws g-               , additiveGroupLaws g-               , affineSpaceLaws g-               , aesonLaws g-               ]-        hardWrap =-            let g :: Gen (HardWrap 10) = HardWrap <$> Gen.enumBounded-            in [semigroupLaws g, monoidLaws g, affineSpaceLaws g, aesonLaws g]-        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]-        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-               ]-    in defaultMain $-       testGroup-           "tests"-           [ testGroup "Periodic 20" periodic-           , testGroup "HardWrap 20" hardWrap-           , testGroup "Coord [HardWrap 10, Periodic 20]" coord-           , testGroup "Coord [Periodic 10, Periodic 20]" coord2-           , 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]))-                  ])+  let periodic =+        let g :: Gen (Periodic 10) = genPeriodic+        in [ semigroupLaws g+           , monoidLaws g+           , additiveGroupLaws g+           , affineSpaceLaws g+           , aesonLaws g            ]+      hardWrap =+        let g :: Gen (HardWrap 10) = HardWrap <$> Gen.enumBounded+        in [semigroupLaws g, monoidLaws g, affineSpaceLaws g, aesonLaws g]+      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+           ]+      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+           ]+  in defaultMain $+     testGroup+       "tests"+       [ testGroup "Periodic 20" periodic+       , testGroup "HardWrap 20" hardWrap+       , testGroup "Coord [HardWrap 10, Periodic 20]" coord+       , testGroup "Coord [Periodic 10, Periodic 20]" coord2+       , testGroup+           "Coord creation"+           (coordCreationTests+              (genCoord+                 ((HardWrap <$> Gen.enumBounded) :*+                  (Periodic <$> Gen.enumBounded) :*+                  Nil) :: Gen (Coord '[ HardWrap 10, Periodic 10]))+              (Gen.enumBounded :: Gen 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]))+            ])+       ]