{-# Language
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 Data.Proxy
import GHC.Stack
import Control.Monad
-- | An alias for IndexedListLiterals
type ILL = IndexedListLiterals
-- | 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)
-- > Just (1,2,3)
--
-- >> fromList ["word","up"] :: Maybe (String, String, String)
-- > Nothing
--
-- >> fromList ['z'] :: Maybe (Only Char)
-- > 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 (Only 1)
-- > [1]
--
-- >> toList (1,2,3)
-- > [1,2,3]
--
-- >> toList ZeroTuple
-- > []
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
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 ++ "]"
," 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]
fromList' [a1,a2] = (a1,a2)
instance IndexedListLiterals (a,a,a) 3 a where
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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)