diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,11 @@ # Grids +[HACKAGE](http://hackage.haskell.org/package/grids) + Grids can have an arbitrary amount of dimensions, specified by a type-level -list of `Nat`s. They're backed by a single contiguous Vector and gain the associated performance benefits. Currently -only boxed immutable vectors are supported, but let me know if you need other variants. +list of `Nat`s. They're backed by a single contiguous Vector and gain the +associated performance benefits. Currently only boxed immutable vectors are +supported, but let me know if you need other variants. Here's how we might represent a Tic-Tac-Toe board: @@ -15,7 +18,8 @@ ticTacToe = generate toPiece ``` -You can collapse the grid down to nested lists! The output type of `toNestedLists` depends on your dimensions, e.g.: +You can collapse the grid down to nested lists! The output type of +`toNestedLists` depends on your dimensions, e.g.: - `Grid [3, 3] Piece` will generate: `[[Piece]]` - `Grid [2, 2, 2] Char` will generate: `[[[Char]]]` diff --git a/grids.cabal b/grids.cabal --- a/grids.cabal +++ b/grids.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: a9762c7345dd2ce0dbbd1c65d6e6529407c552773f52e506e39795e5ca9b3793 +-- hash: 21db274f8abd8e6d956d24ef25c4ad5c0c1118727eccae42c59a1db28229edd3 name: grids -version: 0.1.1.0 +version: 0.2.0.0 description: Arbitrary sized type-safe grids with useful combinators category: Data Structures homepage: https://github.com/ChrisPenner/grids#readme @@ -39,6 +39,5 @@ , base >=4.7 && <5 , distributive , finite-typelits - , lens , vector default-language: Haskell2010 diff --git a/src/Data/Grid.hs b/src/Data/Grid.hs --- a/src/Data/Grid.hs +++ b/src/Data/Grid.hs @@ -4,6 +4,7 @@ {-# language ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -12,30 +13,29 @@ {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE UndecidableSuperClasses #-} +{-# LANGUAGE RankNTypes #-} -module Data.Grid ( - Grid(..) - , GridSize - , Coord - , (:#)(..) - , gridSize - , Dimensions(..) - , generate - , NestLists(..) - , UnNestLists(..) - , fromNestedLists - , fromList - , (//) - ) where +module Data.Grid + ( Grid(..) + , GridSize + , Dimensions(..) + , Coord + , (:#)(..) + , NestedLists + , generate + , toNestedLists + , fromNestedLists + , fromList + , (//) + ) +where import Data.Distributive import Data.Functor.Rep import qualified Data.Vector as V -import GHC.TypeLits as L import Data.Proxy -import Data.Functor.Compose -import Control.Lens import Data.Kind import GHC.TypeNats as N import Data.Finite @@ -43,11 +43,24 @@ import Data.List import Data.Bifunctor +toFinite :: (KnownNat n) => Integral m => m -> Finite n +toFinite = finite . fromIntegral + +fromFinite :: Num n => Finite m -> n +fromFinite = fromIntegral . getFinite + +-- | An grid of arbitrary dimensions. +-- +-- e.g. a @Grid [2, 3] Int@ might look like: +-- +-- > generate id :: Grid [2, 3] Int +-- > (Grid [[0,1,2], +-- > [3,4,5]]) newtype Grid (dims :: [Nat]) a = Grid (V.Vector a) deriving (Eq, Functor, Foldable, Traversable) -instance (NestLists dims, Show (NestedLists dims a)) => Show (Grid dims a) where +instance (Dimensions dims, Show (NestedLists dims a)) => Show (Grid dims a) where show g = "(Grid " ++ show (toNestedLists g) ++ ")" instance (Dimensions dims, Semigroup a) => Semigroup (Grid dims a) where @@ -60,38 +73,49 @@ pure a = tabulate (const a) liftA2 f (Grid v) (Grid u) = Grid $ V.zipWith f v u -type family GridSize dims :: Nat where +-- | Calculate the number of elements in a grid of the given dimensionality +type family GridSize (dims :: [Nat]) :: Nat where + GridSize '[] = 0 GridSize (x:'[]) = x GridSize (x:xs) = (x N.* GridSize xs) +-- | Used for constructing arbitrary depth coordinate lists +-- e.g. @('Finite' 2 ':#' 'Finite' 3)@ data x :# y = x :# y deriving (Show, Eq, Ord) infixr 9 :# +-- | The coordinate type for a given dimensionality +-- +-- > Coord [2, 3] == Finite 2 :# Finite 3 +-- > Coord [4, 3, 2] == Finite 4 :# Finite 3 :# Finite 2 type family Coord (dims :: [Nat]) where Coord '[n] = Finite n Coord (n:xs) = Finite n :# Coord xs -gridSize - :: forall (dims :: [Nat]) . KnownNat (GridSize dims) => Proxy dims -> Int -gridSize _ = fromIntegral (L.natVal (Proxy @(GridSize dims))) - -class (KnownNat (GridSize dims)) => Dimensions (dims :: [Nat]) where +-- | Represents valid dimensionalities. All non empty lists of Nats have +-- instances +class (AllC KnownNat dims, KnownNat (GridSize dims)) => Dimensions (dims :: [Nat]) where toCoord :: Proxy dims -> Finite (GridSize dims) -> Coord dims fromCoord :: Proxy dims -> Coord dims -> Finite (GridSize dims) + gridSize + :: Proxy dims -> Int + gridSize _ = fromIntegral $ natVal (Proxy @(GridSize dims)) + nestLists :: Proxy dims -> V.Vector a -> NestedLists dims a + unNestLists :: Proxy dims -> NestedLists dims a -> [a] +type family AllC (c :: x -> Constraint) (ts :: [x]) :: Constraint where + AllC c '[] = () + AllC c (x:xs) = (c x, AllC c xs) + instance (KnownNat x) => Dimensions '[x] where toCoord _ i = i fromCoord _ i = i - -toFinite :: (KnownNat n) => Integral m => m -> Finite n -toFinite = finite . fromIntegral - -fromFinite :: Num n => Finite m -> n -fromFinite = fromIntegral . getFinite + nestLists _ = V.toList + unNestLists _ xs = xs -instance (KnownNat (x N.* GridSize (y:xs)), KnownNat x, Dimensions (y:xs)) => Dimensions (x:y:xs) where +instance (KnownNat (GridSize (x:y:xs)), KnownNat x, Dimensions (y:xs)) => Dimensions (x:y:xs) where toCoord _ n = firstCoord :# toCoord (Proxy @(y:xs)) remainder where firstCoord = toFinite (n `div` fromIntegral (gridSize (Proxy @(y:xs)))) @@ -101,6 +125,8 @@ where firstPart = fromFinite x * gridSize (Proxy @(y:xs)) rest = fromFinite (fromCoord (Proxy @(y:xs)) ys) + nestLists _ v = nestLists (Proxy @(y:xs)) <$> chunkVector (Proxy @(GridSize (y:xs))) v + unNestLists _ xs = concat (unNestLists (Proxy @(y:xs)) <$> xs) instance (Dimensions dims) => Distributive (Grid dims) where distribute = distributeRep @@ -110,67 +136,72 @@ index (Grid v) ind = v V.! fromIntegral (fromCoord (Proxy @dims) ind) tabulate f = Grid $ V.generate (fromIntegral $ gridSize (Proxy @dims)) (f . toCoord (Proxy @dims) . fromIntegral) -instance (Dimensions dims, ind ~ Coord dims) - => FunctorWithIndex ind (Grid dims) where - imap = imapRep - -instance (Dimensions dims, ind ~ Coord dims) - => FoldableWithIndex ind (Grid dims) where - ifoldMap = ifoldMapRep - -instance (Dimensions dims, ind ~ Coord dims) - => TraversableWithIndex ind (Grid dims) where - itraverse = itraverseRep - -generate :: forall dims a . Dimensions dims => (Int -> a) -> Grid dims a -generate f = Grid $ V.generate (gridSize (Proxy @dims)) f - +-- | Computes the level of nesting requried to represent a given grid +-- dimensionality as a nested list +-- +-- > NestedLists [2, 3] Int == [[Int]] +-- > NestedLists [2, 3, 4] Int == [[[Int]]] type family NestedLists (dims :: [Nat]) a where NestedLists '[] a = a NestedLists (_:xs) a = [NestedLists xs a] -class NestLists (dims :: [Nat]) where - nestLists :: Proxy dims -> V.Vector a -> NestedLists dims a +-- | Build a grid by selecting an element for each element +generate :: forall dims a . Dimensions dims => (Int -> a) -> Grid dims a +generate f = Grid $ V.generate (gridSize (Proxy @dims)) f +-- | Build a grid by selecting an element for each coordinate +generateCoord + :: forall dims a . Dimensions dims => (Coord dims -> a) -> Grid dims a +generateCoord f = generate (f . toCoord (Proxy @dims) . fromIntegral) + chunkVector :: forall n a . KnownNat n => Proxy n -> V.Vector a -> [V.Vector a] chunkVector _ v | V.null v = [] | otherwise - = let (before, after) = V.splitAt (fromIntegral $ L.natVal (Proxy @n)) v + = let (before, after) = V.splitAt (fromIntegral $ natVal (Proxy @n)) v in before : chunkVector (Proxy @n) after -instance (KnownNat n) => NestLists '[n] where - nestLists _ = V.toList - -instance (KnownNat n, NestLists (n:ns), Dimensions (m:n:ns), Dimensions (n:ns)) => NestLists (m:n:ns) where - nestLists _ v = nestLists (Proxy @(n:ns)) <$> chunkVector (Proxy @(GridSize (n:ns))) v - +-- | Turn a grid into a nested list structure. List nesting increases for each +-- dimension +-- +-- > toNestedLists (G.generate id :: Grid [2, 3] Int) +-- > [[0,1,2],[3,4,5]] toNestedLists - :: forall dims a . (NestLists dims) => Grid dims a -> NestedLists dims a + :: forall dims a . (Dimensions dims) => Grid dims a -> NestedLists dims a toNestedLists (Grid v) = nestLists (Proxy @dims) v -class UnNestLists (dims :: [Nat]) where - unNestLists :: Proxy dims -> NestedLists dims a -> [a] - -instance UnNestLists '[n] where - unNestLists _ xs = xs - -instance (UnNestLists (n:ns)) => UnNestLists (m:n:ns) where - unNestLists _ xs = concat (unNestLists (Proxy @(n:ns)) <$> xs) - +-- | Turn a nested list structure into a Grid if the list is well formed. +-- Required list nesting increases for each dimension +-- +-- > fromNestedLists [[0,1,2],[3,4,5]] :: Maybe (Grid [2, 3] Int) +-- > Just (Grid [[0,1,2],[3,4,5]]) +-- > fromNestedLists [[0],[1,2]] :: Maybe (Grid [2, 3] Int) +-- > Nothing fromNestedLists :: forall dims a - . (UnNestLists dims, Dimensions dims) + . Dimensions dims => NestedLists dims a -> Maybe (Grid dims a) fromNestedLists = fromList . unNestLists (Proxy @dims) -fromList :: forall a dims . (Dimensions dims) => [a] -> Maybe (Grid dims a) +-- | Convert a list into a Grid or fail if not provided the correct number of +-- elements +-- +-- > G.fromList [0, 1, 2, 3, 4, 5] :: Maybe (Grid [2, 3] Int) +-- > Just (Grid [[0,1,2],[3,4,5]]) +-- > G.fromList [0, 1, 2, 3] :: Maybe (Grid [2, 3] Int) +-- > Nothing +fromList + :: forall a dims + . (KnownNat (GridSize dims), Dimensions dims) + => [a] + -> Maybe (Grid dims a) fromList xs = let v = V.fromList xs in if V.length v == gridSize (Proxy @dims) then Just $ Grid v else Nothing +-- | Update elements of a grid (//) :: forall dims a . (Dimensions dims) diff --git a/src/Data/Grid/Lens.hs b/src/Data/Grid/Lens.hs --- a/src/Data/Grid/Lens.hs +++ b/src/Data/Grid/Lens.hs @@ -1,11 +1,28 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleContexts #-} -module Data.Grid.Lens where +module Data.Grid.Lens (cell) where import Data.Grid -import Control.Lens as L import Data.Functor.Rep as R +import Data.Vector as V +import Data.Proxy +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens' s a = Lens s s a a + +lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b +lens sa sbt afb s = sbt s <$> afb (sa s) + +-- | Focus an element of a grid cell - :: (Dimensions dims, Eq (Coord dims)) => Coord dims -> Lens' (Grid dims a) a -cell c = lens (`R.index` c) (\s b -> s & itraversed . L.index c .~ b) + :: forall dims a + . (Dimensions dims, Eq (Coord dims)) + => Coord dims + -> Lens' (Grid dims a) a +cell c = lens get set + where + get = flip R.index c + vectorOffset = fromIntegral (fromCoord (Proxy @dims) c) + set (Grid v) new = Grid (v V.// [(vectorOffset, new)])