diff --git a/indexed-list-literals.cabal b/indexed-list-literals.cabal --- a/indexed-list-literals.cabal +++ b/indexed-list-literals.cabal @@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: indexed-list-literals -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Type safe indexed list literals homepage: https://github.com/davidm-d/indexed-list-literals license: BSD3 @@ -67,7 +67,7 @@ test-suite IndexedListLiterals-test type: exitcode-stdio-1.0 main-is: Docs.hs - build-depends: base, indexed-list-literals + build-depends: base, indexed-list-literals, hspec hs-source-dirs: test default-language: Haskell2010 diff --git a/src/Data/IndexedListLiterals.hs b/src/Data/IndexedListLiterals.hs --- a/src/Data/IndexedListLiterals.hs +++ b/src/Data/IndexedListLiterals.hs @@ -1,107 +1,165 @@ {-# Language - DataKinds, - MultiParamTypeClasses, - TypeInType, - ConstraintKinds, - FunctionalDependencies, - FlexibleInstances + DataKinds + , MultiParamTypeClasses + , TypeInType + , ConstraintKinds + , FunctionalDependencies + , FlexibleInstances + , TypeApplications + , RankNTypes + , ScopedTypeVariables #-} module Data.IndexedListLiterals ( IndexedListLiterals(..) , ILL , module Data.Tuple.Only , ZeroTuple(..) + , len + , fromList + , fromListP ) where import GHC.TypeLits import Data.Kind import Data.Tuple.Only --- import Control.Monad +import Data.Proxy +import GHC.Stack +import Control.Monad -- | An alias for IndexedListLiterals type ILL = IndexedListLiterals --- | A type class which allows you to write tuples which can be transformed into a list +-- | the fromList variants take a list and convert it into a tuple +-- it's sort of the inverse of toList +-- fromListP (len @3) [1,2,3] == Just (1,2,3) +-- fromListP (len @3) ["word","up"] == Nothing +-- fromListP (len @1) ['z'] == Just (Only 'z') +fromListP :: forall input (length :: Nat) output len. + (KnownNat length, ILL input length output) + => len length -> [output] -> Maybe input +fromListP _length = fromList + +len :: Proxy a +len = Proxy + +-- | (fromList [1,2,3] :: Maybe (Int, Int, Int)) `shouldBe` Just (1,2,3) +-- (fromList ["word","up"] :: Maybe (String, String, String)) `shouldBe` Nothing +-- (fromList ['z'] :: Maybe (Only Char)) `shouldBe` Just (Only 'z') +fromList :: forall input (length :: Nat) output. + (KnownNat length, ILL input length output) + => [output] -> Maybe input +fromList xs + | length xs == i = Just $ fromList' xs + | otherwise = Nothing + where i = fromIntegral $ natVal (len @length) + +-- | A type class which allows you to write tuples which can be transformed to and from a list -- the length of the list is also provided as a Nat class IndexedListLiterals (input :: Type) (length :: Nat) (output :: Type) | output length -> input, input -> output length where - toList :: input -> [output] + toList :: input -> [output] + -- | a partial fromList with bad error messages + fromList' :: [output] -> input instance IndexedListLiterals (ZeroTuple a) 0 a where toList ZeroTuple = [] + fromList' [] = ZeroTuple instance IndexedListLiterals (Only a) 1 a where toList (Only a) = [a] + fromList' [a] = Only a --- | Intuitively the zero tuple is () or Void but this breaks the Functional Dependency "input -> output length" stopping reliable inference, so this constructor is used to preserve type information +-- | Intuitively the zero tuple is () or Void but this breaks the Functional Dependency +-- "input -> output length" stopping reliable inference, so this constructor is used to preserve type information data ZeroTuple a = ZeroTuple -- all code generated below comes from this function --- generate :: Int -- ^ up to N --- -> String --- generate n = unlines $ join $ map ("":) $ take n $ dropOneTuple res where --- values = map ((:) 'a' . show) [1 :: Int ..] --- types = "a" : types --- withCommas = scanl1 (\a b -> a++","++b) --- className = "IndexedListLiterals" --- template tys vals length = - -- ["instance " ++ className ++ " (" ++ tys ++ ") " ++ show length ++ " " ++ head types ++ " where" --- ," toList (" ++ vals ++ ") = [" ++ vals ++ "]"] --- res = zipWith3 template (withCommas types) (withCommas values) [0 :: Int ..] --- dropOneTuple = tail +generate :: Int -- ^ up to N + -> String +generate n = unlines $ join $ map ("":) $ take n $ dropOneTuple res where + values = map ((:) 'a' . show) [1 :: Int ..] + types = "a" : types + withCommas = scanl1 (\a b -> a++","++b) + className = "IndexedListLiterals" + template tys vals length = + ["instance " ++ className ++ " (" ++ tys ++ ") " ++ show length ++ " " ++ head types ++ " where" + ," toList (" ++ vals ++ ") = [" ++ vals ++ "]" + ," fromList' [" ++ vals ++ "] = (" ++ vals ++ ")" + ] + res = zipWith3 template (withCommas types) (withCommas values) [1 :: Int ..] + dropOneTuple = tail instance IndexedListLiterals (a,a) 2 a where - toList (a1,a2) = [a1,a2] + toList (a1,a2) = [a1,a2] + fromList' [a1,a2] = (a1,a2) instance IndexedListLiterals (a,a,a) 3 a where - toList (a1,a2,a3) = [a1,a2,a3] + toList (a1,a2,a3) = [a1,a2,a3] + fromList' [a1,a2,a3] = (a1,a2,a3) instance IndexedListLiterals (a,a,a,a) 4 a where - toList (a1,a2,a3,a4) = [a1,a2,a3,a4] + toList (a1,a2,a3,a4) = [a1,a2,a3,a4] + fromList' [a1,a2,a3,a4] = (a1,a2,a3,a4) instance IndexedListLiterals (a,a,a,a,a) 5 a where - toList (a1,a2,a3,a4,a5) = [a1,a2,a3,a4,a5] + toList (a1,a2,a3,a4,a5) = [a1,a2,a3,a4,a5] + fromList' [a1,a2,a3,a4,a5] = (a1,a2,a3,a4,a5) instance IndexedListLiterals (a,a,a,a,a,a) 6 a where - toList (a1,a2,a3,a4,a5,a6) = [a1,a2,a3,a4,a5,a6] + toList (a1,a2,a3,a4,a5,a6) = [a1,a2,a3,a4,a5,a6] + fromList' [a1,a2,a3,a4,a5,a6] = (a1,a2,a3,a4,a5,a6) instance IndexedListLiterals (a,a,a,a,a,a,a) 7 a where - toList (a1,a2,a3,a4,a5,a6,a7) = [a1,a2,a3,a4,a5,a6,a7] + toList (a1,a2,a3,a4,a5,a6,a7) = [a1,a2,a3,a4,a5,a6,a7] + fromList' [a1,a2,a3,a4,a5,a6,a7] = (a1,a2,a3,a4,a5,a6,a7) instance IndexedListLiterals (a,a,a,a,a,a,a,a) 8 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8) = [a1,a2,a3,a4,a5,a6,a7,a8] + toList (a1,a2,a3,a4,a5,a6,a7,a8) = [a1,a2,a3,a4,a5,a6,a7,a8] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8] = (a1,a2,a3,a4,a5,a6,a7,a8) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a) 9 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9) = [a1,a2,a3,a4,a5,a6,a7,a8,a9] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9) = [a1,a2,a3,a4,a5,a6,a7,a8,a9] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9] = (a1,a2,a3,a4,a5,a6,a7,a8,a9) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a) 10 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a) 11 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a) 12 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a) 13 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a) 14 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 15 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 16 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 17 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 18 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 19 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19) instance IndexedListLiterals (a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a) 20 a where - toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20] + toList (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) = [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20] + fromList' [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20] = (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) diff --git a/test/Docs.hs b/test/Docs.hs --- a/test/Docs.hs +++ b/test/Docs.hs @@ -3,6 +3,7 @@ import Data.IndexedListLiterals import GHC.TypeLits import Data.Kind +import Test.Hspec data Matrix (x :: Nat) (y :: Nat) (ty :: Type) @@ -40,6 +41,17 @@ -- | just making sure the docs type check main :: IO () -main = do - _ <- return (a,b,c,v,x,y,z) - return () +main = hspec $ do + describe "fromListP" $ + it "should follow it's documentation" $ do + fromListP (len @3) [1,2,3] `shouldBe` Just (1,2,3) + fromListP (len @3) ["word","up"] `shouldBe` Nothing + fromListP (len @1) ['z'] `shouldBe` Just (Only 'z') + + describe "fromList" $ + it "should follow it's documentation" $ do + (fromList [1,2,3] :: Maybe (Int, Int, Int)) `shouldBe` Just (1,2,3) + (fromList ["word","up"] :: Maybe (String, String, String)) `shouldBe` Nothing + (fromList ['z'] :: Maybe (Only Char)) `shouldBe` Just (Only 'z') + +