diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## 0.1.0.0 + +- Initial release +- Includes `IsList` instances for `Array`s with `Integral` indices, +up to 5 dimensions diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2020 Evgeny Poberezkin + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# array-list + +[IsList](https://hackage.haskell.org/package/base/docs/GHC-Exts.html#t:IsList) instances of [Array](https://hackage.haskell.org/package/array/docs/Data-Array.html#t:Array) for [OverloadedLists](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#overloaded-lists) extension + +See [docs and usage examples on hackage](http://hackage.haskell.org/package/array-list/docs/Data-Array-IsList.html). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/array-list.cabal b/array-list.cabal new file mode 100644 --- /dev/null +++ b/array-list.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: ed946011242c8c41f9762a9ddaadd8ee8ab793a2361e2cba2c0bcc0d11f18c9d + +name: array-list +version: 0.1.0.0 +synopsis: IsList instances of Array for OverloadedLists extension +description: This package provides "orphan" instances 'IsList' for 'Array' data types + with `Integral` indices up to 5 dimensions to allow initializing + 'Array's from [nested] lists using 'OverloadedLists' GHC extension. +category: Data, Array, List +homepage: https://github.com/epoberezkin/array-list#readme +bug-reports: https://github.com/epoberezkin/array-list/issues +author: Evgeny Poberezkin +maintainer: evgeny@poberezkin.com +copyright: 2020 Evgeny Poberezkin +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/epoberezkin/array-list + +library + exposed-modules: + Data.Array.IsList + other-modules: + Paths_array_list + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns + build-depends: + array ==0.5.* + , base >=4.7 && <5 + default-language: Haskell2010 + +test-suite array-list-doctest + type: exitcode-stdio-1.0 + main-is: doctest-driver.hs + other-modules: + Main + Paths_array_list + hs-source-dirs: + tests + ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns + build-depends: + array ==0.5.* + , base >=4.7 && <5 + , doctest ==0.17.* + , doctest-driver-gen ==0.3.* + default-language: Haskell2010 + +test-suite array-list-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_array_list + hs-source-dirs: + tests + ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns + build-depends: + array ==0.5.* + , array-list + , base >=4.7 && <5 + , hspec ==2.7.* + default-language: Haskell2010 diff --git a/src/Data/Array/IsList.hs b/src/Data/Array/IsList.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/IsList.hs @@ -0,0 +1,240 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Module : Data.Array.IsList +-- Copyright : (c) Evgeny Poberezkin +-- License : MIT +-- +-- Maintainer : evgeny@poberezkin.com +-- Stability : experimental +-- Portability : non-portable +-- +-- This package provides "orphan" 'IsList' instances for 'Array's +-- with `Integral` indices up to 5 dimensions to allow initializing +-- 'Array's from [nested] lists using 'OverloadedLists' GHC extension. +-- +-- __Examples__: +-- +-- >>> ["one","two","three"] :: Array Int String +-- array (0,2) [(0,"one"),(1,"two"),(2,"three")] +-- +-- >>> [[0,1,2], [10,11,12]] :: Array (Int, Int) Int +-- array ((0,0),(1,2)) [((0,0),0),((0,1),1),((0,2),2),((1,0),10),((1,1),11),((1,2),12)] +-- +-- If any of the nested lists contains different number of elements +-- for the same dimension, the array creation will fail. +-- +-- >>> [[1],[2,3]] :: Array (Int, Int) Int +-- array *** Exception: Error in array index +module Data.Array.IsList + ( IsList, + fromList, + toList, + ) +where + +import Data.Array +import Data.Int +import Data.List +import Data.Word +import GHC.Exts +import Numeric.Natural + +instance IsList (Array Int e) where + type Item (Array Int e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Int8 e) where + type Item (Array Int8 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Int16 e) where + type Item (Array Int16 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Int32 e) where + type Item (Array Int32 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Int64 e) where + type Item (Array Int64 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Integer e) where + type Item (Array Integer e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Natural e) where + type Item (Array Natural e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Word e) where + type Item (Array Word e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Word8 e) where + type Item (Array Word8 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Word16 e) where + type Item (Array Word16 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Word32 e) where + type Item (Array Word32 e) = e + fromList = genericFromList + toList = elems + +instance IsList (Array Word64 e) where + type Item (Array Word64 e) = e + fromList = genericFromList + toList = elems + +genericFromList :: (Integral i, Ix i) => [e] -> Array i e +genericFromList xs = listArray (0, top xs) xs + +splitList :: Integral i => i -> i -> [e] -> [[e]] +splitList _ _ [] = [] +splitList l r xs = + let (part, rest) = genericSplitAt (r - l + 1) xs + in part : splitList l r rest + +top :: Integral i => [e] -> i +top l = genericLength l - 1 + +h1 :: [e] -> e +h1 = head + +h2 :: [[e]] -> e +h2 = head . head + +h3 :: [[[e]]] -> e +h3 = head . h2 + +h4 :: [[[[e]]]] -> e +h4 = head . h3 + +inxd :: Integral i => [e] -> [(i, e)] +inxd = zip [0 ..] + +instance + (Integral i, Integral j, Ix i, Ix j) => + IsList (Array (i, j) e) + where + type Item (Array (i, j) e) = [e] + fromList :: [[e]] -> Array (i, j) e + fromList l = + array + ((0, 0), (top l, top $ h1 l)) + [ ((i, j), x) + | (i, xs) <- inxd l, + (j, x) <- inxd xs + ] + toList :: Array (i, j) e -> [[e]] + toList arr = + let ((_, l), (_, r)) = bounds arr + in splitList l r $ elems arr + +instance + (Integral i, Integral j, Integral k, Ix i, Ix j, Ix k) => + IsList (Array (i, j, k) e) + where + type Item (Array (i, j, k) e) = [[e]] + fromList :: [[[e]]] -> Array (i, j, k) e + fromList l = + array + ((0, 0, 0), (top l, top $ h1 l, top $ h2 l)) + [ ((i, j, k), x) + | (i, xss) <- inxd l, + (j, xs) <- inxd xss, + (k, x) <- inxd xs + ] + toList :: Array (i, j, k) e -> [[[e]]] + toList arr = + let ((_, l1, l2), (_, r1, r2)) = bounds arr + in splitList l1 r1 + $ splitList l2 r2 + $ elems arr + +instance + ( Integral i, + Integral j, + Integral k, + Integral m, + Ix i, + Ix j, + Ix k, + Ix m + ) => + IsList (Array (i, j, k, m) e) + where + type Item (Array (i, j, k, m) e) = [[[e]]] + fromList :: [[[[e]]]] -> Array (i, j, k, m) e + fromList l = + array + ( (0, 0, 0, 0), + (top l, top $ h1 l, top $ h2 l, top $ h3 l) + ) + [ ((i, j, k, m), x) + | (i, xsss) <- inxd l, + (j, xss) <- inxd xsss, + (k, xs) <- inxd xss, + (m, x) <- inxd xs + ] + toList :: Array (i, j, k, m) e -> [[[[e]]]] + toList arr = + let ((_, l1, l2, l3), (_, r1, r2, r3)) = bounds arr + in splitList l1 r1 + $ splitList l2 r2 + $ splitList l3 r3 + $ elems arr + +instance + ( Integral i, + Integral j, + Integral k, + Integral m, + Integral n, + Ix i, + Ix j, + Ix k, + Ix m, + Ix n + ) => + IsList (Array (i, j, k, m, n) e) + where + type Item (Array (i, j, k, m, n) e) = [[[[e]]]] + fromList :: [[[[[e]]]]] -> Array (i, j, k, m, n) e + fromList l = + array + ( (0, 0, 0, 0, 0), + (top l, top $ h1 l, top $ h2 l, top $ h3 l, top $ h4 l) + ) + [ ((i, j, k, m, n), x) + | (i, xssss) <- inxd l, + (j, xsss) <- inxd xssss, + (k, xss) <- inxd xsss, + (m, xs) <- inxd xss, + (n, x) <- inxd xs + ] + toList :: Array (i, j, k, m, n) e -> [[[[[e]]]]] + toList arr = + let ((_, l1, l2, l3, l4), (_, r1, r2, r3, r4)) = bounds arr + in splitList l1 r1 + $ splitList l2 r2 + $ splitList l3 r3 + $ splitList l4 r4 + $ elems arr diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} + +import Data.Array +import Data.Array.IsList +import Test.Hspec + +main :: IO () +main = hspec do + describe "IsList (Array Int e)" do + it "[1,2,3]" $ + ([1, 2, 3] :: Array Int Int) + `shouldBe` array (0, 2) [(0, 1), (1, 2), (2, 3)] + it "[\"one\",\"two\",\"three\"]" $ + (["one", "two", "three"] :: Array Int String) + `shouldBe` array (0, 2) [(0, "one"), (1, "two"), (2, "three")] + it "toList $ fromList [1,2,3]" $ + toList ([1, 2, 3] :: Array Int Int) + `shouldBe` [1, 2, 3] + it "toList $ fromList [\"one\",\"two\",\"three\"]" $ + toList (["one", "two", "three"] :: Array Int String) + `shouldBe` ["one", "two", "three"] + describe "IsList (Array (Int,Int) e)" do + it "[[1, 2], [3, 4], [5, 6]]" $ + ( [ [1, 2], + [3, 4], + [5, 6] + ] :: + Array (Int, Int) Int + ) + `shouldBe` array + ((0, 0), (2, 1)) + [ ((0, 0), 1), + ((0, 1), 2), + ((1, 0), 3), + ((1, 1), 4), + ((2, 0), 5), + ((2, 1), 6) + ] + it "toList . fromList == id" $ + toList + ( [ [1, 2], + [3, 4], + [5, 6] + ] :: + Array (Int, Int) Int + ) + `shouldBe` [[1, 2], [3, 4], [5, 6]] + describe "IsList (Array (Int,Int,Int) e)" do + it "3D-array" $ + ( [ [[1, 2, 3], [4, 5, 6]], + [[7, 8, 9], [10, 11, 12]], + [[13, 14, 15], [16, 17, 18]] + ] :: + Array (Int, Int, Int) Int + ) + `shouldBe` array + ((0, 0, 0), (2, 1, 2)) + [ ((0, 0, 0), 1), + ((0, 0, 1), 2), + ((0, 0, 2), 3), + ((0, 1, 0), 4), + ((0, 1, 1), 5), + ((0, 1, 2), 6), + ((1, 0, 0), 7), + ((1, 0, 1), 8), + ((1, 0, 2), 9), + ((1, 1, 0), 10), + ((1, 1, 1), 11), + ((1, 1, 2), 12), + ((2, 0, 0), 13), + ((2, 0, 1), 14), + ((2, 0, 2), 15), + ((2, 1, 0), 16), + ((2, 1, 1), 17), + ((2, 1, 2), 18) + ] + it "toList . fromList == id" $ + toList + ( [ [[1, 2, 3], [4, 5, 6]], + [[7, 8, 9], [10, 11, 12]], + [[13, 14, 15], [16, 17, 18]] + ] :: + Array (Int, Int, Int) Int + ) + `shouldBe` [ [[1, 2, 3], [4, 5, 6]], + [[7, 8, 9], [10, 11, 12]], + [[13, 14, 15], [16, 17, 18]] + ] + describe "IsList (Array (Int,Int,Int,Int) e)" do + it "4D-array" $ + ( [ [ [[0, 1], [2, 3]], + [[4, 5], [6, 7]] + ], + [ [[8, 9], [10, 11]], + [[12, 13], [14, 15]] + ] + ] :: + Array (Int, Int, Int, Int) Int + ) + `shouldBe` array + ((0, 0, 0, 0), (1, 1, 1, 1)) + [ ((0, 0, 0, 0), 0), + ((0, 0, 0, 1), 1), + ((0, 0, 1, 0), 2), + ((0, 0, 1, 1), 3), + ((0, 1, 0, 0), 4), + ((0, 1, 0, 1), 5), + ((0, 1, 1, 0), 6), + ((0, 1, 1, 1), 7), + ((1, 0, 0, 0), 8), + ((1, 0, 0, 1), 9), + ((1, 0, 1, 0), 10), + ((1, 0, 1, 1), 11), + ((1, 1, 0, 0), 12), + ((1, 1, 0, 1), 13), + ((1, 1, 1, 0), 14), + ((1, 1, 1, 1), 15) + ] + it "toList . fromList == id" $ + toList + ( [ [ [[0, 1], [2, 3]], + [[4, 5], [6, 7]] + ], + [ [[8, 9], [10, 11]], + [[12, 13], [14, 15]] + ] + ] :: + Array (Int, Int, Int, Int) Int + ) + `shouldBe` [ [ [[0, 1], [2, 3]], + [[4, 5], [6, 7]] + ], + [ [[8, 9], [10, 11]], + [[12, 13], [14, 15]] + ] + ] + describe "IsList (Array (Int,Int,Int,Int,Int) e)" do + it "5D-array" $ + ( [ [ [[[0, 1], [2, 3]], [[4, 5], [6, 7]]], + [[[8, 9], [10, 11]], [[12, 13], [14, 15]]] + ], + [ [[[16, 17], [18, 19]], [[20, 21], [22, 23]]], + [[[24, 25], [26, 27]], [[28, 29], [30, 31]]] + ] + ] :: + Array (Int, Int, Int, Int, Int) Int + ) + `shouldBe` array + ((0, 0, 0, 0, 0), (1, 1, 1, 1, 1)) + [ ((0, 0, 0, 0, 0), 0), + ((0, 0, 0, 0, 1), 1), + ((0, 0, 0, 1, 0), 2), + ((0, 0, 0, 1, 1), 3), + ((0, 0, 1, 0, 0), 4), + ((0, 0, 1, 0, 1), 5), + ((0, 0, 1, 1, 0), 6), + ((0, 0, 1, 1, 1), 7), + ((0, 1, 0, 0, 0), 8), + ((0, 1, 0, 0, 1), 9), + ((0, 1, 0, 1, 0), 10), + ((0, 1, 0, 1, 1), 11), + ((0, 1, 1, 0, 0), 12), + ((0, 1, 1, 0, 1), 13), + ((0, 1, 1, 1, 0), 14), + ((0, 1, 1, 1, 1), 15), + ((1, 0, 0, 0, 0), 16), + ((1, 0, 0, 0, 1), 17), + ((1, 0, 0, 1, 0), 18), + ((1, 0, 0, 1, 1), 19), + ((1, 0, 1, 0, 0), 20), + ((1, 0, 1, 0, 1), 21), + ((1, 0, 1, 1, 0), 22), + ((1, 0, 1, 1, 1), 23), + ((1, 1, 0, 0, 0), 24), + ((1, 1, 0, 0, 1), 25), + ((1, 1, 0, 1, 0), 26), + ((1, 1, 0, 1, 1), 27), + ((1, 1, 1, 0, 0), 28), + ((1, 1, 1, 0, 1), 29), + ((1, 1, 1, 1, 0), 30), + ((1, 1, 1, 1, 1), 31) + ] + it "toList . fromList == id" $ + toList + ( [ [ [[[0, 1], [2, 3]], [[4, 5], [6, 7]]], + [[[8, 9], [10, 11]], [[12, 13], [14, 15]]] + ], + [ [[[16, 17], [18, 19]], [[20, 21], [22, 23]]], + [[[24, 25], [26, 27]], [[28, 29], [30, 31]]] + ] + ] :: + Array (Int, Int, Int, Int, Int) Int + ) + `shouldBe` [ [ [[[0, 1], [2, 3]], [[4, 5], [6, 7]]], + [[[8, 9], [10, 11]], [[12, 13], [14, 15]]] + ], + [ [[[16, 17], [18, 19]], [[20, 21], [22, 23]]], + [[[24, 25], [26, 27]], [[28, 29], [30, 31]]] + ] + ] diff --git a/tests/doctest-driver.hs b/tests/doctest-driver.hs new file mode 100644 --- /dev/null +++ b/tests/doctest-driver.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF doctest-driver-gen -optF src -optF -XOverloadedLists #-}