import System.IO
import System.Environment
import System.IO.Unsafe
import Data.List

import Data.Type.Kind

args = unsafePerformIO getArgs
recurse_depth = max 1 $ read (args !! 0)

main = putStr module_str

module_str = unlines $ header_lines ++ data_lines ++ instance_lines ++ tuple_lines ++ cast_lines ++ ty_con_lines

header_lines = 
	[ "{-# LANGUAGE KindSignatures #-}"
	, "{-# LANGUAGE ScopedTypeVariables #-}"
	, "{-# LANGUAGE FlexibleContexts #-}"
	, "{-# LANGUAGE FlexibleInstances #-}"
	, "{-# LANGUAGE OverlappingInstances #-}"
	, "{-# LANGUAGE TemplateHaskell #-}"
	, "-- | This module was automatically generated to handle 'Kind's with maximum of" ++ show recurse_depth ++ " 'KindUnit's."
	, "module Data.Type.Generated where"
	, "import Data.Type.Framework"
	, "import Data.Type.Kind (Kind(KindArrow,KindUnit))"
	, "import Unsafe.Coerce (unsafeCoerce)"
	, "import Language.Haskell.TH (Name)"
	]

data_lines = concat $ map data_dec kinds

data_dec k =
	[ "-- | An encapsulation of type with a kind @ " ++ kindSignature k ++ " @."
	, "data Type" ++ kindName k ++ " ( x :: " ++ kindSignature k ++ " ) = Type" ++ kindName k
	, "instance TypeClass (Type" ++ kindName k ++ " t) where"
	, "\ttype_ = Type" ++ kindName k
	, "\tkindOf _ = " ++ show k
	] ++
	case to_type k of
		Nothing -> []
		Just ck ->
			[ "instance Typed (Type" ++ kindName ck ++ " Type" ++ kindName k ++ ") where"
			, "\ttypeID _ = makeTypeID \"type\" \"Data.Type.Generated.Type" ++ kindName k ++ "\""
			]

instance_lines = concat $ map instance_dec kinds

instance_dec KindUnit = []
instance_dec f@(KindArrow p r) =
	[ "instance (Typed (Type" ++ kindName f ++ " f), Typed (Type" ++ kindName p ++ " p)) => Typed (Type" ++ kindName r ++ " (f p)) where"
	, "\ttypeID _ = typeID (type_ :: Type" ++ kindName f ++ " f) `applyTypeID` typeID (type_ :: Type" ++ kindName p ++ " p)"
	]

tuple_lines = concat $ map tuple_dec tuple_kinds

tuple_dec k = let tk = succKind k in
	[ "instance Typed (Type" ++ kindName tk ++ " " ++ tuple_name k ++ ") where"
	, "\ttypeID _ = makeTypeID \"base\" $ show '" ++ tuple_name k
	]

cast_lines =
	[ "cast :: forall f t. (Typed (Type f), Typed (Type t)) => f -> Maybe t"
	, "cast x ="
	, "\tif typeID (Type :: Type f) == typeID (Type :: Type t)"
	, "\t\tthen Just $ unsafeCoerce x"
	, "\t\telse Nothing"
	]

ty_con_lines :: [String]
ty_con_lines
	=  [ "-- | Given a 'Kind' return the template haskell 'Name' for the appropriate type encapsulator."
	   , "typeConstructorName :: Kind -> Name"
	   ]
	++ concat (map ty_con_dec kinds)
	++ ["typeConstructorName _ = error \"Type constructor recurse depth exceeded. (Recompile the module type with a higher recurse depth.)\""]

ty_con_dec k =
	[ "typeConstructorName (" ++ show k ++ ") = ''Type" ++ kindName k
	]

to_type :: Kind -> Maybe Kind
to_type k = if d k == recurse_depth then Nothing else Just (KindArrow k KindUnit)
	where
	d (KindArrow p r) = d p + d r
	d KindUnit        = 1

tuple_name k = '(' : f k
	where
	f (KindArrow _ r) = ',' : f r
	f KindUnit        = ")"

tuple_kinds :: [Kind]
tuple_kinds = map f [2..recurse_depth-1]
	where
	f 1 = KindUnit
	f n = KindArrow KindUnit $ f (n-1)

kinds :: [Kind]
kinds = generateKinds recurse_depth