From c649363e18e1945e50f62c59163824081820e816 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Tue, 18 Feb 2020 19:28:59 -0800 Subject: [PATCH] Data.NList --- CHANGELOG.md | 5 + Main.hs | 4 + README.md | 8 +- Setup.hs | 2 + TestGen.hs | 52 +++++ default.nix | 30 +++ indexed-containers.cabal | 45 ++++ release.nix | 8 + src/Data/NList.hs | 402 +++++++++++++++++++++++++++++++++++ test/hspec/Data/NListSpec.hs | 82 +++++++ test/hspec/Main.hs | 1 + 11 files changed, 638 insertions(+), 1 deletion(-) create mode 100644 CHANGELOG.md create mode 100644 Main.hs create mode 100644 Setup.hs create mode 100755 TestGen.hs create mode 100644 default.nix create mode 100644 indexed-containers.cabal create mode 100644 release.nix create mode 100644 src/Data/NList.hs create mode 100644 test/hspec/Data/NListSpec.hs create mode 100644 test/hspec/Main.hs diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..5ae437b --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for indexed-containers + +## 0.1.0.0 -- 2020-02-18 + +* Initial release. diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..65ae4a0 --- /dev/null +++ b/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/README.md b/README.md index 88f0248..69af986 100644 --- a/README.md +++ b/README.md @@ -1 +1,7 @@ -# indexed-containers \ No newline at end of file +# indexed-containers: simple, no-frills indexed lists. + +This library contains lists whose types are indexed by their lengths. The implementation is a simple +wrapper around a regular list. + +If the lengths of your lists are known statically, using indexed lists improves type safety +with no runtime overhead. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/TestGen.hs b/TestGen.hs new file mode 100755 index 0000000..67a668e --- /dev/null +++ b/TestGen.hs @@ -0,0 +1,52 @@ +#!/usr/bin/env stack +-- stack --resolver lts-15.0 script --package filepath --package directory --package extra +-- To run: ./TestGen.hs + +module TestGen (main) where + +import Data.List.Extra (replace, stripPrefix, trim) +import Data.Maybe (mapMaybe) +import System.Directory +import System.FilePath + +import Prelude hiding (mod) + +main :: IO () +main = genTestsFor "Data.NList" + +genTestsFor :: String -> IO () +genTestsFor mod = do + let inputFile = "src" replace "." [pathSeparator] mod <.> "hs" + outputFile = "test/hspec" (replace "." [pathSeparator] mod ++ "Spec.hs") + src <- readFile inputFile + createDirectoryIfMissing True (takeDirectory outputFile) + let lns = fmap trim (lines src) + tests = mapMaybe (stripPrefix "-- > ") lns + writeFile outputFile . unlines $ header mod ++ fmap (indent 6) tests + +header :: String -> [String] +header mod = + [ "-- Generated code, do not modify by hand. Generate by running TestGen.hs." + , "" + , "{-# LANGUAGE DataKinds #-}" + , "{-# LANGUAGE TypeApplications #-}" + , "{-# LANGUAGE TypeFamilies #-}" + , "{-# OPTIONS_GHC -w #-}" + , "module " ++ mod ++ "Spec where" + , "" + , "import Test.Hspec" + , "import Prelude hiding (concat, drop, head, init, last, length, replicate, reverse, splitAt, tail, take, unzip, zip, zipWith)" + ] ++ ["import " ++ mod] ++ + [ "" + , "infix 4 ===" + , "(===) :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation" + , "(===) = shouldBe" + , "" + , "spec :: Spec" + , "spec = do" + , " describe \"Testing " ++ mod ++ "\" $ do" + , " it \"\" $ do" + ] + +indent :: Int -> String -> String +indent n = (replicate n ' ' ++) diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..7cb4c2d --- /dev/null +++ b/default.nix @@ -0,0 +1,30 @@ +{ nixpkgs ? import {}, compiler ? "default", doBenchmark ? false }: + +let + + inherit (nixpkgs) pkgs; + + f = { mkDerivation, base, hspec, hspec-discover, stdenv }: + mkDerivation { + pname = "indexed-containers"; + version = "0.1.0.0"; + src = ./.; + libraryHaskellDepends = [ base ]; + testHaskellDepends = [ base hspec ]; + testToolDepends = [ hspec-discover ]; + homepage = "https://github.com/zliu41/indexed-containers#readme"; + description = "Simple, no-frills indexed lists"; + license = stdenv.lib.licenses.bsd3; + }; + + haskellPackages = if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}; + + variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; + + drv = variant (haskellPackages.callPackage f {}); + +in + + if pkgs.lib.inNixShell then drv.env else drv diff --git a/indexed-containers.cabal b/indexed-containers.cabal new file mode 100644 index 0000000..c463ebf --- /dev/null +++ b/indexed-containers.cabal @@ -0,0 +1,45 @@ +cabal-version: 2.4 +-- Initial package description 'indexed-containers.cabal' generated by +-- 'cabal init'. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: indexed-containers +version: 0.1.0.0 +synopsis: Simple, no-frills indexed lists. +description: If the lengths of your lists are known statically, using indexed lists improves type safety with no runtime overhead. +category: Data Structures +homepage: https://github.com/zliu41/indexed-containers#readme +bug-reports: https://github.com/zliu41/indexed-containers/issues +author: Ziyang Liu +maintainer: Ziyang Liu +copyright: 2020 Ziyang Liu +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: CHANGELOG.md, README.md +tested-with: GHC==8.10.1, GHC==8.8.2, GHC==8.6.5, GHC==8.4.4 + +library + exposed-modules: + Data.NList + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +test-suite hspec + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Data.NListSpec + hs-source-dirs: + test/hspec + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , hspec >=2.4.8 && <2.8 + , indexed-containers + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover == 2.* diff --git a/release.nix b/release.nix new file mode 100644 index 0000000..6c0b1c6 --- /dev/null +++ b/release.nix @@ -0,0 +1,8 @@ +{ compiler ? "default" }: + +let + pkgs = import { }; + +in + { indexed-containers = pkgs.haskellPackages.callPackage ./default.nix { inherit compiler; }; + } diff --git a/src/Data/NList.hs b/src/Data/NList.hs new file mode 100644 index 0000000..dee14ba --- /dev/null +++ b/src/Data/NList.hs @@ -0,0 +1,402 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE NoStarIsType #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : Data.NList +-- Maintainer : Ziyang Liu +-- +-- Lists whose types are indexed by their lengths. The implementation is a simple +-- wrapper around a regular list. +-- +-- All functions in this module are total. The time complexity of each function is +-- the same as that of the corresponding function on regular lists. +module Data.NList + ( + -- * NList type + NList + + -- * Basic functions + + , (<:>) + , (<++>) + , length + , head + , headMay + , tail + , tail' + , tailMay + , last + , lastMay + , init + , init' + , initMay + , toList + + -- * Extracing sublists + , take + , drop + , splitAt + + -- * Indexing + , kth + + -- * Transformations + , reverse + , intersperse + , transpose + , concat + + -- * Ordered lists + , sort + , sortOn + , sortBy + + -- * Zipping and unzipping + , zip + , zipWith + , unzip + + -- * Construction + , replicate + , empty + , singleton + , mk1 + , mk2 + , mk3 + , mk4 + , mk5 + , mk6 + , mk7 + , mk8 + , mk9 + , mk10 + + -- * Predecessor of a Nat + , Pred + ) where + +import qualified Data.List as List +import Data.Proxy (Proxy(..)) +import GHC.TypeLits (KnownNat, Nat, natVal, type (+), type (-), type(*), type (<=)) + +import Prelude hiding (concat, drop, head, init, last, length, replicate, reverse, splitAt, tail, take, unzip, zip, zipWith) + +infixr 5 <:> + +infixr 5 <++> + +-- | A list whose length is statically known. +-- +-- Type parameter @n@, of kind 'Nat', is the length of the list. +newtype NList (n :: Nat) a = List [a] deriving (Eq, Ord) + +-- | The empty list. +-- +-- > length empty === 0 +empty :: NList 0 a +empty = List [] + +-- | A singleton list. +-- +-- > length (singleton 'a' :: NList 1 Char) === 1 +singleton :: a -> NList 1 a +singleton a = List [a] + +-- | Prepend an element to a list. +-- +-- > 'a' <:> singleton 'b' === mk2 'a' 'b' +(<:>) :: a -> NList n a -> NList (n + 1) a +(<:>) x (List xs) = List (x : xs) + +-- | Append two lists. +-- +-- > mk2 'a' 'b' <++> mk3 'c' 'd' 'e' === mk5 'a' 'b' 'c' 'd' 'e' +(<++>) :: NList n a -> NList m a -> NList (n + m) a +(<++>) (List xs) (List ys) = List (xs List.++ ys) + +-- | Length of a list. +-- +-- > length (mk3 'a' 'b' 'c') === 3 +length :: NList n a -> Int +length (List xs) = List.length xs + +-- | Head of a non-empty list. +-- +-- > head (mk3 'a' 'b' 'c') === 'a' +head :: (1 <= n) => NList n a -> a +head (List xs) = List.head xs + +-- | Head of a list. +-- +-- > headMay (empty :: NList 0 Int) === Nothing +-- > headMay (mk3 'a' 'b' 'c') === Just 'a' +headMay :: NList n a -> Maybe a +headMay (List []) = Nothing +headMay (List (x:_)) = Just x + +-- | Tail of a non-empty list. +-- +-- > tail (singleton 'a') === empty +-- > tail (mk3 'a' 'b' 'c') === mk2 'b' 'c' +tail :: (1 <= n) => NList n a -> NList (Pred n) a +tail (List xs) = List (List.tail xs) + +-- | Tail of a list. Returns an empty list if the input is empty. +-- +-- > tail' (empty :: NList 0 ()) === empty +-- > tail' (singleton 'a') === empty +-- > tail' (mk3 'a' 'b' 'c') === mk2 'b' 'c' +tail' :: NList n a -> NList (Pred n) a +tail' (List []) = List [] +tail' (List (_:xs)) = List xs + +-- | Tail of a list. Returns Nothing if the input is empty. +-- +-- > tailMay (empty :: NList 0 ()) === Nothing +-- > tailMay (singleton 'a') === Just empty +-- > tailMay (mk3 'a' 'b' 'c') === Just (mk2 'b' 'c') +tailMay :: NList n a -> Maybe (NList (Pred n) a) +tailMay (List []) = Nothing +tailMay (List (_:xs)) = Just (List xs) + +-- | The last element of a non-empty list. +-- +-- > last (mk3 'a' 'b' 'c') === 'c' +last :: (1 <= n) => NList n a -> a +last (List xs) = List.last xs + +-- | The last element of a list. +-- +-- > lastMay (empty :: NList 0 Int) === Nothing +-- > lastMay (mk3 'a' 'b' 'c') === Just 'c' +lastMay :: NList n a -> Maybe a +lastMay (List []) = Nothing +lastMay (List xs) = Just (List.last xs) + +-- | All elements of a non-empty list except the last one. +-- +-- > init (singleton 'a') === empty +-- > init (mk3 'a' 'b' 'c') === mk2 'a' 'b' +init :: (1 <= n) => NList n a -> NList (Pred n) a +init (List xs) = List (List.init xs) + +-- | All elements of a list except the last one. Returns an empty list +-- if the input is empty. +-- +-- > init' (empty :: NList 0 ()) === empty +-- > init' (singleton 'a') === empty +-- > init' (mk3 'a' 'b' 'c') === mk2 'a' 'b' +init' :: NList n a -> NList (Pred n) a +init' (List []) = List [] +init' (List xs) = List (List.init xs) + +-- | All elements of a list except the last one. Returns Nothing +-- if the input is empty. +-- +-- > initMay (empty :: NList 0 ()) === Nothing +-- > initMay (singleton 'a') === Just empty +-- > initMay (mk3 'a' 'b' 'c') === Just (mk2 'a' 'b') +initMay :: NList n a -> Maybe (NList (Pred n) a) +initMay (List []) = Nothing +initMay (List xs) = Just $ List (List.init xs) + +-- | Return the first @k@ elements of a list whose length is at least @k@. +-- +-- > take @0 (mk3 'a' 'b' 'c') === empty +-- > take @2 (mk3 'a' 'b' 'c') === mk2 'a' 'b' +-- > take @3 (mk3 'a' 'b' 'c') === mk3 'a' 'b' 'c' +take :: forall k n a. (KnownNat k, k <= n) => NList n a -> NList k a +take (List xs) = List (List.take k xs) + where + k = fromIntegral (natVal (Proxy :: Proxy k)) + +-- | Drop the first @k@ elements of a list whose length is at least @k@. +-- +-- > drop @0 (mk3 'a' 'b' 'c') === mk3 'a' 'b' 'c' +-- > drop @2 (mk3 'a' 'b' 'c') === singleton 'c' +-- > drop @3 (mk3 'a' 'b' 'c') === empty +drop :: forall k n a. (KnownNat k, k <= n) => NList n a -> NList (n-k) a +drop (List xs) = List (List.drop k xs) + where + k = fromIntegral (natVal (Proxy :: Proxy k)) + +-- | Return the first @k@ elements, paired with the remaining elements, of +-- a list whose length is at least @k@. +-- +-- > splitAt @0 (mk3 'a' 'b' 'c') === (empty, mk3 'a' 'b' 'c') +-- > splitAt @2 (mk3 'a' 'b' 'c') === (mk2 'a' 'b', singleton 'c') +-- > splitAt @3 (mk3 'a' 'b' 'c') === (mk3 'a' 'b' 'c', empty) +splitAt :: forall k n a. (KnownNat k, k <= n) => NList n a -> (NList k a, NList (n-k) a) +splitAt (List xs) = let (ys, zs) = List.splitAt k xs in (List ys, List zs) + where + k = fromIntegral (natVal (Proxy :: Proxy k)) + +-- | Reverse a list. +-- +-- > reverse (mk3 'a' 'b' 'c') === mk3 'c' 'b' 'a' +reverse :: NList n a -> NList n a +reverse (List xs) = List (List.reverse xs) + +-- | Take an element and a list, and insert the element in between elements +-- of the list. +-- +-- > intersperse (',') empty === empty +-- > intersperse (',') (singleton 'a') === singleton 'a' +-- > intersperse (',') (mk3 'a' 'b' 'c') === mk5 'a' ',' 'b' ',' 'c' +intersperse :: a -> NList n a -> NList (Pred (n * 2)) a +intersperse x (List xs) = List (List.intersperse x xs) + +-- | Transpose the rows and columns of a two dimensional list. +-- +-- > transpose (mk2 (mk3 1 2 3) (mk3 4 5 6)) === mk3 (mk2 1 4) (mk2 2 5) (mk2 3 6) +transpose :: NList n (NList m a) -> NList m (NList n a) +transpose (List xss) = List . fmap List $ List.transpose (fmap toList xss) + +-- | Return the element at index @k@ (starting from 0) in a list with at least +-- @k+1@ elements. +-- +-- > kth @0 (mk4 'a' 'b' 'c' 'd') === 'a' +-- > kth @3 (mk4 'a' 'b' 'c' 'd') === 'd' +kth :: forall k n a. (KnownNat k, k <= n-1) => NList n a -> a +kth (List xs) = xs List.!! fromIntegral (natVal (Proxy :: Proxy k)) + +-- | Stably sort a list. +-- +-- > sort (mk6 1 4 2 8 5 7) === mk6 1 2 4 5 7 8 +sort :: Ord a => NList n a -> NList n a +sort (List xs) = List (List.sort xs) + +-- | Sort a list by applying a function to each element and comparing the results. +-- +-- > sortOn negate (mk6 1 4 2 8 5 7) === mk6 8 7 5 4 2 1 +sortOn :: Ord b => (a -> b) -> NList n a -> NList n a +sortOn f (List xs) = List (List.sortOn f xs) + +-- | Non-overloaded version of 'sort'. +-- +-- > sortBy (\x y -> compare (-x) (-y)) (mk6 1 4 2 8 5 7) === mk6 8 7 5 4 2 1 +sortBy :: (a -> a -> Ordering) -> NList n a -> NList n a +sortBy f (List xs) = List (List.sortBy f xs) + +-- | Convert an 'NList' into a regular list. +-- +-- > toList (mk3 'a' 'b' 'c') === "abc" +toList :: NList n a -> [a] +toList (List xs) = xs + +-- | Zip two lists of the same length. +-- +-- > zip (mk2 1 2) (mk2 'a' 'b') === mk2 (1, 'a') (2, 'b') +zip :: NList n a -> NList n b -> NList n (a, b) +zip (List xs) (List ys) = List (xs `List.zip` ys) + +-- | Zip with a function. +-- +-- > zipWith (+) (mk2 1 2) (mk2 3 4) === mk2 4 6 +zipWith :: (a -> b -> c) -> NList n a -> NList n b -> NList n c +zipWith f (List xs) (List ys) = List (List.zipWith f xs ys) + +-- | Unzip a list of pairs. +-- +-- > unzip (mk2 (1, 'a') (2, 'b')) === ((mk2 1 2), (mk2 'a' 'b')) +unzip :: NList n (a, b) -> (NList n a, NList n b) +unzip (List xs) = (List ys, List zs) + where + (ys, zs) = List.unzip xs + +-- | Concatenate the sublists of a two-dimensional list. +-- +-- > concat (mk2 (mk3 1 2 3) (mk3 4 5 6)) === mk6 1 2 3 4 5 6 +concat :: NList n (NList m a) -> NList (n * m) a +concat (List xss) = List (List.concatMap toList xss) + +-- | Return a list containing @n@ copies of the given element. +-- +-- > replicate @3 'a' === mk3 'a' 'a' 'a' +replicate ::forall n a. KnownNat n => a -> NList n a +replicate = List . List.replicate n + where + n = fromIntegral $ natVal (Proxy :: Proxy n) + +-- | +-- > toList (mk1 'a') === "a" +mk1 :: a -> NList 1 a +mk1 = singleton + +-- | +-- > toList (mk2 'a' 'b') === "ab" +mk2 :: a -> a -> NList 2 a +mk2 a1 a2 = List [a1, a2] + +-- | +-- > toList (mk3 'a' 'b' 'c') === "abc" +mk3 :: a -> a -> a -> NList 3 a +mk3 a1 a2 a3 = List [a1, a2, a3] + +-- | +-- > toList (mk4 'a' 'b' 'c' 'd') === "abcd" +mk4 :: a -> a -> a -> a -> NList 4 a +mk4 a1 a2 a3 a4 = List [a1, a2, a3, a4] + +-- | +-- > toList (mk5 'a' 'b' 'c' 'd' 'e') === "abcde" +mk5 :: a -> a -> a -> a -> a -> NList 5 a +mk5 a1 a2 a3 a4 a5 = List [a1, a2, a3, a4, a5] + +-- | +-- > toList (mk6 'a' 'b' 'c' 'd' 'e' 'f') === "abcdef" +mk6 :: a -> a -> a -> a -> a -> a -> NList 6 a +mk6 a1 a2 a3 a4 a5 a6 = List [a1, a2, a3, a4, a5, a6] + +-- | +-- > toList (mk7 'a' 'b' 'c' 'd' 'e' 'f' 'g') === "abcdefg" +mk7 :: a -> a -> a -> a -> a -> a -> a -> NList 7 a +mk7 a1 a2 a3 a4 a5 a6 a7 = List [a1, a2, a3, a4, a5, a6, a7] + +-- | +-- > toList (mk8 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h') === "abcdefgh" +mk8 :: a -> a -> a -> a -> a -> a -> a -> a -> NList 8 a +mk8 a1 a2 a3 a4 a5 a6 a7 a8 = List [a1, a2, a3, a4, a5, a6, a7, a8] + +-- | +-- > toList (mk9 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i') === "abcdefghi" +mk9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> NList 9 a +mk9 a1 a2 a3 a4 a5 a6 a7 a8 a9 = List [a1, a2, a3, a4, a5, a6, a7, a8, a9] + +-- | +-- > toList (mk10 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i' 'j') === "abcdefghij" +mk10 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> NList 10 a +mk10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = List [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10] + +instance (KnownNat n, Show a) => Show (NList n a) where + showsPrec p (List xs) = showParen (p > 10) $ + showString "List " . shows (natVal (Proxy :: Proxy n)) . showString " " . shows xs + +instance Functor (NList n) where + fmap f (List xs) = List (List.map f xs) + +instance KnownNat n => Applicative (NList n) where + pure = replicate + (<*>) = zipWith ($) + +instance Foldable (NList n) where + foldr f z (List xs) = List.foldr f z xs + +instance Traversable (NList n) where + sequenceA (List xs) = List <$> sequenceA xs + +-- | The 'Pred' type family is used to maintain the invariant that +-- @n@ is a 'KnownNat' (i.e., @n >= 0@) for all @List n a@. +type family Pred (n :: Nat) :: Nat where + Pred 0 = 0 + Pred n = (n-1) diff --git a/test/hspec/Data/NListSpec.hs b/test/hspec/Data/NListSpec.hs new file mode 100644 index 0000000..731242f --- /dev/null +++ b/test/hspec/Data/NListSpec.hs @@ -0,0 +1,82 @@ +-- Generated code, do not modify by hand. Generate by running TestGen.hs. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -w #-} +module Data.NListSpec where + +import Test.Hspec +import Prelude hiding (concat, drop, head, init, last, length, replicate, reverse, splitAt, tail, take, unzip, zip, zipWith) +import Data.NList + +infix 4 === +(===) :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation +(===) = shouldBe + +spec :: Spec +spec = do + describe "Testing Data.NList" $ do + it "" $ do + length empty === 0 + length (singleton 'a' :: NList 1 Char) === 1 + 'a' <:> singleton 'b' === mk2 'a' 'b' + mk2 'a' 'b' <++> mk3 'c' 'd' 'e' === mk5 'a' 'b' 'c' 'd' 'e' + length (mk3 'a' 'b' 'c') === 3 + head (mk3 'a' 'b' 'c') === 'a' + headMay (empty :: NList 0 Int) === Nothing + headMay (mk3 'a' 'b' 'c') === Just 'a' + tail (singleton 'a') === empty + tail (mk3 'a' 'b' 'c') === mk2 'b' 'c' + tail' (empty :: NList 0 ()) === empty + tail' (singleton 'a') === empty + tail' (mk3 'a' 'b' 'c') === mk2 'b' 'c' + tailMay (empty :: NList 0 ()) === Nothing + tailMay (singleton 'a') === Just empty + tailMay (mk3 'a' 'b' 'c') === Just (mk2 'b' 'c') + last (mk3 'a' 'b' 'c') === 'c' + lastMay (empty :: NList 0 Int) === Nothing + lastMay (mk3 'a' 'b' 'c') === Just 'c' + init (singleton 'a') === empty + init (mk3 'a' 'b' 'c') === mk2 'a' 'b' + init' (empty :: NList 0 ()) === empty + init' (singleton 'a') === empty + init' (mk3 'a' 'b' 'c') === mk2 'a' 'b' + initMay (empty :: NList 0 ()) === Nothing + initMay (singleton 'a') === Just empty + initMay (mk3 'a' 'b' 'c') === Just (mk2 'a' 'b') + take @0 (mk3 'a' 'b' 'c') === empty + take @2 (mk3 'a' 'b' 'c') === mk2 'a' 'b' + take @3 (mk3 'a' 'b' 'c') === mk3 'a' 'b' 'c' + drop @0 (mk3 'a' 'b' 'c') === mk3 'a' 'b' 'c' + drop @2 (mk3 'a' 'b' 'c') === singleton 'c' + drop @3 (mk3 'a' 'b' 'c') === empty + splitAt @0 (mk3 'a' 'b' 'c') === (empty, mk3 'a' 'b' 'c') + splitAt @2 (mk3 'a' 'b' 'c') === (mk2 'a' 'b', singleton 'c') + splitAt @3 (mk3 'a' 'b' 'c') === (mk3 'a' 'b' 'c', empty) + reverse (mk3 'a' 'b' 'c') === mk3 'c' 'b' 'a' + intersperse (',') empty === empty + intersperse (',') (singleton 'a') === singleton 'a' + intersperse (',') (mk3 'a' 'b' 'c') === mk5 'a' ',' 'b' ',' 'c' + transpose (mk2 (mk3 1 2 3) (mk3 4 5 6)) === mk3 (mk2 1 4) (mk2 2 5) (mk2 3 6) + kth @0 (mk4 'a' 'b' 'c' 'd') === 'a' + kth @3 (mk4 'a' 'b' 'c' 'd') === 'd' + sort (mk6 1 4 2 8 5 7) === mk6 1 2 4 5 7 8 + sortOn negate (mk6 1 4 2 8 5 7) === mk6 8 7 5 4 2 1 + sortBy (\x y -> compare (-x) (-y)) (mk6 1 4 2 8 5 7) === mk6 8 7 5 4 2 1 + toList (mk3 'a' 'b' 'c') === "abc" + zip (mk2 1 2) (mk2 'a' 'b') === mk2 (1, 'a') (2, 'b') + zipWith (+) (mk2 1 2) (mk2 3 4) === mk2 4 6 + unzip (mk2 (1, 'a') (2, 'b')) === ((mk2 1 2), (mk2 'a' 'b')) + concat (mk2 (mk3 1 2 3) (mk3 4 5 6)) === mk6 1 2 3 4 5 6 + replicate @3 'a' === mk3 'a' 'a' 'a' + toList (mk1 'a') === "a" + toList (mk2 'a' 'b') === "ab" + toList (mk3 'a' 'b' 'c') === "abc" + toList (mk4 'a' 'b' 'c' 'd') === "abcd" + toList (mk5 'a' 'b' 'c' 'd' 'e') === "abcde" + toList (mk6 'a' 'b' 'c' 'd' 'e' 'f') === "abcdef" + toList (mk7 'a' 'b' 'c' 'd' 'e' 'f' 'g') === "abcdefg" + toList (mk8 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h') === "abcdefgh" + toList (mk9 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i') === "abcdefghi" + toList (mk10 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i' 'j') === "abcdefghij" diff --git a/test/hspec/Main.hs b/test/hspec/Main.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/test/hspec/Main.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}