```
-- | Algorithms and operations on type kinds.
module Data.Type.Kind
( Kind(..)
, succKind
, recurseKind
, parameters
, kindVariables
, kindSignature
, kindName
, generateKinds
) where

import Data.Word

-- | Type kind representation.
data Kind
= KindUnit
| KindArrow Kind Kind
deriving (Eq,Ord,Show)

-- | Adds @ -> * @ to the end of a kind.
--
-- >             * ==> * -> *
-- >        * -> * ==> * -> * -> *
-- > (* -> *) -> * ==> (* -> *) -> * -> *
succKind :: Kind -> Kind
succKind (KindArrow p r) = KindArrow p \$ succKind r
succKind KindUnit        = KindArrow KindUnit KindUnit

-- | Transforms from @k@ to @ k -> * @.
--
-- >             * ==> * -> *
-- >        * -> * ==> (* -> *) -> *
-- > (* -> *) -> * ==> ((* -> *) -> *) -> *
recurseKind :: Kind -> Kind
recurseKind k = KindArrow k KindUnit

-- | Extract kinds of a kinds parameters.
parameters :: Kind -> [Kind]
parameters (KindArrow p r) = p : parameters r
parameters KindUnit = []

-- | Show kinds parameters with kind signatures.
kindVariables
:: String -- ^ The base string to add in front of a position number.
-> Kind   -- ^ The kind being shown.
-> String
kindVariables t k = kv (0::Word) k
where
kv c KindUnit               = []
kv c (KindArrow KindUnit p) = ' ' : t ++ show c ++ kv (succ c) p
kv c (KindArrow f p)        = " ( " ++ t ++ show c ++ " :: " ++ kindSignature f ++ " )" ++ kv (succ c) p

-- | Get a kind signature from a 'Kind'.
kindSignature :: Kind -> String
kindSignature KindUnit               = "*"
kindSignature (KindArrow KindUnit p) = "* -> " ++ kindSignature p
kindSignature (KindArrow f p)        = "( " ++ kindSignature f ++ " ) -> " ++ kindSignature p

-- | Get the bastard string representation of a 'Kind'.
kindName :: Kind -> String
kindName KindUnit               = ""
kindName (KindArrow KindUnit p) = 'X' : kindName p
kindName (KindArrow f p)        =
let
h KindUnit               = "X"
h (KindArrow KindUnit p) = 'X' : h p
h (KindArrow f p)        = 'B' : h f ++ 'E' : h p
in 'B' : h f ++ 'E' : kindName p

-- | Read the bastard string representation to 'Kind'.
readKindName :: String -> Kind
readKindName ""       = KindUnit
readKindName ('X':xs) = KindArrow KindUnit \$ readKindName xs
let
h ('X':'E':xs) = (xs, KindUnit)
h ('X':xs)     = let (rs,p) = h xs in (rs, KindArrow KindUnit p)
h _            = error "Illegal kind name."
in
let (rs,p) = h xs
in KindArrow p \$ readKindName rs

-- | Generates all possible 'Kind's given the maximum 'KindUnit's allowed.
--
-- > 1:1 1
-- > *
-- >
-- > 2:1 2
-- > *->*
-- >
-- > 3:2 4
-- > *->*->*
-- > (*->*)->*
-- >
-- > 4:5 9
-- > *->*->*->*
-- > (*->*)->*->*
-- > *->(*->*)->*
-- > (*->*->*)->*
-- > ((*->*)->*)->*
-- >
-- > 5:14 23
-- > *->*->*->*->*
-- > (*->*)->(*->*)->*
-- > (*->*)->*->*->*
-- > *->(*->*)->*->*
-- > *->*->(*->*)->*
-- > (*->*->*)->*->*
-- > ((*->*)->*)->*->*
-- > *->(*->*->*)->*
-- > *->((*->*)->*)->*
-- > (*->*->*->*)->*
-- > ((*->*)->*->*)->*
-- > (*->(*->*)->*)->*
-- > ((*->*->*)->*)->*
-- > (((*->*)->*)->*)->*
--
-- The series continues: 1,1,2,5,14,42,132,429,1430,4862,...
generateKinds
:: Int    -- ^the maximum 'KindUnits' allowed.
-> [Kind]
generateKinds ml = concat \$ map kinds_g [1..ml]
where
kinds_g l = concat \$ map (kinds_h l) [1..max 1 (l-1)]
kinds_h 1 1 = [KindUnit]
kinds_h l 1 = map (KindArrow KindUnit) \$ kinds_h (l-1) 1
kinds_h l g =
let p = [ KindArrow f p | f <- kinds_g g, p <- kinds_g (l-g) ] in
if g /= l-1 then p ++ map (KindArrow KindUnit) (kinds_h (l-1) g) else p

```